PureBoard

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

Abfrage des Mausklicks

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

Seite 6 von 7

Verfasst: 21.07.2006 17:00
von Kaeru Gaman
interessanter weise funzt es bei mir unter 3.94 sogar... o_O

aber du hast ja überhaupt keinen gummiband-effekt drin...

Verfasst: 21.07.2006 17:02
von Brügge
1mom wird gemacht ^^

Verfasst: 21.07.2006 17:05
von Brügge
so...

sonst noch wünsche ?? :wink:

Code: Alles auswählen

InitSprite()
InitKeyboard()
InitMouse()
InitSound()

OpenScreen(1280,1024,32, "CAD")
StartSpecialFX() 


Dim Linie(1000,5)

;line(x,1) = xachse1
;line(x,2) = yachse1
;line(x,3) = xachse2
;line(x,4) = yachse2
;line(x,5) = art (ob ein kreis gezeichnet werden soll oder eine linie)

Global art.w
Global x.f
Global y.f
Global radius.f
Global bogen.f


bogen = 3.1415926 / 180
art = 1

;wenn art = 1 ist dann wird eine linie gezeichnet bei 2 ein kreis 
;bogen ist die konstance, womit wir uns den obtimalen bogenmaß ausrechnen kannst

Repeat
ExamineKeyboard() 
ExamineMouse() 
  

If art > 2 
  art = 1
EndIf 
 
  
If KeyboardPushed(#PB_Key_Escape)
  esc = 1
EndIf
  

If MouseButton(1)
  If druck2 = 0
    If MouseX() > 1000
      If MouseY() < 20
        esc = 1
      EndIf
      If MouseY() < 40
        If MouseY() > 20 
          art = art +1
        EndIf
      EndIf
      If MouseY() > 40
        If MouseY() < 60 
          anzahl = anzahl -1
          If anzahl <0 
            anzahl = 0
          EndIf
          linie(anzahl,1) = 0
          linie(anzahl,2) = 0
          linie(anzahl,3) = 0
          linie(anzahl,4) = 0
          linie(anzahl,5) = 0        
        EndIf
      EndIf
    EndIf
  EndIf
  druck2 = 1
Else
  druck2 = 0
EndIf


If MouseButton(1)
  If druck1 = 0
    x1 = MouseX()
    y1 = MouseY()
  EndIf
  druck1 = 1
Else
  If druck1 = 1
    x2 = MouseX()
    y2 = MouseY()
    
    If x1 < 1000
      If x2 < 1000
        linie(anzahl,1) = x1
        linie(anzahl,2) = y1
        linie(anzahl,3) = x2
        linie(anzahl,4) = y2
        linie(anzahl,5) = art
        anzahl = anzahl +1
        x1 = 0
        x2 = 0
        y1 = 0
        y2 = 0
      EndIf
    EndIf
    
  EndIf
  druck1 = 0
EndIf

ClearScreen(0,0,0)

StartDrawing(ScreenOutput())
FrontColor (150,150,150)

LineXY(1000,0,1000,1024)
LineXY(0,0,0,1024)
LineXY(0,0,1000,0)
LineXY(0,1024,1000,1024)

Locate(1010,0)
DrawText("Programm Beenden") 
Locate(1010,20)
If art = 1
  DrawText("Zu Kreis Wechseln") 
EndIf
If art = 2
  DrawText("Zu Linie Wechseln") 
EndIf
Locate(1010,40)
DrawText("Letzten Teil Löschen") 

FrontColor (255,0,0)
For i = 0 To 1000
  If linie(i,5) > 0
    If linie(i,5) = 1
      LineXY(linie(i,1),linie(i,2),linie(i,3),linie(i,4))
    EndIf
    If linie(i,5) = 2
      x = (linie(i,1) - linie(i,3))*(linie(i,1) - linie(i,3)) 
      y = (linie(i,2) - linie(i,4))*(linie(i,2) - linie(i,4))
      radius = Sqr(x+y)
      
      For j = 1 To 361
        sinx = Sin(j*bogen)*radius+linie(i,1)
        cosy = Cos(j*bogen)*radius+linie(i,2)
        If j > 1
          LineXY(sinx,cosy,sinxalt,cosyalt)
        EndIf
        sinxalt = sinx
        cosyalt = cosy
        
      Next j
      
    EndIf
  EndIf
Next i



Box(MouseX(),MouseY(),10,10)


If x1 > 0 
  FrontColor(0,255,0)
  LineXY(x1,y1,MouseX(),MouseY())
EndIf

StopDrawing()

FlipBuffers()

Until esc = 1

MFG!

Verfasst: 21.07.2006 17:11
von Kaeru Gaman
> sonst noch wünsche ??

- das gummiband sollte ein gummiring werden, wenn man auf kreis schaltet
- wenn ich auf einen der "buttons" klicke, fängt er auch ein gummiband an...
- kann man irgendwie farben einstellen?
- mach doch mal Buttons draus, nicht einfach text und auch noch mit festem hintergrund... ;)
- das ganze bringt auch noch nix, weil man die linien- und kreis-objekte nicht anwählen und bearbeitet kann...
- und ihre zeichenreihenfolge ändern kann
- und dann sollte man das ganze ja auch noch speichern und laden und woanders benutzen können...

