Mauszeiger hinterherzeichnen incl. speicherung in Array

Übersicht

BlitzBasic

Allgemein

	alliswrong Betreff: Mauszeiger hinterherzeichnen incl. speicherung in Array	Mo, Mai 12, 2008 12:16 Antworten mit Zitat
Hallo Leute, ich habe folgendes vor: Der User soll anhand der Maus etwas zeichnen können. Das ganze soll mit linien gemacht werden, da die einzelnen Punkte verbunden werden sollen. Zudem muss die letzte mausstrecke in einem array gespeichert werden um nachher festzustellen, ob der user einen kreis gezeichnet hat oder nicht. Es geht jetzt erstmal um das zeichnen beim mousedown(1), folgendes habe ich bereits realisiert: Code: [AUSKLAPPEN] [EINKLAPPEN] ; Debugmodus Const c_debug = 1 ; Grafikeinstellungen Global g_graphicsWidth = 800 ; Auflösung x Global g_graphicsHeight = 600 ; Auflösung y Global g_graphicsDepth = 0 ; Farbtiefe (0 = auto) Global g_graphicsMode = 1 ; Modus (1 = Fullscreen, 2 = window, 3 = scale window) ; Debug Modus aktiv? If c_debug = 1 Then g_graphicsMode = 2 ; Window Mode End If ; Grafik initialisieren und Buffer setzen Graphics g_graphicsWidth, g_graphicsHeight, g_graphicsDepth, g_graphicsMode SetBuffer BackBuffer() ; Hintergrundfarbe auf weiss ClsColor 255,255,255 Dim a_UserClick(g_graphicsWidth, g_graphicsHeight) Function drawUserClick() Local l_x = 0, l_y = 0 Local l_letztesElementX = -1, l_letztesElementY = -1 For l_x = 0 To g_graphicsWidth-1 For l_y = 0 To g_graphicsHeight-1 If a_UserClick(l_x, l_y) = 1 Then If l_letztesElementX > -1 Then Line l_letztesElementX, l_letztesElementY, l_x, l_y End If l_letztesElementX = l_x l_letztesElementY = l_y End If Next Next End Function Function clearUserClick() Dim a_UserClick(g_graphicsWidth, g_graphicsHeight) End Function Repeat Cls Color 0,0,0 If MouseDown(1) Then a_UserClick(MouseX(), MouseY()) = 1 drawUserClick() Else clearUserClick() End If Flip Until KeyHit(1) So nun habe ich aber das Problem, dass er mir zwar der maus folgt und linien zeichnet, sobald ich aber einen kreis zeichne passieren sehr komische sachen. er verbindet nicht den letzten punkt mit dem neuen, sondern immer den letzten punkt unterhalb der aktuellen linie. ist irgendwie schwer zu erklären, am besten probiert ihr den code mal selbst aus. wäre froh wenn mir jemand helfen könnte. hab gestern den halben tag probiert und konnte heut nacht kaum schlafen deswegen. das muss doch schaffbar sein. Danke euch allen! ps: Wirklich eine super community hier. denke ich werde öfter hier stöbern. [EDIT]Lauffähigen/Optimierten Code eingebunden[/Edit][/b]

alliswrong

Betreff: Mauszeiger hinterherzeichnen incl. speicherung in Array

Mo, Mai 12, 2008 12:16
Antworten mit Zitat

Hallo Leute, ich habe folgendes vor:
Der User soll anhand der Maus etwas zeichnen können. Das ganze soll mit linien gemacht werden, da die einzelnen Punkte verbunden werden sollen.
Zudem muss die letzte mausstrecke in einem array gespeichert werden um nachher festzustellen, ob der user einen kreis gezeichnet hat oder nicht.

Es geht jetzt erstmal um das zeichnen beim mousedown(1), folgendes habe ich bereits realisiert:

Code: [AUSKLAPPEN]

So nun habe ich aber das Problem, dass er mir zwar der maus folgt und linien zeichnet, sobald ich aber einen kreis zeichne passieren sehr komische sachen. er verbindet nicht den letzten punkt mit dem neuen, sondern immer den letzten punkt unterhalb der aktuellen linie. ist irgendwie schwer zu erklären, am besten probiert ihr den code mal selbst aus.

wäre froh wenn mir jemand helfen könnte. hab gestern den halben tag probiert und konnte heut nacht kaum schlafen deswegen. das muss doch schaffbar sein.

Danke euch allen!
ps: Wirklich eine super community hier. denke ich werde öfter hier stöbern.

[EDIT]Lauffähigen/Optimierten Code eingebunden[/Edit][/b]

