Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Outlook-Panelbar erstellen
(c) by Rolf Koch - Rokosoft - Koblenz / 2004
www.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&