Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Bitmaps: Breite und Höhe von Grafiken auslesen (*.gif,*.bmp,*.pcx,*.tga,*.wmf,*.png,*.ico,*.emf,*.jpg)
PRFellow-Vorlage (08/2000)
Autoren:
Dieser Quelltext ist eine Gemeinschaftsarbeit von:
Thomas Hölzer, Andreas Miethe, Hans-Jürgen Trog - Alle Rechte vorbehalten
Breite und Höhe aus Datei lesen für Grafiken folgender Formate:
GIF, PCX, WMF, EMF, BMP, JPG, PNG, TGA, ICO
Der Quelltext und das hier dargelegte Verfahren sind FREEWARE unter der
Bedingung, dass bei Verwendung die Autoren erwähnt werden!
aktualisiert am 15.09.00
Declare size#
PROC GetGIFDimension
Parameters file$
DIM size#,4
FileMode 0
Assign #1,file$
OpenRW #1
Seek #1,6
BlockRead(#1,size#,0,4)
CloseRW #1
PRINT file$;:
PRINT Breite:,@Word(size#,0),Höhe:,@Word(size#,2)
PRINT
FileMode 2
DISPOSE size#
EndProc
PROC GetBMPDimension
Parameters file$
DIM size#,8
FileMode 0
Assign #1,file$
OpenRW #1
Seek #1,18
BlockRead(#1,size#,0,8)
CloseRW #1
PRINT file$;:
PRINT Breite:,@Word(size#,0),Höhe:,@Word(size#,4)
PRINT
FileMode 2
DISPOSE size#
EndProc
PROC GetPCXDimension
Parameters file$
DIM size#,4
FileMode 0
Assign #1,file$
OpenRW #1
Seek #1,8
BlockRead(#1,size#,0,4)
CloseRW #1
PRINT file$;:
PRINT Breite:,Add(@Word(size#,0),1),Höhe:,Add(@Word(size#,2),1)
PRINT
FileMode 2
DISPOSE size#
EndProc
PROC GetTGADimension
Parameters file$
DIM size#,4
FileMode 0
Assign #1,file$
OpenRW #1
Seek #1,12
BlockRead(#1,size#,0,4)
CloseRW #1
PRINT file$;:
PRINT Breite:,@Word(size#,0),Höhe:,@Word(size#,2)
PRINT
FileMode 2
DISPOSE size#
EndProc
PROC GetWMFDimension
Parameters file$
DIM size#,8
FileMode 0
Assign #1,file$
OpenRW #1
Seek #1,10
BlockRead(#1,size#,0,4)
CloseRW #1
FileMode 2
es kann vorkommen, dass die Größenangaben an anderer Stelle stehen!
if @Or(@equ(@Word(size#,0),0),@equ(@Word(size#,2),0))
FileMode 0
Assign #1,file$
OpenRW #1
Seek #1,16
BlockRead(#1,size#,0,8)
CloseRW #1
FileMode 2
PRINT file$;:
PRINT Breite:,@Word(size#,0),Höhe:,@Word(size#,4)
PRINT
else
PRINT file$;:
PRINT Breite:,@Word(size#,0),Höhe:,@Word(size#,2)
PRINT
endif
DISPOSE size#
EndProc
PROC GetPNGDimension
Parameters file$
DIM size#,4
FileMode 0
Assign #1,file$
OpenRW #1
Seek #1,18
BlockRead(#1,size#,1,1)
Seek #1,19
BlockRead(#1,size#,0,1)
Seek #1,22
BlockRead(#1,size#,3,1)
Seek #1,23
BlockRead(#1,size#,2,1)
CloseRW #1
PRINT file$;:
PRINT Breite:,@Word(size#,0),Höhe:,@Word(size#,2)
PRINT
FileMode 2
DISPOSE size#
EndProc
PROC GetIconDimension
Declare Icons&,x%
Parameters file$
DIM Size#,16
FileMode 0
LET x% = 0
Assign #1,file$
OpenRW #1
Seek #1,4
wieviele Icons sind im File ?
BlockRead(#1,Size#,0,2)
PRINT file$;:,
PRINT Icons gesamt,@Word(Size#,0)
Print
LET Icons& = @Word(Size#,0)
WHILENOT equ(x%,Icons&)
zum Einstiegspunkt der einzelnen Icons
Seek #1,add(6,(mul(x%,16)))
BlockRead(#1,Size#,0,16)
PRINT Icon:,str$(add(x%,1)), - ,
PRINT Breite,@Byte(size#,0),Pixel, - ,
PRINT Höhe,@Byte(size#,1),Pixel, - ,
PRINT Farben,@Byte(size#,2) 0 wenn >= 8-BitPerPixel
PRINT BitPerPixel,@Word(size#,6), - ,
Print
let x%=x%+1
EndWhile
CloseRW #1
FileMode 2
DISPOSE Size#
EndProc
PROC GetEMFDimension
Parameters file$
DIM size#,8
FileMode 0
Assign #1,file$
OpenRW #1
Seek #1,16
BlockRead(#1,size#,0,8)
CloseRW #1
PRINT file$;:
PRINT Breite,@Word(size#,0),Höhe,@Word(size#,4)
PRINT
FileMode 2
DISPOSE size#
EndProc
*********************************************
ab hier Groesse von JPG-Files ermitteln
###############################
Declare breite%,höhe%,size1#
PROC GetJPGDimensions
Parameters File$
PROC GetJPGDimension
Groessenangaben auslesen
########################
Declare Back$
Parameters file$,Match%
DIM size1#,4
FileMode 0
Assign #1,file$
OpenRW #1
Seek #1,Match%
BlockRead(#1,size1#,1,1)
Seek #1,Match%+1
BlockRead(#1,size1#,0,1)
Seek #1,Match%+2
BlockRead(#1,size1#,3,1)
Seek #1,Match%+3
BlockRead(#1,size1#,2,1)
CloseRW #1
LET Back$ = add$(str$(@Word(size1#,2))
,ADD$(,,str$(@Word(size1#,0))))
DISPOSE size1#
FileMode 2
RETURN back$
EndProc
PROC GetJPGMatch
Segmentmarker fuer Start of Frame-Marker suchen
5 Bytes danach kann man die Grossenangaben auslesen.
Start of Frama-Marker ist immer $FFC0 oder $FFC2.
###################################################
DEF MakeWord(2) Or(%(1),Mul(%(2),$100))
Declare x%,fs%,y%,back$
Parameters file$,x%
FileMode 0
Assign #1,file$
OpenRW #1
let fs% = @GetFileSize(#1)
DIM size#,fs%
BlockRead(#1,size#,0,fs%)
CloseRW #1
WHILENOT equ(x%,fs%)
IF or(equ(MakeWord(Byte(size#,x%+1),
Byte(size#,x%)),65472),
equ(MakeWord(Byte(size#,x%+1),
Byte(size#,x%)),65474))
LET y%=x%+5 5 bytes dazu
GetJPGDimension File$,y% Groessenangaben lesen
LET back$=@$(0)
LET x%=fs%-1
endif
let x%=x%+1
EndWhile
DISPOSE size#
let breite%=val(Substr$(@$(0),1,,))
let höhe%=val(Substr$(@$(0),2,,))
PRINT file$;:
PRINT Breite:,breite%,Höhe:,höhe%
PRINT
FileMode 2
RETURN back$
EndProc
PROC GetJPGDIM
Segment-Laenge des 1. Segmentes suchen
und ueberspringen.
#######################################
DEF MakeWord(2) Or(%(1),Mul(%(2),$100))
Declare aaa%,back$
Parameters file$
FileMode 0
Assign #1,file$
OpenRW #1
DIM size#,65535 Maximale Segmentgroesse
BlockRead(#1,size#,0,65535)
CloseRW #1
Segmentlaenge 2 Byte + 4 = Segmentende
LET aaa% = add(Makeword(Byte(size#,5),Byte(size#,4)),4)
DISPOSE size#
FileMode 2
GetJPGMatch file$,aaa% Position ab Segmentende suchen
LET back$=@$(0)
RETURN back$
endproc
GetJPGDIM File$
EndProc
Ende des JPG-Abschnittes
********************************************
declare file$, wählen%, ende%, weg%
PROC BILDLADEN
let file$=@LoadFile$(Verzeichnis wählen, auf eine Datei klicken, auf Öffnen klicken,
alle Bilder|*.BMP;*.JPG;*.PCX;*.TGA;*.GIF;*.WMF;*.EMF;*.ICO;*.PNG)
ENDPROC
Hauptprogramm
Def IsFileExt(2) Equ$(Right$(Upper$($(1)),3),$(2))
Decimals 0
Window 0,0-600,300
Cls
let wählen%=@createbutton(%hwnd,Bild wählen,350,190,170,24)
let weg%=@createbutton(%hwnd,Ende,350,220,170,24)
let ende% = 0
WHILENOT ende%
waitinput
IF @getfocus(weg%)
let ende% = 1
ELSEIF @getfocus(wählen%)
cls
BILDLADEN
IF @neq$(file$,)
If IsFileExt(file$,BMP)
GetBMPDimension file$
ELSEIf IsFileExt(file$,GIF)
GetGIFDimension file$
ELSEIf IsFileExt(file$,PCX)
GetPCXDimension file$
ELSEIf IsFileExt(file$,TGA)
GetTGADimension file$
ELSEIf IsFileExt(file$,WMF)
GetWMFDimension file$
ELSEIf IsFileExt(file$,EMF)
GetEMFDimension file$
ELSEIf IsFileExt(file$,JPG)
GetJPGDim file$
ELSEIf IsFileExt(file$,PNG)
GetPNGDimension file$
ELSEIf IsFileExt(file$,ICO)
GetICODimension<le$
endif
endif
endif
wend
end
(965)
Deutsch
English
Français
Español
Italia