Zuletzt bearbeitet von alliswrong am Mo, Mai 12, 2008 13:12, insgesamt einmal bearbeitet

	The Shark	Mo, Mai 12, 2008 12:39 Antworten mit Zitat
Das Problem ist, dass teile des codes fehlen zB habe ich das eingefügt, da es sonst abgestürzt ist Code: [AUSKLAPPEN] [EINKLAPPEN] Global g_graphicsWidth=400 Global g_graphicsHeight=300 Graphics g_graphicsWidth,g_graphicsHeight,0,2 es passiert allerdings nichts, das fenster bleibt schwarz und ich hab keine lust, irgendwelche fehlenden codeteile zu ersetzen, du solltest also den ganzen code posten, oder wenigstens dafür sorgen, dass er funktioniert!

The Shark

Mo, Mai 12, 2008 12:39
Antworten mit Zitat

Das Problem ist, dass teile des codes fehlen zB habe ich das eingefügt, da es sonst abgestürzt ist

Code: [AUSKLAPPEN]

Global g_graphicsWidth=400
Global g_graphicsHeight=300

Graphics g_graphicsWidth,g_graphicsHeight,0,2

es passiert allerdings nichts, das fenster bleibt schwarz und ich hab keine lust, irgendwelche fehlenden codeteile zu ersetzen, du solltest also den ganzen code posten, oder wenigstens dafür sorgen, dass er funktioniert!

	alliswrong	Mo, Mai 12, 2008 12:43 Antworten mit Zitat
Oh sorry, hab gedacht das wäre kein problem die grafikeinstellungen selbst zu schreiben und die farbe auf schwarz zu setzen. Hier der lauffähige code: Code: [AUSKLAPPEN] [EINKLAPPEN] ; Debugmodus Const c_debug = 1 ; Grafikeinstellungen Global g_graphicsWidth = 800 ; Auflösung x Global g_graphicsHeight = 600 ; Auflösung y Global g_graphicsDepth = 0 ; Farbtiefe (0 = auto) Global g_graphicsMode = 1 ; Modus (1 = Fullscreen, 2 = window, 3 = scale window) ; Debug Modus aktiv? If c_debug = 1 Then g_graphicsMode = 2 ; Window Mode End If ; Grafik initialisieren und Buffer setzen Graphics g_graphicsWidth, g_graphicsHeight, g_graphicsDepth, g_graphicsMode SetBuffer BackBuffer() ; Hintergrundfarbe auf weiss ClsColor 255,255,255 Dim a_UserClick(g_graphicsWidth, g_graphicsHeight) Function drawUserClick() Local l_x = 0, l_y = 0 Local l_letztesElementX = -1, l_letztesElementY = -1 For l_x = 0 To g_graphicsWidth For l_y = 0 To g_graphicsHeight If a_UserClick(l_x, l_y) = 1 Then If l_letztesElementX > -1 Then Line l_letztesElementX, l_letztesElementY, l_x, l_y End If l_letztesElementX = l_x l_letztesElementY = l_y End If Next Next End Function Function clearUserClick() Local i_x = 0, i_y = 0 For i_x = 0 To g_graphicsWidth For i_y = 0 To g_graphicsHeight If a_UserClick(i_x, i_y) = 1 Then a_UserClick(i_x, i_y) = 0 End If Next Next End Function Repeat Cls Color 0,0,0 If MouseDown(1) Then a_UserClick(MouseX(), MouseY()) = 1 drawUserClick() Else clearUserClick() End If Flip Until KeyHit(1) Muss ich mir merken, dass ich nur lauffähigen code poste [/code]

alliswrong

Mo, Mai 12, 2008 12:43
Antworten mit Zitat

Oh sorry, hab gedacht das wäre kein problem die grafikeinstellungen selbst zu schreiben und die farbe auf schwarz zu setzen.
Hier der lauffähige code:

Code: [AUSKLAPPEN]

Muss ich mir merken, dass ich nur lauffähigen code poste Wink

[/code]

	The Shark	Mo, Mai 12, 2008 13:02 Antworten mit Zitat
