Code:
; En attendant d'avoir le temps, voici un tree qui drag et drop ses items.
;*************************************************************************************************************************************************
Structure TreeItem
*ElementAddress
*Parent
Index.I
Text.S
bExpanded.I
SubExist.I
List *Sub.TreeItem()
ChildBuildingIndex.I
bForbidden.I
EndStructure
Structure ExpandBox
Left.I
Top.I
Right.I
Bottom.I
*Boolean
EndStructure
Structure ItemInfo
Left.I
Top.I
Right.I
Bottom.I
*Item
EndStructure
Structure Tree
*TreeMark
ChildBuildingIndex.I
GadgetNum.I
*Items.TreeItem
List *ExpandBox.ExpandBox()
List *ItemInfo.ItemInfo()
*ItemSource
*ItemTarget
ItemTargetParented.I
EndStructure
ExamineDesktops()
w0 = DesktopWidth(0)
h0 = DesktopHeight(0)
d0 = DesktopDepth(0)
b1 = 128
Win1 = OpenWindow(#PB_Any, b1, b1, w0 - (2 * b1), h0 - (2 * b1), "", #PB_Window_SystemMenu | #PB_Window_SizeGadget)
w1 = WindowWidth(Win1)
h1 = WindowHeight(Win1)
Gdt2 = CanvasGadget(#PB_Any, 0, 0, 512, h1, #PB_Canvas_Keyboard)
SetActiveGadget(Gdt2)
Procedure CreateItem(*Parent.TreeItem, Text.S, bExpanded = 0)
Define *Sub.TreeItem
If *Parent\SubExist = 0
InitializeStructure(*Parent, TreeItem)
*Parent\SubExist = 1
EndIf
Temp = AddElement(*Parent\Sub() )
*Parent\Sub() = AllocateMemory(SizeOf(TreeItem) )
*Parent\ChildBuildingIndex + 1
*Sub = *Parent\Sub()
*Sub\ElementAddress = Temp
*Sub\Index = *Parent\ChildBuildingIndex
*Sub\Text = Text
*Sub\bExpanded = bExpanded
*Sub\Parent = *Parent
ProcedureReturn *Sub
EndProcedure
Procedure InsertItem(*Parent.TreeItem, Text.S, bExpanded = 0)
Define *Sub.TreeItem
If *Parent\SubExist = 0
InitializeStructure(*Parent, TreeItem)
*Parent\SubExist = 1
EndIf
Temp = InsertElement(*Parent\Sub() )
*Parent\Sub() = AllocateMemory(SizeOf(TreeItem) )
*Parent\ChildBuildingIndex + 1
*Sub = *Parent\Sub()
*Sub\ElementAddress = Temp
*Sub\Index = *Parent\ChildBuildingIndex
*Sub\Text = Text
*Sub\bExpanded = bExpanded
*Sub\Parent = *Parent
ProcedureReturn *Sub
EndProcedure
Define *Tree0.TreeItem = AllocateMemory(SizeOf(TreeItem) )
Define *Tree.Tree = AllocateMemory(SizeOf(Tree) )
InitializeStructure(*Tree, Tree)
*Tree\GadgetNum = Gdt2
*Tree\Items = *Tree0
For I = 0 To 3
N + 1
Define *X0.TreeItem = CreateItem(*Tree0, "Text " + Str(N), 1)
For J = 0 To 3
N + 1
Define *X1.TreeItem = CreateItem(*X0, "Text " + Str(N), 1)
For K = 0 To 3
N + 1
CreateItem(*X1, "Text " + Str(N), 0)
Next
Next
Next
Global C1 = RGB(0, 0, 0)
Global C0 = RGB(255, 255, 255)
Global ItemX = 0
Global ItemY = 0
Global ItemW
Global ItemH
Global ItemNum = 0
Global ItemCaseW
Global ItemStart = 0
Global Size = 12
Global FaultFont.S = "courier new"
LoadFont(0, FaultFont, Size)
Global DragStart.I
Global WinPhant.I
Global ImgPhant.I
Global GdtPhant.I
Global WinDnD.I
Global ImgDnD.I
Global ImgDnDW.I
Global ImgDnDH.I
Global GdtDnD.I
Global PhantW = 256
Global ScrollBorder = 64
Global Delta
Global ForceEvent
Procedure DrawExpandBox(*X0.TreeItem, *Tree.Tree, X, Y, W, H)
Define *P0.ExpandBox = AllocateMemory(SizeOf(ExpandBox) )
AddElement(*Tree\ExpandBox() )
*Tree\ExpandBox() = *P0
*P0\Left = X
*P0\Top = Y
*P0\Right = X + (W - 1)
*P0\Bottom = Y + (H - 1)
*P0\Boolean = @*X0\bExpanded
Box(X, Y, W, H, C1)
Box(X + 2, Y + 2, W - 4, H - 4, C0)
If (*X0\bExpanded & 1) = 0
W_2 = W / 2
H_2 = H / 2
W_4 = W / 4
H_4 = H / 4
Box(X + W_2 - 1, Y + H_4, 2, H_2, C1)
Box(X + W_4, Y + H_2 - 1, W_2, 2, C1)
EndIf
EndProcedure
Procedure DrawItem(*X0.TreeItem, *Tree.Tree, X, Y, W, H)
Define *P0.ItemInfo = AllocateMemory(SizeOf(ItemInfo) )
AddElement(*Tree\ItemInfo() )
*Tree\ItemInfo() = *P0
*P0\Left = X
*P0\Top = Y
*P0\Right = X + (W - 1)
*P0\Bottom = Y + (H - 1)
*P0\Item = *X0
DrawText(X, Y, *X0\Text, C1, C0)
EndProcedure
Procedure DisplayItem(*Tree0.TreeItem, *Tree.Tree)
Define *X0.TreeItem
ItemX + ItemCaseW
ForEach(*Tree0\Sub() )
*X0 = *Tree0\Sub()
If ItemNum => ItemStart
ItemW = TextWidth(*X0\Text)
ItemH = TextHeight("A")
Box(0, ItemY, OutputWidth(), ItemH, C0)
If *X0\SubExist
DrawExpandBox(*X0, *Tree, ItemX - ItemH + 2, ItemY + 2, ItemH - 4, ItemH - 4)
EndIf
DrawItem(*X0, *Tree, ItemX, ItemY, ItemW, ItemH)
ItemY + ItemH
EndIf
ItemNum + 1
If *X0\SubExist
If *X0\bExpanded
DisplayItem(*X0, *Tree)
EndIf
EndIf
Next
ItemX - ItemCaseW
EndProcedure
Procedure DisplayItems(*Tree.Tree)
Define *Tree0.TreeItem = *Tree\Items
If StartDrawing(CanvasOutput(*Tree\GadgetNum) )
DrawingFont(FontID(0) )
ItemX = 0
ItemY = 0
ItemNum = 0
ItemCaseW = TextHeight("A")
ForEach(*Tree\ExpandBox() )
FreeMemory(*Tree\ExpandBox() )
Next
ClearList(*Tree\ExpandBox() )
ForEach(*Tree\ItemInfo() )
FreeMemory(*Tree\ItemInfo() )
Next
ClearList(*Tree\ItemInfo() )
DisplayItem(*Tree0, *Tree)
If ItemY < OutputHeight()
Box(0, ItemY, OutputWidth(), OutputHeight() - ItemY, C0)
EndIf
StopDrawing()
EndIf
EndProcedure
Procedure CheckExpandBox(*Tree.Tree, MouseX, MouseY)
Define *P0.ExpandBox
Define *P1.INTEGER
ForEach(*Tree\ExpandBox() )
*P0 = *Tree\ExpandBox()
If MouseX => *P0\Left
If MouseX <= *P0\Right
If MouseY => *P0\Top
If MouseY <= *P0\Bottom
*P1 = *P0\Boolean
*P1\I ! 1
DisplayItems(*Tree)
ProcedureReturn 1
EndIf
EndIf
EndIf
EndIf
Next
EndProcedure
Procedure CheckItem(*Tree.Tree, MouseX, MouseY)
Define *P0.ItemInfo
Define *X0.TreeItem
ForEach(*Tree\ItemInfo() )
*P0 = *Tree\ItemInfo()
If (MouseX => *P0\Left) Or DragStart
If (MouseX <= *P0\Right) Or DragStart
If MouseY => *P0\Top
If MouseY <= *P0\Bottom
If DragStart = 0
*X0 = *P0\Item
*Tree\Itemsource = *X0
DragStart = 1
SetGadgetAttribute(*Tree\GadgetNum, #PB_Canvas_Clip, 1)
PhantW = GadgetWidth(*Tree\GadgetNum) - (*P0\Right - *P0\Left)
WinPhant = OpenWindow(#PB_Any, 0, 0, PhantW, 1, "", #PB_Window_BorderLess | #PB_Window_NoActivate)
ImgPhant = CreateImage(#PB_Any, PhantW, 4, 32, RGB(0, 0, 255) )
StartDrawing(ImageOutput(ImgPhant) )
DrawingFont(FontID(0) )
ImgDnDW = TextWidth(*X0\Text)
ImgDnDH = TextHeight(*X0\Text)
StopDrawing()
GdtPhant = ImageGadget(#PB_Any, 0, 0, PhantW, 4, ImageID(ImgPhant) )
WinDnD = OpenWindow(#PB_Any, 0, 0, ImgDnDW, ImgDnDH, "", #PB_Window_BorderLess | #PB_Window_NoActivate)
ImgDnD = CreateImage(#PB_Any, ImgDnDW, ImgDnDH, 32, C0)
StartDrawing(ImageOutput(ImgDnD) )
DrawingFont(FontID(0) )
DrawText(0, 0, *X0\Text, C1, C0)
StopDrawing()
GdtDnD = ImageGadget(#PB_Any, 0, 0, 128, 4, ImageID(ImgDnD) )
Else
*X0 = *P0\Item
If *X0\SubExist
H1_2 = (Abs(*P0\Top - *P0\Bottom) / 2.0) + 1
Else
H1_3 = (Abs(*P0\Top - *P0\Bottom) / 3.0) + 1
Choice = Int((MouseY - *P0\Top) / H1_3)
If Choice = 2
Define *Parent.TreeItem
*Parent = *X0\Parent
If *X0\Index < ListSize(*Parent\Sub() )
Choice = 1
EndIf
EndIf
EndIf
GdtScrX = GadgetX(*Tree\GadgetNum, #PB_Gadget_ScreenCoordinate)
GdtScrY = GadgetY(*Tree\GadgetNum, #PB_Gadget_ScreenCoordinate)
X = GdtScrX + *P0\Left
If Choice = 1
X = GdtScrX + *P0\Right
Y = (GdtScrY + *P0\Top) + ((*P0\Bottom - *P0\Top) / 2)
EndIf
*Tree\ItemTargetParented = Choice
ResizeWindow(WinPhant, X, Y, GdtScrX + PhantW - X, #PB_Ignore)
ResizeWindow(WinDnD, GdtScrX + PhantW, GdtScrY + MouseY - (ImgDnDH / 2), #PB_Ignore, #PB_Ignore)
EndIf
ProcedureReturn *X0
EndIf
EndIf
EndIf
EndIf
Next
EndProcedure
Procedure TreeCopyItem(*Tree.Tree, Parented, *SourceOption = 0, *TargetOption = 0)
Define *Parent.TreeItem
Define *Source.TreeItem
Define *Source2.TreeItem
Define *InitialTarget.TreeItem
Define *Target.TreeItem
Define *New.TreeItem
Define *New2.TreeItem
Define bForbidden
If *SourceOption = 0
*Source = *Tree\ItemSource
bForbidden = 1
Else
*Source = *SourceOption
bForbidden = 0
EndIf
If *TargetOption = 0
*Target = *Tree\ItemTarget
Else
*Target = *TargetOption
EndIf
If Parented = 1
*Target\bForbidden | bForbidden
*New = CreateItem(*Target, *Source\Text, *Source\bExpanded)
If *Source\SubExist And (Not *Source\bForbidden)
ForEach(*Source\Sub() )
TreeCopyItem(*Tree, 1, *Source\Sub(), *New)
Next
EndIf
*Target\bForbidden & (~1)
EndIf
EndProcedure
;- Principe
DisplayItems(*Tree)
Repeat
Ev = WaitWindowEvent()
If Ev = #PB_Event_Gadget
Evt = EventType()
MouseX = GetGadgetAttribute(Gdt2, #PB_Canvas_MouseX)
MouseY = GetGadgetAttribute(Gdt2, #PB_Canvas_MouseY)
If Evt = #PB_EventType_LeftButtonDown
If CheckExpandBox(*Tree, MouseX, MouseY) = 0
CheckItem(*Tree, MouseX, MouseY)
EndIf
EndIf
If DragStart
If (GetGadgetAttribute(Gdt2, #PB_Canvas_Buttons) = #PB_Canvas_LeftButton)
Result = CheckItem(*Tree, MouseX, MouseY)
If Result
*Tree\ItemTarget = Result
EndIf
Else
FreeGadget(GdtPhant)
FreeImage(ImgPhant)
CloseWindow(WinPhant)
FreeGadget(GdtDnD)
FreeImage(ImgDnD)
CloseWindow(WinDnD)
DragStart = 0
SetGadgetAttribute(*Tree\GadgetNum, #PB_Canvas_Clip, 0)
TreeCopyItem(*Tree, *Tree\ItemTargetParented)
DisplayItems(*Tree)
EndIf
EndIf
Control = Bool(GetGadgetAttribute(Gdt2, #PB_Canvas_Modifiers) = #PB_Canvas_Shift)
Delta = GetGadgetAttribute(Gdt2, #PB_Canvas_WheelDelta)
ForceEvent = 0
If DragStart
If MouseY < ScrollBorder
Delta = 1
EndIf
If MouseY > (GadgetHeight(Gdt2) - ScrollBorder)
Delta = -1
EndIf
EndIf
If Delta
If Control
Size + Delta
If Size < 12
Size = 12
EndIf
FreeFont(0)
LoadFont(0, FaultFont, Size)
Else
ItemStart - Delta
If ItemStart < 0
ItemStart = 0
EndIf
EndIf
DisplayItems(*Tree)
EndIf
EndIf
Until Ev = #PB_Event_CloseWindow