Bei einem Gedrehten viereck Draq points zeichnen ?

Für Probleme bezüglich Grafik, Audio, GL, ACS, ...
Antworten
pluto
Lazarusforum e. V.
Beiträge: 7178
Registriert: So 19. Nov 2006, 12:06
OS, Lazarus, FPC: Linux Mint 19.3
CPU-Target: AMD
Wohnort: Oldenburg(Oldenburg)

Bei einem Gedrehten viereck Draq points zeichnen ?

Beitrag von pluto »

Hallo,
mit folgenden proceduren kann ich ein polygone drehen:
(die RotatePoints habe ich nicht selbst geschrieben, sonder mir von http://www.delphifourm.de 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;


Das drehen klappt wunder bar. Ich kann sogar ein Hintergrund zeichnen, jetzt möchte ich gerne in allen 8 ecken(4 ecken und die mitten jeweils) kleine punkte(Virecke zeichnen) zum vergrößern des objektes !

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


ich hoffe mein vorhaben ist klar....
(die Kommentare habe ich gelassen, damit ihr sieht was ich alles probiert habe)
MFG
Michael Springwald

pluto
Lazarusforum e. V.
Beiträge: 7178
Registriert: So 19. Nov 2006, 12:06
OS, Lazarus, FPC: Linux Mint 19.3
CPU-Target: AMD
Wohnort: Oldenburg(Oldenburg)

Beitrag von pluto »

ich habe es hinbekommen jetzt gibt es leidern noch einen Fehler mit der Mitte:
ich habe vier punkte Defniert und nun möchte ich auch noch jeweil die Mitte Belgen.

ich habe den code so umgeschrieben:

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;var outDaten:TTest;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(w,y); // Rechte ecke(Oben)
  Daten[2]:=Point(w,h); // Rechte ecke(Unten)
  Daten[3]:=Point(x,h); // Linke ecke(Unten)
 
//  if r > 0 then begin
    mx:=x+((w-x) div 2);
    my:=y+((h-y) 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; h:=Daten[2].y;
    outDaten:=Daten;
//       result.left:=Daten[0].x; result.top:=Daten[0].y;
  //     result.Right:=Daten[2].x; result.Bottom:=Daten[3].y;
    end;
//  end;
 
  canvas.Polygon(Daten);
end;
 
procedure TRoationRectEck.DrawPoints(x,y,w,h:Integer;fisSel:Boolean;Buffer:TBitmap);
var
  px,py,pw,ph,t,l:Integer;
  sx,sy,sw,sh:Integer;
  r:TTest;
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+5;
    ph:=h+5;
    // Hintergrund Viereck Zeichnen
    SetLength(r,4);
    DrawRect(px,py,pw,ph,fRoation,buffer.canvas,r,True);
 
    SizePoint[0]:=Rect(r[0].x,r[0].y,r[0].x+5,r[0].y+5); // Lings Oben
    SizePoint[1]:=Rect(r[1].x,r[1].y,r[1].x-5,r[1].y+5); // Rechts Oben
    SizePoint[2]:=Rect(r[3].x,r[3].y,r[3].x+5,r[3].y-5); // Lings Unten
    SizePoint[3]:=Rect(r[2].x,r[2].y,r[2].x-5,r[2].y-5); // Rechts Unten
 
    SizePoint[4]:=Rect(r[0].x+( (r[1].x-r[0].x) div 2),
                       r[0].y,
                       r[0].x+( (r[1].x-r[0].x) div 2)+5,
                       r[0].y+5); // Mitte Oben
 
 
    // Einzele punkte zeichnen
    for t:=0 to High(SizePoint) do begin
      Buffer.Canvas.brush.Color:=clYellow;
 
      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;
      sh:=SizePoint[t].Bottom;
      l:=0; // fRoation
      DrawRect(sx,sy,sw,sh,fRoation,buffer.canvas,r,False)
    end;
 
  end;
end; // TRoationRectEck.DrawPoints


jetzt wird leider die Mitte falsch berechnet wenn ich den fRoation ändere bei 0 klappt es wunderbar aber sobalt ich den wert auf 10 setzte verschiebt sich der punkt in der Mitte.

Warum weiß ich leider nicht !

ich hoffe euch ist klar worauf ich rauß möchte !
MFG
Michael Springwald

pluto
Lazarusforum e. V.
Beiträge: 7178
Registriert: So 19. Nov 2006, 12:06
OS, Lazarus, FPC: Linux Mint 19.3
CPU-Target: AMD
Wohnort: Oldenburg(Oldenburg)

Beitrag von pluto »

hat keiner einer Idee wie das gelöst werden kann ?
z.b. habe ich auch noch Probleme die Vierecke an Ecken richtig anzuzeigen !
die müsten sich eigentlich mit drehen aber das tun sie leider nicht *schnif*

dabei wollte ich diese funkion gerne für ein Spiel verwenden was ich plane !
MFG
Michael Springwald

Antworten