XProfan

'Code a Ermittlung el Maße de Bilddateien, sin esta a invitar.
'bisher voluntad folgende Formate automáticamente erkannt y el Maße ausgelesen:
'.bmp, .jpg, .gif, .png, .ico
'El Ausgaben para el .ico-Formato voluntad todavía erweitert.
'Außerdem se el Farbtiefe para Bilder todavía ausgelesen voluntad
'weitere folgen.
'el Code beruht en uno Presentación de
'Thomas Hölzer, Andreas Miethe, Hans-Jürgen Trog de el Jahr 2000
'$H StringsPfade.ph
'~StrFormat
'~HexFormatX

Proc MakeWord'con optionalem Parámetro. Wenn el gesetzt es, voluntad el Bytes vertauscht, el macht lo einfacher Bytes de una Zona (GetByte) umzuwandeln.

    If %pcount = 3

        Parámetros lbyte%, hbyte%'modus%
        Volver (hbyte% & $FF) | ((lbyte% & $FF) << 8)

    Más

        Parámetros lbyte%, hbyte%
        Volver (lbyte% & $FF) | ((hbyte% & $FF) << 8)

    EndIf

ENDPROC

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

Proc IconInfo.IconInfo

    Parámetros x%,y%,col&,bpp&
    .x% = x%
    .y% = y%
    .col& = col&
    .bpp& = bpp&

ENDPROC

Proc BitmapInfo.BitmapInfo

    Parámetros File$
    Declarar b#,Encabezamiento#
    Dim Encabezamiento#,45
    Declarar Pos%
    .Name$ = File$
    BlockRead(File$,Encabezamiento#,0,45)

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

        .Typ$ = "ico"
        .Anzahl% = Word(Encabezamiento#,4)

        If .Anzahl% > 0

            Declarar Icon#[.Anzahl%]

            WhileLoop 0, .Anzahl% - 1',16

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

            Wend

        EndIf

    ElseIf Char$(Encabezamiento#,0,3) = "ÿØÿ"'el son como Hexwerte: FFD8FF + E0 oder E1

        Select Char$(Encabezamiento#,3,1)'viertes Signo suchen

            CaseOf "\xE0","\xE1"' "Ã","Ã	","â","ã","ä","Ã¥","æ","ç","è","é","ê","ë","ì","í","î","ï" bisher son me sólo el beiden ersten Möglichkeiten untergekommen

            .Typ$ = "jpg"
            Dim b#,10000
            Claro b#
            BlockRead(File$,b#,0,10000)

            WhileLoop 0, 15

                'Búsqueda después de FFC0 - detrás de él posición el Maße
                'auch hier puede evtl weitere Werte posición. Möglich son wohl FF + C0 a CF.
                'por lo tanto la Ermittlung en uno Bucle
                Pos% = MemPos(b#,0,Chr$($FF) + Chr$($C0 + &Loop) + Chr$($00) + Chr$($11))
                Case Pos% > -1: Romper

            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$(Encabezamiento#,0,2) = "BM"

        .Typ$ = "bmp"
        .x& = Largo(Encabezamiento#,18)
        .y& = Largo(Encabezamiento#,22)

    ElseIf Char$(Encabezamiento#,0,3) = "GIF"

        .Typ$ = "gif"
        .x& = Word(Encabezamiento#,6)
        .y& = Word(Encabezamiento#,8)

    ElseIf String$(Encabezamiento#,3) = "EMF"

        .Typ$ = "emf"

    ElseIf Char$(Encabezamiento#,0,4) = Chr$($89) + "PNG"

        .Typ$ = "png"
        .x& = MakeWord(Byte(Encabezamiento#,18),Byte(Encabezamiento#,19),1)
        .y& = MakeWord(Byte(Encabezamiento#,22),Byte(Encabezamiento#,23),1)

    ElseIf Char$(Encabezamiento#,0,4) = Chr$($D7) + Chr$($CD) + chr$($C6) + Chr$($9A)

        .Typ$ = "wmf"

    EndIf

    Caso negativo .Typ$ = "ico"

        .Anzahl% = .x& And .y&

    EndIf

ENDPROC

Proc Test

    Parámetros Bild$
    Declarar Bild#
    Case Bild$ = "":Bild$ = "Africa_satellite_plane.jpg"

    If FileExists(Bild$)

        Bild# = New(BitmapInfo,Bild$)

        With Bild#

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

        EndWith

        Disponer Bild#

    Más

        Imprimir "Fehler",Bild$

    EndIf

    WaitInput

ENDPROC

Test()

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