1. dnake für den lauffähigen code. Das problem ist, dass wenn das jeder so macht, dann muss man nur noch codes korrigieren. 2. wofür genau brauchst du das? Ich würde das nämlich mit types lösen 3. einige kleinigkeiten: - Timer benutzen -Code: [AUSKLAPPEN] [EINKLAPPEN] For l_x = 0 To g_graphicsWidth-1 For l_y = 0 To g_graphicsHeight-1 Das reicht, die punkte gehen nur von 0-799 bzw von 0-399 array löschen müsste mit neu dimensionieren schneller gehen, also einfach Code: [AUSKLAPPEN] [EINKLAPPEN] Dim a_UserClick(g_graphicsWidth, g_graphicsHeight) statt Code: [AUSKLAPPEN] [EINKLAPPEN] For i_x = 0 To g_graphicsWidth For i_y = 0 To g_graphicsHeight If a_UserClick(i_x, i_y) = 1 Then a_UserClick(i_x, i_y) = 0 End If Next Next hinter das problem bin ich noch nicht gerkommen , ich arbeite aber dran Edit: Ok ichg habs. du gehst den array von links oben nach rechts unten durch, dabei verbindest du nicht die aufeinanderfolgenden punkte, sondern einfach die, die zuerst abgearbeitet werden. An der lösung arbeite ich, dazu müsste ich aber wissen, wofür das ist, damit ich weis, wie ichs programmieren kann.

The Shark

Mo, Mai 12, 2008 13:02
Antworten mit Zitat

1. dnake für den lauffähigen code. Das problem ist, dass wenn das jeder so macht, dann muss man nur noch codes korrigieren.

2. wofür genau brauchst du das? Ich würde das nämlich mit types lösen

3. einige kleinigkeiten:
- Timer benutzen

-Code: [AUSKLAPPEN]

For l_x = 0 To g_graphicsWidth-1
For l_y = 0 To g_graphicsHeight-1

Das reicht, die punkte gehen nur von 0-799 bzw von 0-399

array löschen müsste mit neu dimensionieren schneller gehen, also einfach Code: [AUSKLAPPEN]

Dim a_UserClick(g_graphicsWidth, g_graphicsHeight)

statt
Code: [AUSKLAPPEN]

For i_x = 0 To g_graphicsWidth
For i_y = 0 To g_graphicsHeight
If a_UserClick(i_x, i_y) = 1 Then
a_UserClick(i_x, i_y) = 0
End If
Next
Next

hinter das problem bin ich noch nicht gerkommen Confused

, ich arbeite aber dran

Edit: Ok ichg habs. du gehst den array von links oben nach rechts unten durch, dabei verbindest du nicht die aufeinanderfolgenden punkte, sondern einfach die, die zuerst abgearbeitet werden. An der lösung arbeite ich, dazu müsste ich aber wissen, wofür das ist, damit ich weis, wie ichs programmieren kann.

Zuletzt bearbeitet von The Shark am Mo, Mai 12, 2008 13:08, insgesamt einmal bearbeitet

	alliswrong	Mo, Mai 12, 2008 13:08 Antworten mit Zitat
Hey, erstmal danke für die Tipps. Das mit dem Schleifendurchlauf -1 hatte ich bereits drin. hab ausversehen den alten code geschickt. Eine erneue Array deklaration scheint mir ebenfalls schneller, wusster garnicht dass ich das in bb so machen kann. Danke. Mitm Timer hab ich noch in bb nichts gemacht, schau ich mir mal an. Wobei ich mir nicht vorstellen kann wofür ich den benutzen soll. Das "eigentliche" Problem scheint mir nen tick trickiger zu sein. Hab schon stunden damit verbracht, tausend mal probiert und im forum gesucht. Das zeichnen einer linie ohne speicherung gibts hier im forum. aber die kombination von beiden ist irgendwie eigenartig. Das ganze soll nacher einer mausgestenerkennung dienen - wenn ich es schaffe sowas hinzubekommen. Programmiere auf Arbeit eigentlich C# und VB.NET / Java und das auch "nur" in form von programmen. also keine grafik wie bei spielen. Erstma danke dir, hast natürlich recht mit dem vollständigen code. würde mich auch mit der zeit aufregen wenn jeder immer nicht lauffähigen code postet.

alliswrong

Mo, Mai 12, 2008 13:08
Antworten mit Zitat

Hey, erstmal danke für die Tipps.
Das mit dem Schleifendurchlauf -1 hatte ich bereits drin. hab ausversehen den alten code geschickt.
Eine erneue Array deklaration scheint mir ebenfalls schneller, wusster garnicht dass ich das in bb so machen kann. Danke.

Mitm Timer hab ich noch in bb nichts gemacht, schau ich mir mal an. Wobei ich mir nicht vorstellen kann wofür ich den benutzen soll.

Das "eigentliche" Problem scheint mir nen tick trickiger zu sein. Hab schon stunden damit verbracht, tausend mal probiert und im forum gesucht. Das zeichnen einer linie ohne speicherung gibts hier im forum. aber die kombination von beiden ist irgendwie eigenartig.

