XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Bildbetrachter
Lauffähig ab Profan-Version 5.0
###################################
Andreas Miethe * November 1998
###################################
BITMAPS (BMP),(RLE),(DIB)
ICONS   (ICO)
CURSOR  (CUR),(ANI)
einlesen und einem Control zuweisen
###################################
Definitionen
############
DEF @ALoadImage(6) ! USER32,LoadImageA
Loadimage :
Parameter : %Hinstance,Name$,Art,X,Y,Flags
HInstance = das aufrufende Programm
Name$     = Name des Bildes, Cursors, Icons
Art       = BITMAP(0) ICON(1) CURSOR(2) METAFILE(3)
X         = Groesse X-Achse
Y         = Groesse Y-Achse
Flags:
LR_DEFAULTCOLOR     0x0000
LR_MONOCHROME       0x0001
LR_COLOR            0x0002
LR_COPYRETURNORG    0x0004
LR_COPYDELETEORG    0x0008
LR_LOADFROMFILE     0x0010
LR_LOADTRANSPARENT  0x0020
LR_DEFAULTSIZE      0x0040
LR_VGACOLOR         0x0080
LR_LOADMAP3DCOLORS  0x1000
LR_CREATEDIBSECTION 0x2000
LR_COPYFROMRESOURCE 0x4000
LR_SHARED           0x8000
Deklarationen
#############
Declare Bild&,Art%,Bild#,Ende%
Declare x%
Let x%=0
Declare ImageControl&[9],Window2&[9]  das reicht fuer 10 Bilder, kann natuerlich auch variabel hochgesetzt
Declare Image$,ver!
Declare AnzahlBilder%
Let AnzahlBilder% = -1
Hauptfenster aufbauen
#####################
SettrueColor 1
WindowTitle Bildbetrachter für Bitmaps, Icons, Cursor, animierte Cursor ...
Window Add(%Maxx,1),0 - %Maxx,%Maxy
Cls @RGB(192,192,192)
UseFont Arial,15,0,0,0,0
SetDialogFont 1
UseIcon A
########################################################
Menue aufbauen
Voreinstellungen :
Bildinformationen werden nach laden des Bildes aktiviert
########################################################
PopUp Programm
AppendMenu 100,Bild Laden
Separator
AppendMenu 102,Ende
PopUp Bilder
Das Hauptfenster auf den Bildschirm
###################################
SetWindowPos %Hwnd = 0,0 - %Maxx,%Maxy

