Code : Tout sélectionner
;***********************************************************************************************************
; © MicrodevWeb 2015
; Name SpeeDev GDI
; Version B0.1
; Date : 2015/10/21
; PB 5.40
;***********************************************************************************************************
; XIncludeFile "include/Tree.pbi"
;-* Constantes
#Title="SpeedDev B0.1"
#Flag=#PB_Window_ScreenCentered|#PB_Window_SystemMenu|#PB_Window_Maximize|#PB_Window_MaximizeGadget|
#PB_Window_MinimizeGadget|#PB_Window_SizeGadget
#NbLg=1
#Fr=0
#En=1
#ExploreurWidth=200
#CanvasWidth=2500
#CanvasHeight=2500
Enumeration
#MainForm
#MainArea
#MainCanvas
#MainSplitter
#MainTree
#MainMenu
#MainToolBar
#M_NewFile
#T_NewFile
#M_OpenFile
#T_OpenFile
#M_CloseFile
#M_SaveFile
#T_SaveFile
#M_SaveAsFile
#M_Exit
#M_AddTable
#T_AddTable
#M_EditTable
#T_EditTable
#M_DeleteTable
#T_DeleteTable
#M_AddColumn
#T_AddColumn
#M_EditColumn
#T_EditColumn
#M_DeleteColumn
#T_DeleteColumn
#TableForm
#TableVisu
#TableName
#TableSubmit
#TableChancel
#TableHeaderBgColorBt
#TableHeaderFgColorBt
#TableFgColorBt
#TableHeaderFontBt
#TableFontBt
#TableLineColorBt
EndEnumeration
Enumeration
#Ico_New
#Ico_Edit
#Ico_Delete
#Ico_Add
#Tmp_Img
#Grid_Img
EndEnumeration
;}
;-* Catch
; CatchImage(#Ico_New,?NewIco)
; CatchImage(#Ico_Edit,?EditIco)
; CatchImage(#Ico_Delete,?DeleteIco)
; CatchImage(#Ico_Add,?AddIco)
;}
;-* Structures
Structure Pos
X.i
Y.i
W.i
H.i
EndStructure
Structure Column
Name$
FgColor.i
BgColor.i
Font.i
EndStructure
Structure Table Extends Pos
Name$
List myColumn.Column()
HeaderBgColor.i
HeaderFgColor.i
HeaderFont.i
BgColor.i
LineColor.i
EndStructure
Structure Db
Name$
Map myTable.Table()
EndStructure
;}
;-* Global Variables
Global myDb.DB,gCuLg,Dim msg$(#NbLg),gEvent,gGridOn.b=#True,gGrideSpace=10,
gHeaderHeight=30,gMouseX,gMouseY,gTableHover$,gClicOn.b=#False,gOldPos.Pos,
gOldObject.Pos,gTableSelected$,H_LU.Pos,H_RU.Pos,H_MU.Pos,
H_LD.Pos,H_RD.Pos,H_MD.Pos,H_LM.Pos,H_RM.Pos,gModeHandle$="",
gActionOn.b=#False,gNewPos.Pos,gModeNew.b=#True
;}
;-* Macro
Macro mMenuTitle(FrTitle,EngMessage)
msg$(#Fr)=FrTitle
msg$(#En)=EngMessage
MenuTitle(msg$(gCuLg))
EndMacro
Macro mMenuItem(MenuItemId,FrText,EnText,ShortCut="")
msg$(#Fr)=FrText
msg$(#En)=EnText
If ShortCut<>""
msg$(#Fr)+Chr(9)+ShortCut
msg$(#En)+Chr(9)+ShortCut
EndIf
MenuItem(#M_NewFile,msg$(gCuLg))
EndMacro
Macro mToolBarToolTip(ToolBarId,ButtonId,FrText,EnText,ShortCut="")
msg$(#Fr)=FrText
msg$(#En)=EnText
If ShortCut<>""
msg$(#Fr)+" "+ShortCut
msg$(#En)+" "+ShortCut
EndIf
ToolBarToolTip(ToolBarId,ButtonId,msg$(gCuLg))
EndMacro
;}
;-* Declare
Declare Draw()
Declare DrawTmpImg()
Declare DrawGrid()
Declare EventCanvas()
;}
;-* Main Form
Procedure EventNewFile()
EndProcedure
Procedure EventOpenFile()
EndProcedure
Procedure EventSaveFile()
EndProcedure
Procedure EventSaveAsFile()
EndProcedure
Procedure EventCloseFile()
EndProcedure
Procedure EventExit()
EndProcedure
Procedure EventAddTable()
EndProcedure
Procedure EventEditTable()
EndProcedure
Procedure EventDeleteTable()
EndProcedure
Procedure EventAddColumn()
EndProcedure
Procedure EventEditColumn()
EndProcedure
Procedure EventDeleteColumn()
EndProcedure
Procedure MakeMainMenu()
CreateMenu(#MainMenu,WindowID(#MainForm))
CreateToolBar(#MainToolBar,WindowID(#MainForm))
;{ File
; mMenuTitle("Fichier","File")
; mMenuItem(#M_NewFile,"Nouveau","New","ALT + N ")
; AddKeyboardShortcut(#MainForm,#PB_Shortcut_Alt|#PB_Shortcut_N,#M_NewFile)
; ToolBarStandardButton(#T_NewFile,#PB_ToolBarIcon_New)
; mToolBarToolTip(#MainToolBar,#T_NewFile,"Nouveau fichier","New file","ALT+N")
; BindMenuEvent(#MainMenu,#M_NewFile,@EventNewFile())
;
; mMenuItem(#M_OpenFile,"Ouvrir","Open","ALT + O")
; AddKeyboardShortcut(#MainForm,#PB_Shortcut_Alt|#PB_Shortcut_O,#M_OpenFile)
; ToolBarStandardButton(#T_OpenFile,#PB_ToolBarIcon_Open)
; mToolBarToolTip(#MainToolBar,#T_OpenFile,"Ouvrir un fichier","Open file","ALT+O")
; BindMenuEvent(#MainMenu,#M_OpenFile,@EventOpenFile())
;
; mMenuItem(#M_SaveFile,"Sauver","Save","CTRL + S")
; AddKeyboardShortcut(#MainForm,#PB_Shortcut_Control|#PB_Shortcut_O,#M_SaveFile)
; ToolBarStandardButton(#T_SaveFile,#PB_ToolBarIcon_Save)
; mToolBarToolTip(#MainToolBar,#T_SaveFile,"Sauver le fichier","Save file","ALT+O")
; BindMenuEvent(#MainMenu,#M_SaveFile,@EventSaveFile())
;
; mMenuItem(#M_SaveAsFile,"Sauver sous","Save as")
; BindMenuEvent(#MainMenu,#M_SaveFile,@EventSaveAsFile())
;
; mMenuItem(#M_CloseFile,"Fermer","Close")
; BindMenuEvent(#MainMenu,#M_CloseFile,@EventCloseFile())
;
; MenuBar()
; mMenuItem(#M_Exit,"Quitter","Exit")
; BindMenuEvent(#MainMenu,#M_Exit,@EventExit())
; ;}
; ;{ Table
; ToolBarSeparator()
; mMenuTitle("Table","Table")
; mMenuItem(#M_AddTable,"Nouveau","New","CTRL + A ")
; AddKeyboardShortcut(#MainForm,#PB_Shortcut_Control|#PB_Shortcut_A,#M_AddTable)
; BindMenuEvent(#MainMenu,#M_AddTable,@EventAddTable())
; ToolBarImageButton(#T_AddTable,ImageID(#Ico_New))
; mToolBarToolTip(#MainToolBar,#T_AddTable,"Nouvelle table","New table","CTRL+O")
;
; mMenuItem(#M_EditTable,"Editer","Edit","CTRL + E ")
; AddKeyboardShortcut(#MainForm,#PB_Shortcut_Control|#PB_Shortcut_E,#M_EditTable)
; BindMenuEvent(#MainMenu,#M_EditTable,@EventEditTable())
; ToolBarImageButton(#T_EditTable,ImageID(#Ico_Edit))
; mToolBarToolTip(#MainToolBar,#T_EditTable,"Editer la table","Edit table","CTRL+E")
;
; mMenuItem(#M_DeleteTable,"Supprimer","Delete","CTRL + X ")
; AddKeyboardShortcut(#MainForm,#PB_Shortcut_Control|#PB_Shortcut_X,#M_DeleteTable)
; BindMenuEvent(#MainMenu,#M_DeleteTable,@EventDeleteTable())
; ToolBarImageButton(#T_DeleteTable,ImageID(#Ico_Delete))
; mToolBarToolTip(#MainToolBar,#T_EditTable,"Supprimer la table","Delete table","CTRL+X")
; ;}
; ;{ Column
; ToolBarSeparator()
; mMenuTitle("Colonne","Clolumn")
; mMenuItem(#M_AddColumn,"Nouveau","New","CTRL + A ")
; AddKeyboardShortcut(#MainForm,#PB_Shortcut_Control|#PB_Shortcut_A,#M_AddColumn)
; BindMenuEvent(#MainMenu,#M_AddColumn,@EventAddColumn())
; ToolBarImageButton(#T_AddColumn,ImageID(#Ico_Add))
; mToolBarToolTip(#MainToolBar,#T_AddColumn,"Ajouter une colonne","Add column","CTRL+O")
;
; mMenuItem(#M_EditColumn,"Editer","Edit","CTRL + E ")
; AddKeyboardShortcut(#MainForm,#PB_Shortcut_Control|#PB_Shortcut_E,#M_EditColumn)
; BindMenuEvent(#MainMenu,#M_EditColumn,@EventEditColumn())
; ToolBarImageButton(#T_EditColumn,ImageID(#Ico_Edit))
; mToolBarToolTip(#MainToolBar,#T_EditColumn,"Editer une colonne","Edit column","CTRL+E")
;
; mMenuItem(#M_DeleteColumn,"Supprimer","Delete","CTRL + D ")
; AddKeyboardShortcut(#MainForm,#PB_Shortcut_Control|#PB_Shortcut_D,#M_DeleteColumn)
; BindMenuEvent(#MainMenu,#M_DeleteColumn,@EventDeleteColumn())
; ToolBarImageButton(#T_DeleteColumn,ImageID(#Ico_Delete))
; mToolBarToolTip(#MainToolBar,#T_DeleteColumn,"Supprimer une colonne","Delete column","CTRL+D")
; ;}
EndProcedure
Procedure MakeMainGadget()
Protected W=WindowWidth(#MainForm)
Protected Y=ToolBarHeight(#MainToolBar);+MenuHeight()
Protected H=WindowHeight(#MainForm)-(Y+MenuHeight())
ScrollAreaGadget(#MainArea,0,Y,W,H,#CanvasWidth,#CanvasHeight,10)
CanvasGadget(#MainCanvas,0,0,#CanvasWidth,#CanvasHeight,#PB_Canvas_Keyboard)
BindGadgetEvent(#MainCanvas,@EventCanvas())
CloseGadgetList()
; Tree::Create(#MainTree,0,0,#ExploreurWidth,H)
; SplitterGadget(#MainSplitter,0,Y,W,H,Tree::GetIdGadget(#MainTree),#MainArea,#PB_Splitter_Vertical)
; SetGadgetState(#MainSplitter,#ExploreurWidth)
CreateImage(#Tmp_Img,#CanvasWidth,#CanvasHeight)
DrawGrid()
DrawTmpImg()
Draw()
EndProcedure
Procedure OpenMainForm()
OpenWindow(#MainForm,0,0,800,600,#Title,#Flag)
MakeMainMenu()
MakeMainGadget()
EndProcedure
;}
;-* Table Form
Procedure DrawPrevTable()
EndProcedure
Procedure OpenTableForm()
Protected WF=400,HF=400,M=10,W,X,Y,H,
Flag=#PB_Window_ScreenCentered|#PB_Window_SystemMenu
Dim title$(#NbLg)
If gModeNew
title$(#Fr)="Nouvelle table"
title$(#En)="New table"
Else
title$(#Fr)="Edition de la table"
title$(#En)="Edit table"
EndIf
DisableWindow(#MainForm,#True)
OpenWindow(#TableForm,0,0,WF,HF,title$(gCuLg),Flag)
X=M
Y=M
W=(WF/2)-(M*2)
H=HF-(M*2)
DrawPrevTable()
CanvasGadget(#TableVisu,M,M,W,H,ImageID(Img))
EndProcedure
;}
;-* Draw
Procedure DrawGrid()
StartDrawing(ImageOutput(#Tmp_Img))
;{ Eraze canvas
Box(0,0,#CanvasWidth,#CanvasHeight,$CDFAFF)
;}
If gGridOn
Protected X=gGrideSpace,Y=gGrideSpace
While X<#CanvasWidth
Y=gGrideSpace
While Y<#CanvasHeight
Plot(X,Y,$13458B)
Y+gGrideSpace
Wend
X+gGrideSpace
Wend
EndIf
StopDrawing()
EndProcedure
Procedure DrawHandles()
Protected X,Y,W=8
With myDb\myTable()
;{ Up
; Left Up
X=\X-(W/2)
Y=\Y-(W/2)
AddPathBox(X,Y,W,W)
H_LU\X=X
H_LU\Y=Y
H_LU\W=W
; Right Up
X=(\X+\W)-(W/2)
AddPathBox(X,Y,W,W)
H_RU\X=X
H_RU\Y=Y
H_RU\W=W
; Midle Up
X=(\X+(\W/2))-(W/2)
AddPathBox(X,Y,W,W)
H_MU\X=X
H_MU\Y=Y
H_MU\W=W
;}
;{ Down
; Left Down
X=\X-(W/2)
Y=(\Y+\H)-(W/2)
AddPathBox(X,Y,W,W)
H_LD\X=X
H_LD\Y=Y
H_LD\W=W
; Right Down
X=(\X+\W)-(W/2)
AddPathBox(X,Y,W,W)
H_RD\X=X
H_RD\Y=Y
H_RD\W=W
; Midle Down
X=(\X+(\W/2))-(W/2)
AddPathBox(X,Y,W,W)
H_MD\X=X
H_MD\Y=Y
H_MD\W=W
;}
;{ Midle
; Left
X=\X-(W/2)
Y=(\Y+(\H/2))-(W/2)
AddPathBox(X,Y,W,W)
H_LM\X=X
H_LM\Y=Y
H_LM\W=W
; Right
X=(\X+\W)-(W/2)
AddPathBox(X,Y,W,W)
H_RM\X=X
H_RM\Y=Y
H_RM\W=W
;}
VectorSourceColor($FB696969)
FillPath()
EndWith
EndProcedure
Procedure DrawTable()
Protected txt$,X,Y
ForEach myDb\myTable()
With myDb\myTable()
AddPathBox(\X,\Y,\W,gHeaderHeight)
VectorSourceColor(\HeaderBgColor)
FillPath()
txt$=\Name$
VectorFont(FontID(\HeaderFont))
While VectorTextWidth(txt$)>(\W-10)
txt$=Left(txt$,Len(txt$)-4)
txt$+"..."
Wend
X=\X+((\W/2)-(VectorTextWidth(txt$)/2))
Y=\Y+((gHeaderHeight/2)-(VectorTextHeight(txt$)/2))
MovePathCursor(X,Y)
VectorSourceColor(\HeaderFgColor)
AddPathText(txt$)
FillPath()
AddPathBox(\X,\Y+gHeaderHeight,\W,\H-gHeaderHeight)
VectorSourceColor(\BgColor)
FillPath()
AddPathBox(\X,\Y,\W,\H)
VectorSourceColor(\LineColor)
StrokePath(2)
Y=\y+gHeaderHeight+5
If \H>gHeaderHeight+VectorTextHeight("W")
ForEach \myColumn()
VectorFont(FontID(\myColumn()\Font))
txt$=\myColumn()\Name$
While VectorTextWidth(txt$)>(\W-10)
txt$=Left(txt$,Len(txt$)-4)
txt$+"..."
Wend
MovePathCursor(\X+5,Y)
AddPathText(txt$)
VectorSourceColor(\myColumn()\FgColor)
FillPath()
Y+VectorTextHeight(txt$)+5
If (Y+(VectorTextHeight(txt$)+5))>(\Y+\H)
Break
EndIf
Next
EndIf
EndWith
VectorSourceColor($FB000000)
StrokePath(2)
If gTableSelected$=myDb\myTable()\Name$
DrawHandles()
EndIf
Next
EndProcedure
Procedure DrawTmpImg()
DrawGrid()
StartVectorDrawing(ImageVectorOutput(#Tmp_Img))
DrawTable()
StopVectorDrawing()
EndProcedure
Procedure Draw()
StartVectorDrawing(CanvasVectorOutput(#MainCanvas))
MovePathCursor(0,0)
DrawVectorImage(ImageID(#Tmp_Img))
StopVectorDrawing()
EndProcedure
Procedure PreDrawTable()
Protected DepX=gMouseX-gOldPos\X
DepY=gMouseY-gOldPos\Y
gActionOn=#True
With gNewPos
Select gModeHandle$
Case "MOV"
If gOldObject\X+DepX<0
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
ProcedureReturn
EndIf
If gOldObject\Y+DepY<0
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
ProcedureReturn
EndIf
If gOldObject\X+gOldObject\W+DepX>#CanvasWidth
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
ProcedureReturn
EndIf
If gOldObject\Y+gOldObject\H+DepY>#CanvasHeight
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
ProcedureReturn
EndIf
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Arrows)
\X=gOldObject\X+DepX
\Y=gOldObject\Y+DepY
\W=gOldObject\W
\H=gOldObject\H
Case "H_RU"
If gOldObject\Y+DepY<0
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
ProcedureReturn
EndIf
If gOldObject\X+gOldObject\W+DepX>#CanvasWidth
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
ProcedureReturn
EndIf
If gOldObject\W+DepX<20
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
ProcedureReturn
EndIf
If gOldObject\H-DepY<gHeaderHeight
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
ProcedureReturn
EndIf
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_LeftDownRightUp)
\X=gOldObject\X
\Y=gOldObject\Y+DepY
\W=gOldObject\W+DepX
\H=gOldObject\H-DepY
Case "H_MU"
If gOldObject\Y+DepY<0
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
ProcedureReturn
EndIf
If gOldObject\H-DepY<gHeaderHeight
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
ProcedureReturn
EndIf
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_UpDown)
\X=gOldObject\X
\Y=gOldObject\Y+DepY
\W=gOldObject\W
\H=gOldObject\H-DepY
Case "H_LM"
If gOldObject\X+DepX<0
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
ProcedureReturn
EndIf
If gOldObject\W-DepX<20
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
ProcedureReturn
EndIf
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_LeftRight)
\X=gOldObject\X+DepX
\Y=gOldObject\Y
\W=gOldObject\W-DepX
\H=gOldObject\H
Case "H_RM"
If gOldObject\X+gOldObject\W+DepX>#CanvasWidth
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
ProcedureReturn
EndIf
If gOldObject\W+DepX<20
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
ProcedureReturn
EndIf
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_LeftRight)
\X=gOldObject\X
\Y=gOldObject\Y
\W=gOldObject\W+DepX
\H=gOldObject\H
Case "H_MD"
If gOldObject\H+DepY<gHeaderHeight
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
ProcedureReturn
EndIf
If gOldObject\H+gOldObject\Y+DepY>#CanvasHeight
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
ProcedureReturn
EndIf
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_UpDown)
\X=gOldObject\X
\Y=gOldObject\Y
\W=gOldObject\W
\H=gOldObject\H+DepY
Case "H_LD"
If gOldObject\X+DepX<0
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
ProcedureReturn
EndIf
If gOldObject\W-DepX<20
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
ProcedureReturn
EndIf
If gOldObject\W-DepX+gOldObject\X>#CanvasWidth
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
ProcedureReturn
EndIf
If gOldObject\Y+gOldObject\H+DepY>#CanvasHeight
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
ProcedureReturn
EndIf
If gOldObject\H+DepY<gHeaderHeight
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
ProcedureReturn
EndIf
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_LeftDownRightUp)
\X=gOldObject\X+DepX
\Y=gOldObject\Y
\W=gOldObject\W-DepX
\H=gOldObject\H+DepY
Case "H_RD"
If gOldObject\W+DepX<20
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
ProcedureReturn
EndIf
If gOldObject\H+DepY<gHeaderHeight
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
ProcedureReturn
EndIf
If gOldObject\W+gOldObject\X+DepX>#CanvasWidth
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
ProcedureReturn
EndIf
If gOldObject\H+gOldObject\Y+DepY>#CanvasHeight
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
ProcedureReturn
EndIf
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_LeftUpRightDown)
\X=gOldObject\X
\Y=gOldObject\Y
\W=gOldObject\W+DepX
\H=gOldObject\H+DepY
Case "H_LU"
If gOldObject\X+DepX<0
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
ProcedureReturn
EndIf
If gOldObject\Y+DepY<0
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
ProcedureReturn
EndIf
If gOldObject\H-DepY<gHeaderHeight
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
ProcedureReturn
EndIf
If gOldObject\W-DepX<20
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
ProcedureReturn
EndIf
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_LeftUpRightDown)
\X=gOldObject\X+DepX
\Y=gOldObject\Y+DepY
\W=gOldObject\W-DepX
\H=gOldObject\H-DepY
EndSelect
EndWith
StartVectorDrawing(CanvasVectorOutput(#MainCanvas))
MovePathCursor(0,0)
DrawVectorImage(ImageID(#Tmp_Img))
With gNewPos
AddPathBox(\X,\Y,\W,\H)
EndWith
VectorSourceColor($FF00E300)
DotPath(2,8)
StopVectorDrawing()
EndProcedure
;}
;-* EventCanvas
Procedure HoverTable()
gTableHover$=""
ForEach myDb\myTable()
With myDb\myTable()
If (gMouseX>=\X And gMouseX<=(\X+\W)) And
(gMouseY>=\Y And gMouseY<=(\Y+\H))
gTableHover$=\Name$
ProcedureReturn #True
EndIf
EndWith
Next
ProcedureReturn #False
EndProcedure
Procedure HoverHandle()
With H_LU
If (gMouseX>=\X And gMouseX<=(\X+\W)) And
(gMouseY>=\Y And gMouseY<=(\Y+\W))
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_LeftUpRightDown)
gModeHandle$="H_LU"
ProcedureReturn
EndIf
EndWith
With H_RU
If (gMouseX>=\X And gMouseX<=(\X+\W)) And
(gMouseY>=\Y And gMouseY<=(\Y+\W))
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_LeftDownRightUp)
gModeHandle$="H_RU"
ProcedureReturn
EndIf
EndWith
With H_MU
If (gMouseX>=\X And gMouseX<=(\X+\W)) And
(gMouseY>=\Y And gMouseY<=(\Y+\W))
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_UpDown)
gModeHandle$="H_MU"
ProcedureReturn
EndIf
EndWith
With H_LD
If (gMouseX>=\X And gMouseX<=(\X+\W)) And
(gMouseY>=\Y And gMouseY<=(\Y+\W))
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_LeftDownRightUp)
gModeHandle$="H_LD"
ProcedureReturn
EndIf
EndWith
With H_RD
If (gMouseX>=\X And gMouseX<=(\X+\W)) And
(gMouseY>=\Y And gMouseY<=(\Y+\W))
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_LeftUpRightDown)
gModeHandle$="H_RD"
ProcedureReturn
EndIf
EndWith
With H_MD
If (gMouseX>=\X And gMouseX<=(\X+\W)) And
(gMouseY>=\Y And gMouseY<=(\Y+\W))
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_UpDown)
gModeHandle$="H_MD"
ProcedureReturn
EndIf
EndWith
With H_LM
If (gMouseX>=\X And gMouseX<=(\X+\W)) And
(gMouseY>=\Y And gMouseY<=(\Y+\W))
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_LeftRight)
gModeHandle$="H_LM"
ProcedureReturn
EndIf
EndWith
With H_RM
If (gMouseX>=\X And gMouseX<=(\X+\W)) And
(gMouseY>=\Y And gMouseY<=(\Y+\W))
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_LeftRight)
gModeHandle$="H_RM"
ProcedureReturn
EndIf
EndWith
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Arrows)
gModeHandle$="MOV"
EndProcedure
Procedure EventCanvas()
Select EventType()
Case #PB_EventType_MouseMove
gMouseX=GetGadgetAttribute(#MainCanvas,#PB_Canvas_MouseX)
gMouseY=GetGadgetAttribute(#MainCanvas,#PB_Canvas_MouseY)
; Debug gModeHandle$
; Debug gClicOn
If gModeHandle$<>"" And gClicOn
PreDrawTable()
ProcedureReturn
EndIf
If gClicOn
ProcedureReturn
EndIf
If HoverTable()
If gTableSelected$<>""
HoverHandle()
ProcedureReturn
EndIf
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Hand)
ProcedureReturn
EndIf
SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Default)
Case #PB_EventType_LeftButtonDown
If gClicOn=#False
gOldPos\X=gMouseX
gOldPos\Y=gMouseY
; Si sur table méorise la position de la table
If gTableHover$<>""
FindMapElement(myDb\myTable(),gTableHover$)
With myDb\myTable()
gOldObject\X=\X
gOldObject\Y=\Y
gOldObject\W=\W
gOldObject\H=\H
EndWith
gTableSelected$=gTableHover$
DrawTmpImg()
Draw()
Else
gTableSelected$=""
gModeHandle$=""
DrawTmpImg()
Draw()
EndIf
EndIf
gClicOn=#True
Case #PB_EventType_LeftButtonUp
If gTableSelected$<>""And gActionOn
FindMapElement(myDb\myTable(),gTableSelected$)
With myDb\myTable()
\X=gNewPos\X
\Y=gNewPos\Y
\W=gNewPos\W
\H=gNewPos\H
EndWith
gActionOn=#False
DrawTmpImg()
Draw()
EndIf
gClicOn=#False
EndSelect
EndProcedure
;}
;{-* Generate sample data
; Filled Db attribute
With myDb
\Name$="Teste"
EndWith
; Make the table
AddMapElement(myDb\myTable(),"Customers")
With myDb\myTable()
\BgColor=RGBA(220,220,220,255)
\HeaderBgColor=RGBA(0,0,255,255)
\HeaderFgColor=RGBA(255, 255, 255, 251)
\HeaderFont=LoadFont(#PB_Any,"Arial",12,#PB_Font_HighQuality)
\LineColor=RGBA(0, 0, 0, 251)
\Name$="Customers"
\W=100
\H=150
\X=50
\Y=50
AddElement(\myColumn())
\myColumn()\FgColor=$FB000000
\myColumn()\Name$="Nom"
\myColumn()\Font=LoadFont(#PB_Any,"Arial",11,#PB_Font_HighQuality)
AddElement(\myColumn())
\myColumn()\FgColor=$FB000000
\myColumn()\Name$="Adresse"
\myColumn()\Font=LoadFont(#PB_Any,"Arial",11,#PB_Font_HighQuality)
AddElement(\myColumn())
\myColumn()\FgColor=$FB000000
\myColumn()\Name$="Localité"
\myColumn()\Font=LoadFont(#PB_Any,"Arial",11,#PB_Font_HighQuality)
AddElement(\myColumn())
\myColumn()\FgColor=$FB000000
\myColumn()\Name$="Code"
\myColumn()\Font=LoadFont(#PB_Any,"Arial",11,#PB_Font_HighQuality)
AddElement(\myColumn())
\myColumn()\FgColor=$FB000000
\myColumn()\Name$="Pays"
\myColumn()\Font=LoadFont(#PB_Any,"Arial",11,#PB_Font_HighQuality)
AddElement(\myColumn())
\myColumn()\FgColor=$FB000000
\myColumn()\Name$="Contact"
\myColumn()\Font=LoadFont(#PB_Any,"Arial",11,#PB_Font_HighQuality)
AddElement(\myColumn())
\myColumn()\FgColor=$FB000000
\myColumn()\Name$="Gsm"
\myColumn()\Font=LoadFont(#PB_Any,"Arial",11,#PB_Font_HighQuality)
EndWith
;}
;{-* Run Programme
OpenMainForm()
;}
;{-* Main loop
Repeat:gEvent=WaitWindowEvent():Until gEvent=#PB_Event_CloseWindow
End
;}
; DataSection
; NewIco: :IncludeBinary "img\new.ico"
; EditIco: :IncludeBinary "img\pencil.ico"
; DeleteIco: :IncludeBinary "img\deletered.ico"
; AddIco: :IncludeBinary "img\add.ico"
; EndDataSection