Das ganze soll nacher einer mausgestenerkennung dienen - wenn ich es schaffe sowas hinzubekommen.
Programmiere auf Arbeit eigentlich C# und VB.NET / Java und das auch "nur" in form von programmen. also keine grafik wie bei spielen.

Erstma danke dir, hast natürlich recht mit dem vollständigen code. würde mich auch mit der zeit aufregen wenn jeder immer nicht lauffähigen code postet.

	The Shark	Mo, Mai 12, 2008 13:10 Antworten mit Zitat
Die daten sollen dann also als array vorliegen, oder als bild, das analysiert wird? edit: wegen timer: Der sorgt dafür, dass das programm nicht 100% cpu braucht oder zu schnell läuft. noch was: du solltest flip 0, benutzen, sonst macht er vsync -> 100% auslastung

The Shark

Mo, Mai 12, 2008 13:10
Antworten mit Zitat

Die daten sollen dann also als array vorliegen, oder als bild, das analysiert wird?

edit: wegen timer: Der sorgt dafür, dass das programm nicht 100% cpu braucht oder zu schnell läuft.

noch was: du solltest flip 0, benutzen, sonst macht er vsync -> 100% auslastung

	alliswrong	Mo, Mai 12, 2008 13:14 Antworten mit Zitat
Die Daten sollen im array liegen. Sobald der user aufhört zu zeichnen soll das array analysiert werden was für eine geste er gezeichnet hat. So ähnlich wie man es von black&white kennt. Natülich erstmal nur ganz einfach einen kreis zeichnen. Beispiel: User zeichnet einen Kreis mit der maus (mousedown(1)). Sobald der user die maus loslässt wird die gezeichnete strecke aus dem array analysiert ob der kreis geschlossen war. wenn ja, soll er irgendetwas machen. [edit]ok danke, das mit dem flip 0 kannt ich noch nicht. den timer hab ich glaube ich schonmal gesehen im bezug auf die spielgeschwindigkeit auf unterschiedlichen rechner. schau ich mir mal an. bin leider gleich weg mit meiner freundin dabei würd ich eigentlich gern proggen. naja, was muss das muss[/edit]

alliswrong

Mo, Mai 12, 2008 13:14
Antworten mit Zitat

Die Daten sollen im array liegen.
Sobald der user aufhört zu zeichnen soll das array analysiert werden was für eine geste er gezeichnet hat.
So ähnlich wie man es von black&white kennt.

Natülich erstmal nur ganz einfach einen kreis zeichnen.
Beispiel:

User zeichnet einen Kreis mit der maus (mousedown(1)).
Sobald der user die maus loslässt wird die gezeichnete strecke aus dem array analysiert ob der kreis geschlossen war. wenn ja, soll er irgendetwas machen.

[edit]ok danke, das mit dem flip 0 kannt ich noch nicht. den timer hab ich glaube ich schonmal gesehen im bezug auf die spielgeschwindigkeit auf unterschiedlichen rechner. schau ich mir mal an. bin leider gleich weg mit meiner freundin dabei würd ich eigentlich gern proggen. naja, was muss das muss[/edit]

	The Shark	Mo, Mai 12, 2008 13:33 Antworten mit Zitat
