PureBasic Forums - English

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