PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Drawing vector sotware (PB 5.40)

https://www.purebasic.fr/english/viewtopic.php?t=63758

Page 1 of 1

Drawing vector sotware (PB 5.40)

Posted: Sat Oct 17, 2015 2:01 pm
by microdevweb
For change my idea from my RAD, i make a litel drawing vector sotware. This is very simple, you can also create the box. In this i use memory database and don't use the list for testing.

You have need create a new document, you can push on ALT+B for create a box with your mouse, clik et move your mouse for draw a box, clik on this for editing. After that your see the handle and you can use this handle.

NB: Actualy this code have more bug

Image

Code: Select all

;**********************************************************************************************************
; Author : MicordevWeb
; Name : EasyDraw
; Date : 2015/10/17
; Version: B 0.1
; Pb: 5.40 lst
;**********************************************************************************************************
EnableExplicit
UseSQLiteDatabase()
Enumeration 
      #Font
      #MainForm
      #MainMenu
      #New
      #Open
      #Save
      #SaveAs
      #Close
      #Exit
      #PropertieForm
      #SpW
      #SpH
      #BtSubmit
      #BtChancel
      #ScrollArea
      #Canvas
      #NewBox
      #NewCircle
EndEnumeration
Enumeration 
      #ModeSelect
      #MdNewBox
      #MdNewCircle
EndEnumeration
Enumeration 
      #ObBox
      #ObCircle
EndEnumeration
Structure Pos 
      X.d
      Y.d
      W.d
      H.d
