XProfan

#################################################################
Das Teil habe Yo para Eigengebrauch geschrieben y enthält
sicher algunos Fehler (mi ersten Gehversuche con el API) aber
tal vez findet sí irgend wer el ".inc" nützlich.Für Tips über
evtl. vorhandene Fehler oder Verbesserungen wäre Yo dankbar!
R.Schneider
#################################################################
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 Seleccionar objeto(2) !"GDI32","SelectObject"
##################################################################
SB_Create
##################################################################
Parámetro (max.15) : Breite el Spalten en Pixel
Letzter Parámetro = -1, Spalte reicht a para rechten Fensterrand
------------------------------------------------------------------
Rückgabewert: Handle el Statuszeile
------------------------------------------------------------------

Proc SB_Create

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

    WhileLoop n%

        If @%(&Loop) <> -1

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

        Más

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

        EndIf

        Let p& = p& + 4

    EndWhile

    Let StatusWindow& = @CreateStatusWindow($50000003,0,%Hwnd,2001)
    SendMessage(StatusWindow&,$0404,n%,Parts#)  SB_SETPARTS
    Disponer Parts#
    Volver StatusWindow&

ENDPROC

__________________________________________________________________
##################################################################
Path_Ellipsis
##################################################################
Parámetro : Handle el Statuszeile
Index el Spalte (Base = 1)
Texto (z.B.Pfadangabe) el Spalte
------------------------------------------------------------------

Proc Path_Ellipsis

    Parámetros StatusWindow&, Part%, StatusText$
    Declarar Rect#, DC&
    Dim Rect#,16
    dec Part%
    SendMessage(StatusWindow&,$40A,Part%,Rect#)            SB_GETRECT
    Largo Rect#,0 = @Largo(Rect#,0) + 2
    Largo Rect#,4 = @Largo(Rect#,4) + 2
    Largo Rect#,8 = @Largo(Rect#,8) - 4
    Let DC& = GetDC(StatusWindow&)
    SetBkMode(DC&,1)
    Seleccionar objeto(DC&,%Font)
    DrawText(DC&,Addr(StatusText$),@Len(StatusText$),Rect#,$4100)
    Disponer Rect#
    ReleaseDC(StatusWindow&,DC&)

ENDPROC

__________________________________________________________________
##################################################################
SB_Redraw
##################################################################
Parámetro : Handle el Statuszeile
Zeichnet el Statuszeile neu (por ejemplo después de ändern el Fenstergröße)
------------------------------------------------------------------

Proc SB_Redraw

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

ENDPROC

__________________________________________________________________
##################################################################
SB_SetHeight
##################################################################
Parámetro : Handle el Statuszeile
Höhe el Statuszeile = Valor + (2 * Rahmenbreite)
------------------------------------------------------------------

Proc SB_SetHeight

    Parámetros StatusWindow&, Height%
    @SendMessage(StatusWindow&,$0408,Height%,0) SB_SETMINHEIGHT
    SB_Redraw

ENDPROC

__________________________________________________________________
##################################################################
SB_SetText
##################################################################
Parámetro : Handle el Statuszeile
Index el Spalte (Base = 1)
Texto el Spalt
Textausrichtung 0 = links, 1 = zentriert, 2 = rechts
------------------------------------------------------------------

Proc SB_SetText

    Parámetros 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
##################################################################
Parámetro : Handle el Statuszeile
Index el Spalte (Base = 1)
Icondatei Mit Pfad (*.exe, *.dll oder *.ico,
Formato:16x16, Leerstring löscht el Icon)
Index des Icons (Base = 0)
------------------------------------------------------------------

Proc WM_SetIcon

    Parámetros StatusWindow&, Part%, IconPfad$, IconIdx%
    Declarar hIcon&, hIcon#
    Dim hIcon#,4
    dec Part%
    ExtractIconEx(Addr(IconPfad$),IconIdx%,0,hIcon#,1)
    Let hIcon& = @Largo(hIcon#,0)
    Disponer hIcon#
    SendMessage(StatusWindow&,$040F,Part%,hIcon&)  SB_SETICON

ENDPROC

__________________________________________________________________
##################################################################
WM_SetFont
##################################################################
Parámetro : Handle el Statuszeile
Fonthandle (Nach Gebrauch es el Font otra vez con
"DeleteObject" a löschen, así el
Ressourcen freigegeben se.)
------------------------------------------------------------------

Proc WM_SetFont

    Parámetros StatusWindow&, hFont&
    SendMessage(StatusWindow&,$0030,hFont&,1)  WM_SETFONT

ENDPROC

__________________________________________________________________
##################################################################
SB_SetBkColor
##################################################################
Parámetro : Handle el Statuszeile
Farbe ( -1 setzt el Farbe zurück)
------------------------------------------------------------------

Proc SB_SetBkColor

    Parámetros StatusWindow&, Color&

    If Color& = -1

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

    Más

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

    EndIf

ENDPROC

___________________________________________________________________

#################################################################
Ein pocos Spielereien con meiner "StatusWindow.inc". Hakt manchmal
todavía una bißchen, antes allem bajo W98. Bajo XP gehts eigentlich
bastante bien. Yo kann lo sólo no mejor aber Yo arbeite daran.
R.Schneider
#################################################################
SetErrorLevel 0
Declarar Ende_HWND%
Declarar Editar1&, Button1&, Button2&, Button3&, SB&
Declarar RadioButton1&, RadioButton2&, RadioButton3&, RadioButton4&
Declarar RadioButton5&, RadioButton6&, RadioButton7&, RadioButton8&
Declarar RadioButton9&, RadioButton10&, RadioButton11&
Declarar FontFett&, FontKursiv&
Declarar Texto$, AltText$
 $I StatusWindow.inc
SetTrueColor 1
Ventana de Estilo 575
Título de la ventana "StatusWindowDemo"
Ventana @Int(%MaxX / 2 - 183),200-366,200
UseFont "MS Sans Serif",13,0,0,0,0
SetDialogFont 1
Let Editar1&=@Crear("Edit",%HWND,"StatusWindow",32,88,121,21)
Let Button1&=@Crear("Button",%HWND,"Part 1",168,88,75,20)
Let Button2&=@Crear("Button",%HWND,"Pfad",168,118,75,20)
Let Button3&=@Crear("Button",%HWND,"Beenden",265,118,75,20)
Let RadioButton1& = @Crear("Radio Button",%hWnd,"Left",32,20,50,13)
Let RadioButton2& = @Crear("Radio Button",%hWnd,"Center",32,40,50,13)
Let RadioButton3& = @Crear("Radio Button",%hWnd,"Right",32,60,50,13)
@Crear(Groupbox,%hWnd,"TextAlign",25,4,70,73)
SetCheck RadioButton1&,1
Let RadioButton4& = @Crear("Radio Button",%hWnd,"Ohne",112,20,50,13)
Let RadioButton5& = @Crear("Radio Button",%hWnd,"Mit",112,40,50,13)
@Crear(Groupbox,%hWnd,"Icon",105,4,70,73)
SetCheck RadioButton4&,1
Let RadioButton6& = @Crear("Radio Button",%hWnd,"Normal",192,20,55,13)
Let RadioButton7& = @Crear("Radio Button",%hWnd,"Fett",192,40,50,13)
Let RadioButton8& = @Crear("Radio Button",%hWnd,"Kursiv",192,60,50,13)
@Crear(Groupbox,%hWnd,"Schrift",185,4,70,73)
SetCheck RadioButton6&,1
Let RadioButton9& = @Crear("Radio Button",%hWnd,"System",272,20,55,13)
Let RadioButton10& = @Crear("Radio Button",%hWnd,"Rot",272,40,50,13)
Let RadioButton11& = @Crear("Radio Button",%hWnd,"Blau",272,60,50,13)
@Crear(Groupbox,%hWnd,"Farbe",265,4,70,73)
SetCheck RadioButton9&,1
Let FontFett& = @Crear("Font","MS Sans Serif",13,0,1,0,0)
Let FontKursiv& = @Crear("Font","MS Sans Serif",13,0,0,1,0)
Let SB& = SB_Create(130,-1)
Let AltText$ = $PROGDIR

Proc Edición

    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 Texto$ = @GetText $(Editar1&)
    SB_SetBkColor SB&,-1
    WM_SetFont SB&,%Font
    SB_SetText SB&,1,Texto$,0
    WM_SetIcon SB&,1,"StatusZeileDemo.exe",-1
    Path_Ellipsis SB&,2,AltText$

ENDPROC

Proc Align

    Parámetros a%
    Let Texto$ = @GetText $(Editar1&)
    SB_SetText SB&,1,Texto$,a%

ENDPROC

Proc Schrift

    Parámetros Font&
    WM_SetFont SB&,Font&
    Path_Ellipsis SB&,2,AltText$

ENDPROC

Proc Farbe

    Parámetros Wert&
    SB_SetBkColor SB&,Wert&
    Path_Ellipsis SB&,2,AltText$

ENDPROC

Proc Pfadausgabe

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

    If Texto$ <> ""

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

    Más

        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

Sinestar encargado Ende_HWND%

    WaitInput

    If  %key = 2

        Let Ende_HWND%=1

    ElseIf %wmPaint

        SB_Redraw SB&
        Path_Ellipsis SB&,2,AltText$

    ElseIf GetFocus(Button1&)

        Edición

    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&)

        Schrift %Font

    ElseIf GetFocus(RadioButton7&)

        Schrift FontFett&

    ElseIf GetFocus(RadioButton8&)

        Schrift FontKursiv&

    ElseIf GetFocus(RadioButton9&)

        Farbe -1

    ElseIf GetFocus(RadioButton10&)

        Farbe $0000FF

    ElseIf GetFocus(RadioButton11&)

        Farbe $FF0000

    ElseIf GetFocus(Button2&)

        Pfadausgabe

    ElseIf GetFocus(Button3&)

        Let Ende_HWND%=1

    EndIf

Wend

DeleteObject FontFet&
DeleteObject FontKursiv&
End