XProfan

Struct GB = gb& , search& , verz& , num& , art& , label&
Def ExtractIcon(3) !"SHELL32","ExtractIconA"
Def LoadImage(6)   !"USER32","LoadImageA"
Def %WinX 565
Def %WinY 305

SubProc Create.Switch

    parameters h& , t$ , x% , y% , dx% , dy%
    return Control("Button",t$,$50011003,x%,y%,dx%,dy%,h&,1002,%Hinstance)

endproc

proc SetNumeric

    parameters e& , on%

    if TestBit(GetStyle(e&),13)            es_numeric = an

        ifnot on%                            if aus

            SetStyle e& , GetStyle(e&) - $2000

        endif

        else                                  es_numeric = aus

        if on%                               if an

            SetStyle e& , GetStyle(e&) + $2000

        endif

    endif

endproc

 $0001 = 00. Stelle
 $0002 = 01. Stelle
 $0004 = 02. Stelle
 $0008 = 03. Stelle
 $0010 = 04. Stelle
 $0020 = 05. Stelle
 $0040 = 06. Stelle
 $0080 = 07. Stelle
 $0100 = 08. Stelle
 $0200 = 09. Stelle
 $0400 = 10. Stelle
 $0800 = 11. Stelle
 $1000 = 12. Stelle
 $2000 = 13. Stelle

proc Delimit

    parameters e&

    if TestBit(GetStyle(e&),7)AutoHScroll

        SetStyle e& , (GetStyle(e&)-$80)

    endif

endproc