Proc Bildladen

    Declare Maxb!,Maxh!,xx!,ver1!
    Let xx! = 1
    Let Maxb! = 0
    Let Maxh! = 0
    Let Image$ = @LoadFile$(Bild Laden...,Bitmaps|*.BMP;*.RLE;*.DIB;|Icon|*.ICO|Cursor|*.CUR;*.ANI)

    If GT$(Image$,)

        Dim Bild#,Len(Image$) + 1
        Imageart bestimmen
        ##################
        Case Equ$(Upper$(Right$(Image$,3)),Upper$(BMP)):Let Art% = 0
        Case Equ$(Upper$(Right$(Image$,3)),Upper$(RLE)):Let Art% = 0
        Case Equ$(Upper$(Right$(Image$,3)),Upper$(DIB)):Let Art% = 0
        Case Equ$(Upper$(Right$(Image$,3)),Upper$(ICO)):Let Art% = 1
        Case Equ$(Upper$(Right$(Image$,3)),Upper$(CUR)):Let Art% = 2
        Case Equ$(Upper$(Right$(Image$,3)),Upper$(ANI)):Let Art% = 2
        Image der Variablen zuweisen
        ############################

        If equ(Art%,0)

            Mloadbmp Image$
            Let maxh!=%bmpy
            Let maxb!=%bmpx
            let ver!=div(%bmpy,%bmpx)  Verhaeltnis X_Y - Achse
            Das Bitmap koennte groesser als der Bildschirm sein, daher
            X und Y-Achsen an Bildschirmgroesse anpassen
            ##########################################################

            whilenot and(lt(maxh!,sub(%Maxy,180)),lt(maxb!,sub(%Maxx,10)))

                Let maxh!=sub(maxh!,xx!)
                Let maxb!=sub(Maxb!,div(xx!,ver!))
                Let xx!=add (xx!,1)

            wend

            String Bild#,0 = Image$
            Let Bild& = @ALoadImage(%HInstance,Bild#,Art%,Maxb!,Maxh!,$0050)

        ElseIf neq(Art%,0)

            String Bild#,0 = Image$
            Let Bild& = @ALoadImage(%HInstance,Bild#,Art%,0,0,$0050)

        endif

        Dispose Bild#

    EndProc

    Proc Bildzeigen

        Inc AnzahlBilder%  Zaehler um eins hochsetzen
        AppendMenu add(200,anzahlbilder%),Image$  Menuepunkt hinzufuegen
        Declare Breite%,Button%,Ende1%
        Declare BildInfo%,Bildname$,Bildbreite%,Bildhoehe%,Bildart%
        Let Window2&[AnzahlBilder%] = @CreateWindow(%Hwnd,image$,0,0,0,0)
        ImageControl nach Art erstellen
        ###############################
        Case Equ(art%,0):Let ImageControl&[AnzahlBilder%] = @Control(Static,,$5000100E,0,0,0,0,Window2&[AnzahlBilder%],1001,%Hinstance)
        Case Gt(art%,0):Let ImageControl&[AnzahlBilder%] = @Control(Static,,$50001003,0,0,0,0,Window2&[AnzahlBilder%],1001,%Hinstance)
        Image dem Control zuweisen
        ##########################
        Sendmessage(ImageControl&[AnzahlBilder%],$0172,Art%,Bild&)
        Case Lt(Width(ImageControl&[AnzahlBilder%]),500):Let Breite%=500 Mindestbreite des Fensters
        Case Gt(Width(ImageControl&[AnzahlBilder%]),500):Let Breite%=Width(ImageControl&[AnzahlBilder%])
        SetWindowPos Window2&[AnzahlBilder%] = 4,40 - Breite%,add(Height(ImageControl&[AnzahlBilder%]),148)
        @CreateText(Window2&[AnzahlBilder%],Bildinformationen,10,add(Height(ImageControl&[AnzahlBilder%]),20),300,24)
        @CreateText(Window2&[AnzahlBilder%],add$(Bildname : ,Image$),10,add(Height(ImageControl&[AnzahlBilder%]),40),400,24)

        If equ(art%,0)

            @CreateText(Window2&[AnzahlBilder%],add$(add$(Bildbreite : ,str$(%bmpx)), Pixel),10,add(Height(ImageControl&[AnzahlBilder%]),60),300,24)
            @CreateText(Window2&[AnzahlBilder%],add$(add$(Bildhöhe : ,str$(%bmpy)), Pixel),10,add(Height(ImageControl&[AnzahlBilder%]),80),300,24)

        elseif neq(art%,0)

            @CreateText(Window2&[AnzahlBilder%],add$(add$(Bildbreite : ,str$(Width(ImageControl&[AnzahlBilder%]))), Pixel),10,add(Height(ImageControl&[AnzahlBilder%]),60),300,24)
            @CreateText(Window2&[AnzahlBilder%],add$(add$(Bildhöhe : ,str$(Height(ImageControl&[AnzahlBilder%]))), Pixel),10,add(Height(ImageControl&[AnzahlBilder%]),80),300,24)

        endif

        Case Equ(Art%,0):@CreateText(Window2&[AnzahlBilder%],Bildart : BITMAP,10,add(Height(ImageControl&[AnzahlBilder%]),100),300,24)
        Case Equ(Art%,1):@CreateText(Window2&[AnzahlBilder%],Bildart : ICON,10,add(Height(ImageControl&[AnzahlBilder%]),100),300,24)
        Case Equ(Art%,2):@CreateText(Window2&[AnzahlBilder%],Bildart : CURSOR,10,add(Height(ImageControl&[AnzahlBilder%]),100),300,24)

    EndProc

    Hauptprogramm
    #############
    Let Ende% = 0

    Whilenot Ende%

        Waitinput
        Let x%=0

        whilenot equ(x%,add(AnzahlBilder%,1))

            if and(equ(getactivewindow(),Window2&[x%]),equ(%message,160))

                destroywindow(Window2&[x%])

            endif

            Inc x%

        wend

        If MenuItem(102)

            Let Ende% = 1

        ElseIf MenuItem(100)

            if lt(anzahlbilder%,9)

                Bildladen
                Bildzeigen

            else

                Messagebox(Grenze erreicht,Meldung,0)

            endif

        ElseIf MenuItem(200)

            Destroywindow(Window2&[0])
            RemoveMenu 200
            Dec anzahlbilder%

        ElseIf MenuItem(201)

            Destroywindow(Window2&[1])
            Dec anzahlbilder%
            RemoveMenu 201

        ElseIf MenuItem(202)

            Destroywindow(Window2&[2])
            Dec anzahlbilder%
            RemoveMenu 202

        ElseIf MenuItem(203)

            Destroywindow(Window2&[3])
            Dec anzahlbilder%
            RemoveMenu 203

        ElseIf MenuItem(204)

            Destroywindow(Window2&[4])
            Dec anzahlbilder%
            RemoveMenu 204

        ElseIf MenuItem(205)

            Destroywindow(Window2&[5])
            Dec anzahlbilder%
            RemoveMenu 205

        ElseIf MenuItem(206)

            Destroywindow(Window2&[6])
            Dec anzahlbilder%
            RemoveMenu 206

        ElseIf MenuItem(207)

            Destroywindow(Window2&[7])
            Dec anzahlbilder%
            RemoveMenu 207

        ElseIf MenuItem(208)

            Destroywindow(Window2&[8])
            Dec anzahlbilder%
            RemoveMenu 208

        ElseIf MenuItem(209)

            Destroywindow(Window2&[9])
            Dec anzahlbilder%
            RemoveMenu 209

        EndIf

    EndWhile

    End