Also das zeichnen geht jetzt, das mit dem array versuche ich, müsste zu schaffen sein. EDIT: Der array ist drin, er wird ins debugfenster geschrieben, wenn man was gemalt hat. Code: [AUSKLAPPEN] [EINKLAPPEN] Type point Field x Field y End Type Const SCREENWIDTH = 120 Const SCREENHEIGHT = 100 Global timer=CreateTimer(60) Global pt.point,msx,msy,old_msx,old_msy,points,msstate Graphics SCREENWIDTH, SCREENHEIGHT, 0, 2 SetBuffer BackBuffer() Dim screenarr(SCREENWIDTH,SCREENHEIGHT) While Not KeyDown(1) WaitTimer(timer) Cls If MouseDown(1) msstate=1 msx=MouseX() msy=MouseY() If msx<>old_msx Or msy<>old_msy newpoint(msx,msy) EndIf old_msx=msx old_msy=msy drawline() Else If msstate=1;Es wurde etwas gezeichnet For x=0 To SCREENWIDTH-1 For y=0 To SCREENHEIGHT-1 reihe$=reihe$+screenarr(x,y) Next DebugLog reihe$ reihe$="" Next EndIf msstate=0 Delete Each point points=0 Dim screenarr(SCREENWIDTH,SCREENHEIGHT) EndIf Flip 0 Wend End Function newpoint(x,y) pt.point=New point pt\x=x pt\y=y points=points+1 End Function Function drawline() pt.point=First point If points>1 LockBuffer BackBuffer() For i=1 To points-1 x1=pt\x y1=pt\y pt.point=After pt.point x2=pt\x y2=pt\y Linie(x1,y1,x2,y2,255,255,255) liniearray(x1,y1,x2,y2) Next UnlockBuffer BackBuffer() EndIf End Function Function Liniearray(x1, y1, x2, y2) dx = x2 - x1 dy = y2 - y1 If dx > 0 Then inc_x = 1 Else inc_x = -1 EndIf If dy > 0 Then inc_y = 1 Else inc_y = -1 EndIf If Abs(dy) < Abs(dx) Then error = -Abs(dx) delta = 2 * Abs(dy) schwelle = 2 * error While x1 <> x2 screenarr(x1, y1)=1 x1 = x1 + inc_x error = error + delta If error > 0 Then y1 = y1 + inc_y: error = error + schwelle Wend Else error = -Abs(dy) delta = 2 * Abs(dx) schwelle = 2 * error While y1 <> y2 screenarr(x1, y1)=1 y1 = y1 + inc_y error = error + delta If error > 0 x1 = x1 + inc_x: error = error + schwelle Wend EndIf screenarr(x2, y2)=1 End Function Function Linie(x1, y1, x2, y2, r, g, b) farbe = r$10000 + g$100 + b dx = x2 - x1 dy = y2 - y1 If dx > 0 Then inc_x = 1 Else inc_x = -1 EndIf If dy > 0 Then inc_y = 1 Else inc_y = -1 EndIf If Abs(dy) < Abs(dx) Then error = -Abs(dx) delta = 2 * Abs(dy) schwelle = 2 * error While x1 <> x2 WritePixelFast x1, y1, farbe x1 = x1 + inc_x error = error + delta If error > 0 Then y1 = y1 + inc_y: error = error + schwelle Wend Else error = -Abs(dy) delta = 2 * Abs(dx) schwelle = 2 * error While y1 <> y2 WritePixelFast x1, y1, farbe y1 = y1 + inc_y error = error + delta If error > 0 x1 = x1 + inc_x: error = error + schwelle Wend EndIf WritePixel x2, y2, farbe End Function

The Shark

Mo, Mai 12, 2008 13:33
Antworten mit Zitat

Also das zeichnen geht jetzt, das mit dem array versuche ich, müsste zu schaffen sein.

EDIT: Der array ist drin, er wird ins debugfenster geschrieben, wenn man was gemalt hat.
Code: [AUSKLAPPEN]

Type point
Field x
Field y
End Type

Const SCREENWIDTH = 120
Const SCREENHEIGHT = 100

Global timer=CreateTimer(60)
Global pt.point,msx,msy,old_msx,old_msy,points,msstate

Graphics SCREENWIDTH, SCREENHEIGHT, 0, 2

SetBuffer BackBuffer()
Dim screenarr(SCREENWIDTH,SCREENHEIGHT)

While Not KeyDown(1)
WaitTimer(timer)
Cls

If MouseDown(1)
   msstate=1
   msx=MouseX()
   msy=MouseY()

   If msx<>old_msx Or msy<>old_msy
      newpoint(msx,msy)
   EndIf
   old_msx=msx
   old_msy=msy

   drawline()
Else
   If msstate=1;Es wurde etwas gezeichnet

      For x=0 To SCREENWIDTH-1
         For y=0 To SCREENHEIGHT-1
            reihe$=reihe$+screenarr(x,y)
         Next
         DebugLog reihe$
         reihe$=""
      Next
   EndIf
   msstate=0

   Delete Each point
   points=0
   Dim screenarr(SCREENWIDTH,SCREENHEIGHT)
EndIf

Flip 0
Wend
End

Function newpoint(x,y)
pt.point=New point
pt\x=x
pt\y=y
points=points+1
End Function

Function drawline()
pt.point=First point
If points>1
   LockBuffer BackBuffer()
   For i=1 To points-1
      x1=pt\x
      y1=pt\y

      pt.point=After pt.point

      x2=pt\x
      y2=pt\y

      Linie(x1,y1,x2,y2,255,255,255)
      liniearray(x1,y1,x2,y2)
   Next
   UnlockBuffer BackBuffer()
EndIf
End Function

Function Liniearray(x1, y1, x2, y2)
dx = x2 - x1
dy = y2 - y1

If dx > 0 Then
   inc_x = 1
Else
   inc_x = -1
EndIf
If dy > 0 Then
   inc_y = 1
Else
   inc_y = -1
EndIf

