XProfan

Français

R.Schneider

Statusbar avec Path_Ellipsis zur Ausgabe de Pfaden qui
ungekürzt pas plus dans qui Statuszeile passen würden.
cela partie habe je zum Eigengebrauch geschrieben et contient
sûrement quelques faute (mon ersten Gehversuche avec qui API)
Pour Tips sur peut-être. vorhandene faute ou bien Verbesserungen
wäre je reconnaissant.

Rudger

Kompilieren Marque Séparation

#################################################################
cela partie habe je zum Eigengebrauch geschrieben et contient
sûrement quelques faute (mon ersten Gehversuche avec qui API) mais
peut-être findet oui irgend qui qui ".inc" nützlich.Pour Tips über
peut-être vorhandene faute ou bien Verbesserungen wäre je reconnaissant!
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
##################################################################
paramètre (max.15) : Breite qui Spalten dans Pixel
dernier paramètre = -1, Spalte reicht jusqu'à zum rechten Fensterrand
------------------------------------------------------------------
Rückgabewert: Handle qui Statuszeile
------------------------------------------------------------------

Proc SB_Create

    Déclarer Parts#, Pixel%, StatusWindow&, n%, p&
    Laisser n% = %PCount
    Claire p&, Pixel%
    Faible Parts#,(n% * 4)

    WhileLoop n%

        Si @%(&Boucle) <> -1

            Long Parts#,p& = @%(&Boucle) + Pixel%
            Laisser Pixel% = Pixel% + @%(&Boucle)

        D'autre

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

        EndIf

        Laisser p& = p& + 4

    Endwhile

    Laisser StatusWindow& = @CreateStatusWindow($50000003,0,%Hwnd,2001)
    SendMessage(StatusWindow&,$0404,n%,Parts#)  SB_SETPARTS
    Dispose Parts#
    Retour StatusWindow&

ENDPROC

__________________________________________________________________
##################################################################
Path_Ellipsis
##################################################################
paramètre : Handle qui Statuszeile
index qui Spalte (la base = 1)
Text (z.B.Pfadangabe) qui Spalte
------------------------------------------------------------------

Proc Path_Ellipsis

    Paramètres StatusWindow&, Part%, StatusText$
    Déclarer Rect#, DC&
    Faible 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
    Laisser 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
##################################################################
paramètre : Handle qui Statuszeile
Zeichnet qui Statuszeile récente (z.B. pour ändern qui Fenstergröße)
------------------------------------------------------------------

Proc SB_Redraw

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

ENDPROC

__________________________________________________________________
##################################################################
SB_SetHeight
##################################################################
paramètre : Handle qui Statuszeile
Hauteur qui Statuszeile = Wert + (2 * Rahmenbreite)
------------------------------------------------------------------

Proc SB_SetHeight

    Paramètres StatusWindow&, Height%
    @SendMessage(StatusWindow&,$0408,Height%,0) SB_SETMINHEIGHT
    SB_Redraw

ENDPROC

__________________________________________________________________
##################################################################
SB_SetText
##################################################################
paramètre : Handle qui Statuszeile
index qui Spalte (la base = 1)
Text qui Spalt
Textausrichtung 0 = à gauche, 1 = zentriert, 2 = à droite
------------------------------------------------------------------

Proc SB_SetText

    Paramètres StatusWindow&, Part%, StatusText$, Align%
    Cas Align% = 1 : Laisser StatusText$ = Chr$(9) + StatusText$
    Cas Align% = 2 : Laisser StatusText$ = Chr$(9) + Chr$(9) + StatusText$
    dec Part%
    SendMessage(StatusWindow&,$401,Part%,Addr(StatusText$)) SB_SETTEXT

ENDPROC

__________________________________________________________________
##################################################################
SB_SetIcon
##################################################################
paramètre : Handle qui Statuszeile
index qui Spalte (la base = 1)
Icondatei avec Pfad (*.exe, *.dll ou bien *.ico,
Format:16x16, Leerstring löscht cela Icon)
index des Icônes (la base = 0)
------------------------------------------------------------------

Proc WM_SetIcon

    Paramètres StatusWindow&, Part%, IconPfad$, IconIdx%
    Déclarer hIcon&, hIcon#
    Faible hIcon#,4
    dec Part%
    ExtractIconEx(Addr(IconPfad$),IconIdx%,0,hIcon#,1)
    Laisser hIcon& = @Long(hIcon#,0)
    Dispose hIcon#
    SendMessage(StatusWindow&,$040F,Part%,hIcon&)  SB_SETICON

ENDPROC

__________________________________________________________________
##################################################################
WM_SetFont
##################################################################
paramètre : Handle qui Statuszeile
Fonthandle (Pour Gebrauch ist qui Font wieder avec
«DeleteObject» trop effacer, avec cela qui
Ressourcen freigegeben volonté.)
------------------------------------------------------------------

Proc WM_SetFont

    Paramètres StatusWindow&, hFont&
    SendMessage(StatusWindow&,$0030,hFont&,1)  WM_SETFONT

ENDPROC

__________________________________________________________________
##################################################################
SB_SetBkColor
##################################################################
paramètre : Handle qui Statuszeile
la couleur ( -1 mets qui la couleur zurück)
------------------------------------------------------------------

Proc SB_SetBkColor

    Paramètres StatusWindow&, Color&

    Si Color& = -1

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

    D'autre

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

    EndIf

ENDPROC

___________________________________________________________________

Kompilieren Marque Séparation

#################################################################
un paire Spielereien avec meiner "StatusWindow.inc". Hakt quelquefois
encore un bißchen, avant allem sous W98. sous XP gehts eigentlich
entier bien. je peux es arrêt pas besser mais je arbeite daran.
R.Schneider
#################################################################
SetErrorLevel 0
Déclarer Ende_HWND%
Déclarer Éditer1&, Button1&, Button2&, Button3&, SB&
Déclarer RadioButton1&, RadioButton2&, RadioButton3&, RadioButton4&
Déclarer RadioButton5&, RadioButton6&, RadioButton7&, RadioButton8&
Déclarer RadioButton9&, RadioButton10&, RadioButton11&
Déclarer FontFett&, FontKursiv&
Déclarer Text$, AltText$
 $I StatusWindow.inc
SetTrueColor 1
Fenêtre Style 575
Titre de la fenêtre "StatusWindowDemo"
Fenêtre @Int(%MaxX / 2 - 183),200-366,200
UseFont "MS Sans Serif",13,0,0,0,0
SetDialogFont 1
Laisser Éditer1&=@Créer("Edit",%HWND,"StatusWindow",32,88,121,21)
Laisser Button1&=@Créer("Button",%HWND,"Part 1",168,88,75,20)
Laisser Button2&=@Créer("Button",%HWND,"Pfad",168,118,75,20)
Laisser Button3&=@Créer("Button",%HWND,"Beenden",265,118,75,20)
Laisser RadioButton1& = @Créer(Bouton Radio ",%hWnd,"Left",32,20,50,13)
Laisser RadioButton2& = @Créer(Bouton Radio ",%hWnd,"Center",32,40,50,13)
Laisser RadioButton3& = @Créer(Bouton Radio ",%hWnd,"Right",32,60,50,13)
@Créer(Groupbox,%hWnd,"TextAlign",25,4,70,73)
SetCheck RadioButton1&,1
Laisser RadioButton4& = @Créer(Bouton Radio ",%hWnd,"Ohne",112,20,50,13)
Laisser RadioButton5& = @Créer(Bouton Radio ",%hWnd,"Mit",112,40,50,13)
@Créer(Groupbox,%hWnd,"Icon",105,4,70,73)
SetCheck RadioButton4&,1
Laisser RadioButton6& = @Créer(Bouton Radio ",%hWnd,"Normal",192,20,55,13)
Laisser RadioButton7& = @Créer(Bouton Radio ",%hWnd,"Fett",192,40,50,13)
Laisser RadioButton8& = @Créer(Bouton Radio ",%hWnd,"Kursiv",192,60,50,13)
@Créer(Groupbox,%hWnd,"Schrift",185,4,70,73)
SetCheck RadioButton6&,1
Laisser RadioButton9& = @Créer(Bouton Radio ",%hWnd,"System",272,20,55,13)
Laisser RadioButton10& = @Créer(Bouton Radio ",%hWnd,"Rot",272,40,50,13)
Laisser RadioButton11& = @Créer(Bouton Radio ",%hWnd,"Blau",272,60,50,13)
@Créer(Groupbox,%hWnd,"Farbe",265,4,70,73)
SetCheck RadioButton9&,1
Laisser FontFett& = @Créer("Font","MS Sans Serif",13,0,1,0,0)
Laisser FontKursiv& = @Créer("Font","MS Sans Serif",13,0,0,1,0)
Laisser SB& = SB_Create(130,-1)
Laisser 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
    Laisser Text$ = @GetText $(Éditer1&)
    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

    Paramètres a%
    Laisser Text$ = @GetText $(Éditer1&)
    SB_SetText SB&,1,Text$,a%

ENDPROC

Proc Schrift

    Paramètres Font&
    WM_SetFont SB&,Font&
    Path_Ellipsis SB&,2,AltText$

ENDPROC

Proc la couleur

    Paramètres Wert&
    SB_SetBkColor SB&,Wert&
    Path_Ellipsis SB&,2,AltText$

ENDPROC

Proc Pfadausgabe

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

    Si Text$ <> »

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

    D'autre

        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

    Si  %clé = 2

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

        la couleur -1

    ElseIf GetFocus(RadioButton10&)

        la couleur $0000FF

    ElseIf GetFocus(RadioButton11&)

        la couleur $FF0000

    ElseIf GetFocus(Button2&)

        Pfadausgabe

    ElseIf GetFocus(Button3&)

        Laisser Ende_HWND%=1

    EndIf

Wend

DeleteObject FontFet&
DeleteObject FontKursiv&
Fin