......und trotz allem wird es immer ein fullscreen bleiben... ;)

Verfasst: 21.07.2006 17:18
von Brügge

Code: Alles auswählen

InitSprite()
InitKeyboard()
InitMouse()
InitSound()

OpenScreen(1280,1024,32, "CAD")
StartSpecialFX() 


Dim Linie(1000,5)

;line(x,1) = xachse1
;line(x,2) = yachse1
;line(x,3) = xachse2
;line(x,4) = yachse2
;line(x,5) = art (ob ein kreis gezeichnet werden soll oder eine linie)

Global art.w
Global x.f
Global y.f
Global radius.f
Global bogen.f


bogen = 3.1415926 / 180
art = 1

;wenn art = 1 ist dann wird eine linie gezeichnet bei 2 ein kreis 
;bogen ist die konstance, womit wir uns den obtimalen bogenmaß ausrechnen kannst

Repeat
ExamineKeyboard() 
ExamineMouse() 
  

If art > 2 
  art = 1
EndIf 
 
  
If KeyboardPushed(#PB_Key_Escape)
  esc = 1
EndIf
  

If MouseButton(1)
  If druck2 = 0
    If MouseX() > 1000
      If MouseY() < 20
        esc = 1
      EndIf
      If MouseY() < 40
        If MouseY() > 20 
          art = art +1
        EndIf
      EndIf
      If MouseY() > 40
        If MouseY() < 60 
          anzahl = anzahl -1
          If anzahl <0 
            anzahl = 0
          EndIf
          linie(anzahl,1) = 0
          linie(anzahl,2) = 0
          linie(anzahl,3) = 0
          linie(anzahl,4) = 0
          linie(anzahl,5) = 0        
        EndIf
      EndIf
    EndIf
  EndIf
  druck2 = 1
Else
  druck2 = 0
EndIf


If MouseButton(1)
  If druck1 = 0
    x1 = MouseX()
    y1 = MouseY()
  EndIf
  druck1 = 1
Else
  If druck1 = 1
    x2 = MouseX()
    y2 = MouseY()
    
    If x1 < 1000
      If x2 < 1000
        linie(anzahl,1) = x1
        linie(anzahl,2) = y1
        linie(anzahl,3) = x2
        linie(anzahl,4) = y2
        linie(anzahl,5) = art
        anzahl = anzahl +1
        x1 = 0
        x2 = 0
        y1 = 0
        y2 = 0
      EndIf
    EndIf
    
  EndIf
  druck1 = 0
EndIf

ClearScreen(0,0,0)

StartDrawing(ScreenOutput())
FrontColor (150,150,150)

LineXY(1000,0,1000,1024)
LineXY(0,0,0,1024)
LineXY(0,0,1000,0)
LineXY(0,1024,1000,1024)

Locate(1010,0)
DrawText("Programm Beenden") 
Locate(1010,20)
If art = 1
  DrawText("Zu Kreis Wechseln") 
EndIf
If art = 2
  DrawText("Zu Linie Wechseln") 
EndIf
Locate(1010,40)
DrawText("Letzten Teil Löschen") 

FrontColor (255,0,0)
For i = 0 To 1000
  If linie(i,5) > 0
    If linie(i,5) = 1
      LineXY(linie(i,1),linie(i,2),linie(i,3),linie(i,4))
    EndIf
    If linie(i,5) = 2
      x = (linie(i,1) - linie(i,3))*(linie(i,1) - linie(i,3)) 
      y = (linie(i,2) - linie(i,4))*(linie(i,2) - linie(i,4))
      radius = Sqr(x+y)
      
      For j = 1 To 361
        sinx = Sin(j*bogen)*radius+linie(i,1)
        cosy = Cos(j*bogen)*radius+linie(i,2)
        If j > 1
          LineXY(sinx,cosy,sinxalt,cosyalt)
        EndIf
        sinxalt = sinx
        cosyalt = cosy
        
      Next j
      
    EndIf
  EndIf
Next i


If x1 > 1000
  x1 = 0
EndIf

Box(MouseX(),MouseY(),10,10)


If x1 > 0 
  If art = 1
    FrontColor(0,255,0)
    LineXY(x1,y1,MouseX(),MouseY())
  EndIf
  If art = 2
    FrontColor(0,255,0)
    radius = Sqr((x1-MouseX())*(x1-MouseX())+(y1-MouseY())*(y1-MouseY()))
    For j = 0 To 361
      sinx = Sin(j * bogen) * radius + x1
      cosy = Cos(j * bogen) * radius + y1
      If j > 0
        LineXY(sinx,cosy,sinxalt,cosyalt)
      EndIf
      sinxalt = sinx
      cosyalt = cosy
    Next j
    
  EndIf
EndIf

StopDrawing()

FlipBuffers()

Until esc = 1


ok sonst noch was??

Verfasst: 22.07.2006 18:13
von Falko
Von mir aus kann Brügge mit dem DOS-Screen gerne weitermachen.
Deshalb brauche ich dann wohl die weiteren API's nicht mehr für die Demo anpassen.
Da beim Fullscreen kein Fenster bewegt wird, können die Linien auch nicht
verschwinden :lol:

Darum habe ich mir erstmal Gedanken gemacht, wie man in Windows
das zuletzt gezeichnete Bild beibehalten kann ( Eine Art AutoRedraw)

Bitte nicht meckern, es ist nur ein Anfangsbeispiel für Windowsmalereien 8)

