PureBoard

Code: Alles auswählen

#WindowsBlue     = $E6A07A
#OliveGree       = $ABD8CA
#WindowsSiver    = $D3C7C3
#ContainerBlue   = $FFF2ED
#ContainerGreen  = $ECF6F6
#ContainerSilver = $F5F1F0
#TME_HOVER       = 1
#TME_LEAVE       = 2

Structure CTStruct ; Eigenschaften eines Container
 CTNr.l
 CTHwnd.l
 CTText.s
 CTx.l
 CTy.l 
 CTWidth.l
 CTSize.l
 CTHeight.l
 CTDisable.b
 CTIcon.l
 CTMinMax.b
EndStructure

Global PB_Callback_intern
Global *mywnd_XPS.CWPSTRUCT
Global *mymsg_XPS.MSG
Global myRect_XPS.RECT
Global subRect_XPS.RECT
Global HWND_XPS,Grundcontainer,Weite_XPS,Oben_XPS,Links_XPS,ox,oy,oh,WndProcHook_XPS
Global Unten_XPS,CCounter,ContainerOffset,AllContainerHight,MsgProcHook_XPS
Global ContainerWidth,BlueImage,ColorSkin
Global Dim SCA.CTStruct(5);SubContainerArray
Global Dim HCA.CTStruct(5);HeadContainerArray

