XProfan

#################################################################
the part have I to that Eigengebrauch written and contains
sure some Error (my first Gehversuche with the API) but
Perhaps finds Yes ever who The ".inc" useful.for hints über
possibly available Error or Improvements would I grateful!
R.tailor
#################################################################
Def ExtractIconEx(5) !"SHELL32","ExtractIconExA"
Def CreateStatusWindow(4) !"COMCTL32","CreateStatusWindowA"
Def GetSysColor(1) !"USER32","GetSysColor"
Def GetDC(1) !"USER32","GetDC"
Def ReleaseDC(2) !"USER32","ReleaseDC"
Def DrawText(5) !"USER32","DrawTextA"
Def InvalidateRect(3) !"USER32","InvalidateRect"
Def UpdateWindow(1) !"USER32","UpdateWindow"
Def SetBkMode(2) !"GDI32","SetBkMode"
Def SelectObject(2) !"GDI32","SelectObject"
##################################################################
SB_Create
##################################################################
Parameter (max.15) : wide the Split in Pixel
last Parameter = -1, slot reicht To to that rechten Fensterrand
------------------------------------------------------------------
Return Value: lever the Statuszeile
------------------------------------------------------------------

Proc SB_Create

    Declare Parts#, Pixel%, StatusWindow&, n%, p&
    Let n% = %PCount
    Clear p&, Pixel%
    Dim Parts#,(n% * 4)

    WhileLoop n%

        If @%(&Loop) <> -1

            Long Parts#,p& = @%(&Loop) + Pixel%
            Let Pixel% = Pixel% + @%(&Loop)

        Else

            Long Parts#,p& = @%(&Loop)

        EndIf

        Let p& = p& + 4

    EndWhile

    Let StatusWindow& = @CreateStatusWindow($50000003,0,%Hwnd,2001)
    Sendmessage(StatusWindow&,$0404,n%,Parts#)  SB_SETPARTS
    Dispose Parts#
    Return StatusWindow&

ENDPROC

__________________________________________________________________
##################################################################
Path_Ellipsis
##################################################################
Parameter : lever the Statuszeile
index the slot (Base = 1)
Text (z.B.Pfadangabe) the slot
------------------------------------------------------------------

Proc Path_Ellipsis

    Parameters StatusWindow&, Part%, StatusText$
    Declare Rect#, DC&
    Dim Rect#,16
    dec Part%
    Sendmessage(StatusWindow&,$40A,Part%,Rect#)            SB_GETRECT
    Long Rect#,0 = @Long(Rect#,0) + 2
    Long Rect#,4 = @Long(Rect#,4) + 2
    Long Rect#,8 = @Long(Rect#,8) - 4
    Let DC& = GetDC(StatusWindow&)
    SetBkMode(DC&,1)
    SelectObject(DC&,%Font)
    DrawText(DC&,Addr(StatusText$),@Len(StatusText$),Rect#,$4100)
    Dispose Rect#
    ReleaseDC(StatusWindow&,DC&)

ENDPROC

__________________________________________________________________
##################################################################
SB_Redraw
##################################################################
Parameter : lever the Statuszeile
draw The Statuszeile new (in example to ändern the Fenstergröße)
------------------------------------------------------------------

Proc SB_Redraw

    Sendmessage(&(1),$0005,0,0)  WM_SIZE

ENDPROC

__________________________________________________________________
##################################################################
SB_SetHeight
##################################################################
Parameter : lever the Statuszeile
Höhe the Statuszeile = worth + (2 * Rahmenbreite)
------------------------------------------------------------------

Proc SB_SetHeight

    Parameters StatusWindow&, Height%
    @Sendmessage(StatusWindow&,$0408,Height%,0) SB_SETMINHEIGHT
    SB_Redraw

ENDPROC

__________________________________________________________________
##################################################################
SB_SetText
##################################################################
Parameter : lever the Statuszeile
index the slot (Base = 1)
Text the Spalt
Textausrichtung 0 = left, 1 = Centered, 2 = right
------------------------------------------------------------------

Proc SB_SetText

    Parameters StatusWindow&, Part%, StatusText$, Align%
    Case Align% = 1 : Let StatusText$ = Chr$(9) + StatusText$
    Case Align% = 2 : Let StatusText$ = Chr$(9) + Chr$(9) + StatusText$
    dec Part%
    Sendmessage(StatusWindow&,$401,Part%,Addr(StatusText$)) SB_SETTEXT

ENDPROC

__________________________________________________________________
##################################################################
SB_SetIcon
##################################################################
Parameter : lever the Statuszeile
index the slot (Base = 1)
Icondatei with way (*.exe, *.dll or *.ico,
stature:16x16, Leerstring deletes the Icon)
index the Icons (Base = 0)
------------------------------------------------------------------

Proc WM_SetIcon

    Parameters StatusWindow&, Part%, IconPfad$, IconIdx%
    Declare hIcon&, hIcon#
    Dim hIcon#,4
    dec Part%
    ExtractIconEx(Addr(IconPfad$),IconIdx%,0,hIcon#,1)
    Let hIcon& = @Long(hIcon#,0)
    Dispose hIcon#
    SendMessage(StatusWindow&,$040F,Part%,hIcon&)  SB_SETICON

ENDPROC

__________________________________________________________________
##################################################################
WM_SetFont
##################################################################
Parameter : lever the Statuszeile
Fonthandle (After use is the Font again with
"DeleteObject" To delete, so The
Ressourcen released be.)
------------------------------------------------------------------

Proc WM_SetFont

    Parameters StatusWindow&, hFont&
    Sendmessage(StatusWindow&,$0030,hFont&,1)  WM_SETFONT

ENDPROC

__________________________________________________________________
##################################################################
SB_SetBkColor
##################################################################
Parameter : lever the Statuszeile
colour ( -1 setting The colour back)
------------------------------------------------------------------

Proc SB_SetBkColor

    Parameters StatusWindow&, Color&

    If Color& = -1

        Sendmessage(StatusWindow&,$2001,0,GetSysColor($F)) SB_SETBKCOLOR

    Else

        Sendmessage(StatusWindow&,$2001,0,Color&) SB_SETBKCOLOR

    EndIf

ENDPROC

___________________________________________________________________

#################################################################
One couple Spielereien with of my "StatusWindow.inc". Hakt sometimes
yet one slightly, to everything under W98. under XP GEHTS really
integrally well. I can it hold not rather but I work on it.
R.tailor
#################################################################
SetErrorLevel 0
Declare Ende_HWND%
Declare Edit1&, Button1&, Button2&, Button3&, SB&
Declare RadioButton1&, RadioButton2&, RadioButton3&, RadioButton4&
Declare RadioButton5&, RadioButton6&, RadioButton7&, RadioButton8&
Declare RadioButton9&, RadioButton10&, RadioButton11&
Declare FontFett&, FontKursiv&
Declare Text$, AltText$
 $I Status Window.inc
SetTrueColor 1
Window Style 575
Window Title "StatusWindowDemo"
Window @Int(%MaxX / 2 - 183),200-366,200
UseFont "MS Sans Serif",13,0,0,0,0
SetDialogFont 1
Let Edit1&=@Create("Edit",%HWND,"StatusWindow",32,88,121,21)
Let Button1&=@Create("Button",%HWND,"Part 1",168,88,75,20)
Let Button2&=@Create("Button",%HWND,"Pfad",168,118,75,20)
Let Button3&=@Create("Button",%HWND,"Beenden",265,118,75,20)
Let RadioButton1& = @Create("RadioButton",%hWnd,"Left",32,20,50,13)
Let RadioButton2& = @Create("RadioButton",%hWnd,"Center",32,40,50,13)
Let RadioButton3& = @Create("RadioButton",%hWnd,"Right",32,60,50,13)
@Create(Groupbox,%hWnd,"TextAlign",25,4,70,73)
SetCheck RadioButton1&,1
Let RadioButton4& = @Create("RadioButton",%hWnd,"Ohne",112,20,50,13)
Let RadioButton5& = @Create("RadioButton",%hWnd,"Mit",112,40,50,13)
@Create(Groupbox,%hWnd,"Icon",105,4,70,73)
SetCheck RadioButton4&,1
Let RadioButton6& = @Create("RadioButton",%hWnd,"Normal",192,20,55,13)
Let RadioButton7& = @Create("RadioButton",%hWnd,"Fett",192,40,50,13)
Let RadioButton8& = @Create("RadioButton",%hWnd,"Kursiv",192,60,50,13)
@Create(Groupbox,%hWnd,"Schrift",185,4,70,73)
SetCheck RadioButton6&,1
Let RadioButton9& = @Create("RadioButton",%hWnd,"System",272,20,55,13)
Let RadioButton10& = @Create("RadioButton",%hWnd,"Rot",272,40,50,13)
Let RadioButton11& = @Create("RadioButton",%hWnd,"Blau",272,60,50,13)
@Create(Groupbox,%hWnd,"Farbe",265,4,70,73)
SetCheck RadioButton9&,1
Let FontFett& = @Create("Font","MS Sans Serif",13,0,1,0,0)
Let FontKursiv& = @Create("Font","MS Sans Serif",13,0,0,1,0)
Let SB& = SB_Create(130,-1)
Let AltText$ = $PROGDIR

Proc spending

    SetCheck RadioButton1&,1
    SetCheck RadioButton2&,0
    SetCheck RadioButton3&,0
    SetCheck RadioButton4&,1
    SetCheck RadioButton5&,0
    SetCheck RadioButton6&,1
    SetCheck RadioButton7&,0
    SetCheck RadioButton8&,0
    SetCheck RadioButton9&,1
    SetCheck RadioButton10&,0
    SetCheck RadioButton11&,0
    Let Text$ = @GetText$(Edit1&)
    SB_SetBkColor SB&,-1
    WM_SetFont SB&,%Font
    SB_SetText SB&,1,Text$,0
    WM_SetIcon SB&,1,"StatusZeileDemo.exe",-1
    Path_Ellipsis SB&,2,AltText$

ENDPROC

Proc Align

    Parameters a%
    Let Text$ = @GetText$(Edit1&)
    SB_SetText SB&,1,Text$,a%

ENDPROC

Proc Font

    Parameters Font&
    WM_SetFont SB&,Font&
    Path_Ellipsis SB&,2,AltText$

ENDPROC

Proc colour

    Parameters Wert&
    SB_SetBkColor SB&,Wert&
    Path_Ellipsis SB&,2,AltText$

ENDPROC

Proc Pfadausgabe

    Let Text$ = @LoadFile $("Datei auswählen","*.*")

    If Text$ <> ""

        Path_Ellipsis SB&,2,Text$
        Let AltText$ = Text$

    Else

        Path_Ellipsis SB&,2,AltText$

    EndIf

    SetWindowPos %hWnd=%WinLeft,%WinTop-(%WinRight - %WinLeft)+1,(%WinBottom - %WinTop);0

ENDPROC

WM_SetFont SB&, %Font
Path_Ellipsis SB&,2,$PROGDIR
SetAutoPaint 0

WhileNot Ende_HWND%

    WaitInput

    If  %key = 2

        Let Ende_HWND%=1

    ElseIf %wmPaint

        SB_Redraw SB&
        Path_Ellipsis SB&,2,AltText$

    ElseIf GetFocus(Button1&)

        spending

    ElseIf GetFocus(RadioButton1&)

        Align 0

    ElseIf GetFocus(RadioButton2&)

        Align 1

    ElseIf GetFocus(RadioButton3&)

        Align 2

    ElseIf GetFocus(RadioButton4&)

        WM_SetIcon SB&,1,$progDir + "StatusZeileDemo.exe",-1

    ElseIf GetFocus(RadioButton5&)

        WM_SetIcon SB&,1,$progDir + "StatusZeileDemo.exe",0

    ElseIf GetFocus(RadioButton6&)

        Font %Font

    ElseIf GetFocus(RadioButton7&)

        Font FontFett&

    ElseIf GetFocus(RadioButton8&)

        Font FontKursiv&

    ElseIf GetFocus(RadioButton9&)

        colour -1

    ElseIf GetFocus(RadioButton10&)

        colour $0000FF

    ElseIf GetFocus(RadioButton11&)

        colour $FF0000

    ElseIf GetFocus(Button2&)

        Pfadausgabe

    ElseIf GetFocus(Button3&)

        Let Ende_HWND%=1

    EndIf

Wend

DeleteObject FontFet&
DeleteObject FontKursiv&
End