If Abs(dy) < Abs(dx) Then
   error = -Abs(dx)
   delta = 2 * Abs(dy)
   schwelle = 2 * error
   While x1 <> x2
      screenarr(x1, y1)=1
      x1 = x1 + inc_x
      error = error + delta
      If error > 0 Then y1 = y1 + inc_y: error = error + schwelle
   Wend
Else
   error = -Abs(dy)
   delta = 2 * Abs(dx)
   schwelle = 2 * error
   While y1 <> y2
      screenarr(x1, y1)=1
      y1 = y1 + inc_y
      error = error + delta
      If error > 0 x1 = x1 + inc_x: error = error + schwelle
   Wend
EndIf
screenarr(x2, y2)=1
End Function

Function Linie(x1, y1, x2, y2, r, g, b)
farbe = r*$10000 + g*$100 + b
dx = x2 - x1
dy = y2 - y1

If dx > 0 Then
   inc_x = 1
Else
   inc_x = -1
EndIf
If dy > 0 Then
   inc_y = 1
Else
   inc_y = -1
EndIf

If Abs(dy) < Abs(dx) Then
   error = -Abs(dx)
   delta = 2 * Abs(dy)
   schwelle = 2 * error
   While x1 <> x2
      WritePixelFast x1, y1, farbe
      x1 = x1 + inc_x
      error = error + delta
      If error > 0 Then y1 = y1 + inc_y: error = error + schwelle
   Wend
Else
   error = -Abs(dy)
   delta = 2 * Abs(dx)
   schwelle = 2 * error
   While y1 <> y2
      WritePixelFast x1, y1, farbe
      y1 = y1 + inc_y
      error = error + delta
      If error > 0 x1 = x1 + inc_x: error = error + schwelle
   Wend
EndIf
WritePixel x2, y2, farbe
End Function

	alliswrong	Mo, Mai 12, 2008 16:43 Antworten mit Zitat
hey danke dir. versuche nun deinen code zu durchschauen und übertrage das dann auf meinen. melde mich dann nochmal. dickes lob!

alliswrong

Mo, Mai 12, 2008 16:43
Antworten mit Zitat

hey danke dir.
versuche nun deinen code zu durchschauen und übertrage das dann auf meinen.
melde mich dann nochmal. dickes lob!

	alliswrong	Mo, Mai 12, 2008 17:52 Antworten mit Zitat
