PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

XP-SideBar als Include mit Skins

https://www.purebasic.fr/german/viewtopic.php?t=16899

Seite 5 von 5

Re: XP-SideBar als Include mit Skins

Verfasst: 14.07.2010 18:30
von c4s
Momentan bin ich auf der Suche nach einer Sidebar wie sie z.B. bei Spybot zu finden ist und ich glaube mich daran erinnern zu können, dass dieser Code hier ähnliches macht (bin aber nicht mehr ganz sicher, weil ja Bilder vom ersten Post leider Offline sind). Besteht die Möglichkeit das Paket nochmal hochzuladen?

Bzw. gibt es richtige Api-Befehle dafür oder ist es auch bei Spybot nur eine eigene Lösung?

Re: XP-SideBar als Include mit Skins

Verfasst: 15.07.2010 12:57
von mk-soft
Sehr schöne Arbeit :allright:

Bei Window 7 X64 mit PB x64 kommt leider das Event #WM_MOUSEHOVER nicht durch ???

FF <)

Re: XP-SideBar als Include mit Skins

Verfasst: 20.01.2011 21:38
von SamsonToomas
Hollo to all and sorry for English writing in German forum
i need to use this useful code in my project
and i need use a pic in bottom of sidebar and control it (change if need)
Bild

please help me for this request, Thanks

Re: XP-SideBar als Include mit Skins

Verfasst: 20.01.2011 21:48
von TomS
Look for the following code:

Code: Alles auswählen

Con4 = AddContainer(290,"Container 4")
UseGadgetList(Con4);Gadget jetzt in Container 4 schreiben
ExplorerListGadget(6,5,5,170, 280,"")
And simply add this after it:

Code: Alles auswählen

Con5 = AddContainer(290, "Container 5")
UseGadgetList(Con5)
ImageGadget(7 ,5, 5, 170, 280, ImageID)

Re: XP-SideBar als Include mit Skins

Verfasst: 21.01.2011 08:31
von SamsonToomas
thanks TomS
but i need a fix image (without a Container by Up and Down after any click).

Re: XP-SideBar als Include mit Skins

Verfasst: 21.01.2011 14:37
von bobobo
disablegadget(...) might help

Re: XP-SideBar als Include mit Skins

Verfasst: 19.01.2012 16:10
von dysti
Hallo,
der Downloadlink funktioniert nicht!
Ist das bei Euch auch so?
Gruß Dysti

Re: XP-SideBar als Include mit Skins

Verfasst: 20.01.2012 02:40
von Bisonte
Ist nicht weiter wild. Im Thread selbst ist der Source abgebildet, nur die
Images muss man sich selbst erstellen.
Da sie nur der Farbgebung dienen, eigentlich einfach. Sind nur eine einfarbige
Box pro Bild.

oder nutze dies (weil wir alle faule sind ;) ):

Code: Alles auswählen

; XP-SideBar
; Author : legion
; Original : http://purebasic.fr/german/viewtopic.php?p=201675#p201675
; leicht modifiziert wegen nicht mehr funktionierendem DL

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

Structure CTStruct ; Eigenschaften eines Container
CTNr.i
CTHwnd.i
CTText.s
CTx.i
CTy.i
CTWidth.i
CTSize.i
CTHeight.i
CTDisable.i
CTIcon.i
CTMinMax.i
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 MakeXPSkinImage(Color)
  
  Protected Image = CreateImage(#PB_Any,32,32)
  
  If IsImage(Image)
    If StartDrawing(ImageOutput(Image))
      Box(0,0,OutputWidth(),OutputHeight(),Color)
      StopDrawing()
    EndIf
    ProcedureReturn Image  
  EndIf
  ProcedureReturn #False
  
EndProcedure

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   = MakeXPSkinImage(#WindowsBlue) ;CatchImage(#PB_Any,?BLUEx)
     TextColor = $FF8E42
    ElseIf ColorSkin = 1
     BlueImage   = MakeXPSkinImage(#OliveGree) ;CatchImage(#PB_Any,?OLIVx)
     TextColor = $1D9272
    ElseIf ColorSkin = 2
     BlueImage   = MakeXPSkinImage(#WindowsSiver) ;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   = MakeXPSkinImage(#WindowsBlue) ;CatchImage(#PB_Any,?BLUEx)
    TextColor = $C65D21
   ElseIf ColorSkin = 1
    BlueImage   = MakeXPSkinImage(#OliveGree) ;CatchImage(#PB_Any,?OLIVx)
    TextColor = $2D6656
   ElseIf ColorSkin = 2
    BlueImage   = MakeXPSkinImage(#WindowsSiver) ;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_()) 
  UseGadgetList(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

Download Link nicht mehr gültig

Verfasst: 21.01.2012 14:19
von alen
@legion
Grüß Gott,

der Download Link funktioniert nicht mehr :-(
Gibt es einen alternativen Download ?

Grüße aus dem Ruhrgebiet.
Alen
legion hat geschrieben:Hallo !

Habe wie versprochen den MouseHover implementiert.
Die neue Version steht ab sofort zum Download bereit.

Download

Lg. Legion

Re: XP-SideBar als Include mit Skins

Verfasst: 21.01.2012 15:24
von Bisonte
Gibt es einen alternativen Download ?
Ähm siehe mein posting oben....
das ist die "aktuelle" ;) Version, der XPSidebar.pbi inklusive der Grafiken (werden jetzt on the fly erstellt)
das Testbeispiel ist immer noch im ersten Post von diesem Thread
Alle Zeiten sind UTC+02:00
Seite 5 von 5

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de