dynamic Drawing

Share your advanced PureBasic knowledge/code with the community.
Post Reply
User avatar
gurj
Enthusiast
Enthusiast
Posts: 693
Joined: Thu Jan 22, 2009 3:48 am
Location: china
Contact:
Contact gurj

dynamic Drawing

Post by gurj »

Code: Select all

Global fs=$Ffddddff,fsd=7;辅助色,Dim xy(50,1)
Procedure makeInvisible(win)
 SetWindowColor(win, $6f6f6f) 
 win=WindowID(win)
 SetWindowLongPtr_(win, #GWL_EXSTYLE,$00080000)
 SetLayeredWindowAttributes_(win, $6f6f6f, 0, #LWA_COLORKEY) 
EndProcedure
Procedure lineG(Image,Gadget,x1,y1,x2,y2,lineWidth)
 If lineWidth<fsd:lw0=lineWidth:lineWidth=fsd:EndIf
 lw2=lineWidth/2+1:lw22=lineWidth+2
 If x1<x2:x1_=x1-lw2:xx2=x2+lw2-x1:xx1=lw2:Width=xx2+lw22:Else
 xx1=x1+lw2-x2:xx2=lw2:x1_=x2-lw2:Width=xx1+lw22:EndIf
 If y1<y2:y1_=y1-lw2:yy2=y2+lw2-y1:yy1=lw2:Height=yy2+lw22
  Else:yy1=y1+lw2-y2:yy2=lw2:y1_=y2-lw2:Height=yy1+lw22:EndIf
 If CreateImage(Image,Width,Height,32,$ffffffff) And
    StartVectorDrawing(ImageVectorOutput(Image)):EndIf
 MovePathCursor(xx1,yy1):AddPathLine(xx2,yy2)
 If lw0>0:VectorSourceColor(fs):StrokePath(lineWidth)
  MovePathCursor(xx1,yy1):AddPathLine(xx2,yy2)
 VectorSourceColor($ff0000ff):StrokePath(lw0):Else
  VectorSourceColor($ff0000ff):StrokePath(lineWidth)
 EndIf
 StopVectorDrawing()
 ImageGadget(Gadget,x1_,y1_,Width,Height,ImageID(Image))
EndProcedure
Procedure scrollproc2()
 SetGadgetAttribute(1, #PB_ScrollArea_X, GetGadgetAttribute(2, #PB_ScrollArea_X))
 SetGadgetAttribute(1, #PB_ScrollArea_Y, GetGadgetAttribute(2, #PB_ScrollArea_Y))
EndProcedure

OpenWindow(0, 0, 0, 550, 550, "dynamic Drawing", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget| #PB_Window_ScreenCentered)
SetWindowColor(0, $f7f7f7)
TrackBarGadget(80, 0,  0, 200, 20, 1, 20)
TextGadget(0,20,80,400,25,"DragDrop Gadget 11(line) or 12(Point) or 13(Point)")

rex=WindowX(0,#PB_Window_InnerCoordinate)
rey=WindowY(0,#PB_Window_InnerCoordinate)
wFlags = #PB_Window_BorderLess

OpenWindow(1, rex, rey, 550, 550, "", wFlags,WindowID(0))
ScrollAreaGadget(1,0,25, 550, 525,1800,1200)
SetGadgetColor(1,#PB_Gadget_BackColor,$6f6f6f);TransparentColor
gx0=128:gy0=28:gx_=28:gy_=28:lineWidth=1
lineG(0,11,gx0,gy0,gx_,gy_,lineWidth)

OpenWindow(2, rex, rey, 550, 550, "", wFlags,WindowID(0))
ScrollAreaGadget(2,0,25, 550, 525,1800,1200)
SetGadgetColor(2,#PB_Gadget_BackColor, $6f6f6f);TransparentColor
BindGadgetEvent(2, @scrollproc2())
bj=lineWidth/2+3:bj2=bj<<1
If  CreateImage(1,bj2,bj2,32,$ffffffff)
 If StartVectorDrawing(ImageVectorOutput(1))
  AddPathCircle(bj,bj,bj)
  VectorSourceColor(RGBA(0, 0, 0, 255))
  FillPath()
  StopVectorDrawing()
 EndIf
 TextGadget(8,gx_-bj+20,gy_-bj,22,20,"A")
 SetGadgetColor(8,#PB_Gadget_BackColor, $6f6f6f)
 ImageGadget(12,gx_-bj,gy_-bj,bj2,bj2,ImageID(1))
 ImageGadget(13,gx0-bj,gy0-bj,bj2,bj2,ImageID(1))
ImageGadget(14,gx_-bj+50,gy_-bj,bj2,bj2,ImageID(1)):EndIf
DisableGadget(14,1)

makeInvisible(1)
makeInvisible(2)
;StickyWindow(2,1)
re:
Repeat
 Select WaitWindowEvent(500)
  Case #PB_Event_Gadget
   If EventGadget()=80:appQuit = 2:Break
   Else:If GetAsyncKeyState_(#VK_LBUTTON):eg=EventGadget():EndIf:EndIf
  Case #WM_LBUTTONUP:jx=0:eg=-1:SetActiveWindow(2)
   ;本来不使用Win1,不需要SetActiveWindow(2),Win2就总是Active,但是图片总是方形的,所以加Win1解决
  Case #WM_MOUSEMOVE
   If eg>10:If jx=1:appQuit = 3:Break
     Else:jx=1:Gosub cs:EndIf:EndIf
   Case #PB_Event_MoveWindow:If EventWindow()=0
    rex=WindowX(0,#PB_Window_InnerCoordinate)
    rey=WindowY(0,#PB_Window_InnerCoordinate)
    ResizeWindow(1, rex, rey,#PB_Ignore,#PB_Ignore)
   ResizeWindow(2, rex, rey,#PB_Ignore,#PB_Ignore):EndIf
  Case #PB_Event_CloseWindow:appQuit = 1
 EndSelect
Until appQuit = 1

If appQuit = 3:x01=WindowMouseX(0):y01=WindowMouseY(0)
 If x00<>x01 Or y00<>y01
  x00=x01:y00=y01:x=x01-x0:y=y01-y0
  gx_=gx+x:gy_=gy+y:If eg>11:OpenGadgetList(1)
   lineG(0,11,gx0+bj,gy0+bj,gx_+bj,gy_+bj,lineWidth)
  Else:ResizeGadget(11,gx1+x,gy1+y,#PB_Ignore,#PB_Ignore)
  ResizeGadget(13,gx0+x,gy0+y,#PB_Ignore,#PB_Ignore):EndIf
  If eg=11:ResizeGadget(12,gx+x,gy+y,#PB_Ignore,#PB_Ignore)
   Else:ResizeGadget(eg,gx_,gy_,#PB_Ignore,#PB_Ignore):EndIf:EndIf
 Goto re
ElseIf appQuit = 2:gx=GadgetX(12)+bj:gy=GadgetY(12)+bj
 gx0=GadgetX(13)+bj:gy0=GadgetY(13)+bj
 lineWidth=GetGadgetState(80):bj=lineWidth/2+3:bj2=bj<<1
 If  CreateImage(1,bj2,bj2,32,$ffffffff)
  If StartVectorDrawing(ImageVectorOutput(1))
   AddPathCircle(bj,bj,bj)
   VectorSourceColor(RGBA(0, 0, 0, 255))
   FillPath()
   OpenGadgetList(2)
   ImageGadget(12,gx-bj,gy-bj,bj2,bj2,ImageID(1))
   ImageGadget(13,gx0-bj,gy0-bj,bj2,bj2,ImageID(1))
   StopVectorDrawing()
 EndIf:EndIf:OpenGadgetList(1)
 lineG(0,11,gx0,gy0,gx,gy,lineWidth)
Goto re:EndIf
;SetActiveWindow(2)
End
cs: :x0=WindowMouseX(0):y0=WindowMouseY(0)
If eg=11:gx1=GadgetX(11):gy1=GadgetY(11)
 gx=GadgetX(12):gy=GadgetY(12)
 gx0=GadgetX(13):gy0=GadgetY(13)
Else:gx=GadgetX(eg):gy=GadgetY(eg)
gx0=GadgetX(25-eg):gy0=GadgetY(25-eg):EndIf
Return
my pb for chinese:
http://ataorj.ys168.com
Top
collectordave
Addict
Addict
Posts: 1310
Joined: Fri Aug 28, 2015 6:10 pm
Location: Portugal

Re: dynamic Drawing

Post by collectordave »

For dynamic drawing etc you may want to look at this post

http://www.purebasic.fr/english/viewtop ... 12&t=65607

Regards

cd
Any intelligent fool can make things bigger and more complex. It takes a touch of genius — and a lot of courage to move in the opposite direction.
Top
User avatar
gurj
Enthusiast
Enthusiast
Posts: 693
Joined: Thu Jan 22, 2009 3:48 am
Location: china
Contact:
Contact gurj

Re: dynamic Drawing

Post by gurj »

thanks,but i can't open your that https lnk.
my pb for chinese:
http://ataorj.ys168.com
Top
collectordave
Addict
Addict
Posts: 1310
Joined: Fri Aug 28, 2015 6:10 pm
Location: Portugal

Re: dynamic Drawing

Post by collectordave »

Hi
Try from here

https://github.com/collectordave/PureBasic-VectorIcons right click and open in new tab.

Works fine for me?

Regards

cd
Any intelligent fool can make things bigger and more complex. It takes a touch of genius — and a lot of courage to move in the opposite direction.
Top
User avatar
gurj
Enthusiast
Enthusiast
Posts: 693
Joined: Thu Jan 22, 2009 3:48 am
Location: china
Contact:
Contact gurj

Re: dynamic Drawing

Post by gurj »

fine! use tab...
i study...
thanks and blessing you! collectordave .
Last edited by gurj on Sun Feb 12, 2017 3:43 am, edited 2 times in total.
my pb for chinese:
http://ataorj.ys168.com
Top
User avatar
gurj
Enthusiast
Enthusiast
Posts: 693
Joined: Thu Jan 22, 2009 3:48 am
Location: china
Contact:
Contact gurj

Re: dynamic Drawing

Post by gurj »

update to use old ImageID ... this:

Code: Select all

Global fs=$Ffddddff,fsd=7;辅助色,Dim xy(50,1)
Procedure makeInvisible(win);for Transparency
 SetWindowColor(win, $6f6f6f) 
 win=WindowID(win)
 SetWindowLongPtr_(win, #GWL_EXSTYLE,$00080000)
 SetLayeredWindowAttributes_(win, $6f6f6f, 0, #LWA_COLORKEY) 
EndProcedure
CreateImage(10,1,1,32,$ffffffff)
Procedure lineG(Image,Gadget,x1,y1,x2,y2,lineWidth)
 If lineWidth<fsd:lw0=lineWidth:lineWidth=fsd:EndIf
 lw2=lineWidth/2+1:lw22=lineWidth+2
 If x1<x2:x1_=x1-lw2:xx2=x2+lw2-x1:xx1=lw2:Width=xx2+lw22:Else
 xx1=x1+lw2-x2:xx2=lw2:x1_=x2-lw2:Width=xx1+lw22:EndIf
 If y1<y2:y1_=y1-lw2:yy2=y2+lw2-y1:yy1=lw2:Height=yy2+lw22
  Else:yy1=y1+lw2-y2:yy2=lw2:y1_=y2-lw2:Height=yy1+lw22:EndIf
 If IsImage(Image):ResizeImage(Image,Width,Height)
  box=1:Else:CreateImage(Image,Width,Height,32,$ffffffff):EndIf
 StartVectorDrawing(ImageVectorOutput(Image))
 If box=1:AddPathBox(0,0,Width,Height)
 VectorSourceColor($FF6f6f6f):FillPath():EndIf;not $ffffffff,TransparencyColor is $6f6f6f,see Procedure makeInvisible(win)
 MovePathCursor(xx1,yy1):AddPathLine(xx2,yy2)
 If lw0>0:VectorSourceColor(fs):StrokePath(lineWidth)
  MovePathCursor(xx1,yy1):AddPathLine(xx2,yy2)
 VectorSourceColor($ff0000ff):StrokePath(lw0):Else
  VectorSourceColor($ff0000ff):StrokePath(lineWidth)
 EndIf
 StopVectorDrawing()
 If IsGadget(Gadget)
  SetGadgetState(Gadget,ImageID(10));for clear residues shadow ,or use HideGadget(Gadget,1)
  ResizeGadget(Gadget,x1_,y1_,Width,Height)
  SetGadgetState(Gadget,ImageID(Image));:HideGadget(Gadget,0)
 Else:ImageGadget(Gadget,x1_,y1_,Width,Height,ImageID(Image)):EndIf
EndProcedure
Procedure scrollproc2()
 SetGadgetAttribute(1, #PB_ScrollArea_X, GetGadgetAttribute(2, #PB_ScrollArea_X))
 SetGadgetAttribute(1, #PB_ScrollArea_Y, GetGadgetAttribute(2, #PB_ScrollArea_Y))
EndProcedure

OpenWindow(0, 0, 0, 550, 550, "dynamic Drawing", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget| #PB_Window_ScreenCentered)
SetWindowColor(0, $f7f7f7)
TrackBarGadget(80, 0,  0, 200, 20, 1, 20)
TextGadget(0,20,80,400,25,"DragDrop Gadget 11(line) or 12(Point) or 13(Point)")
TextGadget(7,211,0,62,20,"")
rex=WindowX(0,#PB_Window_InnerCoordinate)
rey=WindowY(0,#PB_Window_InnerCoordinate)
wFlags = #PB_Window_BorderLess

OpenWindow(1, rex, rey, 550, 550, "", wFlags,WindowID(0))
ScrollAreaGadget(1,0,25, 550, 525,1800,1200)
SetGadgetColor(1,#PB_Gadget_BackColor,$6f6f6f);TransparentColor
gx0=128:gy0=28:gx_=28:gy_=28:lineWidth=1
lineG(0,11,gx0,gy0,gx_,gy_,lineWidth)

OpenWindow(2, rex, rey, 550, 550, "", wFlags,WindowID(0))
ScrollAreaGadget(2,0,25, 550, 525,1800,1200)
SetGadgetColor(2,#PB_Gadget_BackColor, $6f6f6f);TransparentColor
BindGadgetEvent(2, @scrollproc2())
bj=lineWidth/2+3:bj2=bj<<1
If  CreateImage(1,bj2,bj2,32,$ffffffff)
 If StartVectorDrawing(ImageVectorOutput(1))
  AddPathCircle(bj,bj,bj)
  VectorSourceColor(RGBA(0, 0, 0, 255))
  FillPath()
  StopVectorDrawing()
 EndIf
 TextGadget(8,gx_-bj+20,gy_-bj,22,20,"A")
 SetGadgetColor(8,#PB_Gadget_BackColor, $6f6f6f)
 ImageGadget(12,gx_-bj,gy_-bj,bj2,bj2,ImageID(1))
 ImageGadget(13,gx0-bj,gy0-bj,bj2,bj2,ImageID(1))
ImageGadget(14,gx_-bj+50,gy_-bj,bj2,bj2,ImageID(1)):EndIf
DisableGadget(14,1)

makeInvisible(1)
makeInvisible(2)
;StickyWindow(2,1)
Repeat:Event=WaitWindowEvent(5000)
 If Event:Select Event
   Case #PB_Event_Gadget
    If EventGadget()=80
     gx=GadgetX(12)+bj:gy=GadgetY(12)+bj
     gx0=GadgetX(13)+bj:gy0=GadgetY(13)+bj
     lineWidth=GetGadgetState(80):bj=lineWidth/2+3:bj2=bj<<1
     If  CreateImage(1,bj2,bj2,32,$ffffffff)
      If StartVectorDrawing(ImageVectorOutput(1))
       AddPathCircle(bj,bj,bj)
       VectorSourceColor(RGBA(0, 0, 0, 255))
       FillPath()
       OpenGadgetList(2)
       ImageGadget(12,gx-bj,gy-bj,bj2,bj2,ImageID(1))
       ImageGadget(13,gx0-bj,gy0-bj,bj2,bj2,ImageID(1))
       StopVectorDrawing()
     EndIf:EndIf:OpenGadgetList(1)
     lineG(0,11,gx0,gy0,gx,gy,lineWidth)
    Else:If GetAsyncKeyState_(#VK_LBUTTON):eg=EventGadget():EndIf:EndIf
   Case #WM_LBUTTONUP:jx=0:eg=-1:SetActiveWindow(2)
    ;本来不使用Win1,不需要SetActiveWindow(2),Win2就总是Active,但是图片总是方形的,所以加Win1解决
   Case #WM_MOUSEMOVE
    If eg>10:If jx=1
      x01=WindowMouseX(0):y01=WindowMouseY(0)
      If x00<>x01 Or y00<>y01
       x00=x01:y00=y01:x=x01-x0:y=y01-y0
       gx_=gx+x:gy_=gy+y:If eg>11:OpenGadgetList(1)
        lineG(0,11,gx0+bj,gy0+bj,gx_+bj,gy_+bj,lineWidth)
       Else:ResizeGadget(11,gx1+x,gy1+y,#PB_Ignore,#PB_Ignore)
       ResizeGadget(13,gx0+x,gy0+y,#PB_Ignore,#PB_Ignore):EndIf
       If eg=11:ResizeGadget(12,gx+x,gy+y,#PB_Ignore,#PB_Ignore)
        Else:ResizeGadget(eg,gx_,gy_,#PB_Ignore,#PB_Ignore):EndIf:EndIf
      Else:jx=1:Gosub cs:EndIf:EndIf
    Case #PB_Event_MoveWindow:If EventWindow()=0
     rex=WindowX(0,#PB_Window_InnerCoordinate)
     rey=WindowY(0,#PB_Window_InnerCoordinate)
     ResizeWindow(1, rex, rey,#PB_Ignore,#PB_Ignore):WaitWindowEvent();for clear a new WindowEvent
    ResizeWindow(2, rex, rey,#PB_Ignore,#PB_Ignore):WaitWindowEvent():EndIf
   Case #PB_Event_CloseWindow:appQuit = 1
  EndSelect:EndIf
Until appQuit = 1

End
cs: :x0=WindowMouseX(0):y0=WindowMouseY(0)
If eg=11:gx1=GadgetX(11):gy1=GadgetY(11)
 gx=GadgetX(12):gy=GadgetY(12)
 gx0=GadgetX(13):gy0=GadgetY(13)
Else:gx=GadgetX(eg):gy=GadgetY(eg)
gx0=GadgetX(25-eg):gy0=GadgetY(25-eg):EndIf
Return
my pb for chinese:
http://ataorj.ys168.com
Top
Post Reply

Return to “Tricks 'n' Tips”