Einzelnen Beitrag anzeigen

hansklok

Registriert seit: 14. Apr 2004
Ort: Karlsruhe
318 Beiträge
 
Delphi 2010 Architect
 
#1

Zeichenprogramm mit Drag & Drop

  Alt 30. Jul 2004, 13:35
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
Miniaturansicht angehängter Grafiken
grafik.png  
  Mit Zitat antworten Zitat