PureBasic Forums - English

Code: Select all

;should use PathBoundsWidth(), PathBoundsHeight() ....
Procedure lineG(Image,Gadget,x1,y1,x2,y2,PlotWidth)
 xx=Abs(x1-x2):yy=Abs(y1-y2):zz=Sqr(xx*xx+yy*yy)
 z_.f=PlotWidth/zz:zy=z_*yy:zx=z_*xx:zy2=zy/2:zx2=zx/2
 Width=xx+zy:Height=yy+zx
 If CreateImage(Image,Width,Height,32,$ffffffff) And
    StartVectorDrawing(ImageVectorOutput(Image))
  x_=zy2:x1_=Width-zy2:If (x1-x2)*(y1-y2)>-1
   ;(x1-x2)*(y1-y2)>-1 == (x1<x2 And y1<y2) Or (x1>=x2 And y1>=y2)
   y_=zx2:y1_=Height-zx2:Else:y_=Height-zx2:y1_=zx2:EndIf
  MovePathCursor(x_,y_):AddPathLine(x1_,y1_,#PB_Path_Default)
  VectorSourceColor($ff0000ff):StrokePath(PlotWidth)
 StopVectorDrawing():EndIf
 If x1>x2:a=x2:Else:a=x1:EndIf:If y1>y2:b=y2:Else:b=y1:EndIf
 ImageGadget(Gadget,a-zy2,b-zx2,Width,Height,ImageID(Image))
EndProcedure
Procedure ForceGadgetZOrder(gadget)
   SetWindowLong_(GadgetID(gadget),#GWL_STYLE,GetWindowLong_(GadgetID(gadget),#GWL_STYLE)|#WS_CLIPSIBLINGS)
   SetWindowPos_(GadgetID(gadget),#HWND_TOP,0,0,0,0,#SWP_NOSIZE|#SWP_NOMOVE)
EndProcedure
If OpenWindow(0, 0, 0, 420, 440, "Image", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
 ScrollAreaGadget(0, 10, 30, 400, 400, 1400, 1200)
 If  CreateImage(0,16,16,32,$ffffffff) And StartVectorDrawing(ImageVectorOutput(0))
  AddPathCircle(8, 8,8):VectorSourceColor($ff0eff0e)
  FillPath():StopVectorDrawing()
  ImageGadget(1,  20, 20,16,16,ImageID(0))
  ImageGadget(2,120,20,16,16,ImageID(0))
  ImageGadget(3,80,20,16,16,ImageID(0))
 EndIf
 gx0=128:gy0=28:gx_=28:gy_=28:PlotWidth=10
 lineG(1,4,gx0,gy0,gx_,gy_,PlotWidth)

 ForceGadgetZOrder(4)
 ForceGadgetZOrder(1)
; ResizeGadget(4,#PB_Ignore,#PB_Ignore,#PB_Ignore,#PB_Ignore)

 Repeat
  Event = WaitWindowEvent()
 Until Event = #PB_Event_CloseWindow
EndIf
End

Code: Select all

Procedure SetGadgetStyle(Gadget,Style=#WS_CLIPSIBLINGS)
SetWindowLong_(GadgetID(Gadget), #GWL_STYLE, GetWindowLong_(GadgetID(Gadget), #GWL_STYLE) | Style)
EndProcedure
Procedure SetGadgetPos(Gadget,Pos=#HWND_TOP)
 ;first ahead SetGadgetStyle(),then:
 SetWindowPos_(GadgetID(Gadget), Pos,0,0,0,0, #SWP_NOSIZE | #SWP_NOMOVE)
; #HWND_BOTTOM
; Places the window at the bottom of the Z order. If the hWnd parameter identifies a topmost window, the window loses its topmost status And is placed at the bottom of all other windows.
; #HWND_NOTOPMOST
; Places the window above all non-topmost windows (that is, behind all topmost windows). This flag has no effect If the window is already a non-topmost window.
; #HWND_TOP
; Places the window at the top of the Z order.
; #HWND_TOPMOST
; Places the window above all non-topmost windows. The window maintains its topmost position even when it is deactivated.
EndProcedure
Procedure SetGadgetPosA(Gadget1,Gadget2)
 ;first ahead SetGadgetStyle() for Gadget1,then:
 SetWindowPos_(GadgetID(Gadget1), GadgetID(Gadget2),0,0,0,0, #SWP_NOSIZE | #SWP_NOMOVE)
; Gadget1 'on' Gadget
EndProcedure
Procedure SetGadgetPosB(Gadget,Level.a)
 ;first ahead SetGadgetStyle() for Gadget,then:
 Static Dim GadgetLevel(255,1)
;.....
EndProcedure
OpenWindow(0,120,100,640,480,"")

ButtonGadget(0,10,10,170,50,"! must ZOrder !")
ButtonGadget(1,150,20,170,50,"Botton")
StringGadget(2,40,40,240,150,"Top")
ButtonGadget(3,10,170,170,50,"Botton")
ButtonGadget(4,190,170,170,50,"Bottom")
ButtonGadget(5,190,190,170,50,"Bottom")
For a=1 To 4
 SetGadgetStyle(a)
 SetGadgetPosA(a,a+1)
Next
Repeat
Until WaitWindowEvent()=#PB_Event_CloseWindow

Code: Select all

Procedure lineG(Image,Gadget,x1,y1,x2,y2,lineWidth)
 xx=Abs(x1-x2):yy=Abs(y1-y2):zz.f=Sqr(xx*xx+yy*yy)
 z_.f=lineWidth/zz:zy.f=z_*yy:zx.f=z_*xx:zy2.f=zy/2:zx2.f=zx/2
 Width=xx+zy:Height=yy+zx
 If CreateImage(Image,Width,Height,32,$ffffffff) And
    StartVectorDrawing(ImageVectorOutput(Image))
  x_=zy2:x1_=Width-zy2:If (x1-x2)*(y1-y2)>-1
   ;[(x1-x2)*(y1-y2)>-1] == [(x1<x2 And y1<y2) Or (x1>=x2 And y1>=y2)]
   y_=zx2:y1_=Height-zx2:Else:y_=Height-zx2:y1_=zx2:EndIf
  MovePathCursor(x_,y_):AddPathLine(x1_,y1_,#PB_Path_Default)
  VectorSourceColor($ff0000ff):StrokePath(lineWidth)
 StopVectorDrawing():EndIf
 If x1>x2:a=x2:Else:a=x1:EndIf:If y1>y2:b=y2:Else:b=y1:EndIf
 ImageGadget(Gadget,a-zy2,b-zx2,Width,Height,ImageID(Image))
EndProcedure
Procedure ForceGadgetZOrder(gadget)
   SetWindowLong_(GadgetID(gadget),#GWL_STYLE,GetWindowLong_(GadgetID(gadget),#GWL_STYLE)|#WS_CLIPSIBLINGS)
   SetWindowPos_(GadgetID(gadget),#HWND_TOP,0,0,0,0,#SWP_NOSIZE|#SWP_NOMOVE)
EndProcedure
If OpenWindow(0, 0, 0, 420, 440, "Move/drag Image", #PB_Window_SystemMenu | #PB_Window_ScreenCentered) = 0
 MessageRequester("Fatal error", "Program terminated.")
 End
EndIf
;StringGadget(98,10,0,111,20,""):StringGadget(99,122,0,111,20,"")
ScrollAreaGadget(0, 10, 30, 400, 400, 1400, 1200)
 ;x1=200:y1=300:x2=20:y2=80:Gosub lin
If  CreateImage(1,16,16,32,$ffffffff)
 If StartVectorDrawing(ImageVectorOutput(1))
 AddPathCircle(8, 8,8)
 VectorSourceColor(RGBA(0, 0, 0, 255))
 FillPath()
 StopVectorDrawing()
 EndIf
 gx0=128:gy0=28:gx_=28:gy_=28:lineWidth=10
ImageGadget(2,  20, 20,16,16,ImageID(1))
ImageGadget(3,120,20,16,16,ImageID(1))
ImageGadget(4,80,20,16,16,ImageID(1)):EndIf
lineG(0,1,gx0,gy0,gx_,gy_,lineWidth)

Area.RECT:GetWindowRect_(GadgetID(0),Area)
Area\left+2:Area\top+2:Area\right-25:Area\bottom-25
hdc=GetDC_(0):InvertRect_(hdc,Area);:InvertRect_(hdc,Area)
For a=1 To 4
ForceGadgetZOrder(a)
Next
DisableGadget(4,1)
;*****************************
;DragDrop Gadget 1(line) or 2(Point) or 3(Point)
;*****************************
Repeat
 Event = WaitWindowEvent()
 Select Event;右击-放开也获取焦点
   Case #PB_Event_Gadget:If GetAsyncKeyState_(#VK_LBUTTON)
   eg=EventGadget():ClipCursor_(Area):EndIf
;     Select eg
;      Case 1
;       Case 2
;    EndSelect
 Case #WM_LBUTTONDOWN:DrawFocusRect_(HDC,Area)
  Case #WM_LBUTTONUP:jx=0:eg=-1:ClipCursor_(0)
  Case #WM_MOUSEMOVE
   ;:
   If eg>0:If jx=1
     x01=WindowMouseX(0):y01=WindowMouseY(0);:If x01>35 And y01>33
     If x00<>x01 Or y00<>y01
     x00=x01:y00=y01:x=x01-x0:y=y01-y0;:sr=(sr+1)%1000:SetGadgetText(98,Str(sr))
     gx_=gx+x:gy_=gy+y:If eg>1:lineG(0,1,gx0+8,gy0+8,gx_+8,gy_+8,lineWidth);Gosub lin
     Else:ResizeGadget(1,gx1+x,gy1+y,#PB_Ignore,#PB_Ignore)
      ResizeGadget(3,gx0+x,gy0+y,#PB_Ignore,#PB_Ignore):EndIf
      If eg=1:ResizeGadget(2,gx+x,gy+y,#PB_Ignore,#PB_Ignore)
    Else:ResizeGadget(eg,gx_,gy_,#PB_Ignore,#PB_Ignore):EndIf:EndIf;:EndIf;:If x<>0 Or y<>0:EndIf
  For a=1 To 4
ForceGadgetZOrder(a)
Next
     Else:jx=1:Gosub cs:EndIf:EndIf;;
  EndSelect
Until Event = #PB_Event_CloseWindow
End
cs: :x0=WindowMouseX(0):y0=WindowMouseY(0)
If eg=1:gx1=GadgetX(1):gy1=GadgetY(1)
 gx=GadgetX(2):gy=GadgetY(2)
gx0=GadgetX(3):gy0=GadgetY(3)
Else:gx=GadgetX(eg):gy=GadgetY(eg)
gx0=GadgetX(5-eg):gy0=GadgetY(5-eg):EndIf
Return