EndStructure
Global myPos.Pos,myOldPos.Pos,UL.Pos,UM.Pos,UR.Pos,
DL.Pos,DM.Pos,DR.Pos,LM.Pos,RM.Pos,newPos.Pos,
gDb,gMotherForm,gModeNew.b,gExt$,gDrawW,gDrawH,
gModeDraw=#ModeSelect,gMouseX,gMouseY,gClicOn.b=#False,
gImgTmp,gActiOn.b,gId=-1,gObj,gCurrentHandle$,gSelected
LoadFont(#Font,"Arial",12,#PB_Font_HighQuality)
Declare OpenDrawPropertie()
Declare CloseForm()
Declare ManageCanvas()
Declare DrawCanvas()
Procedure DbQuey(query$)
      If DatabaseQuery(gDb,query$)=0
            MessageRequester("DbQuey Error",DatabaseError())
            ProcedureReturn #False
      EndIf
      ProcedureReturn #True
EndProcedure
Procedure DbUpdate(query$)
      If DatabaseUpdate(gDb,query$)=0
            MessageRequester("DbUpdate Error",DatabaseError())
            ProcedureReturn #False
      EndIf
      ProcedureReturn #True
EndProcedure
Macro mAddTable(Table)
      query$= "CREATE TABLE "+Table+"("
      For N=0 To ArraySize(Column$(),1)
            If N>0
                  query$+","
            EndIf
            query$+Column$(N,0)+" "+Column$(N,1)
      Next
      query$+")"
      If Not DbUpdate(query$):End:EndIf
EndMacro
Procedure BuildMemorisDb()
      gDb=OpenDatabase(#PB_Any,":memory:","","")
      If gDb=0
            MessageRequester("BuildMemorisDb Error","Can not open DataBase")
            ProcedureReturn #False
      EndIf 
      Protected query$,N
      Dim Column$(7,1)
      Column$(0,0)="id":Column$(1,0)="x":Column$(2,0)="y":Column$(3,0)="w":Column$(4,0)="h"
      Column$(5,0)="fgcolor":Column$(6,0)="bgcolor":Column$(7,0)="filled"
      Column$(0,1)="INTEGER PRIMARY KEY"
      For N=1 To 7 :Column$(N,1)="INTEGER":Next
      mAddTable("box")
      mAddTable("circle")
EndProcedure
Procedure NewDraw()
      gModeNew=#True
      OpenDrawPropertie()
      SetActiveGadget(#spW)
EndProcedure
Procedure OpenDraw()
      
EndProcedure
Procedure SaveDraw()
      
EndProcedure
Procedure SaveAsDraw()
      
EndProcedure
Procedure CloseDraw()
      
EndProcedure
Procedure Exit()
      CloseDatabase(gDb)
      End
EndProcedure
Procedure EventResize()
      ManageCanvas()
EndProcedure
Procedure HoverToForm()
      Protected query$
      query$="SELECT * FROM box WHERE (X<="+Str(gMouseX)+" AND "+
             "(X+W)>="+Str(gMouseX)+")"+
             "AND (Y<="+Str(gMouseY)+" AND (Y+H)>="+Str(gMouseY)+")"
      If Not DbQuey(query$):End:EndIf
      gId=-1
      If FirstDatabaseRow(gDb)
            gId=GetDatabaseLong(gDb,0)
            gObj=#ObBox
            ProcedureReturn #True
      EndIf
      ProcedureReturn #False
EndProcedure
Procedure PreDrawBox()
      gActiOn=#True
      With myPos
            \W=gMouseX-\X
            \H=gMouseY-\Y
            StartVectorDrawing(CanvasVectorOutput(#Canvas))
            DrawVectorImage(ImageID(gImgTmp))
            AddPathBox(\X,\Y,\W,\H)   
            VectorSourceColor(RGBA(211,211,211,255))
            DotPath(2,4)
            StopVectorDrawing()
      EndWith
EndProcedure
Procedure AddBox()
      Protected query$
      query$="INSERT INTO box (x,y,w,h,fgcolor,bgcolor) VALUES ("
      With myPos
            query$+Str(\X)+","+Str(\Y)+","+Str(\W)+","+Str(\H)+","+
                   Str(RGBA(0,0,0,255))+","+Str(RGBA(0,0,0,255))+")"
            If Not DbUpdate(query$) :End:EndIf
      EndWith
      gModeDraw=#ModeSelect
      gActiOn=#False
      DrawCanvas()
EndProcedure
Procedure DrawCanvas()
      Protected query$
      StartVectorDrawing(ImageVectorOutput(gImgTmp))
      ; Efface le dessin
      AddPathBox(0,0,ImageWidth(gImgTmp),ImageHeight(gImgTmp))
      VectorSourceColor(RGBA(255,255,255,255))
      FillVectorOutput()
      ;{ Les box
      query$="SELECT * FROM box"
      If Not DbQuey(query$):End:EndIf
      While NextDatabaseRow(gDb)
            AddPathBox(GetDatabaseLong(gDb,1),GetDatabaseLong(gDb,2),GetDatabaseLong(gDb,3),GetDatabaseLong(gDb,4))
            VectorSourceColor(GetDatabaseLong(gDb,5))
            StrokePath(2)
      Wend
      FinishDatabaseQuery(gDb)
      ;}
      StopVectorDrawing()
      StartVectorDrawing(CanvasVectorOutput(#Canvas))
      DrawVectorImage(ImageID(gImgTmp))
      StopVectorDrawing()
EndProcedure
Procedure PreDrawEdit()
      Protected X,Y,W,H,DepX,DepY
      DepX=gMouseX-myPos\X
      DepY=gMouseY-myPos\Y
      Select gObj
            Case #ObBox
                  gActiOn=#True
                  With myOldPos
                        Select gCurrentHandle$
                              Case ""
                                    X=\X+DepX
                                    Y=\Y+DepY
                                    W=\W
                                    H=\H
                              Case "UL"
                                    X=\X+DepX
                                    Y=\Y+DepY
                                    W=\W-DepX
                                    H=\H-DepY
                              Case "UR"
                                    X=\X
                                    Y=\Y+DepY
                                    W=\W+DepX
                                    H=\H-DepY
                              Case "UM"
                                    X=\X
                                    Y=\Y+DepY
                                    W=\W
                                    H=\H-DepY   
                              Case "DL"
                                    X=\X+DepX
                                    Y=\Y
                                    W=\W-DepX
                                    H=\H+DepY    
                              Case "DR"
                                    X=\X
                                    Y=\Y
                                    W=\W+DepX
                                    H=\H+DepY   
                              Case "DM"
                                    X=\X
                                    Y=\Y
                                    W=\W
                                    H=\H+DepY   
                              Case "LM"
                                    X=\X+DepX
                                    Y=\Y
                                    W=\W-DepX
                                    H=\H   
                              Case "RM"
                                    X=\X
                                    Y=\Y
                                    W=\W+DepX
                                    H=\H        
                        EndSelect
                  EndWith
      EndSelect
      StartVectorDrawing(CanvasVectorOutput(#Canvas))
      DrawVectorImage(ImageID(gImgTmp))
      AddPathBox(X,Y,W,H)   
      With  newPos
            \X=X
            \Y=Y
            \W=W
            \H=H
      EndWith
      VectorSourceColor(RGBA(211,211,211,255))
      DotPath(2,4)
      StopVectorDrawing()
EndProcedure
Procedure DrawHandle()
      Protected X,Y,W=8
      StartVectorDrawing(ImageVectorOutput(gImgTmp))
      With myOldPos
            Select gObj
                  Case #ObBox
                        ; Poignée Haut gauche
                        X=\X-(W/2)
                        Y=\Y-(W/2)
                        AddPathBox(X,Y,W,W)
                        UL\X=X
                        UL\Y=Y
                        UL\W=W
                        ; Poignée Haut droite
                        X=(\X+\W)-(W/2)
                        Y=\Y-(W/2)
                        AddPathBox(X,Y,W,W)
                        UR\X=X
                        UR\Y=Y
                        UR\W=W
                        ; Poignée bas gauche
                        X=\X-(W/2)
                        Y=(\Y+\H)-(W/2)
                        AddPathBox(X,Y,W,W)
                        DL\X=X
                        DL\Y=Y
                        DL\W=W
                        ; Poignée Bas droite
                        X=(\X+\W)-(W/2)
                        Y=(\Y+\H)-(W/2)
                        AddPathBox(X,Y,W,W)
                        DR\X=X
                        DR\Y=Y
                        DR\W=W
                        ; Poignée milieu gauche
                        X=\X-(W/2)
                        Y=(\Y+(\H/2))-(W/2)
                        AddPathBox(X,Y,W,W)
                        LM\X=X
                        LM\Y=Y
                        LM\W=W
                        ; Poignée Milieu droite
                        X=(\X+\W)-(W/2)
                        Y=(\Y+(\H/2))-(W/2)
                        AddPathBox(X,Y,W,W)
                        RM\X=X
                        RM\Y=Y
                        RM\W=W
                        ; Poignée Haut Milieu
                        X=(\X+(\W/2))-(W/2)
                        Y=\Y-(W/2)
                        AddPathBox(X,Y,W,W)
                        UM\X=X
                        UM\Y=Y
                        UM\W=W
                        ; Poignée bas milieu
                        X=(\X+(\W/2))-(W/2)
                        Y=(\Y+\H)-(W/2)
                        AddPathBox(X,Y,W,W)
                        DM\X=X
                        DM\Y=Y
                        DM\W=W
                        VectorSourceColor(RGBA(105,105,105,255))
                        FillPath()
            EndSelect
      EndWith
      StopVectorDrawing()
      StartVectorDrawing(CanvasVectorOutput(#Canvas))
      DrawVectorImage(ImageID(gImgTmp))
      StopVectorDrawing()
EndProcedure
Procedure HoverHandle()
      With UL
            If (gMouseX>=\X And gMouseX<=(\X+\W)) And (gMouseY>=\Y And gMouseY<=(\Y+\W))
                  gCurrentHandle$="UL"
                  SetGadgetAttribute(#Canvas,#PB_Canvas_Cursor,#PB_Cursor_LeftUpRightDown)
                  ProcedureReturn #True
            EndIf
      EndWith
      With UM
            If (gMouseX>=\X And gMouseX<=(\X+\W)) And (gMouseY>=\Y And gMouseY<=(\Y+\W))
                  gCurrentHandle$="UM"
                  SetGadgetAttribute(#Canvas,#PB_Canvas_Cursor,#PB_Cursor_UpDown)
                  ProcedureReturn #True
            EndIf
      EndWith
      With UR
            If (gMouseX>=\X And gMouseX<=(\X+\W)) And (gMouseY>=\Y And gMouseY<=(\Y+\W))
                  gCurrentHandle$="UR"
                  SetGadgetAttribute(#Canvas,#PB_Canvas_Cursor,#PB_Cursor_LeftDownRightUp)
                  ProcedureReturn #True
            EndIf
      EndWith
      With DL
            If (gMouseX>=\X And gMouseX<=(\X+\W)) And (gMouseY>=\Y And gMouseY<=(\Y+\W))
                  gCurrentHandle$="DL"
                  SetGadgetAttribute(#Canvas,#PB_Canvas_Cursor,#PB_Cursor_LeftDownRightUp)
                  ProcedureReturn #True
            EndIf
      EndWith
      With DM
            If (gMouseX>=\X And gMouseX<=(\X+\W)) And (gMouseY>=\Y And gMouseY<=(\Y+\W))
                  gCurrentHandle$="DM"
                  SetGadgetAttribute(#Canvas,#PB_Canvas_Cursor,#PB_Cursor_UpDown)
                  ProcedureReturn #True
            EndIf
      EndWith
      With DR
            If (gMouseX>=\X And gMouseX<=(\X+\W)) And (gMouseY>=\Y And gMouseY<=(\Y+\W))
                  gCurrentHandle$="DR"
                  SetGadgetAttribute(#Canvas,#PB_Canvas_Cursor,#PB_Cursor_LeftUpRightDown)
                  ProcedureReturn #True
            EndIf
      EndWith
      With LM
            If (gMouseX>=\X And gMouseX<=(\X+\W)) And (gMouseY>=\Y And gMouseY<=(\Y+\W))
                  gCurrentHandle$="LM"
                  SetGadgetAttribute(#Canvas,#PB_Canvas_Cursor,#PB_Cursor_LeftRight)
                  ProcedureReturn #True
            EndIf
      EndWith
      With RM
            If (gMouseX>=\X And gMouseX<=(\X+\W)) And (gMouseY>=\Y And gMouseY<=(\Y+\W))
                  gCurrentHandle$="RM"
                  SetGadgetAttribute(#Canvas,#PB_Canvas_Cursor,#PB_Cursor_LeftRight)
                  ProcedureReturn #True
            EndIf
      EndWith
      gCurrentHandle$=""
      ProcedureReturn #False
EndProcedure
Procedure ChangePosition()
      Protected query$
      With newPos
            Select gObj
                  Case #ObBox
                        query$="UPDATE box SET "+
                               "x="+Str(\X)+",y="+Str(\Y)+",w="+Str(\W)+",h="+Str(\H)
                        myOldPos\X=\X
                        myOldPos\Y=\Y
                        myOldPos\W=\W
                        myOldPos\H=\H
            EndSelect
      EndWith
      If Not DbUpdate(query$):End:EndIf
      DrawCanvas()
      DrawHandle()
EndProcedure
Procedure EventCanvas()
      Select EventType()
            Case #PB_EventType_MouseMove
                  gMouseX=GetGadgetAttribute(#Canvas,#PB_Canvas_MouseX)
                  gMouseY=GetGadgetAttribute(#Canvas,#PB_Canvas_MouseY)
                  Select gModeDraw
                        Case  #MdNewBox,#MdNewCircle   
                              SetGadgetAttribute(#Canvas,#PB_Canvas_Cursor,#PB_Cursor_Cross)
                              If gClicOn
                                    PreDrawBox()
                              EndIf
                        Case #ModeSelect  
                              If gId<>-1 And gClicOn
                                    PreDrawEdit()
                              EndIf
                              If Not gClicOn
                                    If HoverHandle()
                                          ProcedureReturn 
                                    EndIf
                                    If HoverToForm()
                                          If gSelected
                                                SetGadgetAttribute(#Canvas,#PB_Canvas_Cursor,#PB_Cursor_Arrows)
                                          Else
                                                SetGadgetAttribute(#Canvas,#PB_Canvas_Cursor,#PB_Cursor_Hand)
                                          EndIf
                                          
                                          ProcedureReturn 
                                    EndIf
                                    SetGadgetAttribute(#Canvas,#PB_Canvas_Cursor,#PB_Cursor_Default)
                              EndIf
                  EndSelect
            Case #PB_EventType_LeftButtonDown
                  If Not gClicOn
                        myPos\X=gMouseX
                        myPos\Y=gMouseY
                        If gId<>-1
                              If gSelected=#True
                                    gActiOn=#True
                              EndIf
                              Select gObj
                                    Case #ObBox
                                          myOldPos\X=GetDatabaseLong(gDb,1)
                                          myOldPos\Y=GetDatabaseLong(gDb,2)
                                          myOldPos\W=GetDatabaseLong(gDb,3)
                                          myOldPos\H=GetDatabaseLong(gDb,4)
                                          DrawHandle()
                                          gSelected=#True
                              EndSelect
                        Else
                              gSelected=#False
                              DrawCanvas()
                        EndIf
                  EndIf
                  gClicOn=#True
            Case #PB_EventType_LeftButtonUp
                  If gActiOn
                        Select gModeDraw
                              Case #MdNewBox
                                    AddBox()
                              Case #ModeSelect
                                    ChangePosition()
                        EndSelect
                  EndIf
                  gClicOn=#False
      EndSelect
EndProcedure
Procedure ManageCanvas()
      UseGadgetList(WindowID(#MainForm))
      If gDrawW>WindowWidth(#MainForm) Or gDrawH>(WindowHeight(#MainForm)-MenuHeight())
            If  IsGadget(#ScrollArea)=0
                  ScrollAreaGadget(#ScrollArea,0,0,WindowWidth(#MainForm),(WindowHeight(#MainForm)-MenuHeight()),
                                   gDrawW,gDrawH,10)
            Else
                  ResizeGadget(#ScrollArea,#PB_Ignore,#PB_Ignore,WindowWidth(#MainForm),(WindowHeight(#MainForm)-MenuHeight()))
                  SetGadgetAttribute(#ScrollArea,#PB_ScrollArea_InnerWidth,gDrawW)
                  SetGadgetAttribute(#ScrollArea,#PB_ScrollArea_InnerHeight,gDrawH)
                  OpenGadgetList(#ScrollArea)
            EndIf
      Else
            If  IsGadget(#ScrollArea)<>0
                  FreeGadget(#ScrollArea)
            EndIf
      EndIf
      If IsGadget(#Canvas)=0
            CanvasGadget(#Canvas,0,0,gDrawW,gDrawH,#PB_Canvas_Keyboard)
            gImgTmp=CreateImage(#PB_Any,gDrawW,gDrawH)
            StartDrawing(ImageOutput(gImgTmp))
            Box(0,0,ImageWidth(gImgTmp),ImageHeight(gImgTmp),$FFFFFF)
            StopDrawing()
            BindGadgetEvent(#Canvas,@EventCanvas())
      Else
            ResizeGadget(#Canvas,#PB_Ignore,#PB_Ignore,gDrawW,gDrawH)
            ResizeImage(gImgTmp,gDrawW,gDrawH)
      EndIf
      If IsGadget(#ScrollArea)<>0
            CloseGadgetList()
      EndIf
EndProcedure
Procedure SavePropertie()
      gDrawW=GetGadgetState(#spW)
      gDrawH=GetGadgetState(#spH)
      CloseForm()
      ManageCanvas()
EndProcedure
Procedure CloseForm()
      If gMotherForm<>-1
            DisableWindow(gMotherForm,#False)
      EndIf
      CloseWindow(EventWindow())
EndProcedure
Procedure OpenDrawPropertie()
      Protected title$
      Protected M=10,X=M,Y=M,W=180,H=30
      Protected WF=(W*1)+(M*2),HF=(H*5)+(M*4)
      Protected Flag=#PB_Window_ScreenCentered|#PB_Window_SystemMenu
      Protected tmp
      gExt$=" pxl"
      If gModeNew
            title$="Nouveau document"
      Else
            title$="Propriété du document"
      EndIf
      gMotherForm=#MainForm
      DisableWindow(gMotherForm,#True)
      OpenWindow(#PropertieForm,0,0,WF,HF,title$,Flag,WindowID(#MainForm))
      tmp=TextGadget(#PB_Any,X,Y,W,H,"Largeur:")
      SetGadgetFont(tmp,FontID(#Font))
      Y+H
      SpinGadget(#spW,X,Y,W,H,0,2500,#PB_Spin_Numeric)
      SetGadgetFont(#spW,FontID(#Font))
      Y+H+M
      tmp=TextGadget(#PB_Any,X,Y,W,H,"Hauteur:")
      SetGadgetFont(tmp,FontID(#Font))
      Y+H
      SpinGadget(#spH,X,Y,W,H,0,2500,#PB_Spin_Numeric)
      SetGadgetFont(#spH,FontID(#Font))
      Y+H+M
      W=(W/2)-M
      ButtonGadget(#BtSubmit,X,Y,W,H,"Valider")
      SetGadgetFont(#BtSubmit,FontID(#Font))
      BindGadgetEvent(#BtSubmit,@SavePropertie())
      X+W+M
      ButtonGadget(#BtChancel,X,Y,W,H,"Annuler")
      SetGadgetFont(#BtChancel,FontID(#Font))
      BindGadgetEvent(#BtChancel,@CloseForm())
      BindEvent(#PB_Event_CloseWindow,@CloseForm(),#PropertieForm)
EndProcedure
Procedure NewBox()
      gActiOn=#False
      gModeDraw=#MdNewBox
EndProcedure
Procedure OpenMainForm()
      Protected Flag=#PB_Window_ScreenCentered|#PB_Window_SystemMenu|#PB_Window_Maximize|#PB_Window_MaximizeGadget
      Flag|#PB_Window_MinimizeGadget|#PB_Window_SizeGadget
      OpenWindow(#MainForm,0,0,800,600,"Easy Draw",Flag)
      CreateMenu(#MainMenu,WindowID(#MainForm))
      MenuTitle("Fichier")
      MenuItem(#New,"Nouveau "+Chr(9)+"ALT N")
      AddKeyboardShortcut(#MainForm,#PB_Shortcut_Alt|#PB_Shortcut_N,#New)
      BindMenuEvent(#MainMenu,#New,@NewDraw())
      MenuItem(#Open,"Ouvrir "+Chr(9)+"ALT O")
      AddKeyboardShortcut(#MainForm,#PB_Shortcut_Alt|#PB_Shortcut_N,#Open)
      BindMenuEvent(#MainMenu,#Open,@OpenDraw())
      MenuItem(#Save,"Sauver "+Chr(9)+"CTRL S")
      AddKeyboardShortcut(#MainForm,#PB_Shortcut_Control|#PB_Shortcut_N,#Save)
      BindMenuEvent(#MainMenu,#Save,@SaveDraw())
      MenuItem(#SaveAs,"Sauver sous ")
      BindMenuEvent(#MainMenu,#SaveAs,@SaveAsDraw())
      MenuItem(#Close,"Fermer ")
      BindMenuEvent(#MainMenu,#Close,@CloseDraw())
      MenuBar()
      MenuItem(#Exit,"Quitter ")
      BindMenuEvent(#MainMenu,#Exit,@Exit())
      MenuTitle("Nouvelle forme")
      MenuItem(#NewBox,"Rectangle "+Chr(9)+"ALT B")
      AddKeyboardShortcut(#MainForm,#PB_Shortcut_Alt|#PB_Shortcut_B,#NewBox)
      BindMenuEvent(#MainMenu,#NewBox,@NewBox())
      BindEvent(#PB_Event_CloseWindow,@Exit(),#MainForm)
      BindEvent(#PB_Event_SizeWindow,@EventResize(),#MainForm)
EndProcedure
BuildMemorisDb()
OpenMainForm()
gDrawW=WindowWidth(#MainForm)
gDrawH=WindowHeight(#MainForm)-MenuHeight()
ManageCanvas()
Global gEvent
Repeat:gEvent=WaitWindowEvent():ForEver

Re: Drawing vector sotware (PB 5.40)

Posted: Sat Oct 17, 2015 4:36 pm
by HanPBF
Hi!
Thanks for sharing Your code!

Why did You choose to store things in :memory:-DB?
Easier to handle? Persistence?
(Maybe I overread it)


Thanks!

Re: Drawing vector sotware (PB 5.40)

Posted: Sat Oct 17, 2015 11:08 pm
by Andre
Nice & thanks, could become useful... :)

Re: Drawing vector sotware (PB 5.40)

Posted: Sun Oct 18, 2015 6:07 pm
by microdevweb
Thank's Andre,

Hi HanPBF, i'm try another method i don't know if this usage of memoris database is easier compared of list or map. I try that, So i find for some code that give more potential (filters, sort). In this code i wand testing the speed whit that. And i finds it's is.
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited