XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Button: Bitmaps und Icons auf Buttons erstellen
Lauffähig ab Profan-Version 5.0
##############################################################
#        BITMAPS und ICONS Button-Controls zuweisen          #
#                   für Profan 6.0 32-Bit                    #
##############################################################
#       Andreas Miethe * Bielefeld * September 1998          #
##############################################################
#   Ein Demo, das zeigen soll, was alles mit Button-Controls #
#            und Bitmaps bzw. Icons möglich ist.             #
##############################################################
#        Dieser Quellcode ist frei für alle Profaner         #
##############################################################
DEF @ALoadIcon(2) !USER32,LoadIconA
DEF @AExtractIcon(3) !SHELL32,ExtractIconA
DEF @ALoadImage(6) ! USER32,LoadImageA
Def @ASleep(1) !Kernel32,Sleep
Declare I%,Ende%
Declare BB1&,BB2&,BB3&,BB4&,BB5&,BB6&,BB7&,OB1&,OB2&,OB3&
Declare TB&
Declare ST#,Datei#,InstIcon&,DllIcon&,ExtIcon&,ExtBMP&,SCIcon&

Proc Lade_Icon

    Ein Icon aus der eigenen Instanz
    ################################
    Parameters Name$
    Dim ST#,30
    String st#,0 = Name$
    Let InstIcon& = @ALoadIcon(%hinstance,st#) Icon A aus HINSTANCE
    Dispose st#

Endproc

Proc Lade_UserIcon

    Ein Icon aus einer DLL
    ######################
    Parameters Name$,Nr%
    Dim ST#,30
    String ST#,0 = Name$
    Let DllIcon& = AExtractIcon(%Hinstance,ST#,Nr%)  Ausgang aus USER.EXE
    Dispose ST#

Endproc

Proc Lade_ExtIcon

    Ein Icon aus einer DLL
    ######################
    Parameters Name$
    Loadimage :
    Parameter : %Hinstance,Name$,Art,X,Y,Flags
    HInstance = das aufrufende Programm
    Name$     = der Name des externen Cursors
    Art       = BITMAP(0) ICON(1)
    X         = Groesse X-Achse
    Y         = Groesse Y-Achse
    Flags     = LoadFromFile($0010) Originalgroesse wenn keine Angaben($0040)
    Dim ST#,30
    String ST#,0 = Name$
    Let ExtIcon& = @ALoadImage(%HInstance,ST#,1,32,32,$0050) Externes Icon laden
    Dispose ST#

Endproc

Proc Lade_Scale_Icon

    Ein skaliertes Icon
    ###################
    Parameters Name$,X%,Y%
    Dim ST#,30
    String ST#,0 = Name$
    Let SCIcon& = @ALoadImage(%HInstance,ST#,1,X%,Y%,$0000) Externes Icon laden
    Dispose ST#
    Dispose Datei#

Endproc

Proc Lade_ExtBmp

    Ein Icon aus einer DLL
    ######################
    Parameters Name$,X%,Y%
    Dim ST#,30
    String ST#,0 = Name$
    Let ExtBMP& = @ALoadImage(%HInstance,ST#,0,X%,Y%,$0050) Externes Icon laden
    Dispose ST#

Endproc

Proc Mach_Toolbar

    Fast eine Toolbar...
    ####################
    Toolbar
    Let TB& = @Control(Static,,$50001000,0,0,WIDTH(%HWND),43,%hwnd,1000,%Hinstance)
    Buttons
    Let BB1& = @Control(Button,,$50000040,0,0,40,40,TB&,1001,%Hinstance)
    Let BB2& = @Control(Button,,$50000040,42,0,40,40,TB&,1002,%Hinstance)
    Let BB3& = @Control(Button,,$50000040,84,0,40,40,TB&,1003,%Hinstance)
    Let BB4& = @Control(Button,,$50000040,126,0,40,40,TB&,1004,%Hinstance)
    Let BB5& = @Control(Button,,$50000040,168,0,40,40,TB&,1005,%Hinstance)
    Let BB6& = @Control(Button,,$50000040,210,0,40,40,TB&,1006,%Hinstance)
    Let BB7& = @Control(Button,,$50000080,SUB(WIDTH(%HWND),70),5,60,32,TB&,1006,%Hinstance)
    Schalter
    Let OB1& = @Control(Button,,$50001043,274,0,40,40,TB&,1005,%Hinstance)
    Let OB2& = @Control(Button,,$50001043,316,0,40,40,TB&,1006,%Hinstance)
    Let OB3& = @Control(Button,,$50001043,358,0,40,40,TB&,1006,%Hinstance)
    Icon Laden und zuweisen
    #######################
    SENDMESSAGE für BUTTON-CONTROLS
    Parameter    : Buttonhandle,$00F7,Art,Bildhandle
    Buttonhandle : Das Handle des Buttons
     $00F7        : Die Message
    ART          : Bitmap(0) Icon(1)
    Bildhandle   : Das Handle des Bitmaps oder Icons
    ################################################
    Lade_Icon A
    Sendmessage(BB1&,$00F7,1,InstIcon&)            Icon dem 1. Button - Control zuweisen
    Lade_Icon Eimer
    Sendmessage(BB2&,$00F7,1,InstIcon&)            Icon dem 2. Button - Control zuweisen
    Lade_Icon Windows
    Sendmessage(BB3&,$00F7,1,InstIcon&)            Skaliertes Icon dem 3. Button - Control zuweisen
    Lade_scale_Icon Editor,24,24
    Sendmessage(BB4&,$00F7,1,SCIcon&)              Ico-Datei dem 4. Button - Control zuweisen
    Lade_ExtIcon Uhr.ico
    Sendmessage(BB5&,$00F7,1,ExtIcon&)             Externes Icon dem 5. Button - Control zuweisen
    Lade_UserIcon User.exe,6
    Sendmessage(BB6&,$00F7,1,DllIcon&)             Icon aus User.exe dem 6. Button - Control zuweisen
    Lade_ExtBmp Ok1.rle,0,0
    Sendmessage(BB7&,$00F7,0,Extbmp&)               Bitmap aus User.exe dem 6. Button - Control zuweisen
    Schalter
    Lade_Icon Computer
    Sendmessage(OB1&,$00F7,1,InstIcon&)            Icon dem 1. Schalter zuweisen
    Lade_Icon Drucker
    Sendmessage(OB2&,$00F7,1,InstIcon&)            Icon dem 2. Schalter zuweisen
    Lade_Icon Text
    Sendmessage(OB3&,$00F7,1,InstIcon&)            Icon dem 3. Schalter zuweisen
    ######################################################################################

Endproc

Proc Text_zeichnen

    UseFont Arial,15,0,0,0,0
    Textcolor @RGB(0,0,0),-1
    Drawtext 10,50,Erklärung zum Programm:
    Drawtext 10,70,1. Um einen schnelleren Bildschirmaufbau zu simulieren wird das Hauptfenster zuerst mal
    Drawtext 10,85,neben dem Bildschirm aufgebaut. Wenn der Aufbau komplett ist kommt es auf den Bildschirm.
    Drawtext 10,105,2.Toolbar
    Drawtext 10,120,Das ist natürlich kein Toolbar-Control sondern nur eine selbstgemachte Nachbildung
    Drawtext 10,135,Erzeugt mit Button-Controls. Die Controls haben als Style $00000040 um Icons aufnehmen zu können.
    Drawtext 10,150,Es können sowohl externe d.h. ICO-Dateien als auch interne Icons d.h. aus DLL oder HInstance geladen werden.
    Drawtext 10,165,Es besteht ebenfalls die Möglichkeit die Icons skaliert zu laden d.h. so groß wie man will.
    Drawtext 10,190,Es besteht hier auch die Möglichkeit richtige Bitmap-Buttons ( OK-Knopf ) zu erstellen.
    Drawtext 10,205,Hierbei ist nur den Style des Controls zu ändern in $00000080 für die Aufnahme von Bitmaps.
    Drawtext 10,220,Eine interessante Möglichkeit sein Programm individuell zu gestalten.
    Drawtext 10,250,Die drei Buttons rechts neben dem Ausgang sind Schalter d.h. sie können an- und ausgeschaltet werden
    Drawtext 10,265,Einfach mal alle Buttons anklicken, um auszutesten.
    Drawtext 10,290,Da die Icons und Bitmaps bis zum Programmende permanent geladen sind, sollte man speziell bei den Bitmaps
    Drawtext 10,305,darauf achten, daß diese nicht zu groß werden, sonst gehen die Systemresourcen in den Keller.
    Drawtext 10,320,Am besten als RLE-Dateien speichern, das reicht für Buttons vollständig aus.
    Drawtext 10,340,Das Fenster kann auch größer oder kleiner gezogen werden, die Toolbar paßt sich an.

Endproc

HAUPTPROGRAMM
#############
SetTrueColor 1
Windowtitle Button-Demo -> BITMAPS und ICONS auf Controls
Window add(%maxx,1),0-640,480           erstmal neben den Bildschirm
CLS @RGB(212,212,212)
Mach_Toolbar
Text_zeichnen
SetWindowPos %HWND = 50,50-640,480      jetzt auf den Bildschirm

Whilenot Ende%

    Getmessage
    Toolbar an Fenster anpassen
    SetWindowPos TB& = 0,0-WIDTH(%HWND),43                  Toolbar anpassen an Fenstergröße
    SetWindowPos BB7& = SUB(WIDTH(%HWND),70),5-60,32        OK-Button anpassen an Toolbar
    @ASleep(60)  etwas warten sonst sieht ja gar nicht das ein Button gedrückt wurde

    if getfocus(BB1&)

        @MessageBox(Icon A gewählt,Meldung,0)

    Elseif getfocus(BB2&)

        @MessageBox(Icon Eimer gewählt,Meldung,0)

    Elseif getfocus(BB3&)

        @MessageBox(Icon Windows gewählt,Meldung,0)

    Elseif getfocus(BB4&)

        @MessageBox(Scaliertes Icon aus HInstance gewählt,Meldung,0)

    Elseif getfocus(BB5&)

        @MessageBox(Externes Icon (ICO-Datei) gewählt,Meldung,0)

    Elseif getfocus(BB7&)

        @MessageBox(Bitmap-Button gewählt,Meldung,0)

    Elseif getfocus(BB6&)

        @MessageBox(Icon aus USER.EXE (Ausgang) gewählt - Programmende,Meldung,0)
        Let Ende% = 1

    endif

Endwhile

end