Super! Das klappt ja eins a! Wobei ich nicht verstehe wofür da so viel umgerechnet wird. Mein ansatz wäre sicherlich auch irgendwie lauffähig gewesen ohne delta, schwelle und error oder? Vielleicht kannst du die funktion liniearray nochmal erklären? Anbei mein code. Habe ihn etwas verkürzt und die beiden funktionen linienarray und linie zusammengefasst. Code: [AUSKLAPPEN] [EINKLAPPEN] ; Debugmodus Const c_debug = 1 ; Grafikeinstellungen Global g_graphicsWidth = 800 ; Auflösung x Global g_graphicsHeight = 600 ; Auflösung y Global g_graphicsDepth = 0 ; Farbtiefe (0 = auto) Global g_graphicsMode = 1 ; Modus (1 = Fullscreen, 2 = window, 3 = scale window) ; Debug Modus aktiv? If c_debug = 1 Then g_graphicsMode = 2 ; Window Mode End If ; Grafik initialisieren und Buffer setzen Graphics g_graphicsWidth, g_graphicsHeight, g_graphicsDepth, g_graphicsMode SetBuffer BackBuffer() ; Hintergrundfarbe auf weiss ClsColor 0,0,0 ; Timer für Geschw. Global g_Timer = CreateTimer(60) ; ### Zeichnen der Userklicks ### Type t_MousePoint Field x Field y End Type Dim a_ClickArray(g_graphicsWidth, g_graphicsHeight) Local l_MouseState = 0 Local l_MouseOldX, l_MouseOldY, l_ArrayDebug$ Global g_MousePoint.t_MousePoint, g_MousePointsCnt Function drawUserClick() g_MousePoint.t_MousePoint = First t_MousePoint If g_MousePointsCnt > 1 Then LockBuffer BackBuffer() Local l_i = 0 Local l_x1, l_y1, l_x2, l_y2 For l_i = 1 To g_MousePointsCnt-1 l_x1 = g_MousePoint\x l_y1 = g_MousePoint\y g_MousePoint.t_MousePoint = After g_MousePoint.t_MousePoint l_x2 = g_MousePoint\x l_y2 = g_MousePoint\y Linie(l_x1, l_y1, l_x2, l_y2, 255,255,255) Next UnlockBuffer BackBuffer() End If End Function Function Linie(i_x1, i_y1, i_x2, i_y2, i_r, i_g, i_b) Local l_farbe = i_r$10000 + i_g$100 + i_b Local l_dx = i_x2 - i_x1 Local l_dy = i_y2 - i_y1 Local l_inc_x, l_inc_y, l_error, l_delta, l_schwelle If l_dx > 0 Then l_inc_x = 1 Else l_inc_x = -1 EndIf If l_dy > 0 Then l_inc_y = 1 Else l_inc_y = -1 EndIf If Abs(l_dy) < Abs(l_dx) Then l_error = -Abs(l_dx) l_delta = 2 * Abs(l_dy) l_schwelle = 2 * l_error While i_x1 <> i_x2 WritePixelFast i_x1, i_y1, l_farbe a_ClickArray(i_x1, i_y1) = 1 i_x1 = i_x1 + l_inc_x l_error = l_error + l_delta If l_error > 0 Then i_y1 = i_y1 + l_inc_y l_error = l_error + l_schwelle End If Wend Else l_error = -Abs(l_dy) l_delta = 2 * Abs(l_dx) l_schwelle = 2 * l_error While i_y1 <> i_y2 WritePixelFast i_x1, i_y1, l_farbe a_ClickArray(i_x1, i_y1) = 1 i_y1 = i_y1 + l_inc_y l_error = l_error + l_delta If l_error > 0 Then i_x1 = i_x1 + l_inc_x l_error = l_error + l_schwelle End If Wend EndIf WritePixel i_x2, i_y2, l_farbe a_ClickArray(i_x2, i_y2) = 1 End Function Repeat WaitTimer(g_Timer) Cls ; ### Zeichnen der Userklicks ### If MouseDown(1) Then l_MouseState = 1 If MouseX() <> l_MouseOldX Or MouseY() <> l_MouseOldY Then g_MousePoint.t_MousePoint = New t_MousePoint g_MousePoint\x = MouseX() g_MousePoint\y = MouseY() g_MousePointsCnt = g_MousePointsCnt + 1 End If l_MouseOldX = MouseX() l_MouseOldY = MouseY() drawUserClick() Else If l_MouseState = 1 Then Local l_x, l_y For l_y = 0 To g_graphicsHeight-1 For l_x = 0 To g_graphicswidth - 1 l_ArrayDebug$ = l_ArrayDebug$ + a_ClickArray(l_x, l_y) Next DebugLog l_ArrayDebug$ l_ArrayDebug$ = "" Next l_MouseState = 0 Delete Each t_MousePoint g_MousePointsCnt = 0 Dim a_ClickArray(g_graphicsWidth, g_graphicsHeight) End If End If Flip 0 Until KeyHit(1) Erstmal danke für die Hilfe. Hast mir sehr weiter geholfen. Werde weiterhin versuchen den Code zu verkleinern und leichter verständlich zu machen. thx

alliswrong

Mo, Mai 12, 2008 17:52
Antworten mit Zitat

Super! Das klappt ja eins a!
Wobei ich nicht verstehe wofür da so viel umgerechnet wird.
Mein ansatz wäre sicherlich auch irgendwie lauffähig gewesen ohne delta, schwelle und error oder?

Vielleicht kannst du die funktion liniearray nochmal erklären?
Anbei mein code. Habe ihn etwas verkürzt und die beiden funktionen linienarray und linie zusammengefasst.

Code: [AUSKLAPPEN]

; Debugmodus
Const c_debug = 1

; Grafikeinstellungen
Global g_graphicsWidth = 800 ; Auflösung x
Global g_graphicsHeight = 600 ; Auflösung y
Global g_graphicsDepth = 0 ; Farbtiefe (0 = auto)
Global g_graphicsMode =    1 ; Modus (1 = Fullscreen, 2 = window, 3 = scale window)

; Debug Modus aktiv?
If c_debug = 1 Then
g_graphicsMode = 2       ; Window Mode
End If

; Grafik initialisieren und Buffer setzen
Graphics g_graphicsWidth, g_graphicsHeight, g_graphicsDepth, g_graphicsMode
SetBuffer BackBuffer()

; Hintergrundfarbe auf weiss
ClsColor 0,0,0

; Timer für Geschw.
Global g_Timer = CreateTimer(60)

; ### Zeichnen der Userklicks ###
Type t_MousePoint
Field x
Field y
End Type

Dim a_ClickArray(g_graphicsWidth, g_graphicsHeight)
Local l_MouseState = 0
Local l_MouseOldX, l_MouseOldY, l_ArrayDebug$
Global g_MousePoint.t_MousePoint, g_MousePointsCnt

Function drawUserClick()
g_MousePoint.t_MousePoint = First t_MousePoint