@Dieter Platzke, ich hoffe Du kannst damit schon etwas mehr anfangen.

Code: Alles auswählen

;PB3.94 DEMO-TESTVERSION , aber weitere API's sind nicht mehr weiter angepasst worden:D

OpenLibrary(0,"user32.dll")
OpenLibrary(1,"gdi32.dll")
InitSprite()
Structure POINTAPI
	x.l
	y.l
EndStructure

#PS_SOLID = $0
#SM_CXSCREEN = $0
#SM_CYSCREEN = $1

WS_OVERLAPPED = $0
WS_CAPTION = $C00000
WS_SYSMENU = $80000
WS_THICKFRAME = $40000
WS_MINIMIZEBOX = $20000
WS_MAXIMIZEBOX = $10000

WS_OVERLAPPEDWINDOW = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)

#WM_LBUTTONDOWN = $201
#WM_LBUTTONUP = $202

Procedure.l GetDC(hwnd.l)
   ProcedureReturn CallFunction(0,"GetDC",hwnd)
EndProcedure
;
Procedure.l CreatePen(nPenStyle.l, nWidth.l, crColor.l)
   ProcedureReturn CallFunction(1,"CreatePen",nPenStyle, nWidth, crColor)
EndProcedure
;
Procedure.l SelectObject(hdc.l, hObject.l)
   ProcedureReturn CallFunction(1,"SelectObject",hdc, hObject)
EndProcedure
;
Procedure.l MoveToEx(hdc.l, x.l, y.l,Point)
   ProcedureReturn CallFunction(1,"MoveToEx",hdc, x, y, lpPoint.POINTAPI)
EndProcedure
;
Procedure.l LineTo(hdc.l, x.l, y.l,Point)
   ProcedureReturn CallFunction(1,"LineTo",hdc, x, y)
EndProcedure
;
Procedure.l DeleteObject(hObject.l)
   ProcedureReturn CallFunction(1,"DeleteObject",hObject)