Procedure DrawContainerHeadHover(hWnd);Containerskinhover wird auf den DC gezeichnet
 Protected i,ConDC,NewImageHDC,TempDC,TextColor
 If CCounter >= 1
  For i = 0 To CCounter -1   
   If HCA(i)\CTHwnd = hWnd
    ConDC = GetDC_(HCA(i)\CTHwnd)      
    If ColorSkin = 0
     BlueImage   = CatchImage(#PB_Any,?BLUEx)
     TextColor = $FF8E42
    ElseIf ColorSkin = 1
     BlueImage   = CatchImage(#PB_Any,?OLIVx)
     TextColor = $1D9272
    ElseIf ColorSkin = 2
     BlueImage   = CatchImage(#PB_Any,?SILVx)
     TextColor = $7C7C7E
    EndIf   
    StartDrawing(ImageOutput(BlueImage))
    DrawingMode(#PB_2DDrawing_Transparent)
    DrawingFont(FontID(0))
    DrawText(15,4,HCA(i)\CTText,TextColor)
    StopDrawing()
   
    TempDC = CreateCompatibleDC_(ConDC)
    SelectObject_(TempDC,ImageID(BlueImage))
    BitBlt_(ConDC,0,0,5,20,TempDC,7,2,#SRCCOPY);linke Bildseite
    BitBlt_(ConDC,5,0,180,20,TempDC,13,2,#SRCCOPY);mittlerer Teil
    If SCA(i)\CTMinMax = 1
     BitBlt_(ConDC,155,0,25,20,TempDC,190,2,#SRCCOPY);rechte Bildseite (Knopf)
    ElseIf SCA(i)\CTMinMax = 0 
     BitBlt_(ConDC,155,0,25,20,TempDC,242,2,#SRCCOPY);rechte Bildseite (Knopf)
    EndIf 
    ReleaseDC_(HCA(i)\CTHwnd,ConDC) : DeleteDC_(TempDC)
    FreeImage(BlueImage)
   EndIf 
  Next i
 EndIf
EndProcedure

Procedure DrawContainerHead();Containerskin wird auf den DC gezeichnet
 Protected i,ConDC,NewImageHDC,TempDC,TextColor
 If CCounter >= 1
  For i = 0 To CCounter -1   
   If ColorSkin = 0
    BlueImage   = CatchImage(#PB_Any,?BLUEx)
    TextColor = $C65D21
   ElseIf ColorSkin = 1
    BlueImage   = CatchImage(#PB_Any,?OLIVx)
    TextColor = $2D6656
   ElseIf ColorSkin = 2
    BlueImage   = CatchImage(#PB_Any,?SILVx)
    TextColor = $3D3D3F
   EndIf   
   StartDrawing(ImageOutput(BlueImage))
   DrawingMode(#PB_2DDrawing_Transparent)
   DrawingFont(FontID(0))
   DrawText(15,4,HCA(i)\CTText,TextColor)
   StopDrawing()
   ConDC = GetDC_(HCA(i)\CTHwnd)
   TempDC = CreateCompatibleDC_(ConDC)
   SelectObject_(TempDC,ImageID(BlueImage))
   BitBlt_(ConDC,0,0,5,20,TempDC,7,2,#SRCCOPY);linke Bildseite
   BitBlt_(ConDC,5,0,180,20,TempDC,13,2,#SRCCOPY);mittlerer Teil
   If SCA(i)\CTMinMax = 1
    BitBlt_(ConDC,155,0,25,20,TempDC,164,2,#SRCCOPY);rechte Bildseite (Knopf)
   ElseIf SCA(i)\CTMinMax = 0 
    BitBlt_(ConDC,155,0,25,20,TempDC,216,2,#SRCCOPY);rechte Bildseite (Knopf)
   EndIf 
   ReleaseDC_(HCA(i)\CTHwnd,ConDC) : DeleteDC_(TempDC)
   FreeImage(BlueImage)
  Next i
 EndIf
EndProcedure

Procedure EraseBackground()
 If IsGadget(Grundcontainer)
  SetWindowPos_(GadgetID(Grundcontainer),#HWND_TOP,Links_XPS,Oben_XPS,ContainerWidth,Unten_XPS,0)
  If Unten_XPS < GetGadgetAttribute(Grundcontainer,#PB_ScrollArea_InnerHeight)
   ContainerWidth = 217
  Else
   ContainerWidth = 200
  EndIf
 EndIf
EndProcedure

Procedure Paint()
 If IsGadget(Grundcontainer)
 SetWindowPos_(GadgetID(Grundcontainer),#HWND_TOP,Links_XPS,Oben_XPS,ContainerWidth,Unten_XPS,0)
 EndIf
EndProcedure

Procedure RePosContainer()
 Protected i
 For i = 1 To CCounter-1
  HCA(i)\CTy = SCA(i-1)\CTHeight + SCA(i-1)\CTy +15 
  SetWindowPos_(HCA(i)\CTHwnd,0,HCA(i)\CTx,HCA(i)\CTy,HCA(i)\CTWidth,HCA(i)\CTHeight,0) 
  If SCA(i)\CTy <> SCA(i-1)\CTHeight + SCA(i-1)\CTy +35
   SCA(i)\CTy = SCA(i-1)\CTHeight + SCA(i-1)\CTy +35   
   SetWindowPos_(SCA(i)\CTHwnd,0,SCA(i)\CTx,SCA(i)\CTy,SCA(i)\CTWidth,SCA(i)\CTHeight,0)
   InvalidateRect_(SCA(i)\CTHwnd,0,#True)
  EndIf
 Next i
EndProcedure

Procedure LButtonDown(HWND)
 Protected i
 AllContainerHight = 0
 For i = 0 To CCounter-1
  If HWND = HCA(i)\CTHwnd
   If SCA(i)\CTMinMax = 1
    SetWindowPos_(SCA(i)\CTHwnd,0,SCA(i)\CTx,SCA(i)\CTy,SCA(i)\CTWidth,0,0)        
    GetClientRect_(SCA(i)\CTHwnd,subRect_XPS)
    SCA(i)\CTHeight = subRect_XPS\bottom        
    SCA(i)\CTMinMax = 0  
   Else    
    SetWindowPos_(SCA(i)\CTHwnd,0,SCA(i)\CTx,SCA(i)\CTy,SCA(i)\CTWidth,SCA(i)\CTSize,0)
    GetClientRect_(SCA(i)\CTHwnd,subRect_XPS)
    SCA(i)\CTHeight = subRect_XPS\bottom   
    SCA(i)\CTMinMax = 1    
   EndIf 
  EndIf 
  AllContainerHight + SCA(i)\CTHeight +35
 Next i 
 If IsGadget(Grundcontainer)
  SetGadgetAttribute(Grundcontainer,#PB_ScrollArea_InnerHeight,AllContainerHight+10)
 EndIf
 RePosContainer()
EndProcedure

Procedure GetPBCallback(HWND)
  ProcedureReturn GetClassLong_(HWND,#GCL_WNDPROC)
EndProcedure

Procedure CallWndProc_XPS(code,wParam,lParam); Sendmessage Hook
Protected WndProcHook_XPS
*mywnd_XPS = lParam 
 If *mywnd_XPS\hwnd = HWND_XPS
  If *mywnd_XPS\message = #WM_ERASEBKGND : EraseBackground() : EndIf
 EndIf
 ProcedureReturn CallNextHookEx_(WndProcHook_XPS,code,wParam,lParam)
EndProcedure

Procedure GetMsgProc_XPS(code,wParam,lParam); Postmessage Hook
 Protected i,MsgProcHook_XPS
 ;Mauspositionen und Fenstergroesse bestimmen
 *mymsg_XPS = lParam 
 If *mymsg_XPS\hwnd = HWND_XPS
  GetClientRect_(*mymsg_XPS\hwnd ,myRect_XPS)
  Weite_XPS = myRect_XPS\right - myRect_XPS\left : Links_XPS = myRect_XPS\left +ox 
  Oben_XPS  = myRect_XPS\top +oy             : Unten_XPS = myRect_XPS\bottom - myRect_XPS\top -oh  
  If *mymsg_XPS\message = #WM_PAINT : Paint() : EndIf   
  If *mymsg_XPS\message = #WM_NCMOUSELEAVE  
   If IsGadget(Grundcontainer)
    SetWindowPos_(GadgetID(Grundcontainer),#HWND_TOP,Links_XPS,Oben_XPS,ContainerWidth,Unten_XPS,0)
   EndIf
  EndIf 
 EndIf 
 ProcedureReturn CallNextHookEx_(MsgProcHook_XPS,code,wParam,lParam)
EndProcedure

Procedure MouseMove(hWnd)
Structure MMTRACKMOUSEEVENT
 cbSize.l
 dwFlags.l
 hwndTrack.l
 dwHoverTime.l
EndStructure
 TMME.MMTRACKMOUSEEVENT
 TMME\cbSize = SizeOf(MMTRACKMOUSEEVENT)
 TMME\dwFlags = #TME_LEAVE | #TME_HOVER
 TMME\dwHoverTime = 10
 TMME\hwndTrack = hWnd
 TrackMouseEvent_(TMME)
EndProcedure

Procedure Container_Callback(hWnd,Msg,wParam,lParam) ; Callback fuer Container
 Protected i
  Select Msg    
    Case #WM_MOUSELEAVE
     DrawContainerHead()
     ProcedureReturn 0          
    Case #WM_MOUSEHOVER
     DrawContainerHeadHover(hWnd)
     ProcedureReturn 0  
    Case #WM_MOUSEMOVE
     MouseMove(hWnd) 
     ProcedureReturn 0    
    Case #WM_LBUTTONDOWN
     LButtonDown(hWnd)
     DrawContainerHead()
     ProcedureReturn 0    
    Case #WM_ERASEBKGND
     For i = 0 To CCounter-1      
      If HCA(i)\CTHwnd = hWnd
       DrawContainerHead()
       ProcedureReturn 0
      EndIf    
     Next i    
    Case #WM_DESTROY
     DeleteObject_( GetClassLong_(hWnd,#GCL_HBRBACKGROUND) )
     ProcedureReturn 0  
  EndSelect  
  If PB_Callback_intern
    ProcedureReturn CallWindowProc_(PB_Callback_intern,hWnd,Msg,wParam,lParam)
  Else
    ProcedureReturn DefWindowProc_(hWnd,Msg,wParam,lParam)
  EndIf  
EndProcedure

Procedure Container(x,y,width,height,parent,backcolor,Name$)
  Protected window_class$,wc.WNDCLASSEX
  Static container_count
  If backcolor = -1
    backcolor  = GetSysColor_(#COLOR_BTNFACE)
  EndIf
  window_class$ = "PGDR_"+Name$+"Container"+RSet(Hex(container_count),3,"0")
  container_count + 1 
  wc\cbSize        = SizeOf(WNDCLASSEX)
  wc\lpfnWndProc   = @Container_Callback()
  wc\hInstance     = 0
  wc\hCursor       = LoadCursor_(0, #IDC_ARROW)
  wc\hbrBackground = CreateSolidBrush_(backcolor)
  wc\lpszClassName = @window_class$
  If RegisterClassEx_(@wc)
    ProcedureReturn CreateWindowEx_(0,window_class$,0,#WS_CHILD|#WS_VISIBLE,x,y,width,height,parent,0,GetModuleHandle_(0),0)
  EndIf
EndProcedure

Procedure InitSidebar(HWND,ContainerCount,Skin,XOffset=0,YOffset=0,HeightOffset=0) 
 If HWND_XPS = 0
  HWND_XPS          = HWND
  CCounter          = 0
  ContainerOffset   = 15
  ContainerWidth    = 200
  AllContainerHight = oy
  ox = XOffset : oy = YOffset : oh = HeightOffset  
  GetClientRect_(HWND_XPS,myRect_XPS)
  Unten_XPS = myRect_XPS\bottom - myRect_XPS\top -oh
  If (Skin < 0) Or (Skin > 2) : ColorSkin = 0 : Else : ColorSkin = Skin : EndIf
  LoadFont(0,"Arial",10,#PB_Font_Bold|#PB_Font_HighQuality) 
  Global Dim SCA.CTStruct(ContainerCount); Anzahl der Container
  Global Dim HCA.CTStruct(ContainerCount); Anzahl der Container
  PB_Callback_intern = GetPBCallback(HWND_XPS); internen PB-Callback ermitteln 
  ; Ein Hook auf Sendmessage und Postmessage 
  WndProcHook_XPS = SetWindowsHookEx_(#WH_CALLWNDPROC,@CallWndProc_XPS(),0,GetCurrentThreadId_())
  MsgProcHook_XPS = SetWindowsHookEx_(#WH_GETMESSAGE,@GetMsgProc_XPS(),0,GetCurrentThreadId_())  
  CreateGadgetList(HWND_XPS)
  Grundcontainer = ScrollAreaGadget(#PB_Any,Links_XPS,Oben_XPS,ContainerWidth,Unten_XPS,200,Unten_XPS,5,#PB_ScrollArea_BorderLess)
  If ColorSkin = 0 
   SetGadgetColor(Grundcontainer,#PB_Gadget_BackColor,#WindowsBlue)
  ElseIf ColorSkin = 1
   SetGadgetColor(Grundcontainer,#PB_Gadget_BackColor,#OliveGree)
  Else
   SetGadgetColor(Grundcontainer,#PB_Gadget_BackColor,#WindowsSiver)
  EndIf 
  ProcedureReturn GadgetID(Grundcontainer)
 Else
  ProcedureReturn 0
 EndIf  
EndProcedure

Procedure AddContainer(Size,Text$)
 Protected Headcontainer,Subcontainer,Scrollchild
 If GadgetID(Grundcontainer) <> 0
  If CCounter >= 1
   ContainerOffset = ContainerOffset + SCA(CCounter-1)\CTHeight + 35
  EndIf
  Scrollchild = FindWindowEx_(GadgetID(Grundcontainer), 0, "PureScrollAreaChild", "")
  AllContainerHight + Size +35 
  Headcontainer = Container(10,ContainerOffset,180,20,Scrollchild,#ContainerBlue,"Head") 
  HCA(CCounter)\CTNr     = CCounter
  HCA(CCounter)\CTHwnd   = Headcontainer
  HCA(CCounter)\CTx      = 10
  HCA(CCounter)\CTy      = ContainerOffset 
  HCA(CCounter)\CTWidth  = 180
  HCA(CCounter)\CTHeight = 20
  HCA(CCounter)\CTSize   = 20
  HCA(CCounter)\CTText   = Text$  
  If ColorSkin = 0
   Subcontainer = Container(10,ContainerOffset+20,180,Size,Scrollchild,#ContainerBlue,"Sub")
  ElseIf ColorSkin = 1
   Subcontainer = Container(10,ContainerOffset+20,180,Size,Scrollchild,#ContainerGreen,"Sub")
  Else
   Subcontainer = Container(10,ContainerOffset+20,180,Size,Scrollchild,#ContainerSilver,"Sub")
  EndIf   
  SCA(CCounter)\CTNr     = CCounter
  SCA(CCounter)\CTHwnd   = Subcontainer
  SCA(CCounter)\CTx      = 10
  SCA(CCounter)\CTy      = ContainerOffset +20
  SCA(CCounter)\CTWidth  = 180
  SCA(CCounter)\CTHeight = Size
  SCA(CCounter)\CTSize   = Size
  SCA(CCounter)\CTText   = Text$
  SCA(CCounter)\CTMinMax = 1
  CCounter +1 
  SetGadgetAttribute(Grundcontainer,#PB_ScrollArea_InnerHeight,AllContainerHight+10)
  If Unten_XPS < AllContainerHight
   ContainerWidth = 217  
  Else
   ContainerWidth = 200
  EndIf 
  ProcedureReturn Subcontainer
 Else
  ProcedureReturn 0
 EndIf
EndProcedure

Procedure SidebarFree()
  UnhookWindowsHookEx_(WndProcHook_XPS)
  UnhookWindowsHookEx_(MsgProcHook_XPS)
  FreeFont(0) 
EndProcedure

DataSection ; Die Bilder zum Aufbau der Container
BLUEx: IncludeBinary "blue.bmp"
OLIVx: IncludeBinary "olive.bmp"
SILVx: IncludeBinary "silver.bmp"
EndDataSection

Code: Alles auswählen

XIncludeFile "XPSideBar.pbi"
#WindowOptions1 = #PB_Window_SystemMenu|#PB_Window_SizeGadget|#PB_Window_TitleBar|#PB_Window_MaximizeGadget
#WindowOptions2 = #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered

HWND = OpenWindow(0,0,0,900,700,"XP-Sidebar-Demo",#WindowOptions1|#WindowOptions2)

;Initialisierung der SideBar, darf nur einmal aufgerufen werden
;InitSidebar(hWnd,Container,Skin,OffsetX,OffsetY,OffsetHoehe)
;hWnd as Long       = Fensterhandle auf dem die SideBar erscheinen soll 
;Container as Long  = Anzahl der Container (reserviert den benötigten Speicherplatz)
;Skin as Long       = XP-Skin 0 = blau, 1 = grün, 2 = silber 
;OffsetX as Long    = X-Offset fuer die SideBar
;OffsetY as Long    = Y-Offset fuer die SideBar (z.B. wenn Tollbar vorhanden)
;OffseHoehe as Long = Offset für die Höhe der SideBar (z.B. wenn Statusbar vorhanden)
If InitSidebar(HWND,4,0,0,0,0)  
;Container hinzufügen
;AddContainer(ContainerHight,Text$)
;ContainerHight as Long = Containerhöhe
;Text$ as String        = Containerbeschriftung
 Con1 = AddContainer(60,"Container 1")
;mit "UseGadgetList(Container)werden alle folgenden Gadget in den Container übernommen. 
 UseGadgetList(Con1)
 Frame3DGadget(1,5,5,170,50,"")
 OptionGadget(2,10,15,160,20,"Option 1")
 OptionGadget(3,10,32,160,20,"Option 2")  
;nächsten Container hinzufügen 
 Con2 = AddContainer(140,"Container 2")
 UseGadgetList(Con2);Gadget jetzt in Container 2 schreiben
 CalendarGadget(7,1,1,178,139)
;nächsten Container hinzufügen 
 Con3 = AddContainer(60,"Container 3")
 UseGadgetList(Con3);Gadget jetzt in Container 3 schreiben
 ButtonGadget(4,5,10,170,20,"Test1")
 ButtonGadget(5,5,35,170,20,"Test2")
;nächsten Container hinzufügen 
 Con4 = AddContainer(290,"Container 4")
 UseGadgetList(Con4);Gadget jetzt in Container 4 schreiben
 ExplorerListGadget(6,5,5,170, 280,"")

EndIf
;zum Abschluss wieder auf die Gadgetliste des Fensters umschalten
UseGadgetList(HWND)

Repeat
  Event = WaitWindowEvent()
  WindowID = EventWindow()
  GadgetID = EventGadget()
  EventType = EventType()
  If Event = #PB_Event_Gadget

  EndIf
Until Event = #PB_Event_CloseWindow

SidebarFree();Resourcen wieder freigeben