proc IconButton

    parameters was$ , h& , x% , y% , dx% , dy%
    declare ico# , hb& , weg$ , num%

    if Upper$(was$) = "RUN"

        weg$ = Par$(0)
        num% = %(7)

    elseif Upper$(was$) = "ICO"

        weg$ = $(7)
        num% = 0

    elseif Upper$(was$) = "DLL"

        weg$ = $(7)
        num% = %(8)

    endif

    dim ico# , len(weg$) + 1
    String ico# , 0 = weg$
    hb& = CONTROL("Button","",bs&,x%,y%,dx%,dy%,h&,1002,%Hinstance)
    SendMessage(hb&,$00F7,1,ExtractIcon(%Hinstance,ico#,num%))
    dispose ico#
    return hb&

endproc

proc BMPButton

    parameters was$ , h& , x% , y% , dx% , dy%
    declare bmp# , hb& , bmp& , name$ , hi&

    if Upper$(was$) = "RUN"

        name$ = $(7)
        hi&   = %hInstance

    elseif Upper$(was$) = "BMP"

        name$ = $(7)
        hi&   = 0

    elseif Upper$(was$) = "DLL"

        name$ = %(7)
        hi&   = $(8)

    endif

    dim bmp#, len(name$) + 1
    string bmp# , 0 = name$
    bmp& = LoadImage(hi&,bmp#,0,dx%-2,dy%-2,if(Equ$(upper$(was$),"BMP"),$0050,0))
    hb&  = Control("Button","",bs&,x%,y%,dx%,dy%,h&,1001,%HInstance)
    SendMessage(hb&,$00F7,0,bmp&)
    dispose bmp#
    return hb&

endproc

+$120 = links
+$220 = rechts
+$400 = oben
+$800 = unten
+$11003 = Schalter
+$8000 = Flat

proc RealizeStyle

    declare style&
    style& = $54010000

    if GetCheck(bnorm&)

        case GetCheck(tl&)     : style& = style& + $400   + $120
        case GetCheck(tm&)     : style& = style& + $400
        case GetCheck(tr&)     : style& = style& + $400   + $220
        case GetCheck(ml&)     : style& = style& +          $120
        case GetCheck(mm&)     : style& = style&
        case GetCheck(mr&)     : style& = style& +          $220
        case GetCheck(bl&)     : style& = style& + $800   + $120
        case GetCheck(bm&)     : style& = style& + $800
        case GetCheck(br&)     : style& = style& + $800   + $220
        case GetCheck(cbml&)   : style& = style& + $2000

    endif

    case GetCheck(cbflat&) : style& = style& + $8000
    case GetCheck(switch&) : style& = style& + $11003
    case GetCheck(bico&)   : style& = style& + $40
    case GetCheck(bbmp&)   : style& = style& + $80
    Return style&

endproc

proc AddLine

    parameters line$
    SetText dummy& , GetText$(dummy&) + line$ + "
    "

endproc

proc AddICOProc

    AddLine "Def ExtractIcon(3) ! qSHELL32q,qExtractIconAq"
    AddLine ""
    AddLine "proc IconButton"
    AddLine "parameters was$ , h& , x% , y% , dx% , dy%"
    AddLine "declare ico# , hb& , weg$ , num%"
    AddLine " if Upper$(was$) = qRUNq"
    AddLine "   weg$ = Par$(0)"
    AddLine "   num% = %(7)"
    AddLine "  elseif Upper$(was$) = qICOq"
    AddLine "   weg$ = $(7)"
    AddLine "   num% = 0"
    AddLine "  elseif Upper$(was$) = qDLLq"
    AddLine "   weg$ = $(7)"
    AddLine "   num% = %(8)"
    AddLine " endif"
    AddLine " Dim ico# , len(weg$) + 1"
    AddLine " String ico# , 0 = weg$"
    AddLine " hb& = CONTROL(qButtonq,qq,$"+Hex$(bs&)+",x%,y%,dx%,dy%,h&,1002,%Hinstance)"
    AddLine " SendMessage(hb&,$00F7,1,ExtractIcon(%hInstance,ico#,num%))"
    AddLine " Dispose ico#"
    AddLine " return hb&"
    AddLine "endproc"

endproc

proc AddBMPProc

    AddLine "Def LoadImage(6) ! qUSER32q,qLoadImageAq"
    AddLine ""
    AddLine "proc BMPButton"
    AddLine "parameters was$ , h& , x% , y% , dx% , dy%"
    AddLine "declare bmp# , hb& , bmp& , name$ , hi&"
    AddLine " if Upper$(was$) = qRUNq"
    AddLine "   name$ = $(7)"
    AddLine "   hi&   = %hInstance"
    AddLine "  elseif Upper$(was$) = qBMPq"
    AddLine "   name$ = $(7)"
    AddLine "   hi&   = 0"
    AddLine "  elseif Upper$(was$) = qDLLq"
    AddLine "   name$ = $(7)"
    AddLine "   hi& = %(8)"
    AddLine " endif"
    AddLine " Dim bmp#, len(name$) + 1"
    AddLine " String bmp# , 0 = name$"
    AddLine " bmp& = LoadImage(hi&,bmp#,0,dx%-2,dy%-2,if(Equ$(upper$(was$),qBMPq),$0050,0))"
    AddLine " hb&  = Control(qButtonq,qq,$"+Hex$(bs&)+",x%,y%,dx%,dy%,h&,1001,%hInstance)"
    AddLine " SendMessage(hb&,$00F7,0,bmp&)"
    AddLine " Dispose bmp#"
    AddLine " return hb&"
    AddLine "endproc"

endproc

proc MakeDaCode

    SetText dummy& , ""
    AddLine "Button-Style: $"+Hex$(bs&)
    AddLine ""
    AddLine "Def SysColor(1) !qUser32q,qGetSysColorq"
    AddLine ""
    AddLine "declare hBTN&"
    AddLine ""

    if GetCheck(bico&)

        AddIcoProc
        AddLine ""

    elseif GetCheck(bbmp&)

        AddBMPProc
        AddLine ""

    endif

    AddLine "cls SysColor(15)"

    if GetCheck(bico&)

        With ico#

            if GetText$(.art&) = "Aus DLL"

                AddLine "IcoButton qDLLq , %hWnd , 5 , 5 , 100 , 50 , q"+GetText$(.verz&)+"q , "+GetText$(.num&)
                AddLine "hBTN& = &(0)"

            elseif GetText$(.art&) = "Aus Datei"

                AddLine "IcoButton qICOq , %hWnd , 5 , 5 , 100 , 50 , q"+GetText$(.verz&)+"q"
                AddLine "hBTN& = &(0)"

            elseif GetText$(.art&) = "Aus Runtime"

                AddLine "IcoButton qRUNq , %hWnd , 5 , 5 , 100 , 50 , "+GetText$(.num&)
                AddLine "hBTN& = &(0)"

            endif

        EndWith

    elseif GetCheck(bbmp&)

        With bmp#

            if GetText$(.art&) = "Aus DLL"

                AddLine "IcoButton qDLLq , %hWnd , 5 , 5 , 100 , 50 , "+GetText$(.num&)+" , q"+GetText$(.verz&)+"q"
                AddLine "hBTN& = &(0)"

            elseif GetText$(.art&) = "Aus Datei"

                AddLine "IcoButton qBMPq , %hWnd , 5 , 5 , 100 , 50 , q"+GetText$(.verz&)+"q"
                AddLine "hBTN& = &(0)"

            elseif GetText$(.art&) = "Aus Runtime"

                AddLine "IcoButton qRUNq , %hWnd , 5 , 5 , 100 , 50 , "+GetText$(.num&)
                AddLine "hBTN& = &(0)"

            endif

        EndWith

    elseif GetCheck(bnorm&)

        AddLine "hBTN& = @Control(qBUTTONq,qBeendenq,\
        "+
        "         $"+Hex$(bs&)+",5,5,100,50,%hWnd,\
        "+
        "         1000,%hInstance)"

    endif

    AddLine ""
    AddLine "whilenot @Equ(%GetFocus,hBTN&)"
    AddLine "  waitinput"
    AddLine "wend"
    AddLine "end"
    SetText code& , GetText$(dummy&)

endproc

proc CheckPic

    declare buffer# , hb& , bmp& , name$ , hi& , jumper%

    if GetCheck(bico&)

    elseif GetCheck(bbmp&)

        parameters was$ , h& , x% , y% , dx% , dy%

        if GetText$(bmp#.art&) = "aus Runtime"

            name$ = bmp#.num&
            hi&   = %hInstance

        elseif GetText$(bmp#.art&) = "aus Datei"

            name$ = bmp#.verz&
            hi&   = 0

        elseif GetText$(bmp#.art&) = "aus DLL"

            jumper% = 1

        endif

        dim buffer#, len(name$) + 1
        string buffer# , 0 = name$
        bmp& = LoadImage(hi&,buffer#,0,dx%-2,dy%-2,if(Equ$(upper$(was$),"BMP"),$0050,0))
        hb&  = Control("Button","",bs&,x%,y%,dx%,dy%,h&,1001,%hInstance)
        SendMessage(hb&,$00F7,0,bmp&)
        dispose buffer&

    endif

endproc

proc BuildUp

    declare wx% , wy%
    WindowStyle 26
    WindowTitle "Button-Helfer"
    Window %MaxX , %MaxY - %WinX , %WinY
    UseFont "Comic Sans MS" , 17 , 0 , 0 , 1 , 0
    cls External("User32","GetSysColor",15)
    SetDialogFont 1
    dummy& = Create("Text",%hWnd,"",0,0,0,0)
    gbart& = Create("GroupBox",%hWnd,"Art des Button", 5, 5,150,100)
    bnorm& = Create("Switch",%hWnd,"Text-Button"   ,10,20,140, 27)
    bico&  = Create("Switch",%hWnd,"Icon-Button"   ,10,47,140, 27)
    bbmp&  = Create("Switch",%hWnd,"Bitmap-Button" ,10,74,140, 27)
    SetCheck bnorm& , 1
    Text-Bereich
    gbtxt& = Create("GroupBox",%hWnd,"Textausrichtung",5,105,150,100)
    tl& = Create("RadioButton",gbtxt&,"",40+00,20,20,20)
    tm& = Create("RadioButton",gbtxt&,"",40+20,20,20,20)
    tr& = Create("RadioButton",gbtxt&,"",40+40,20,20,20)
    ml& = Create("RadioButton",gbtxt&,"",40+00,40,20,20)
    mm& = Create("RadioButton",gbtxt&,"",40+20,40,20,20)
    mr& = Create("RadioButton",gbtxt&,"",40+40,40,20,20)
    bl& = Create("RadioButton",gbtxt&,"",40+00,60,20,19)
    bm& = Create("RadioButton",gbtxt&,"",40+20,60,20,19)
    br& = Create("RadioButton",gbtxt&,"",40+40,60,20,19)
    cbml&   = Create("CheckBox",gbtxt&,"Mehrere Zeilen",5,78,120,20)
    Icon-Bereich
    ico#.gb&    = Create("GroupBox" ,%hWnd   ,"Icon-Suche",160,5,150,100)
    ico#.art&   = Create("ChoiceBox",ico#.gb&,""          ,  5, 18,140, 80)
    ico#.search&= Create("Button"   ,ico#.gb&,"Suchen"    ,  5, 45, 50, 25)
    ico#.verz&  = Create("Edit"     ,ico#.gb&,"Pfad"      , 60, 45, 85, 20)
    ico#.label& = Create("Text"     ,ico#.gb&,"Nummer:"   ,  5, 75, 60, 20)
    ico#.num&   = Create("Edit"     ,ico#.gb&,"10"        , 70, 75, 75, 20)
    Bitmap-Bereich
    bmp#.gb&    = Create("GroupBox" ,%hWnd   ,"Bitmap-Suche",160,105,150,100)
    bmp#.art&   = Create("ChoiceBox",bmp#.gb&,""            ,  5, 18,140, 80)
    bmp#.search&= Create("Button"   ,bmp#.gb&,"Suchen"      ,  5, 45, 50, 25)
    bmp#.verz&  = Create("Edit"     ,bmp#.gb&,"hInstance&"  , 60, 45, 85, 20)
    bmp#.label& = Create("Text"     ,bmp#.gb&,"Name:"       ,  5, 75, 60, 20)
    bmp#.num&   = Create("Edit"     ,bmp#.gb&,"GESICHT"     , 70, 75, 75, 20)
    cbflat& = Create("CheckBox" ,%hWnd,"Flat-Button"    ,  5,215,150, 20)
    switch& = Create("CheckBox" ,%hWnd,"Schalter-Button",  5,240,150, 20)
    expl&   = Create("Button"   ,%hWnd,"Das Beispiel"   ,160,215,150, 50)
    code&   = Create("MultiEdit",%hWnd,""               ,315,  5,245,260)
    clip&   = Create("Button"   ,%hWnd,"Code in die Zwischenablage kopieren",  5,270,305,30)
    quit&   = Create("Button"   ,%hWnd,"Button-Helfer beenden"              ,315,270,245,30)
    font& = Create("Font","Courier New",15,0,0,0,0)
    Initialisierungen
    SetFont code& , font&
    AddString(ico#.art&,"Aus DLL")
    AddString(ico#.art&,"Aus Datei")
    AddString(ico#.art&,"Aus Runtime")
    AddString(bmp#.art&,"Aus DLL")
    AddString(bmp#.art&,"Aus Datei")
    AddString(bmp#.art&,"Aus Runtime")
    SetNumeric ico#.num& , 1
    Delimit    ico#.num&
    SendMessage(ico#.art&,$014E,1,0)
    SendMessage(bmp#.art&,$014E,1,0)
    EnableWindow bmp#.search& , 0
    EnableWindow ico#.gb&     , 0
    EnableWindow bmp#.gb&     , 0
    SetCheck bnorm& , 1
    SetCheck mm&    , 1
    bs& = RealizeStyle()
    SetStyle expl& , bs&
    MakeDaCode
    wx% = 2 * %WinX -  width(%hWnd)
    wy% = 2 * %WinY - height(%hWnd)
    SetWindowPos %hWnd = (%MaxX-wx%)/2 , (%MaxY-wy%)/2 - wx% , wy%

endproc

proc Beenden

    DeleteObject font&
    Dispose ico#
    Dispose bmp#
    end

endproc

Handles
declare expl& , code& , cbflat& , cbml& , switch& , dummy&
declare gbart& , bnorm& , bico& , bbmp& , ico# , bmp#
declare clip& , quit& , font&
declare gbtxt& , tl& , tm& , tr& , ml& , mm& , mr& , bl& , bm& , br&
Variablen
declare bs& , i% , buttonchecker%
Dim ico# , GB
Dim bmp# , GB
H A U P T P R O G R A M M
BuildUp
bs& = GetStyle(expl&)

whilenot %Key = 2

    GetMessage
    inc i%
    SetText %hWnd , "$" + Hex$(%Message) + " | " + str$(i%)

    ifnot GetCheck(bnorm&) or GetCheck(bico&) or GetCheck(bbmp&)

        SetCheck %GetFocus , 1

    endif

    if (GetFocus(bnorm&) or GetFocus(bico&) or GetFocus(bbmp&)) and not(IsKey(1))

        buttonchecker% = 1

    endif

    if GetFocus(bnorm&)

        SetCheck bico& , 0
        SetCheck bbmp& , 0
        EnableWindow gbtxt& , 1
        EnableWindow ico#.gb& , 0
        EnableWindow bmp#.gb& , 0

    elseif GetFocus(bico&)

        SetCheck bnorm& , 0
        SetCheck bbmp&  , 0
        EnableWindow gbtxt& , 0
        EnableWindow ico#.gb& , 1
        EnableWindow bmp#.gb& , 0

    elseif GetFocus(bbmp&)

        SetCheck bnorm& , 0
        SetCheck bico&  , 0
        EnableWindow gbtxt& , 0
        EnableWindow ico#.gb& , 0
        EnableWindow bmp#.gb& , 1

    endif

    With bmp#

        if GetText$(.art&) = "Aus DLL"

            EnableWindow .search& , 0
            EnableWindow .verz&   , 1
            EnableWindow .label&  , 1
            EnableWindow .num&    , 1
            SetText .verz& , "hInstance&"
            SetText .num&  , "GESICHT"

        elseif GetText$(.art&) = "Aus Datei"

            EnableWindow .search& , 1
            EnableWindow .verz&   , 1
            EnableWindow .label&  , 0
            EnableWindow .num&    , 0
            SetText .verz& , "Pfad"
            SetText .num&  , ""

        elseif GetText$(.art&) = "Aus Runtime"

            EnableWindow .search& , 0
            EnableWindow .verz&   , 0
            EnableWindow .label&  , 1
            EnableWindow .num&    , 1
            SetText .verz& , ""
            SetText .num&  , "GESICHT"

        endif

    EndWith

    With ico#

        if GetText$(.art&) = "Aus DLL"

            EnableWindow .search& , 1
            EnableWindow .verz&   , 1
            EnableWindow .label&  , 1
            EnableWindow .num&    , 1

        elseif GetText$(.art&) = "Aus Datei"

            EnableWindow .search& , 1
            EnableWindow .verz&   , 1
            EnableWindow .label&  , 0
            EnableWindow .num&    , 0

        elseif GetText$(.art&) = "Aus Runtime"

            EnableWindow .search& , 0
            EnableWindow .verz&   , 0
            EnableWindow .label&  , 1
            EnableWindow .num&    , 1

        endif

    EndWith

    bs& = RealizeStyle()

    if (bs& <> GetStyle(expl&)) or buttonchecker%

        MakeDaCode

        if GetCheck(cbml&)

            SetText expl& , "Das
            Beispiel"

        else

            SetText expl& , "Das Beispiel"

        endif

        SetStyle expl& , bs&
        buttonchecker% = 0

    endif

wend

Beenden
Ende

!Tl& = Create("RadioButton",%Hwnd,"",40+00+10,20+105,20,20)
Tm& = Create("RadioButton",%Hwnd,"",40+20+10,20+105,20,20)
Tr& = Create("RadioButton",%Hwnd,"",40+40+10,20+105,20,20)
Ml& = Create("RadioButton",%Hwnd,"",40+00+10,40+105,20,20)
Mm& = Create("RadioButton",%Hwnd,"",40+20+10,40+105,20,20)
Mr& = Create("RadioButton",%Hwnd,"",40+40+10,40+105,20,20)
Bl& = Create("RadioButton",%Hwnd,"",40+00+10,60+105,20,19)
Bm& = Create("RadioButton",%Hwnd,"",40+20+10,60+105,20,19)
Br& = Create("RadioButton",%Hwnd,"",40+40+10,60+105,20,19)