EndProcedure
;
Procedure.l GetSystemMetrics(nIndex.l)
   ProcedureReturn CallFunction(0,"GetSystemMetrics",nIndex)
EndProcedure
;
Procedure.w ScreenWidth ()
  ProcedureReturn GetSystemMetrics_ (#SM_CXSCREEN)
EndProcedure
;
Procedure.w ScreenHeight ()
  ProcedureReturn GetSystemMetrics_ (#SM_CYSCREEN)
EndProcedure



;
Procedure CopyWindow (fromWindow, x, y)

  width = ScreenWidth ()
  height = ScreenHeight ()
  
  fromDC = GetWindowDC_ (fromWindow)
      toDC = StartDrawing (ImageOutput ())
          BitBlt_ (toDC, 0,-29, WindowWidth(), WindowHeight()+29, fromDC, x, y, #SRCCOPY)
      StopDrawing ()
  ReleaseDC_ (fromWindow, fromDC)

EndProcedure
;
Procedure Lin(x,y,x1,y1,Width,Color) 
   hDC=GetDC(WindowID(0)) 
   pen=CreatePen(#PS_SOLID,Width,color)  
   hPenOld=SelectObject(hDC,pen) 
   MoveToEx(hDC,x,y,0):LineTo(hDC,x1,y1,0) 
   DeleteObject(pen) 
   DeleteObject(hPenOld) 
EndProcedure 
  
_X=GetSystemMetrics(#SM_CXSCREEN)-8 : _Y=GetSystemMetrics(#SM_CYSCREEN)-68 


OpenWindow(0,0,0,_X,_Y,#PB_Window_SystemMenu,"") 
Set=0
CreateImage (0, WindowWidth() ,WindowHeight() )
Repeat 
event = WaitWindowEvent()

Select event
   Case #PB_Event_MoveWindow
          
          StartDrawing (WindowOutput ())
          DrawImage (ImageID (), 0, 0)
         StopDrawing ()
   Case  #WM_LBUTTONDOWN 
   
               x1 = WindowMouseX() 
               y1 = WindowMouseY()
               Set=1
   Case #WM_LBUTTONUP
              If Set=1
              x2 = WindowMouseX() 
              y2 = WindowMouseY()
              lin(x1,y1,x2,y2,2,RGB(255,0,0))
              CopyWindow (WindowID(0),0,0)
              Set=0
              EndIf
EndSelect 
Until event = #PB_Event_CloseWindow 
CloseLibrary(0): CloseLibrary(1)
[Edit]
Und da sich bei der DEMO-Version die Zeilenbegrenzung durch
den Rattenschwanz von Deklarationen den Source unnötig auffüllen würde, habe ich das für die Vollversion wieder etwas abgekürzt :lol:
Mit Menü, Linienstärke und Color

Code: Alles auswählen

;Hier  der Source ohne Rattenschwanz für PB-Vollversion 3.94
;


Procedure.w ScreenWidth ()
  ProcedureReturn GetSystemMetrics_ (#SM_CXSCREEN)
EndProcedure
;
Procedure.w ScreenHeight ()
  ProcedureReturn GetSystemMetrics_ (#SM_CYSCREEN)
EndProcedure
;
Procedure CopyWindow (fromWindow, x, y)

  width = ScreenWidth ()
  height = ScreenHeight ()
  
  fromDC = GetWindowDC_ (fromWindow)
      toDC = StartDrawing (ImageOutput ())
          BitBlt_ (toDC, 0,-49, WindowWidth(), WindowHeight()+49, fromDC, x, y, #SRCCOPY)
      StopDrawing ()
  ReleaseDC_ (fromWindow, fromDC)

EndProcedure
;
Procedure Lin(x,y,x1,y1,Width,Color) 
   hDC=GetDC_(WindowID(0)) 
   pen=CreatePen_(#PS_SOLID,Width,color)  
   hPenOld=SelectObject_(hDC,pen) 
   MoveToEx_(hDC,x,y,0):LineTo_(hDC,x1,y1) 
   DeleteObject_(pen) 
   DeleteObject_(hPenOld) 
EndProcedure 
  
_X=GetSystemMetrics_(#SM_CXSCREEN)-8 : _Y=GetSystemMetrics_(#SM_CYSCREEN)-68 


OpenWindow(0,0,0,_X,_Y,#PB_Window_SystemMenu,"")
If CreateMenu(0, WindowID())
    MenuTitle("Einstellungen")
        MenuItem( 1, "Linienstärke")
         MenuItem( 2, "Linienfarbe")
     CloseSubMenu()
      MenuBar()
      MenuItem( 3, "&Quit")
EndIf
CreateImage (0, WindowWidth() ,WindowHeight() )
CopyWindow (WindowID(0),0,0)
; 
Set=0

Repeat 
event = WaitWindowEvent()

Select event
   Case #PB_Event_Menu
             Select EventMenuID()  
              Case 1
                Ld=Val(InputRequester("Strichstärke eingeben", "Bitte geben sie die Lininendicke ein","5"))
              Case 2
                Lf=Farbe = ColorRequester()
              Case 3
                End
             EndSelect
   Case #PB_Event_MoveWindow 
            StartDrawing (WindowOutput ())
            DrawImage (ImageID (), -4, 0)
            StopDrawing ()
  Case  #WM_LBUTTONDOWN 
            x1 = WindowMouseX() 
            y1 = WindowMouseY()
            Set=1
   Case #WM_LBUTTONUP
            If Set=1
              x2 = WindowMouseX() 
              y2 = WindowMouseY()
              lin(x1,y1,x2,y2,Ld,Lf)
              CopyWindow (WindowID(0),0,0)
              Set=0
            EndIf
EndSelect 
Until event = #PB_Event_CloseWindow
[/Edit]

Grüße Falko

Hallo Falko

Verfasst: 22.07.2006 22:29
von GreyEnt
Hab dein Code ausprobiert.
Wie kann ich nun einen redraw "neuzeichnen" ausführen?

Kann ich PB 4 und 3.92 gleichzeitig auf einen Rechner installiert haben?
Würde gerne die 4er installieren. Möchte aber auch die älteren sachen mir angucken wollen.

Danke für eure vielen vielen Beiträge.

Dieter

Verfasst: 22.07.2006 22:43
von Kaeru Gaman
installiere in unterschiedliche programmverzeichnisse, und mach dir für bei "purebasic.exe" ne verknüpfung, die du auch optisch unterscheiden solltest. in den optionen der IDE (editor) musst du noch "single instance" deaktivieren.
ich hab 3.30, 3.94 und 4.0. läuft problemlos.

Verfasst: 22.07.2006 22:46
von Falko
Hallo Dieter,
das Redraw wird hier bei der Case-abfrage ausgeführt:
Case #PB_Event_MoveWindow

StartDrawing (WindowOutput ())
DrawImage (ImageID (), 0, 0)
StopDrawing ()
Man hätte es z.B. in eine Procedure schreiben können.


Zuvor muss aber ein Imageobjekt angelegt werden was nach dem Windows schon den das aktuelle leere Fenster aufnehmen kann:
CreateImage (0, WindowWidth() ,WindowHeight() ) ; Erzeutg ein leeres Image mit der Imageid 0
CopyWindow (WindowID(0),0,0) ; kopiert das aktuelle Windows (leer) in das Image, was nachher zum redraw gebraucht wird.

Jedes Mal, wenn dann eine Linie fertig gezeichnet ist, wird wie hier dann
das aktuelle Bild ins Image 0 kopiert.
Case #WM_LBUTTONUP
If Set=1
x2 = WindowMouseX()
y2 = WindowMouseY()
lin(x1,y1,x2,y2,2,RGB(255,0,0))
CopyWindow (WindowID(0),0,0)
Set=0
EndIf
Ich hoffe es ist einigermaßen verständlich.

Also, wenn du kreise usw. Zeichnest, muss es ähnlich wie bei Lines in der Caseanweisung überprüft werden. Vielleicht kann man es noch besser anders regeln. Ist ja auch nur ein Beispiel, wie es gehen könnte . ;)


Gruß Falko

Was programmiert Ihr so?

Verfasst: 22.07.2006 23:17
von GreyEnt
Was schreibt Ihr denn so an Code?
Würde ich mir gerne mal anschauen.

Dieter
Alle Zeiten sind UTC+02:00
Seite 6 von 7

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de