Autor |
Beitrag |
Nano-Ware
Beiträge: 394
Erhaltene Danke: 7
|
Verfasst: So 08.07.12 23:47
Hey,
ich arbeite mit den Events "MouseDown", "MouseUp" und "MouseMove" um mit der Maus ein Rechteck zu zeichnen. Bis jetzt lasse ich bei MouseMove immer das vorherige Rechteck mit einer anderen Farbe überschreiben, nur überschreibe ich dann auch andere Rechtecken..
Delphi-Quelltext 1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14:
| procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if down then begin Image1.Canvas.Pen.Color := clWhite; Image1.Canvas.Brush.Color := clWhite; Image1.Canvas.Rectangle(start.X,start.Y,cur.X,cur.Y); cur.X := X; cur.Y := Y; Image1.Canvas.Brush.Color := clRed; Image1.Canvas.Pen.Color := clRed; Image1.Canvas.Rectangle(start.X,start.Y,cur.X,cur.Y); end; end; |
Wie kann ich denn effizient ein Rechteck mit der Maus zeichnen?
|
|
Mathematiker
Beiträge: 2622
Erhaltene Danke: 1447
Win 7, 8.1, 10
Delphi 5, 7, 10.1
|
Verfasst: So 08.07.12 23:59
Nano-Ware hat folgendes geschrieben : | Wie kann ich denn effizient ein Rechteck mit der Maus zeichnen? |
Ob es effizient ist, weiß ich nicht. Ich lösche das alte, bei mir leere Rechteck, in dem ich den Stiftmodus ändere:
Delphi-Quelltext 1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12:
| var stiftmode:tpenmode; ... stiftmode:=image.canvas.pen.mode; image.canvas.pen.color:=clred; image.canvas.pen.mode:=pmnot; image.canvas.brush.style:=bsclear; image.canvas.rectangle(start.x,start.y,xold,yold); image.canvas.rectangle(start.x,start.y,x,y); image.canvas.pen.mode:=stiftmode; xold:=x; yold:=y; ... |
Beste Grüße
Mathematiker
_________________ Töten im Krieg ist nach meiner Auffassung um nichts besser als gewöhnlicher Mord. Albert Einstein
|
|
Nano-Ware
Beiträge: 394
Erhaltene Danke: 7
|
Verfasst: Mo 09.07.12 00:11
Das habe ich auch schon gemacht. Nur will ich das mit einem gefüllten Rechteck machen. Außerdem: Wenn sich zwei Rechtecke überlappen fehlt an den Berührungspunkten der Rahmen..
Man könnte auch das Bild, bevor ein neues Rechteck angefangen würde speichern und immer wieder laden, aber das zieht Performanz...
|
|
mandras
Beiträge: 430
Erhaltene Danke: 107
Win 10
Delphi 6 Prof, Delphi 10.4 Prof
|
Verfasst: Mo 09.07.12 00:29
Ich weiß nicht ob ich das Problem richtig erfaßt habe, aber wäre eine Lösung nicht den Rahmen oder ggf. auch das ganze Rechteck im Modus XOR zu zeichnen, bei einem MouseMove einmal mit der vorherigen Größe (löscht die bisherige Markierung), dann mit der neuen?
|
|
Nano-Ware
Beiträge: 394
Erhaltene Danke: 7
|
Verfasst: Mo 09.07.12 00:36
Tut mir leid mandras, aber ich verstehe garnicht was du meinst. Ich will quasi (damit du es verstehst) ein Mal-Programm schreiben und möchte nun den Teil Programmieren, mit dem ich ein Rechteck zeichne. Ich will das halt wie in Paint "ziehen" können.
|
|
mandras
Beiträge: 430
Erhaltene Danke: 107
Win 10
Delphi 6 Prof, Delphi 10.4 Prof
|
Verfasst: Mo 09.07.12 01:06
Nano-Ware hat folgendes geschrieben : | Tut mir leid mandras, aber ich verstehe garnicht was du meinst. Ich will quasi (damit du es verstehst) ein Mal-Programm schreiben und möchte nun den Teil Programmieren, mit dem ich ein Rechteck zeichne. Ich will das halt wie in Paint "ziehen" können. |
Was ich meine ist folgendes: Du hast bereits korrekt mit Mousedown/move/up die richtigen Events genannt.
Du willst die Markierung wie in Paint arbeiten lassen.
Zur Erläuterung: der XOR-Modus macht folgendes: er invertiert. Aus Schwarz wird Weiß, aus Blau Gelb etc. Ein zweimaliges Zeichnen im XOR Modus bringt das Original zurück.
Ich vereinfache und betrachte nur Umrandung und argumentiere hier mal in Richtung Zustandsautomat:
i
1- MouseDown: Markierungsfunktion fängt an. Koordinaten des Mausklicks merken in X0=x, Y0=y, Xa=X, Ya=Y merken. Zeichne dieses Pixel an (X0,Y0) per XOR (damit Schritt 2 diese Markierung wieder aufheben kann)
2- MouseMove: Neue Koordinaten sind X/Y. Zeichne Rechteck per XOR Modus von (X0,Y0) nach (Xa,Ya) - damit wird die bisherige Markierung aufgehoben. Zeichne nun Rechteck von (X0,Y0) nach (X,Y). Der neue Bereich wird umrahmt. Setze dann Xa=X, Ya=y. (Für Schritt 2 oder 3 in Zukunft)
3- MouseUp: Neue Koordinaten sind X/Y. Zeichne Rechteck per XOR Modus von (X0,Y0) nach (Xa,Ya). Damit wird bish. Markierung aufgehoben. Weitergehende Verarbeitung aufrufen, Koordinaten sind dann: (X0,Y0) bis (X,Y).
|
|
JDKDelphi
Beiträge: 115
Erhaltene Danke: 22
WIN2000, XP, WIN 7 , UNIX, LINUX
Assembler für (Z8x, 68xxx,R6000,Intel), DELPHI 6 Enterprise, MAGIC eDeveloper V9+V10, C++, C#,VB, .NET, zertifizierter iBOLT-Programmierer
|
Verfasst: Mo 09.07.12 10:08
Hallo,
ich mache das immer so:
Vielleicht hilft Dir das. Die Mausevents stammen aus meiner CAD-Anwendung.
Gruß
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124: 125: 126: 127: 128: 129: 130: 131: 132: 133: 134: 135: 136: 137: 138: 139: 140: 141: 142: 143: 144: 145: 146: 147: 148: 149: 150: 151: 152: 153: 154: 155: 156: 157: 158: 159: 160: 161: 162: 163: 164: 165: 166: 167: 168: 169: 170: 171: 172: 173: 174: 175: 176: 177: 178: 179: 180: 181: 182: 183: 184: 185: 186: 187: 188: 189: 190: 191: 192: 193: 194: 195: 196: 197: 198: 199: 200: 201: 202: 203: 204: 205: 206: 207: 208: 209:
| procedure TAXBitmap.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); VAR MX,MY : DOUBLE; tp,tp1 : TPOINT; Taste : INTEGER; begin IF fDrawing = dtNothing THEN BEGIN tp.X := x; tp.Y := y; tp1 := fgui.Mk_Coor_RW(tp); mx := tp1.X; my := tp1.Y; fMP1 := tp1; fMP2 := tp1; Taste := 0; IF Button = TMouseButton(mbLeft) THEN Taste := 1; IF Button = TMouseButton(mbRight) THEN Taste := 2; IF Button = TMouseButton(mbMiddle) THEN Taste := 4; if fevents <> NIL THEN fevents.OnMouseDN(mx,my,Taste); END; IF fDrawing <> dtNothing THEN BEGIN fMousepos.StartX := X; fMousepos.StartY := Y; fMousepos.EndeX := X; fMousepos.EndeY := Y; Image1.Canvas.MoveTo(x,y); END; end;
procedure TAXBitmap.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); VAR MX,MY : DOUBLE; tp,tp1 : TPOINT; Taste : INTEGER; begin IF fDrawing = dtNothing THEN BEGIN tp.X := x; tp.Y := y; tp1 := fgui.Mk_Coor_RW(tp); mx := tp1.X; my := tp1.Y; fMP2 := tp1; Taste := 0; IF Shift = [ssLeft] THEN Taste := 1; IF Shift = [ssRight] THEN Taste := 2; IF Shift = [ssMiddle] THEN Taste := 4; if fevents <> NIL THEN fevents.OnMouseMove(mx,my,Taste); Exit; END; IF ssleft in Shift THEN BEGIN IF fDrawing = dtline THEN BEGIN Image1.Canvas.Pen.Mode := pmNotXor; Image1.Canvas.MoveTo(fMousepos.StartX,fMousepos.StartY); Image1.Canvas.LineTo(fMousepos.EndeX ,fMousepos.EndeY ); Image1.Canvas.MoveTo(fMousepos.StartX,fMousepos.StartY); Image1.Canvas.LineTo(X ,Y ); fMousepos.EndeX := X; fMousepos.EndeY := Y; Image1.Canvas.Pen.Mode := pmCopy; Exit; END; IF (fDrawing = dtRectangle) or(fDrawing = dtCircle) THEN BEGIN Image1.Canvas.DrawFocusRect(sRect(rect(fMousepos.StartX,fMousepos.StartY,fMousepos.EndeX ,fMousepos.EndeY))); Image1.Canvas.DrawFocusRect(sRect(rect(fMousepos.StartX,fMousepos.StartY,X ,Y))); fMousepos.EndeX := X; fMousepos.EndeY := Y; Exit; END; END; end;
procedure TAXBitmap.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); VAR MX,MY : DOUBLE; tp,tp1 : TPOINT; Taste : INTEGER; aobject : TElement; i : INTEGER; gef : BOOLEAN; ObjPtr : INTEGER; PA,PB,PC : INTEGER; PS,pw,pp,pf : WIDESTRING; a,b : TVECTOR; begin IF fDrawing = dtline THEN BEGIN fMousepos.EndeX := X; fMousepos.EndeY := Y; IF fMacroState THEN BEGIN tp.X := fmousepos.StartX; tp.Y := fmousepos.StartY; tp1 := fgui.Mk_Coor_RW(tp); a.rx := tp1.X; a.ry := tp1.Y; tp.X := X; tp.Y := Y; tp1 := fgui.Mk_Coor_RW(tp); b.rx := tp1.X; b.ry := tp1.Y; NewCadObject; DefineCadObject(fdrawing,a,b); END; fDrawing := dtNothing; IF (fEvents <> nil) and fMacroState THEN fevents.OnCADPaintFinished; END; IF fDrawing = dtCircle THEN BEGIN fMousepos.EndeX := X; fMousepos.EndeY := Y; IF fMacroState THEN BEGIN tp.X := fmousepos.StartX; tp.Y := fmousepos.StartY; tp1 := fgui.Mk_Coor_RW(tp); a.rx := tp1.X; a.ry := tp1.Y; tp.X := X; tp.Y := Y; tp1 := fgui.Mk_Coor_RW(tp); b.rx := tp1.X; b.ry := tp1.Y; NewCadObject; DefineCadObject(fdrawing,a,b); END; fDrawing := dtNothing; Image1.Canvas.Ellipse(fMousepos.StartX,fMousepos.StartY,fMousepos.EndeX ,fMousepos.EndeY); IF (fEvents <> nil) and fMacroState THEN fevents.OnCADPaintFinished; END; IF fDrawing = dtText THEN BEGIN fMousepos.EndeX := X; fMousepos.EndeY := Y; IF fMacroState THEN BEGIN tp.X := fmousepos.StartX; tp.Y := fmousepos.StartY; tp1 := fgui.Mk_Coor_RW(tp); a.rx := tp1.X; a.ry := tp1.Y; tp.X := X; tp.Y := Y; tp1 := fgui.Mk_Coor_RW(tp); b.rx := tp1.X; b.ry := tp1.Y; NewCadObject; DefineCadObject(fdrawing,a,b); Textinput1Click(Sender); SetCadText(ftextInput); END; fDrawing := dtNothing; Image1.Canvas.TextOut(fMousepos.StartX,fMousepos.StartY,FTextInput); IF (fEvents <> nil) and fMacroState THEN fevents.OnCADPaintFinished; END; IF fDrawing = dtRectangle THEN BEGIN fMousepos.EndeX := X; fMousepos.EndeY := Y; IF fMacroState THEN BEGIN tp.X := fmousepos.StartX; tp.Y := fmousepos.StartY; tp1 := fgui.Mk_Coor_RW(tp); a.rx := tp1.X; a.ry := tp1.Y; tp.X := X; tp.Y := Y; tp1 := fgui.Mk_Coor_RW(tp); b.rx := tp1.X; b.ry := tp1.Y; NewCadObject; DefineCadObject(fdrawing,a,b); END; fDrawing := dtNothing; Image1.Canvas.Rectangle(fMousepos.StartX,fMousepos.StartY,fMousepos.EndeX ,fMousepos.EndeY); IF (fEvents <> nil) and fMacroState THEN fevents.OnCADPaintFinished; END; IF fDrawing = dtNothing THEN BEGIN gef := False; ObjPtr := -1; tp.X := x; tp.Y := y; tp1 := fgui.Mk_Coor_RW(tp); mx := tp1.X; my := tp1.Y; Taste := 0; PA := 0; PB := 0; PC := 0; PS := ''; IF Button = TMouseButton(mbLeft) THEN Taste := 1; IF Button = TMouseButton(mbRight) THEN Taste := 2; IF Button = TMouseButton(mbMiddle) THEN Taste := 4; IF fQueryObj THEN BEGIN IF FLanelist.Count > 0 THEN BEGIN FOR i := flanelist.Count-1 downto 0 DO BEGIN aobject := flanelist.items[I] as TElement; IF aobject<>NIL THEN BEGIN IF aobject.Check_RangeEx(tp1) then BEGIN Gef := TRUE; ObjPtr := i; PA := aobject.GET_Auftrag; PB := aobject.GET_Platten; PC := aobject.GET_WandNr; PS := widestring(aobject.GET_Einheit); PW := widestring(aobject.Kennung); PP := widestring(aobject.Kennung1); PF := widestring(aobject.Kennung2); break; END; END; END; END; END; if fevents <> NIL THEN BEGIN IF not(gef) THEN fevents.OnMouseUP(mx,my,Taste); IF gef THEN fevents.OnObjFoundEx(ObjPtr,PA,PB,PC,PS,pw,pp,pf); END; END; end; |
_________________ Wo andere aufhören, fange ich erst an..
|
|
Nano-Ware
Beiträge: 394
Erhaltene Danke: 7
|
Verfasst: Mo 09.07.12 15:25
Ich werds einfach mal mit ner transparenten Bitmap versuchen und die drüberlegen und mit GDI+ arbeiten. Ich bin zu blöd dafür
|
|
|