PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Linie verschieben auf Canvas Gadget

https://www.purebasic.fr/german/viewtopic.php?t=25112

Seite 1 von 1

Linie verschieben auf Canvas Gadget

Verfasst: 09.01.2012 12:24
von Hugo
Hallo,
ich versuche gerade ein kleines Malprogramm mit dem Canvas Gadget zu schreiben. Das Meiste funktioniert auch schon ganz gut. Womit ich gerade Probleme habe ist, eine Linie (oder ein anderes 2D Objekt) zu verschieben. Ich hoffe ihr könnt mir da weiterhelfen.
Hier der entsprechende Codeteil dazu.

Code: Alles auswählen

#MainWindow   = 0
#ScrollGadget = 0
#CanvasGadget = 1

MainWindow = OpenWindow( #MainWindow, 0, 0, 800, 600, "Test mit CanvasGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered )
If MainWindow

  If ScrollAreaGadget( #ScrollGadget, 0, 0, WindowWidth( 0 ), WindowHeight( 0 ), 2000, 1000, 10, 0 )
    If CanvasGadget( #CanvasGadget, 0, 0, 2000, 1000, #PB_Canvas_Border )
      SetGadgetAttribute( #CanvasGadget, #PB_Canvas_Cursor, #PB_Cursor_Cross )
      
      StartDrawing( CanvasOutput( #CanvasGadget ) )
        Box( 0, 0, 2000, 1000, $E0E0E0 )
        For x = 10 To 1990 Step 10
          For y = 10 To 990 Step 10
            Plot( x, y, 0 )
          Next
        Next
      StopDrawing()
       
      Repeat
        Select WaitWindowEvent() 
          Case #PB_Event_CloseWindow : ende = #True
          Case #PB_Event_Gadget
            Select EventType() 
              Case #PB_EventType_LeftClick 
                x = GetGadgetAttribute( #CanvasGadget, #PB_Canvas_MouseX ) : y = GetGadgetAttribute( #CanvasGadget, #PB_Canvas_MouseY )
                Debug "Click..     X: " + Str( x ) + ", Y: " + Str( y )
              Case #PB_EventType_MouseMove
                x = GetGadgetAttribute( #CanvasGadget, #PB_Canvas_MouseX ) : y = GetGadgetAttribute( #CanvasGadget, #PB_Canvas_MouseY )
                Debug "Move...     X: " + Str( x ) + ", Y: " + Str( y )
                
                StartDrawing( CanvasOutput( #CanvasGadget ) )
                  DrawingMode( #PB_2DDrawing_Transparent | #PB_2DDrawing_XOr  )
                  LineXY( x, y, x + 500, y, $0000FF )
                StopDrawing()
                
            EndSelect
          
        EndSelect
      Until ende
      
    EndIf  
  EndIf
EndIf
Danke und Gruß,
Hugo

Re: Linie verschieben auf Canvas Gadget

Verfasst: 09.01.2012 13:39
von STARGÅTE
Wenn du Linien oder Objekte verschieben möchtest, musst du diese auch selbst in einer Liste verwalten, damit du sie auch abrufen kannst.

Hier mal ein Beispiel für das zeichnen von Rechtecken, welche ich in einer Objektliste speicher.
(Mit linker Maus zeichnen, mit rechter Maus verschieben.)

Code: Alles auswählen

Enumeration
	#Window
	#Gadget
EndEnumeration

Structure Object
	X.i
	Y.i
	Width.i
	Hight.i
EndStructure

Global NewList Object.Object()
Global *DrawingObject.Object, *MovingObject.Object

Procedure UpdateCanvasGadget(Gadget.i)
	StartDrawing(CanvasOutput(Gadget))
		DrawingMode(#PB_2DDrawing_AlphaBlend)
		Box(0, 0, OutputWidth(), OutputHeight(), $FFFFFFFF)
		ForEach Object()
			If *DrawingObject = @Object()
				Box(*DrawingObject\X, *DrawingObject\Y, *DrawingObject\Width, *DrawingObject\Hight, $80FF8000)
			ElseIf *MovingObject = @Object()
				Box(*MovingObject\X, *MovingObject\Y, *MovingObject\Width, *MovingObject\Hight, $800080FF)
			Else
				Box(Object()\X, Object()\Y, Object()\Width, Object()\Hight, $FF000000)
			EndIf
		Next
	StopDrawing()
EndProcedure


OpenWindow(#Window, 0, 0, 800, 600, "WindowTitle", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)
CanvasGadget(#Gadget, 0, 0, WindowWidth(#Window), WindowHeight(#Window), #PB_Canvas_Border)
SetGadgetAttribute(#Gadget, #PB_Canvas_Cursor, #PB_Cursor_Cross)
UpdateCanvasGadget(#Gadget)

Define PositionX.i, PositionY.i

Repeat
	
	Select WaitWindowEvent()
			
		Case #PB_Event_CloseWindow
			End
			
		Case #PB_Event_Gadget
			Select EventGadget()
				Case #Gadget
					Select EventType()
						Case #PB_EventType_LeftButtonDown
							*DrawingObject = AddElement(Object())
							*DrawingObject\X = GetGadgetAttribute(#Gadget, #PB_Canvas_MouseX)
							*DrawingObject\Y = GetGadgetAttribute(#Gadget, #PB_Canvas_MouseY)
						Case #PB_EventType_RightButtonDown
							PositionX = GetGadgetAttribute(#Gadget, #PB_Canvas_MouseX)
							PositionY = GetGadgetAttribute(#Gadget, #PB_Canvas_MouseY)
							ForEach Object()
								If PositionX >= Object()\X And PositionY >= Object()\Y And PositionX < Object()\X+Object()\Width And PositionY < Object()\Y+Object()\Hight
									*MovingObject = @Object()
									PositionX - *MovingObject\X
									PositionY - *MovingObject\Y
									SetGadgetAttribute(#Gadget, #PB_Canvas_Cursor, #PB_Cursor_Arrows)
								EndIf
							Next
						Case #PB_EventType_MouseMove
							If *DrawingObject
								*DrawingObject\Width = GetGadgetAttribute(#Gadget, #PB_Canvas_MouseX)-*DrawingObject\X
								*DrawingObject\Hight = GetGadgetAttribute(#Gadget, #PB_Canvas_MouseY)-*DrawingObject\Y
							ElseIf *MovingObject
								*MovingObject\X = GetGadgetAttribute(#Gadget, #PB_Canvas_MouseX) - PositionX
								*MovingObject\Y = GetGadgetAttribute(#Gadget, #PB_Canvas_MouseY) - PositionY
							EndIf
						Case #PB_EventType_LeftButtonUp
							If *DrawingObject
								*DrawingObject\Width = GetGadgetAttribute(#Gadget, #PB_Canvas_MouseX)-*DrawingObject\X
								*DrawingObject\Hight = GetGadgetAttribute(#Gadget, #PB_Canvas_MouseY)-*DrawingObject\Y
								If *DrawingObject\Width < 0
									*DrawingObject\X + *DrawingObject\Width : *DrawingObject\Width * -1
								EndIf
								If *DrawingObject\Hight < 0
									*DrawingObject\Y + *DrawingObject\Hight : *DrawingObject\Hight * -1
								EndIf
							EndIf
							*DrawingObject = #Null
						Case #PB_EventType_RightButtonUp
							*MovingObject = #Null
							SetGadgetAttribute(#Gadget, #PB_Canvas_Cursor, #PB_Cursor_Cross)
					EndSelect
					UpdateCanvasGadget(#Gadget)
			EndSelect
			
	EndSelect
	
ForEver

Re: Linie verschieben auf Canvas Gadget

Verfasst: 09.01.2012 13:52
von Hugo
@stargate - Super, danke für die schnelle Antwort! 8)

Re: Linie verschieben auf Canvas Gadget

Verfasst: 11.01.2012 10:21
von kernadec
Stargate, Dank
Sehr gutes Beispiel, wir danken Ihnen für den Austausch von
guten Tag

Code: Alles auswählen

Enumeration
  #Window
  #Gadget
EndEnumeration

Structure Object
  X.i
  Y.i
  Width.i
  Hight.i
  color.l
EndStructure

Global NewList Object.Object()
Global *DrawingObject.Object, *MovingObject.Object

Procedure UpdateCanvasGadget(Gadget.i)
  StartDrawing(CanvasOutput(Gadget))
  DrawingMode(#PB_2DDrawing_AlphaBlend)
  Box(0, 0, OutputWidth(), OutputHeight(), $FFFFFFFF)
  ForEach Object()
    If *DrawingObject = @Object()
      Object()\color=RGBA(Random(255),Random(255),Random(255),128)
      Box(*DrawingObject\X, *DrawingObject\Y, *DrawingObject\Width, *DrawingObject\Hight, $80FF8000)
    ElseIf *MovingObject = @Object()
      Box(*MovingObject\X, *MovingObject\Y, *MovingObject\Width, *MovingObject\Hight, Object()\color)
    Else
      Box(Object()\X, Object()\Y, Object()\Width, Object()\Hight, Object()\color)
    EndIf
  Next
  StopDrawing()
EndProcedure


OpenWindow(#Window, 0, 0, 800, 600, "WindowTitle", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)
CanvasGadget(#Gadget, 0, 0, WindowWidth(#Window), WindowHeight(#Window), #PB_Canvas_Border)
SetGadgetAttribute(#Gadget, #PB_Canvas_Cursor, #PB_Cursor_Cross)
UpdateCanvasGadget(#Gadget)

Define PositionX.i, PositionY.i

Repeat
  
  Select WaitWindowEvent()
      
    Case #PB_Event_CloseWindow
      End
      
    Case #PB_Event_Gadget
      Select EventGadget()
        Case #Gadget
          Select EventType()
            Case #PB_EventType_LeftButtonDown
              *DrawingObject = AddElement(Object())
              *DrawingObject\X = GetGadgetAttribute(#Gadget, #PB_Canvas_MouseX)
              *DrawingObject\Y = GetGadgetAttribute(#Gadget, #PB_Canvas_MouseY)
            Case #PB_EventType_RightButtonDown
              PositionX = GetGadgetAttribute(#Gadget, #PB_Canvas_MouseX)
              PositionY = GetGadgetAttribute(#Gadget, #PB_Canvas_MouseY)
              ForEach Object()
                If PositionX >= Object()\X And PositionY >= Object()\Y And PositionX < Object()\X+Object()\Width And PositionY < Object()\Y+Object()\Hight
                  *MovingObject = @Object()
                  PositionX - *MovingObject\X
                  PositionY - *MovingObject\Y
                  SetGadgetAttribute(#Gadget, #PB_Canvas_Cursor, #PB_Cursor_Arrows)
                EndIf
              Next
            Case #PB_EventType_MouseMove
              If *DrawingObject
                *DrawingObject\Width = GetGadgetAttribute(#Gadget, #PB_Canvas_MouseX)-*DrawingObject\X
                *DrawingObject\Hight = GetGadgetAttribute(#Gadget, #PB_Canvas_MouseY)-*DrawingObject\Y
              ElseIf *MovingObject
                *MovingObject\X = GetGadgetAttribute(#Gadget, #PB_Canvas_MouseX) - PositionX
                *MovingObject\Y = GetGadgetAttribute(#Gadget, #PB_Canvas_MouseY) - PositionY
              EndIf
            Case #PB_EventType_LeftButtonUp
              If *DrawingObject
                *DrawingObject\Width = GetGadgetAttribute(#Gadget, #PB_Canvas_MouseX)-*DrawingObject\X
                *DrawingObject\Hight = GetGadgetAttribute(#Gadget, #PB_Canvas_MouseY)-*DrawingObject\Y
                If *DrawingObject\Width < 0
                  *DrawingObject\X + *DrawingObject\Width : *DrawingObject\Width * -1
                EndIf
                If *DrawingObject\Hight < 0
                  *DrawingObject\Y + *DrawingObject\Hight : *DrawingObject\Hight * -1
                EndIf
              EndIf
              *DrawingObject = #Null
            Case #PB_EventType_RightButtonUp
              *MovingObject = #Null
              SetGadgetAttribute(#Gadget, #PB_Canvas_Cursor, #PB_Cursor_Cross)
          EndSelect
          UpdateCanvasGadget(#Gadget)
      EndSelect
      
  EndSelect
  
ForEver
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de