XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Button mit Icon
-----------------------------------------------------------------
Gruppierte Buttons mit Icons           (P)Fairware, Freeware....
Für Profan 6.0 32 Bit
Buttons können nunmehr mit Icons Dargestellt werden. Durch die
Gruppierung eignen sich diese neben der einfachen Darstellung
insbesondere für Popup-Menüs.
Etwas trickreiche Umsetzung des SysTabcontrols32 im Buttonstil
in Verbindung mit einer Imagelist. Zusätzlich wird hier auch
noch gezeigt, wie mit der Hilfsfunktion Makelong() die Buttons
bzw. die Reiter im Systabcontrol32 in ihrer Höhe und Breite
geändert wird. Dazu muß aber umbedingt der Stil Fixed_lenght ver-
wendet werden.
(c) 1998 Richard Maurukas
----------------------------------------------------------------
DEF GetModuleHandle(1)   !KERNEL32,GetModuleHandleA
DEF LoadIcon(2)          !USER32,LoadIconA
DEF ImageList_Create(5)  !COMCTL32,ImageList_Create
DEF ImageList_AddIcon(2) !COMCTL32,ImageList_AddIcon
DEF ImageList_Destroy(1) !COMCTL32,ImageList_Destroy
DEF MakeLong(2) OR(@&(1),MUL(@&(2),$10000))
DECLARE hIcon&,Iconname#,Executehandle&, e%
DECLARE Imagelist&,HIcon#
dim Iconname#,25
dim Hicon#,24
declare ICOButton&,Einzelbutton&,gewählt%,Ende%
INITTAB -------------------------------------------------------
declare Tabtext#, Tabitem#,Tabcontrol&
Dim Tabtext#,50
Dim Tabitem#,28
Hier eine Struktur für TC_ITEM -32 Bit----------------------------
long Tabitem#,0=$0003    Mask,$0001 für text, $0002 für icons etc
long Tabitem#,4=        Nicht belegt
long Tabitem#,8=        Nicht belegt
Long Tabitem#,12=TabText#Adresse eines null terminierten Strings
Long Tabitem#,16=       Anzahl der Zeichen im Text. Profan geDIMt
long Tabitem#,20=0      Bitmap Handle der Imagelist if Mask $0002
Long Tabitem#,24=       application defined item data
-------------------------------------------------------------------

PROC CREATE_IMAGELIST

    Imagelist erzeugen-------------------------------------------------
    Let Imagelist&=ImageList_Create(16,16,$0001,3,3) Imagelist erzeugen
    Let ExecuteHandle&=GetModuleHandle(0)Handle des laufenden Programms
    icon 0
    String Iconname#,0=A       Icon-Name
    Let Hicon&=loadicon(Executehandle&,Iconname#) Handle des Icons ok
    ImageList_AddIcon(Imagelist&,HIcon&)
    Icon 1
    String Iconname#,0=EDITOR            Icon-Name
    Let Hicon&=loadicon(Executehandle&,Iconname#) Handle des Icons ok
    ImageList_AddIcon(Imagelist&,HIcon&)
    Icon 2
    String Iconname#,0=WINDOWS
    Let Hicon&=loadicon(Executehandle&,Iconname#) Handle des Icons ok
    ImageList_AddIcon(Imagelist&,HIcon&)

ENDPROC

PROC CREATE_ICONBUTTON

    declare Buttontext$,Buttonbreite%
    Tabcontrol erzeugen. Die Stilzusammensetzung beachten.($50000720)
    let ICOButton&=@control(SysTabControl32,,
     $50000720,0,0,0,0,%Hwnd,201, %HInstance)
    LET Einzelbutton&= @control(SysTabControl32,,
     $50000720,0,0,0,0,%Hwnd,202, %HInstance)
    usefont MS Sans Serif,10,0,0,0,0
    sendmessage(ICOButton&,$030,%font,0)
    sendmessage(Einzelbutton&,$030,%font,0)
    Gruppenbuttons-----
    Let e%=0

    Whilenot gt(e%,2)                                   Anzahl der Buttons

        case equ(e%,0):let Buttontext$=Option 11
        case equ(e%,1):let Buttontext$=Irgendwas
        case equ(e%,2):let Buttontext$=Schließen
        String TabText#,0=Buttontext$                     Der Text im Button
        Long Tabitem#,20=e%                               Das Icon für Button
        sendmessage(ICOButton&,$1307,e%,Tabitem#)        Fügt den Button ein
        SendMessage(ICOButton&,$1303,e%,Imagelist&)      Setzt das ICON.
        inc e%

    wend

    Einzelbutton--------
    string Tabtext#,0=Einzelbutton
    long Tabitem#,20=1
    sendmessage(Einzelbutton&,$1307,0,Tabitem#)        Fügt den Button ein
    SendMessage(Einzelbutton&,$1303,1,Imagelist&)      Setzt das ICON.
    let Buttonbreite%=150
    sendmessage(Einzelbutton&,$1329,0,Makelong(ButtonBreite%,24))
    setwindowpos Einzelbutton&=10,95-ButtonBreite%,30
    Sendmessage(Einzelbutton&,$130C,-1,0) nicht gedrückt
    Die Buttongröße im ICOButtoncontrol festlegen Breite,Höhe
    let ButtonBreite%=90
    sendmessage(ICOButton&,$1329,0,Makelong(ButtonBreite%,24))
    setwindowpos ICOButton&=260,40-ButtonBreite%,78
    Sendmessage(ICOButton&,$130C,-1,0)
    enablemenu 101,1
    enablemenu 102,0
    setfocus(%Hwnd)

ENDPROC

Window 100,100-380,180
Windowtitle Buttons mit Icons, (c) 1998 Richard Maurukas
Settruecolor 1
cls rgb(192,192,192)
POPUP Datei
Appendmenu 199,Beenden
CREATE_IMAGELIST
CREATE_ICONBUTTON

whilenot Ende%

    getmessage
    --------------------------------------------------------------------------
    Mit den nachfolgenden zwei Zeilen funktionieren die Buttons im Interpreter
    und im compilierter Form. Lasse ich den Print Befehl weg, funktionierts
    nur im Interpreter.
    locate 0,0
    Print
    --------------------------------------------------------------------------

    IF equ(&Wparam,ICOButton&)

        let gewählt%=Sendmessage(ICOButton&,$130B,0,0)

        if gt(gewählt%,-1)

            let gewählt%=Sendmessage(ICOButton&,$130B,0,0)
            Sendmessage(ICOButton&,$130C,-1,0)
            case equ(gewählt%,1):Editbox(Schreib mal was,1)
            case equ(gewählt%,2):let ende%=1

        endif

    ELSEIF equ(&WPARAM,Einzelbutton&)

        auch WM_SETFOCUS noch mit abfragen.

    ELSEIF and(equ(%Message,32),equ(&WPARAM,Einzelbutton&))

        Sendmessage(Einzelbutton&,$130C,-1,0)

    ELSEIF Menuitem(199)

        let ende%=1

    endif

    setmenuitem 0

wend

ImageList_Destroy(Imagelist&)
Dispose Iconname#
Dispose Hicon#
dispose Tabtext#
dispose Tabitem#