mit folgenden proceduren kann ich ein polygone drehen:
(die RotatePoints habe ich nicht selbst geschrieben, sonder mir von http://www.delphifourm.de" onclick="window.open(this.href);return false; raußgesucht).
Code: Alles auswählen
procedure RotatePoints(var Points: array of TPoint;
const Angle: Extended; const Org: TPoint);
var
Sin, Cos: Extended;
Prime: TPoint;
I: Integer;
begin
SinCos(Angle, Sin, Cos);
for I := Low(Points) to High(Points) do
with Points[I] do
begin
Prime.X := X - Org.X;
Prime.Y := Y - Org.Y;
X := Round(Prime.X * Cos - Prime.Y * Sin) + Org.X;
Y := Round(Prime.X * Sin + Prime.Y * Cos) + Org.Y;
end;
end;
procedure DrawRect(var x,y,w,h,r:Integer; canvas:TCanvas;test:Boolean = False);
var
Daten:array of TPoint;
cosq,singq:Extended;i,xx,yy:Integer;
mx,my:Integer;
begin
SetLength(Daten,4);
Daten[0]:=Point(x,y); // Die Linke ecke(Oben)
Daten[1]:=Point(x+w,y); // Rechte ecke(Oben)
Daten[2]:=Point(x+w,y+h); // Rechte ecke(Unten)
Daten[3]:=Point(x,y+h); // Linke ecke(Unten)
if r > 0 then begin
mx:=x+(w) div 2;
my:=y+(h) div 2;
// form1.Caption:=IntTostr(mx) + '\' + IntTostr(my);
RotatePoints(Daten,DegToRad(r), point(mx,my));
if test = True then begin
x:=Daten[0].x; y:=Daten[0].y;
w:=Daten[2].x-w; h:=Daten[2].y-h;
end;
end;
canvas.Polygon(Daten);
end;
Normalerweise kein Problem.
sobalt ich ein Objekt drehe bleibt leider der Draq-Point leider nicht da wo er bleiben sollte !
(nur der in der linken oberen ecke bleibt).... ich weiß einfach nicht mehr weiter.
Das ist auch das erstmal das ich mich damit beschäftige.
hier ist der code:
Code: Alles auswählen
procedure TRoationRectEck.DrawPoints(x,y,w,h:Integer;fisSel:Boolean;Buffer:TBitmap);
var
px,py,pw,ph,t:Integer;
sx,sy,sw,sh:Integer;
begin
if fisSel = True then begin
if (isfocus) or (sel) then
buffer.canvas.Brush.color:=clBlack
else
if sel then buffer.canvas.Brush.color:=clred;
buffer.canvas.Pen.Style:=psSolid; buffer.canvas.Pen.color:=clYellow;
px:=x-5;
py:=y-5;
pw:=(w-x)+10;
ph:=(h-y)+10;
// Hintergrund Viereck Zeichnen
DrawRect(px,py,pw,ph,fRoation,buffer.canvas,True);
// pw:=pw-10; ph:=ph-10;
// px:=px-10; py:=py-10;
SizePoint[0]:=Rect(px,py,px+5,py+5); // Oben Lings
SizePoint[1]:=Rect(px,py+ph,px+5,py+ph-5); // Unten Lings
// writeLN(SizePoint[1].left,'\',SizePoint[1].top,'\', SizePoint[1].Right,'\',SizePoint[1].Bottom );
// SizePoint[2]:=Rect(pw,py,pw-5,py+5); // Oben Rechts
// SizePoint[3]:=Rect(pw,ph,pw-5,ph-5); // Unten Rechts
// Einzele punkte zeichnen
for t:=0 to High(SizePoint) do begin
if t = pointDrawMove then begin
Buffer.Canvas.Pen.Color:=clRed;
Buffer.Canvas.brush.Color:=clRed
end
else begin
Buffer.Canvas.brush.Color:=clYellow;
Buffer.Canvas.Pen.Color:=clYellow;
end;
sx:=SizePoint[t].Left;
sy:=SizePoint[t].top;
sw:=SizePoint[t].Right-sx;
sh:=SizePoint[t].Bottom-sy;
DrawRect(sx,sy,sw,sh,fRoation,buffer.canvas,False)
end;
end;
end; // TRoationRectEck.DrawPoints
(die Kommentare habe ich gelassen, damit ihr sieht was ich alles probiert habe)