Code: Select all
;MultiSplitter & gadgets container
;by einander
;PB 4.20 - june 2008
;Thanks Sparkie for the procedure NoFlick
Global _nSplitters,_WiSlid
#No=#PB_Ignore
#DBLUE=$880000
#LBLUE=$FFFCC2
Structure Splitter
Slid.l
X.l
Gid.l
EndStructure
Procedure Lim(A,b,c)
If A<b:ProcedureReturn b
ElseIf A>c:ProcedureReturn c
EndIf
ProcedureReturn A
EndProcedure
Macro GadgetRight(Gad) : GadgetX(Gad)+GadgetWidth(Gad) : EndMacro
Macro MMx : WindowMouseX(EventWindow()) : EndMacro
Macro MMy : WindowMouseY(EventWindow()) : EndMacro
Macro DDX : DesktopMouseX() : EndMacro
Macro DDY : DesktopMouseY() : EndMacro
Macro MMK
Abs(GetAsyncKeyState_(#VK_LBUTTON) +GetAsyncKeyState_(#VK_RBUTTON)*2+GetAsyncKeyState_(#VK_MBUTTON)*3)/$8000
EndMacro
Procedure MoveSplitter(Index,Splitter.Splitter(1),X)
Static OldX
If X<>OldX
With Splitter(Index)
OldX=X
X=Lim(X,GadgetRight(Splitter(Index-1)\Slid),GadgetX(Splitter(Index+1)\Slid)-GadgetWidth(Splitter(Index+1)\Slid))
\X=X
ResizeGadget(Splitter(Index-1)\Gid,GadgetRight(Splitter(Index-1)\Slid),#No,GadgetX(\Slid)-GadgetX(Splitter(Index-1)\Slid)-_WiSlid,#No)
ResizeGadget(\Slid,X,#No,#No,#No)
ResizeGadget(\Gid,GadgetRight(Splitter(Index)\Slid),#No,GadgetX(Splitter(Index+1)\Slid)-GadgetX(\Slid)-_WiSlid,#No)
EndWith
EndIf
EndProcedure
Macro GadRGB(Gad,TextRGB,BackRGB)
SetGadgetColor(Gad,1,TextRGB)
SetGadgetColor(Gad,2,BackRGB)
EndMacro
Procedure MyFontID(FontName.s,Height.f=16,Width.f=-1,Angle=0,Orientation=0,Weight=100,Italic=0,Underline=0) ; Set Api Font
; create new font Inside StartDrawing/StopDrawing - Return Font ID - <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
If Width=-1:Width=Height/2:EndIf
F.LOGFONT
F\lfHeight = Height
F\LfWidth = Width
F\LfEscapement = Angle
F\LfOrientation = Orientation
F\LfWeight = Weight ;#FW_BOLD
F\LfItalic = Italic
F\LfUnderline = Underline
F\LfStrikeOut = 0
F\lfCharSet = #ANSI_CHARSET
F\LfOutPrecision = #OUT_DEFAULT_PRECIS
F\LfClipPrecision = #CLIP_DEFAULT_PRECIS
F\LfQuality = #PROOF_QUALITY
F\LfPitchAndFamily = #FF_ROMAN
PokeS(@F\LfFaceName[0], FontName)
ProcedureReturn CreateFontIndirect_(@F.LOGFONT) ; FontID
;When you no longer need the font, call MyFreeFont(FonID) to delete it.
EndProcedure
Procedure FontGad(Gad,FontName.s,Height,Width=-1)
; Set font for gadget GAD inside StartDrawing/StopDrawing
If Width=-1:Width=Height/2:EndIf
FontID=MyFontID(FontName,Height,Width)
SetGadgetFont(Gad,FontID)
ProcedureReturn FontID ; when
;When you no longer need the font, call MyFreeFont(FonID) to delete it.
EndProcedure
Procedure MyFreeFont(FontID)
DeleteObject_(FontID)
EndProcedure
Macro NoFlick(Gad) ; this one is from Sparkie <<<<<<<<<<<<<
SetWindowLong_(GadgetID(Gad), -20, GetWindowLong_(GadgetID(Gad), -20) | $2000000)
EndMacro
Procedure InitSplitter(X,Y,Wi,He,Splitter.Splitter(1))
;first and last buttons (sliders) are not visible, but their position is relevant
CG = ContainerGadget(-1,X,Y,Wi,He,#PB_Container_Flat)
NoFlick(CG)
Dim Splitter.Splitter(_nSplitters+1)
Sep=(Wi+_WiSlid)/(_nSplitters+1)
For i=0 To _nSplitters+1
X=i*Sep-_WiSlid
Splitter(i)\X=X ; start pos equidistant
If i > _nSplitters : X=Wi-2 : EndIf
Splitter(i)\Slid=ButtonGadget(-1,X,1,_WiSlid,He-3,"") ; also try with text and wider _WiSlid
; FontGad(Splitter(i)\Slid,"arial",He*0.7) ; in case splitter(i)\Slid width and text
SetGadgetData(Splitter(i)\Slid,i)
Next
; add some gadgets
;-----------
Wi=GadgetX(Splitter(1)\Slid)-GadgetX(Splitter(0)\Slid) -_WiSlid
Splitter(0)\Gid=EditorGadget(-1,GadgetRight(Splitter(0)\Slid),1,Wi,He-3 )
GadRGB(Splitter(0)\Gid,#DBLUE,$CCFFFF)
FontGad(Splitter(0)\Gid,"arial",20)
For i = 0 To 8 : AddGadgetItem(Splitter(0)\Gid, i, "Line "+Str(i)) : Next
;-----------
Wi=GadgetX(Splitter(2)\Slid)-GadgetX(Splitter(1)\Slid) -_WiSlid
Splitter(1)\Gid=ExplorerTreeGadget(-1,GadgetRight(Splitter(1)\Slid),1,Wi,He-3,"c:\" )
GadRGB(Splitter(1)\Gid,#DBLUE,#LBLUE)
;-----------
Wi=GadgetX(Splitter(3)\Slid)-GadgetX(Splitter(2)\Slid) -_WiSlid
Splitter(2)\Gid=CalendarGadget(-1,GadgetRight(Splitter(2)\Slid),1,Wi,He-3 )
GadRGB(Splitter(2)\Gid,#DBLUE,$DDEEFF)
FontGad(Splitter(2)\Gid,"arial",10)
;------------
Wi=GadgetX(Splitter(4)\Slid)-GadgetX(Splitter(3)\Slid) -_WiSlid
Splitter(3)\Gid=PanelGadget(-1,GadgetRight(Splitter(3)\Slid),1,Wi,He-3 )
AddGadgetItem (Splitter(3)\Gid, -1, "Panel 1")
AddGadgetItem (Splitter(3)\Gid, -1,"Panel 2")
CloseGadgetList()
;------------
Wi=GadgetX(Splitter(5)\Slid)-GadgetX(Splitter(4)\Slid) -_WiSlid
Splitter(4)\Gid=ComboBoxGadget(-1,GadgetRight(Splitter(4)\Slid),1,Wi,He-3,#PB_ComboBox_Editable )
GadRGB(Splitter(4)\Gid,#DBLUE,$DDEEFF)
FontGad(Splitter(4)\Gid,"comic sans MS",16,6)
SetGadgetText(Splitter(4)\Gid,"Enter text")
For i = 1 To 8 : AddGadgetItem(Splitter(4)\Gid, -1,"ComboBox item " + Str(i)) : Next
CloseGadgetList()
ProcedureReturn CG
EndProcedure
Macro MouseOverGadNUM ;- MouseOverGadNum : ret GadgetNUM under mouse
GetDlgCtrlID_(WindowFromPoint_(DDX,DDY))
EndMacro
Procedure MouseOverGadget(GadNUM)
GetWindowRect_(GadgetID(GadNUM),R.RECT)
GetCursorPos_(P.POINT)
ProcedureReturn PtInRect_(R,P\X,P\Y)
EndProcedure
Procedure DragGad(Gad,*Pt.POINT,MK=-1) ;- DragPOS(x,y,wi,he,*Po.Pos) ; pone en *Po\x,*Po\y posicion para Drag Catch
Static Hit,OldMx,OldMy
If MK=-1:MK=MMK:EndIf
If MK=1
If Hit
*Pt\X=MMx-OldMx : *Pt\Y=MMy-OldMy
ElseIf MouseOverGadget(Gad)
OldMx=MMx-GadgetX(Gad) : OldMy=MMy-GadgetY(Gad)
Hit=#True
EndIf
ElseIf MK=0 ; Hit Reset
Hit=#False
EndIf
ProcedureReturn Hit
EndProcedure
Macro Drag(Gad,Selected,Spli)
DragGad(Gad,@pt.POINT)
MoveSplitter(Selected,Spli,pt\X)
EndMacro
;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
hwnd=OpenWindow(0, 100, 100,700,500 ,"MultiSplitter & gadgets container", #WS_OVERLAPPEDWINDOW | #PB_Window_Maximize)
CreateGadgetList(hwnd)
Wi=WindowWidth(0):He=WindowHeight(0)
_nSplitters=4
_WiSlid=7 ; sliders width ; try other sizes, minimum 4 <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Dim Splitter1.Splitter(_nSplitters+1)
Dim Splitter2.Splitter(_nSplitters+1)
CG1=InitSplitter(100,100,600,130,Splitter1())
CG2=InitSplitter(100,300,600,60,Splitter2())
Repeat
If GetAsyncKeyState_(#VK_ESCAPE):End:EndIf
Ev=WindowEvent()
If Ev=0:Delay(10):EndIf
Gad=MouseOverGadNUM
If IsGadget(Gad)
Select Gad
Case Splitter1(1)\Slid To Splitter1(_nSplitters)\Slid
Flag=1 : Index=GetGadgetData(Gad)
Case Splitter2(1)\Slid To Splitter2(_nSplitters)\Slid
Flag=2 : Index=GetGadgetData(Gad)
EndSelect
EndIf
If MMK And Flag
If Selected=0 : Selected=Index : EndIf
If Selected
If Flag=1 : Drag(Gad,Selected,Splitter1())
ElseIf Flag=2 : Drag(Gad,Selected,Splitter2())
EndIf
EndIf
Else
Selected=0:Flag=0
DragGad(0,0,0) ; reset drag
EndIf
Until Ev=#PB_Event_CloseWindow
