XProfan

'Code zur Ermittlung qui Maße de Bilddateien, sans cet trop magasin.
'bisher volonté folgende Formate automatisch erkannt et qui Maße ausgelesen:
'.bmp, .jpg, .gif, .png, .ico
'qui Ausgaben pour cela .ico-Format volonté encore erweitert.
'Aussi soll qui Farbtiefe pour Bilder encore ausgelesen volonté
'weitere folgen.
'qui Code beruht sur einer Présentation de
'Thomas Bois, Andreas Miethe, Hans-Jürgen Trog aus dem l'an 2000
'$H StringsPfade.ph
'~StrFormat
'~HexFormatX

Proc MakeWord'avec optionalem paramètre. si qui gesetzt ist, volonté qui Bytes vertauscht, cela fait es einfacher Bytes aus einem Bereich (GetByte) umzuwandeln.

    Si %pcount = 3

        Paramètres lbyte%, hbyte%'modus%
        Retour (hbyte% & $FF) | ((lbyte% & $FF) << 8)

    D'autre

        Paramètres lbyte%, hbyte%
        Retour (lbyte% & $FF) | ((hbyte% & $FF) << 8)

    EndIf

ENDPROC

Class BitmapInfo = nom$(256),x&,y&,Anzahl%,Typ$(3),BitmapInfo@
Class IconInfo = x%,y%,col&,bpp&,IconInfo@'bpp% = Bits per Pixel

Proc IconInfo.IconInfo

    Paramètres x%,y%,col&,bpp&
    .x% = x%
    .y% = y%
    .col& = col&
    .bpp& = bpp&

ENDPROC

Proc BitmapInfo.BitmapInfo

    Paramètres File$
    Déclarer b#,En-tête#
    Faible En-tête#,45
    Déclarer Pos%
    .nom$ = File$
    BlockRead(File$,En-tête#,0,45)

    Si Right$(Upper$(File$),4) = ".ICO"

        .Typ$ = "ico"
        .Anzahl% = Word(En-tête#,4)

        Si .Anzahl% > 0

            Déclarer Icon#[.Anzahl%]

            WhileLoop 0, .Anzahl% - 1',16

                Seek i%,6 + &Boucle * 16
                Icon#[&Boucle] = New(IconInfo,GetByte(i%),GetByte(i%),GetByte(i%),GetWord(i%))

            Wend

        EndIf

    ElseIf Char$(En-tête#,0,3) = "ÿØÿ"'ce sont comme Hexwerte: FFD8FF + E0 ou bien E1

        Select Char$(En-tête#,3,1)'viertes marque chercher

            CaseOf "\xE0","\xE1"' "Ã","Ã	","â","ã","ä","Ã¥","æ","ç","è","é","ê","ë","ì","í","î","ï" bisher sommes mir seulement qui beiden ersten Opportunités untergekommen

            .Typ$ = "jpg"
            Faible b#,10000
            Claire b#
            BlockRead(File$,b#,0,10000)

            WhileLoop 0, 15

                'cherche pour FFC0 - derrière elle stehen qui Maße
                'aussi ici peut peut-être weitere Werte stehen. Möglich sommes wohl FF + C0 jusqu'à CF.
                'tout autor qui Ermittlung dans einer Boucle
                Pos% = MemPos(b#,0,Chr$($FF) + Chr$($C0 + &Boucle) + Chr$($00) + Chr$($11))
                Cas Pos% > -1: Pause

            Wend

            Inc Pos%,5
            .y& = MakeWord(Byte(b#,Pos%),Byte(b#,Pos% + 1),1)
            .x& = MakeWord(Byte(b#,Pos% + 2),Byte(b#,Pos% + 3),1)
            DisPose b#

        EndSelect

    ElseIf Char$(En-tête#,0,2) = "BM"

        .Typ$ = "bmp"
        .x& = Long(En-tête#,18)
        .y& = Long(En-tête#,22)

    ElseIf Char$(En-tête#,0,3) = "GIF"

        .Typ$ = "gif"
        .x& = Word(En-tête#,6)
        .y& = Word(En-tête#,8)

    ElseIf String$(En-tête#,3) = "EMF"

        .Typ$ = "emf"

    ElseIf Char$(En-tête#,0,4) = Chr$($89) + "PNG"

        .Typ$ = "png"
        .x& = MakeWord(Byte(En-tête#,18),Byte(En-tête#,19),1)
        .y& = MakeWord(Byte(En-tête#,22),Byte(En-tête#,23),1)

    ElseIf Char$(En-tête#,0,4) = Chr$($D7) + Chr$($CD) + chr$($C6) + Chr$($9A)

        .Typ$ = "wmf"

    EndIf

    Si non .Typ$ = "ico"

        .Anzahl% = .x& And .y&

    EndIf

ENDPROC

Proc Test

    Paramètres Bild$
    Déclarer Bild#
    Cas Bild$ = »:Bild$ = "Africa_satellite_plane.jpg"

    Si FileExists(Bild$)

        Bild# = New(BitmapInfo,Bild$)

        With Bild#

            Imprimer "Bildname   = ",.nom$
            Imprimer "Bildtyp    = ",.Typ$
            Imprimer "BildBreite = ",.x&
            Imprimer "BildHöhe   = ",.y&
            Imprimer "Bildanzahl = ",.Anzahl%

        EndWith

        Dispose Bild#

    D'autre

        Imprimer "Fehler",Bild$

    EndIf

    WaitInput

ENDPROC

Test()

CHR_CODE.asm(74) : Error A2121: Symbol not defined : __CF0