XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Panelbar erstellen (so ähnlich wie in Outlook)
(c) by Rolf Koch - Rokosoft - Koblenz / 2004www.rokosoft.de  - webmaster@rokosoft.de
------------------------------------------------------------------------------------------------------------
DECLARE RETURNPANEL1&,RETURNPANEL2&,RETURNPANEL&,PANELUP&,PANELDOWN&
DECLARE PANELFONT&
declare Panelx%,Panelstop%,Panely%
DECLARE rkb#,bmp#,ctrl&
DECLARE rkh&,rkc&,rkbild&
Def @LoadImage(6) !USER32,LoadImageA
DEF ExtractIcon(3) ! SHELL32,ExtractIconA
CharSet 2
PANELFONT&=@CreateFont(Webdings,18,0,0,0,0)

PROC UPDOWN

    If getfocus(paneldown&)

        Panelx%=Panelx%-45
        setwindowpos panel&=0,panelx%-95,3000;0

    ELSEIf getfocus(panelup&)

        Panelx%=Panelx%+45
        setwindowpos panel&=0,panelx%-95,3000;0

    ENDIF

    Sleep 100

    if panelx%=0 or gt(panelx%,0)

        enablewindow Panelup&,0

    else

        enablewindow Panelup&,1

    endif

    If panelx%=-Panely%+45

        enablewindow Paneldown&,0

    else

        enablewindow Paneldown&,1

    endif

ENDPROC

PROC CREATE_PANEL

    PARAMETERS HANDEL&,x%,y%,x2%,y2%
    RETURNPANEL1&=Control(STATIC,,$56000104,x%,y%,x2%,y2%,HANDEL&,2000,%hinstance,512)
    RETURNPANEL2&=Control(STATIC,,$56000104,1,20,x2%-5,y2%-45,RETURNPANEL1&,2000,%hinstance)
    RETURNPANEL&=Control(STATIC,,$56000104,0,0,x2%-5,3000,RETURNPANEL2&,2000,%hinstance)
    PANELUP&=CREATEBUTTON(RETURNPANEL1&,chr$(53),1,1,x2%-6,15)
    PANELDOWN&=CREATEBUTTON(RETURNPANEL1&,chr$(54),1,y2%-20,x2%-6,15)
    Setfont Panelup&,Panelfont&
    Setfont Paneldown&,Panelfont&
    RETURN RETURNPANEL&

ENDPROC

PROC PANELBUTTON

    aus Vorlage (c) Andreas Miethe - Genial DANKE!
    inc Panelstop%
    Panely%=panelstop%*45
    PARAMETERS LBILD$,rhwnd&,rkx%,rky%,rkx2%,rky2%
    Dim rkb#,(Len(LBILD$) + 1)
    String rkb#,0=LBILD$
    Let rkh&=LoadImage(%HInstance,rkb#,0,rkx2%,rky2%,$0050)
    LET rkc&=@Control(Button,,$5000008A,rkx%,rky%,rkx2%,rky2%,rhwnd&,1001,%Hinstance)
    Sendmessage(rkc&,$00F7,0,rkh&)
    Dispose rkb#
    Return rkc&

ENDPROC

-----------------------------------------------------------------
SetErrorLevel 0 Wichtig wegen negativer Fenstergröße
Def GetSysColor(1) !USER32,GetSysColor
Declare PANEL&,INFOBUTTON&,PANELBUTTON1&,PANELBUTTON2&,PANELBUTTON3&
Declare PANELBUTTON4&,PANELBUTTON5&,PANELBUTTON6&
Declare PANELBUTTON7&,PANELBUTTON8&,ENDE%,ANZEIGE&
Windowstyle 63
Windowtitle Panelbar © by Rolf Koch - 2004
WINDOW 22,20-340,355
CLS GetSysColor(15)
SETDIALOGFONT 1
Loadbmp Seite.bmp,0,0;0
CREATE_PANEL %HWND,35,3,102,310 			PANEL ERSTELLEN
Panel&=&(0)						PANEL VARIABLE ZUWEISEN
PANELBUTTON INFOBUTTON.BMP,PANEL&,0,0,95,40		BUTTONS EINFÜGEN (wenn andere Grösse - Include ändern.)
LET INFOBUTTON&=@&(0)
PANELBUTTON BEISPIEL1.BMP,PANEL&,0,45,95,40
LET PANELBUTTON1&=@&(0)
PANELBUTTON BEISPIEL2.BMP,PANEL&,0,90,95,40
LET PANELBUTTON2&=@&(0)
PANELBUTTON BEISPIEL3.BMP,PANEL&,0,135,95,40
LET PANELBUTTON3&=@&(0)
PANELBUTTON BEISPIEL4.BMP,PANEL&,0,180,95,40
LET PANELBUTTON4&=@&(0)
PANELBUTTON BEISPIEL5.BMP,PANEL&,0,225,95,40
LET PANELBUTTON5&=@&(0)
PANELBUTTON BEISPIEL6.BMP,PANEL&,0,270,95,40
LET PANELBUTTON6&=@&(0)
PANELBUTTON BEISPIEL7.BMP,PANEL&,0,315,95,40
LET PANELBUTTON7&=@&(0)
PANELBUTTON BEISPIEL8.BMP,PANEL&,0,360,95,40
LET PANELBUTTON8&=@&(0)
ANZEIGE&=Createmultiedit(%HWND,,140,5,185,-305)	Nur für das Beispiel hier!
UPDOWN 							VOR DER SCHLEIFE UNBEDINGT EINSETZEN!

Whilenot ende%

    Waitinput
    UPDOWN 						UND NACH WAITINPUT NOCHMALS!
    Case getfocus(Infobutton&):Settext Anzeige&,Hier wird mit normalen Profanmitteln eine Panelbar so ähnlich wie in Outlook erzeugt.
    Case getfocus(Panelbutton1&):Settext Anzeige&,Beispielbutton Nummer 1 geklickt!
    Case getfocus(Panelbutton2&):Settext Anzeige&,Beispielbutton Nummer 2 geklickt!
    Case getfocus(Panelbutton3&):Settext Anzeige&,Beispielbutton Nummer 3 geklickt!
    Case getfocus(Panelbutton4&):Settext Anzeige&,Beispielbutton Nummer 4 geklickt!
    Case getfocus(Panelbutton5&):Settext Anzeige&,Beispielbutton Nummer 5 geklickt!
    Case getfocus(Panelbutton6&):Settext Anzeige&,Beispielbutton Nummer 6 geklickt!
    Case getfocus(Panelbutton7&):Settext Anzeige&,Beispielbutton Nummer 7 geklickt!
    Case getfocus(Panelbutton8&):Settext Anzeige&,Beispielbutton Nummer 8 geklickt!
    Setfocus(%hwnd)
    Angewohnheit um nicht auf Objekt zu belassen.

Wend

DELETEOBJECT PANELFONT&
end