XProfan

Deutsch

R.Schneider

Statusbar mit Path_Ellipsis zur Ausgabe von Pfaden die
ungekürzt nicht mehr in die Statuszeile passen würden.
Das Teil habe ich zum Eigengebrauch geschrieben und enthält
sicher einige Fehler (meine ersten Gehversuche mit der API)
Für Tips über evtl. vorhandene Fehler oder Verbesserungen
wäre ich dankbar.

Rudger

Kompilieren Markieren Separieren

#################################################################
Das Teil habe ich zum Eigengebrauch geschrieben und enthält
sicher einige Fehler (meine ersten Gehversuche mit der API) aber
vielleicht findet ja irgend wer die ".inc" nützlich.Für Tips über
evtl. vorhandene Fehler oder Verbesserungen wäre ich 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 SelectObject(2) !"GDI32","SelectObject"
##################################################################
SB_Create
##################################################################
Parameter (max.15) : Breite der Spalten in Pixel
Letzter Parameter = -1, Spalte reicht bis zum rechten Fensterrand
------------------------------------------------------------------
Rückgabewert: Handle der 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 : Handle der Statuszeile
Index der Spalte (Basis = 1)
Text (z.B.Pfadangabe) der Spalte
------------------------------------------------------------------

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 : Handle der Statuszeile
Zeichnet die Statuszeile neu (z.B. nach ändern der Fenstergröße)
------------------------------------------------------------------

Proc SB_Redraw

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

EndProc

__________________________________________________________________
##################################################################
SB_SetHeight
##################################################################
Parameter : Handle der Statuszeile
Höhe der Statuszeile = Wert + (2 * Rahmenbreite)
------------------------------------------------------------------

Proc SB_SetHeight

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

EndProc

__________________________________________________________________
##################################################################
SB_SetText
##################################################################
Parameter : Handle der Statuszeile
Index der Spalte (Basis = 1)
Text der Spalt
Textausrichtung 0 = links, 1 = zentriert, 2 = rechts
------------------------------------------------------------------

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 : Handle der Statuszeile
Index der Spalte (Basis = 1)
Icondatei Mit Pfad (*.exe, *.dll oder *.ico,
Format:16x16, Leerstring löscht das Icon)
Index des Icons (Basis = 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 : Handle der Statuszeile
Fonthandle (Nach Gebrauch ist der Font wieder mit
"DeleteObject" zu löschen, damit die
Ressourcen freigegeben werden.)
------------------------------------------------------------------

Proc WM_SetFont

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

EndProc

__________________________________________________________________
##################################################################
SB_SetBkColor
##################################################################
Parameter : Handle der Statuszeile
Farbe ( -1 setzt die Farbe zurück)
------------------------------------------------------------------

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

___________________________________________________________________

Kompilieren Markieren Separieren

#################################################################
Ein paar Spielereien mit meiner "StatusWindow.inc". Hakt manchmal
noch ein bißchen, vor allem unter W98. Unter XP gehts eigentlich
ganz gut. Ich kann es halt nicht besser aber ich arbeite daran.
R.Schneider
#################################################################
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 StatusWindow.inc
SetTrueColor 1
WindowStyle 575
WindowTitle "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 Ausgabe

    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 Schrift

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

EndProc

Proc Farbe

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

        Ausgabe

    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