Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Multimedia (https://www.delphipraxis.net/16-multimedia/)
-   -   Delphi Problem mit Zeichnen im TImage (https://www.delphipraxis.net/103253-problem-mit-zeichnen-im-timage.html)

Adrian112 13. Nov 2007 11:17


Problem mit Zeichnen im TImage
 
Liste der Anhänge anzeigen (Anzahl: 2)
Hallo,

ich habe angefangen eine Art Paint-Clon zu proggen, hier meine Zeichenrotine:
Delphi-Quellcode:
procedure TForm1.FormCreate(Sender: TObject);
begin
DoubleBuffered := True;
Form1.WindowState := wsMaximized;
Image1.Align := alClient;
with Image1.Canvas do
 begin
  pen.mode:=pmNotXor; // Zeichnenmodus umschalten auf pmNotXor (Für die Gummilinie)
  Image1.canvas.pen.style:=pssolid;
  Pen.Width:=5;
  Pen.Color:=clGreen; // Grüne Stiftfarbe
 end;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if zeichnen then
     with Image1.Canvas do
       begin
        moveto(x_anfang,y_anfang);        

        if SpeedButton1.Down = true then
        begin lineto(x_ende,y_ende); end;

        If SpeedButton2.Down = true then
        begin rectangle(x_Anfang, y_anfang, x_ende, y_ende); end;

        if speedbutton3.Down = true then
        begin ellipse(x_Anfang, y_anfang, x_ende, y_ende); end;
       
       // neues Linienende
       x_ende:=x;
       y_ende:=y;
       // Neue Linie zeichnen
       moveto(x_anfang,y_anfang);
       
       if SpeedButton1.Down = True then
       begin lineto(x_ende,y_ende); end;

       If SpeedButton2.Down = True then
       begin rectangle(x_Anfang, y_anfang, x_ende, y_ende); end;

       if speedbutton3.Down = true then
       begin ellipse(x_Anfang, y_anfang, x_ende, y_ende); end;

       end;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 x_anfang:=x; y_anfang:=y;
  x_ende:=x; y_ende:=y;
  zeichnen:=true;

end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 zeichnen:=false;
end;
So, das funktioniert bis jetzt ja gut (Wenn ich im leeren Image zeichne), nur leider wird die linie wenn ein Bild im Image geladen ist nicht grün sondern (durch den pmNotXor Modus) irgendwie durchsichtig. Siehe Bild 2. Wie kann ich so etwas umgehen? Ich habe schon versucht im pmCopy Modus zu zeichnen, doch das kann ja nicht klappen! :wall:

@ Edit: Falsches Bild ersetzt

Progman 13. Nov 2007 12:01

Re: Problem mit Zeichnen im TImage
 
Kommentier mal die Zeile " pen.mode:=pmNotXor;" aus und schau, wies dann aussieht.

ChrisE 13. Nov 2007 12:08

Re: Problem mit Zeichnen im TImage
 
Hallo Adrian112,

siehe Delphi Hilfe:
Zitat:

pmNotXor
Komplementärfarbe zu pmXor: Kombination von Farbanteilen, die entweder nur im Stift oder nur im Hintergrund der Zeichenfläche enthalten sind, aber nicht in beiden
Es passiert genau das, was du Programmiert hast. Die Frage bleibt: Was willst du tatsächlich haben?
Soll die Farbe immer grün sein? Was passiert dann bei Bildern die grün mit drinne haben oder gar ganz grün sind :-)

Gruß, Chris

Adrian112 13. Nov 2007 12:27

Re: Problem mit Zeichnen im TImage
 
Ja, ich will einfach, das immer eine Linie in der von mir bestimmten Farbe gezeichnet wird, egal wie der Hintergrund / Vordergrund ist. Ich müsste vieleicht den Modus des Stiftes noch ändern können wenn die Linie Gezeichnet wird. Oder (probier ich grad mal aus) die Darstellung während des Zeichnens mit pmNotXor machen und dann vor den LineTo den Modus auf pmCopy setzen.

ChrisE 13. Nov 2007 13:11

Re: Problem mit Zeichnen im TImage
 
Hallo,

wenn ich Dein Problem richtig verstehe, dann liegt es daran, dass du ja beim Aufziehen des Rechecks das "alte" Rechteck löschen musst und das neue Zeichnen.

Folgender Vorschlag von mir:
1. OnMouseDown
Inhalt der aktuellen Darstellung in ein Bitmap zwischenspeichern per BitBlt o.ä.
2. OnMouseMove
a) Den Inhalt von der Darstellung wie sie in MouseDown war auf die Canvas zeichnen (z.B. per BitBlt :-) )
b) Den durch die User-Interaktion hinzugekommenen Inhalt dazu oben drauf zeichnen
3. OnMouseUp
Temporäres Bitmap wieder löschen

Das funktioniert ganz gut und ermöglicht einem auch ganz andere Möglichkeiten einen Rahmen auf zu ziehen (Stichwort AlphaBlending). Aber das nur am Rande.

Gruß, Chris

matashen 13. Nov 2007 13:35

Re: Problem mit Zeichnen im TImage
 
Due solltest alles erstmal ein wenig umstrukturieren.

1. erstelle für deine Zeichenoperationen eine eigene procedure um Zugriffe von verschiedenen Punkten des Programms aus machen zu können.

2. Lege die aktuelle einstellung des Zeichentools in eigenem Type ab. Erleichtert das erfassen und übergeben an andere Routinen.

Dann nimm nicht x_ende und X_Start für sowas gibts Point.

Definier dazu
Delphi-Quellcode:
Origin,MoveTo:TPoint;
Nimm z.B. bei Mousdown
Delphi-Quellcode:
Origin.x:=x;
Origin.y:=y;
MoveTo:=Origin;
zeichnen:=true;
Zeichne(Origin,Origin,pmnotxor);
Zeichne mußt du definieren
Delphi-Quellcode:
procedure Zeichne(Start,Ziel:TPoint; z_style:penstyle);
in mousemove
Delphi-Quellcode:
if zeichnen
then
Zeichne(Origin,MoveTo,pmnotxor);
MoveTo.x:=x
moveTo.y:=y;
Zeichne(Origin,MoveTo,pmnotxor);
und bei mouseup
Delphi-Quellcode:
if zeichnen then
Zeichne(Origin,MoveTo,pmcopy);
so in etwa wirds dann auch einfacher weitere sachen zu integrieren

Gruß Matthias

Progman 13. Nov 2007 14:18

Re: Problem mit Zeichnen im TImage
 
Hi nochmal.
Mal ein kleiner Hinweis:
Delphi-Quellcode:
   if SpeedButton1.Down = True then //macht man nicht!
    begin lineto(x_ende,y_ende); end;
Besser ist:
Delphi-Quellcode:
  if SpeedButton1.Down then lineto(x_ende,y_ende);
  else
  if SpeedButton2.Down then ...
Und als weiteren Vorschlag, so hab ich das mal gemacht:
Über das Image mit dem Bild ein zweites legen, das weiß ist und weiß ist auch die Transparenzfarbe des Images.
Transparent muss natürlich auf True. Dann kann man da drauf rummalen ;)
Die alten Linien mit weiß übermalen, die neue in der gewünschten Farbe... so als Denkanstoß :lol:

Adrian112 13. Nov 2007 15:06

Re: Problem mit Zeichnen im TImage
 
Danke für die guten Tipps (Ja, bei mir haperts noch weng mit der Codestrukturierung) und ich denke so werde ich das auch hinbekommen. :thumb:


Alle Zeitangaben in WEZ +1. Es ist jetzt 14:05 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz