interessanter weise funzt es bei mir unter 3.94 sogar... o_O
aber du hast ja überhaupt keinen gummiband-effekt drin...
Abfrage des Mausklicks
-
Kaeru Gaman
- Beiträge: 17389
- Registriert: 10.11.2004 03:22
so...
sonst noch wünsche ??
MFG!
sonst noch wünsche ??
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!
-
Kaeru Gaman
- Beiträge: 17389
- Registriert: 10.11.2004 03:22
> 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...
- 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...
Der Narr denkt er sei ein weiser Mann.
Der Weise weiß, dass er ein Narr ist.
Der Weise weiß, dass er ein Narr ist.
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 = 1ok sonst noch was??
-
Falko
- Admin
- Beiträge: 3535
- Registriert: 29.08.2004 11:27
- Computerausstattung: PC: MSI-Z590-GC; 32GB-DDR4, ICore9; 2TB M2 + 2x3TB-SATA2 HDD; Intel ICore9 @ 3600MHZ (Win11 Pro. 64-Bit),
Acer Aspire E15 (Win11 Home X64). Purebasic LTS 6.11b1
HP255G8 Notebook @AMD Ryzen 5 5500U with Radeon Graphics 2.10 GHz 3.4GHz, 32GB_RAM, 3TB_SSD (Win11 Pro 64-Bit) - Kontaktdaten:
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
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
@Dieter Platzke, ich hoffe Du kannst damit schon etwas mehr anfangen.
[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
Mit Menü, Linienstärke und Color
[/Edit]
Grüße Falko
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
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
@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)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
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_CloseWindowGrüße Falko
Zuletzt geändert von Falko am 22.07.2006 22:49, insgesamt 1-mal geändert.
Win11 Pro 64-Bit, PB_6.11b1
Hallo Falko
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
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
-
Kaeru Gaman
- Beiträge: 17389
- Registriert: 10.11.2004 03:22
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.
ich hab 3.30, 3.94 und 4.0. läuft problemlos.
Der Narr denkt er sei ein weiser Mann.
Der Weise weiß, dass er ein Narr ist.
Der Weise weiß, dass er ein Narr ist.
-
Falko
- Admin
- Beiträge: 3535
- Registriert: 29.08.2004 11:27
- Computerausstattung: PC: MSI-Z590-GC; 32GB-DDR4, ICore9; 2TB M2 + 2x3TB-SATA2 HDD; Intel ICore9 @ 3600MHZ (Win11 Pro. 64-Bit),
Acer Aspire E15 (Win11 Home X64). Purebasic LTS 6.11b1
HP255G8 Notebook @AMD Ryzen 5 5500U with Radeon Graphics 2.10 GHz 3.4GHz, 32GB_RAM, 3TB_SSD (Win11 Pro 64-Bit) - Kontaktdaten:
Hallo Dieter,
das Redraw wird hier bei der Case-abfrage ausgeführt:
Zuvor muss aber ein Imageobjekt angelegt werden was nach dem Windows schon den das aktuelle leere Fenster aufnehmen kann:
Jedes Mal, wenn dann eine Linie fertig gezeichnet ist, wird wie hier dann
das aktuelle Bild ins Image 0 kopiert.
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
das Redraw wird hier bei der Case-abfrage ausgeführt:
Man hätte es z.B. in eine Procedure schreiben können.Case #PB_Event_MoveWindow
StartDrawing (WindowOutput ())
DrawImage (ImageID (), 0, 0)
StopDrawing ()
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.
Ich hoffe es ist einigermaßen verständlich.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
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
Win11 Pro 64-Bit, PB_6.11b1
Was programmiert Ihr so?
Was schreibt Ihr denn so an Code?
Würde ich mir gerne mal anschauen.
Dieter
Würde ich mir gerne mal anschauen.
Dieter