Début de code GDI

microdevweb · Message par **microdevweb** » jeu. 22/oct./2015 9:15

Pour ceux que cela intéresse je pose le début de mon code pour le GDI de mon RAD, j'ai désactivé le menu et mon Tree personnalisé (motif pour ne pas alourdir le code et ne pas vous obligé à charger les images). Amusez-vous à redimensionner et à déplacer la table

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

Kwai chang caine · Message par **Kwai chang caine** » jeu. 22/oct./2015 13:11

Ca marche niquel, tu utilises la derniere librairie vector.

Si je commence à comprendre, pour ton RAD, tu va faire un peu comme dans ACCESS quand on peut relier les BD par des fleches et tout le toutim ?
Donc rien à voir avec un visual designer comme VB

microdevweb · Message par **microdevweb** » jeu. 22/oct./2015 16:35

Salut Kwai chang caine,

Oui c'est cela après on pourra générer les fenêtres.... Le défit une application de facturations (simple) en moins d'un heure

Edit: Note que cette base pourra déboucher sur plein d'autres possibilités tel que site web, et peu t’être Android (mais la vraiment pas pour tout de suite)

Kwai chang caine · Message par **Kwai chang caine** » ven. 23/oct./2015 12:43

Android. ..quel joli mot qui tinte à mes oreilles

PureBasic

Début de code GDI

Début de code GDI

Re: Début de code GDI

Re: Début de code GDI

Re: Début de code GDI