Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Multimedia (https://www.delphipraxis.net/16-multimedia/)
-   -   Delphi Zeichenprogramm mit Drag & Drop (https://www.delphipraxis.net/26861-zeichenprogramm-mit-drag-drop.html)

hansklok 30. Jul 2004 12:35


Zeichenprogramm mit Drag & Drop
 
Liste der Anhänge anzeigen (Anzahl: 1)
Hallo Delphifreunde!
Heute habe ich mal eine ganz spezielle Frage: Ich erstelle ein Zeichenprogramm. Man kann, wie im Beispielordner das Programm GraphEx die geometrische Figur auswählen & diese dann auf die Zeichenfläche zeichnen. Das ist auch nicht das Problem, sondern das Problem ist: Wie kann ich alle gezeichneten Objekte per Drag & Drop, wie im Bild (im Anhang) zu sehen auf der Zeichenfläche verschieben und deren Eigenschaften (Füllfarbe, Strichmuster etc.) nachträglich ändern?

Hier habe ich auf jeden Fall schon einmal das Problem mit der Füllfarbe gelöst. Man wählt einfach über einen ColorDialog eine beliebige Farbe & geometrische Bereiche werden mit dieser gefüllt. Hier der Quellcode:

Delphi-Quellcode:
{Code-Beispiel wurde unter Delphi 7 Personal getestet}
procedure TForm1.Image1MouseDown(Sender: Tobject; Button: TMouseButton; Shift: TShiftState; X,Y: Integer);
var
   hilfe, farbe: TColor;
begin
   with Image1.Canvas do begin
      Pen.Color:= ColorDialog1.Color;
      Screen.Cursor:= crHourGlass;
      hilfe:= Brush.Color;
      Brush.Color:= Pen.Color;
      farbe:= Pixels[X,Y];
      FloodFill(X,Y, farbe, fssurface);
      Brush.Color:= hilfe;
      Screen.Cursor:= crDefault;
   end
end;
Nächste Frage: Ich habe den Quellcode für eine Funktion zum Drehen eines TImage. Kann ich irgendwie die nachfolgende Funktion auf jedes beliebige Objekt (Rechteck, Ellipse, Polygon etc.) übertragen? Dabei soll das Objekt, mit dem oben beschriebenem Problem markiert werden & dann am grünen Markierungspunkt (der im Bild zu sehen ist) gedreht werden.

Delphi-Quellcode:
procedure RotateBitmap(Dest, Source: TBitmap; Winkel: Extended;
  Hintergrund: TColor; GroesseAnpassen, ImUhrzeigersinn: Boolean);
var
  rw: Boolean;
  Breite: integer;
type
  PR = array[0..2] of byte;
//PR = array[0..3] of byte;
  FArray = array[0..32768] of PR;
  procedure WTest;
  begin
    while Winkel > 360 do Winkel := Winkel - 360;
    while Winkel < 0 do Winkel := Winkel + 360;
    if ImUhrzeigersinn then Winkel := 360 - Winkel;
  end;
  procedure SiCo(W: Extended; var S, C: Extended);
  asm
        FLD    W
        FSINCOS
        FSTP   TBYTE PTR [EDX]
        FSTP   TBYTE PTR [EAX]
        FWAIT
  end;
  function Maximum(M1, M2: Integer): Integer;
  begin
    if M1 > M2 then Result := M1 
    else Result := M2;
  end;
  procedure SC(WKL: Extended; var S, C: Extended);
  begin
    WKL := WKL * (PI / 180);
    SiCo(WKL, S, C);
  end;
var
  CT, ST: Extended;
  I, J, X, Y, DstW, DstH, SrcWD2, SrcHD2: Integer;
  SrcR, DstR: ^FArray;
begin
  Source.PixelFormat := pf24bit;
//Source.PixelFormat := pf32bit;
  Dest.PixelFormat := Source.PixelFormat;
  WTest;
  rw := frac(Winkel / 90) = 0;
  SC(Winkel, ST, CT);
  if GroesseAnpassen then begin
    if (ST * CT) < 0 then begin
      Dest.Width := Round(Abs(Source.Width * CT
        - Source.Height * ST));
      Dest.Height := Round(Abs(Source.Width * ST
        - Source.Height * CT));
    end
    else begin
      Dest.Width := Round(Abs(Source.Width * CT
        + Source.Height * ST));
      Dest.Height := Round(Abs(Source.Width * ST
        + Source.Height * CT));
    end;
  end else begin
    Dest.Width := Source.Width;
    Dest.Height := Source.Height;
  end;
  with Dest.Canvas do begin
    Brush.Style := bsSolid;
    Brush.Color := Hintergrund;
    FillRect(ClipRect);
  end;
  SrcWD2 := Source.Width div 2;
  if CT < 0 then Dec(SrcWD2);
  SrcHD2 := Source.Height div 2;
  if ST < 0 then Dec(SrcHD2);
  Breite := Maximum(Source.Width, Dest.Width) - 1;
  for J := 0 to Maximum(Source.Height, Dest.Height) - 1 do begin
    if rw then
      Y := Trunc(J - Dest.Height / 2 + 0.5) else
      Y := J - Dest.Height div 2;
    for I := 0 to Breite do begin
      if rw then
        X := Trunc(I - Dest.Width / 2) else
        X := I - Dest.Width div 2;
      DstW := Round(X * CT - Y * ST + SrcWD2);
      DstH := Round(X * ST + Y * CT + SrcHD2);
      if (DstH >= 0) and (DstH < Source.Height) and
        (J >= 0) and (J < Dest.Height) and
        (DstW >= 0) and (DstW < Source.Width) and
        (I >= 0) and (I < Dest.Width) then begin
        SrcR := Source.ScanLine[DstH];
        DstR := Dest.Scanline[J];
        DstR[I] := SrcR[DstW];
      end;
    end;
  end;
end;

//Aufruf
procedure TForm1.Button1Click(Sender: TObject);
var Bmp: TBitmap;
begin
  Bmp := TBitmap.create;
  RotateBitmap(Bmp, Image1.picture.bitmap, 53.7, clRed, True, False);
  Refresh;
  canvas.draw(10, 10, Bmp);
  Bmp.free;
end;
Gruss

axelf98 30. Jul 2004 12:56

Re: Zeichenprogramm mit Drag & Drop
 
Das ist leider nicht ganz so einfach... Die Funktion zum Drehen der Bilder bezieht sich auf Bitmaps. Ein Rechteck bei dir ist aber ein Vektorgebilde. Du hast 2 Möglichkeiten:
- Entweder konvertierst du deine Figuren in Bitmaps und drehst sie dann oder
- Drehst sie per Hand und gehst dann bei einem Reckeck mit LineTo() zu jeder Ecke. Das wird bei einer Ellipse aber schon schwieriger.


Alle Zeitangaben in WEZ +1. Es ist jetzt 06:45 Uhr.

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