PureBasic Forums - English

Posted: **Thu Nov 05, 2015 5:40 pm**

One person ask me to PM when make a GDi interface. I post this response for any member

One part
The draw of the grid

Code: Select all

; Name: DrawGrid
; Author: MicrodevWeb
EnableExplicit
Enumeration 
      #MainForm
      #MainCanvas
EndEnumeration
Global gGridSpace=10 ;The space between the dots
Global gGridColor=$2D52A0 ; The backgroud coloe
Global gBgColor=$B3DEF5
Procedure Exit()
      End
EndProcedure
Procedure OpenMainForm()
      Protected Flag=#PB_Window_SystemMenu|#PB_Window_Maximize
      ; Open Window
      OpenWindow(#MainForm,0,0,800,600,"Dssin d'une grille",Flag)
      ; Make canvas
      CanvasGadget(#MainCanvas,0,0,WindowWidth(#MainForm),WindowHeight(#MainForm))
      ; Callback with close window
      BindEvent(#PB_Event_CloseWindow,@Exit(),#MainForm)
EndProcedure
Procedure DrawGrid()
      Protected X=gGridSpace,Y=gGridSpace
      While X<GadgetWidth(#MainCanvas)
            Y=gGridSpace ; Restart Up
            While Y<GadgetHeight(#MainCanvas)
                  Plot(X,Y,gGridColor)
                  Y+gGridSpace ; Move the Dot of Y
            Wend
            X+gGridSpace ; Move the Dot of X
      Wend
EndProcedure
Procedure DrawCanvas()
      StartDrawing(CanvasOutput(#MainCanvas))
      ; Eraze the canvas
      Box(0,0,GadgetWidth(#MainCanvas),GadgetHeight(#MainCanvas),gBgColor)
      ; Draw the grd
      DrawGrid()
      StopDrawing()
EndProcedure
;-* Run programme
; --> List of procedures who must run of started software 
; Open window
OpenMainForm()
; Draw canvas
DrawCanvas()
;}
;-* Main loop
; --> The main loop empty but i manage the event with BindEvent etc...
Repeat :WaitWindowEvent():ForEver
;}

Posted: **Thu Nov 05, 2015 5:49 pm**

Twice part
But where i am?

Above procedure OpenMainForm() make this procedure (i you make this under, you need declare this)

Code: Select all

Procedure EventCanvas()
      Select EventType()
            Case #PB_EventType_MouseMove
                  ; Where i am ?
                  ; stores the position of the mouse in the canvas
                  gMouseX=GetGadgetAttribute(#MainCanvas,#PB_Canvas_MouseX)
                  gMouseY=GetGadgetAttribute(#MainCanvas,#PB_Canvas_MouseY)
                  WhereIsMouse()
            Case #PB_EventType_RightButtonDown
                  
            Case #PB_EventType_RightButtonUp
                  
      EndSelect
EndProcedure

Remember also to create two global variables at the start of your code (notice, little tip staff I preceded the global variables of a small g

Code: Select all

Global gMouseX,gMouseY

Under the procedure EventCanvas() you nedd make this procedure

Code: Select all

Procedure WhereIsMouse()
      Debug "Je suis à "+Str(gMouseX)+" en X et à "+Str(gMouseY)+" en Y"
EndProcedure

Add this in the end of your code to your procedure OpenMainForm()

Code: Select all

 ;  Callback for manage the event of the canvas
      BindGadgetEvent(#MainCanvas,@EventCanvas())

That following soon ...

Posted: **Thu Nov 05, 2015 6:08 pm**

Thirt part
And if we drew something ?

In this part we will begin drawing implemented our part, for that you need to know where one starts

Make this structure and this variable beginning youre code

Code: Select all

Structure Pos
      X.i
      Y.i
EndStructure
Global gOldMouse.Pos

We add this variable for know if the left button is up or down

Code: Select all

Global gClicOn.b=#False

To know the type of draw will make user(manage by menu of other) we will also add this (before your procedures)

Code: Select all

Enumeration DrawMode
      #Select
      #DrawBox
EndEnumeration
Global gDrawMode=#DrawBox

We will now modify the procedure EventCanvas()

Code: Select all

Procedure EventCanvas()
      Select EventType()
            Case #PB_EventType_MouseMove
                  ; Savoir ou l'on est ?
                  ; Je mémorise les position de la souris sur le canvas
                  gMouseX=GetGadgetAttribute(#MainCanvas,#PB_Canvas_MouseX)
                  gMouseY=GetGadgetAttribute(#MainCanvas,#PB_Canvas_MouseY)
                  If Not gClicOn
                        WhereIsMouse()
                  Else
                        ManageDraw()
                  EndIf
            Case #PB_EventType_LeftButtonDown
                  If Not gClicOn
                        ; Store the mouse posistion for the calculate displacement
                        gOldMouse\X=gMouseX
                        gOldMouse\Y=gMouseY
                  EndIf
                  gClicOn=#True ; Indicates that you click on the left button
            Case #PB_EventType_LeftButtonUp
                  gClicOn=#False ;Le bt gauche est relaché
      EndSelect
EndProcedure

We will also add the procedure above this EventCanvas()

Code: Select all

Procedure ManageDraw()
      ;On calcul le déplacement
      Protected DisplacX=gMouseX-gOldMouse\X
      Protected DisplacY=gMouseY-gOldMouse\Y
      Select gDrawMode
            Case #DrawBox  
                  Debug "vous de déplacer de "+Str(DisplacX)+" pixels sur X"
                  Debug "vous de déplacer de "+Str(DisplacY)+" pixels sur Y"
      EndSelect
EndProcedure

Test and normally when you move the mouse you should have the travel distance on both axes

Note: I know I give you the code to parts, but the purpose of this tutorial is not to make a simple copy paste but you explain the reasoning to reach his goals. Afterwards it will be easy to do the same. I will provide you obviously all the code in the end tutorial

Posted: **Thu Nov 05, 2015 6:25 pm**

fourth part
And if we drew something (next)

The draw it's vector type, for that add 2 structures and linked list.

Code: Select all

Structure PosAndSize Extends Pos
      W.i
      H.i
EndStructure
Structure Draw
      List myBox.PosAndSize()
EndStructure
Global newList myDraw.Draw()

Well now we will see a simulation of the rectangle that will be drawn, but for that we have changed our code. Rather than draw directly in our Canvas we will draw in a temporary image, We also immediately created this

Code: Select all

Global gTmpImg

And in the procedure code OpenMainForm() after the creatind of canvas

Code: Select all

 gTmpImg=CreateImage(#PB_Any,GadgetWidth(#MainCanvas),GadgetHeight(#MainCanvas))

I now create a new procedure, nad moved my code from DrawCanvas()in this new procedure, I now also modifies the StartDrawing

Code: Select all

Procedure DrawTmpImg()
      StartDrawing(ImageOutput(gTmpImg))
      ; Eraze the image
      Box(0,0,GadgetWidth(#MainCanvas),GadgetHeight(#MainCanvas),gBgColor)
      ; Draw the grid
      DrawGrid()
      StopDrawing()
EndProcedure

I now also modifies the DrawCanvas()

Code: Select all

Procedure DrawCanvas()
       DrawTmpImg()
      StartDrawing(CanvasOutput(#MainCanvas))
      ; Draw the tempory image
      DrawImage(ImageID(gTmpImg),0,0)
      StopDrawing()
EndProcedure

Finally, I tested to make sure everything works as before

Yeay, that work

Well I'll temporarily store my drawing, I add a new variable (in start code)

Code: Select all

Global gTmpDraw.PosAndSize

And I change my procedure ManageDraw()

Code: Select all

Procedure ManageDraw()
      ;On calcul le déplacement
      Protected DisplacX=gMouseX-gOldMouse\X
      Protected DisplacY=gMouseY-gOldMouse\Y
      Select gDrawMode
            Case #DrawBox  
                  gTmpDraw\X=gOldMouse\X
                  gTmpDraw\Y=gOldMouse\Y
                  gTmpDraw\W=DisplacX
                  gTmpDraw\H=DisplacY
                  DrawPrevBox()
      EndSelect
EndProcedure

Well I'll add a procedure before ManageDraw() this is the procedure that will draw the rectangle for the future (I will use the new library VectorDrawing Pb 5.40)

Code: Select all

StartVectorDrawing(CanvasVectorOutput(#MainCanvas))
      ; I eraze the canvas with the tempory image
      MovePathCursor(0,0)
      DrawVectorImage(ImageID(gTmpImg))
      ; I draw the box
      With gTmpDraw
            AddPathBox(\X,\Y,\W,\H)
            ; WARNING RGBA color so with the alpha values
            VectorSourceColor(RGBA(0, 255, 127, 255))
            DotPath(2,8)
      EndWith
      StopVectorDrawing()

Test, hold the left button and move the mouse normally you should see a green rectangle dashed

WARNING: You need run with Pb 5.40

Weel it's finish for this part in the next part , we will save our all this and draw rectangles

Posted: **Thu Nov 05, 2015 6:56 pm**

Fifth part
And if we drew something (next)

Well we're going to save the position of our rectangle, but when

Hum in your opinion? when the user releases the mouse button, no

Well for that, it is also necessary that I know is there was a rectangle to add

I will add a flag
Add this variable

Code: Select all

Global gNewDraw.b=#False

And modified the code of ManageDraw()

Code: Select all

Procedure ManageDraw()
      ;On calcul le déplacement
      Protected DisplacX=gMouseX-gOldMouse\X
      Protected DisplacY=gMouseY-gOldMouse\Y
      Select gDrawMode
            Case #DrawBox  
                  gTmpDraw\X=gOldMouse\X
                  gTmpDraw\Y=gOldMouse\Y
                  gTmpDraw\W=DisplacX
                  gTmpDraw\H=DisplacY
                  DrawPrevBox()
      EndSelect
      gNewDraw=#True
EndProcedure

And will this code EventCanvas()

Code: Select all

Case #PB_EventType_LeftButtonUp
                  If gNewDraw
                        Select gDrawMode
                              Case #DrawBox
                                    AddNewBox()
                        EndSelect
                  EndIf
                  gNewDraw=#False
                  gClicOn=#False ;Le bt gauche est relaché

I believe that now have guessed, we'll add a procedure

Code: Select all

Procedure AddNewBox()
      AddElement(myDraw())
      AddElement(myDraw()\myBox())
      With myDraw()\myBox()
            \X=gTmpDraw\X
            \Y=gTmpDraw\Y
            \W=gTmpDraw\W
            \H=gTmpDraw\H
      EndWith
      DrawCanvas()
EndProcedure

And we'll also declared at the beginning of the procedure code DrawCanvas()

Code: Select all

Declare DrawCanvas()

Good very nice all this, but I see nothing on the screen

Really, But we nothing dont make to drawing our object, but there just in memory.

Let's go .......... You guessed it, we will create a procedure before DrawTmpImg() (nice indeed is going to make two in case you want to draw something other than box)

Code: Select all

Procedure DrawBox()
      With myDraw()\myBox()
            Box(\X,\Y,\W,\H,RGB(255, 0, 0))
      EndWith
EndProcedure
Procedure DrawOblect()
      ForEach myDraw()
            With myDraw()
                  ForEach \myBox()
                        DrawBox()
                  Next
            EndWith
      Next
EndProcedure

Now just modified this DrawTmpImg()

Code: Select all

Procedure DrawTmpImg()
      StartDrawing(ImageOutput(gTmpImg))
      ; Eraze image
      Box(0,0,GadgetWidth(#MainCanvas),GadgetHeight(#MainCanvas),gBgColor)
      ; Draw grid
      DrawGrid()
      DrawOblect() ; Drawing our object
      StopDrawing()
EndProcedure

That if you test now, you will draw beautiful red box

Next part, modified the size and moved the object

Posted: **Thu Nov 05, 2015 10:44 pm**

sixth part
Which objectt ?
And so for the rest it is important to know on which object I......

We add 2 variables, one memoris type for memorize the current objet overflown, and one for memorize the type of objet (remember from this tuto i use only box, but you can use any more object)

Code: Select all

Global gTypeObjet
Global *gCurrentObjet

Remember to WhereIsMouse(), it's now we really going to use it.

Let's go we changed this

Code: Select all

Procedure WhereIsMouse()
      ; we are on the object
      ItsHoverObject()
EndProcedure

What else a procedure ...

Yes ... I'm like that, the procedure

Code: Select all

Procedure ItsHoverObject()
      ; It is about nothing
      *gCurrentObjet=-1
      gTypeObjet=-1
      ForEach myDraw()
            ForEach myDraw()\myBox()
                  With myDraw()\myBox()
                        If (gMouseX>=\X And gMouseX<=(\X+\W)) And (gMouseY>=\Y And gMouseY<=(\Y+\H))
                              *gCurrentObjet=@myDraw()\myBox()
                              gTypeObjet=#DrawBox
                              ProcedureReturn #True
                        EndIf
                  EndWith
            Next
      Next
      ProcedureReturn #False
EndProcedure

Good a word of explanation, I am departing on anything so I instead

Code: Select all

*gCurrentObjet=-1
 gTypeObjet=-1

Then I look for each rectangle if my mouse is over

Code: Select all

If (gMouseX>=\X And gMouseX<=(\X+\W)) And (gMouseY>=\Y And gMouseY<=(\Y+\H))

If Yes I memorize the object and the object type, and I note that I'm on something

Code: Select all

*gCurrentObjet=@myDraw()\myBox()
 gTypeObjet=#DrawBox
 ProcedureReturn #True

And if we change the mouse type

It would be nice right?

let's go do that...

Code: Select all

Procedure WhereIsMouse()
      ; It is an object
      If ItsHoverObject()
            SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Hand)
            ProcedureReturn 
      EndIf
      SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Default)
EndProcedure

Well, testing, moving your mouse and draw the box

See you soon for later

PureBasic Forums - English

[ TUTO ] How make a GDi interface

[ TUTO ] How make a GDi interface

Re: [ TUTO ] How make a GDi interface

Re: [ TUTO ] How make a GDi interface

Re: [ TUTO ] How make a GDi interface

Re: [ TUTO ] How make a GDi interface

Re: [ TUTO ] How make a GDi interface