If g_MousePointsCnt > 1 Then
   LockBuffer BackBuffer()
   Local l_i = 0
   Local l_x1, l_y1, l_x2, l_y2

   For l_i = 1 To g_MousePointsCnt-1
      l_x1 = g_MousePoint\x
      l_y1 = g_MousePoint\y

      g_MousePoint.t_MousePoint = After g_MousePoint.t_MousePoint

      l_x2 = g_MousePoint\x
      l_y2 = g_MousePoint\y

      Linie(l_x1, l_y1, l_x2, l_y2, 255,255,255)
   Next

   UnlockBuffer BackBuffer()
End If
End Function

Function Linie(i_x1, i_y1, i_x2, i_y2, i_r, i_g, i_b)
Local l_farbe = i_r*$10000 + i_g*$100 + i_b
Local l_dx = i_x2 - i_x1
Local l_dy = i_y2 - i_y1
Local l_inc_x, l_inc_y, l_error, l_delta, l_schwelle

If l_dx > 0 Then
   l_inc_x = 1
Else
   l_inc_x = -1
EndIf

If l_dy > 0 Then
   l_inc_y = 1
Else
   l_inc_y = -1
EndIf

If Abs(l_dy) < Abs(l_dx) Then
   l_error = -Abs(l_dx)
   l_delta = 2 * Abs(l_dy)
   l_schwelle = 2 * l_error

   While i_x1 <> i_x2
      WritePixelFast i_x1, i_y1, l_farbe
      a_ClickArray(i_x1, i_y1) = 1
      i_x1 = i_x1 + l_inc_x
      l_error = l_error + l_delta
      If l_error > 0 Then
         i_y1 = i_y1 + l_inc_y
         l_error = l_error + l_schwelle
      End If
   Wend
Else
   l_error = -Abs(l_dy)
   l_delta = 2 * Abs(l_dx)
   l_schwelle = 2 * l_error

   While i_y1 <> i_y2
      WritePixelFast i_x1, i_y1, l_farbe
      a_ClickArray(i_x1, i_y1) = 1
      i_y1 = i_y1 + l_inc_y
      l_error = l_error + l_delta

      If l_error > 0 Then
         i_x1 = i_x1 + l_inc_x
         l_error = l_error + l_schwelle
      End If

   Wend
EndIf

WritePixel i_x2, i_y2, l_farbe
a_ClickArray(i_x2, i_y2) = 1
End Function

Repeat
WaitTimer(g_Timer)
Cls

; ### Zeichnen der Userklicks ###
If MouseDown(1) Then
   l_MouseState = 1

   If MouseX() <> l_MouseOldX Or MouseY() <> l_MouseOldY Then
      g_MousePoint.t_MousePoint = New t_MousePoint
      g_MousePoint\x = MouseX()
      g_MousePoint\y = MouseY()
      g_MousePointsCnt = g_MousePointsCnt + 1
   End If

   l_MouseOldX = MouseX()
   l_MouseOldY = MouseY()

   drawUserClick()
Else
   If l_MouseState = 1 Then
      Local l_x, l_y

      For l_y = 0 To g_graphicsHeight-1
         For l_x = 0 To g_graphicswidth - 1
            l_ArrayDebug$ = l_ArrayDebug$ + a_ClickArray(l_x, l_y)
         Next
         DebugLog l_ArrayDebug$
         l_ArrayDebug$ = ""
      Next

      l_MouseState = 0
      Delete Each t_MousePoint
      g_MousePointsCnt = 0
      Dim a_ClickArray(g_graphicsWidth, g_graphicsHeight)
   End If
End If

Flip 0
Until KeyHit(1)

Erstmal danke für die Hilfe. Hast mir sehr weiter geholfen. Werde weiterhin versuchen den Code zu verkleinern und leichter verständlich zu machen. thx

	The Shark	Mo, Mai 12, 2008 18:44 Antworten mit Zitat
die linie-funktion ist nicht von mir, das ist eine umsetzung des bresenham-linien-algorythmus. im gegensatz zu line ist es 1. schneller und ich kann 2. jeden pixel der linie direkt abfangen

The Shark

Mo, Mai 12, 2008 18:44
Antworten mit Zitat

die linie-funktion ist nicht von mir, das ist eine umsetzung des bresenham-linien-algorythmus. im gegensatz zu line ist es 1. schneller und ich kann 2. jeden pixel der linie direkt abfangen

Übersicht

BlitzBasic

Allgemein

Nach Oben

BlitzBasic Portal

Mauszeiger hinterherzeichnen incl. speicherung in Array

Betreff: Mauszeiger hinterherzeichnen incl. speicherung in Array