Tshape (Dreieck) drehen?

[br_klaus]

Hallo,
gibt es eine Möglicheit, ein TShape zu drehen?
Ich möchte gerne auf allen 4 Seiten meiner TImage außerhalb des Randes ein kleines Dreieck mit der Spitze nach innen an der jeweiligen Cursorposition mitlaufen lassen (besser als ein Mauskreuz). Aber wenn ich dazu die Dreiecksform des TShape benutze, gibt es da nur eine Form: Spitze nach oben. Wie kann man das ändern?
Habe es schon versucht mit shape1.Canvas.Polygon() oder shape1.canvas.draw(0,0,bmp) (Bitmap in Form des Dreiecks), da ändert sich nichts an der Grundform. Das einzige, was ich bisher ändern kann, ist die Farbe, die Dreiecks-Form bleibt sich immer gleich.
Weiß jemand eine Hilfe?
Herzlichen Dank!
P. Nikolaus

[corpsman]

Wenn man sich die OnPaint Routine von TShape ansieht, dann siehts nicht gut aus für dich...

Code: Alles auswählen

procedure TShape.Paint;
var
  PaintRect: TRect;
  MinSize: Longint;
  P: array[0..3] of TPoint;
  PenInc, PenDec: Integer;
begin
  with Canvas do
  begin
    Pen := FPen;
    Brush := FBrush;
 
    PenInc := Pen.Width div 2;
    PenDec := (Pen.Width - 1) div 2;
 
    PaintRect := Rect(PenInc, PenInc, Self.Width - PenDec, Self.Height - PenDec);
    with PaintRect do
    begin
      MinSize := Min(Right - Left, Bottom - Top);
      if FShape in [stSquare, stRoundSquare, stCircle, stSquaredDiamond] then
      begin
        Left := Left + ((Right - Left) - MinSize) div 2;
        Top := Top + ((Bottom - Top) - MinSize) div 2;
        Right := Left + MinSize;
        Bottom := Top + MinSize;
      end;
    end;
 
    case FShape of
      stRectangle, stSquare:
        Rectangle(PaintRect);
      stRoundRect, stRoundSquare:
        RoundRect(PaintRect, MinSize div 4, MinSize div 4);
      stCircle, stEllipse:
        Ellipse(PaintRect);
      stSquaredDiamond, stDiamond:
      begin
        with Self do
        begin
          P[0].x := PenInc;
          P[0].y := (Height - 1) div 2;
          P[1].x := (Width - 1) div 2;
          P[1].y := PenInc;
          P[2].x := Width - PenInc - 1;
          P[2].y := P[0].y;
          P[3].x := P[1].x;
          P[3].y := Height - PenInc - 1;
          Polygon(P);
        end;
      end;
      stTriangle:
      begin
        with Self do
        begin
          P[0].x := (Width - 1) div 2;
          P[0].y := PenInc;
          P[1].x := Width - PenInc - 1;
          P[1].y := Height - PenInc - 1;
          P[2].x := PenInc;
          P[2].y := Height - PenInc - 1;
          P[3].x := P[0].x;
          P[3].y := P[0].y;
          Polygon(P);
        end;
      end; 
    end;
  end;
  // to fire OnPaint event
  inherited Paint;
end;

Ich würde mal vorschlagen, leite von TShape ab und bastle dir das Triangle geschwind selbst dazu ..

[pluto]

Ich kann mir nicht vorstellen, dass das mit einer TShape geht. Du musst es schon selbst machen oder du verwendest einfach eine Funktion aus der Unit: extgraphics. Schau die mal an.

Alle Funktionen dort erwarten ein Canvas. Du könntest z.b. ein TImage nehmen. Wäre das einfachste.

[Socke]

Ich würde mal vorschlagen, leite von TShape ab und bastle dir das Triangle geschwind selbst dazu ..

Wärs nicht schneller, wenn man im OnPaint-Event einfach das Dreieck nochmal übermalt?

[pluto]

Wärs nicht schneller, wenn man im OnPaint-Event einfach das Dreieck nochmal übermalt?

Das wäre ja doppelte Belastung für die CPU. Wie wäre es einfach mit vier Grafiken? Die man in ein TImage lädt.

[u-boot]

Das stTriangle habe ich verbrochen. Zugegebenermaßen ist es für ein Dreieck sehr starr. Aber Rechtecke usw. von TShape kann man ja auch nicht drehen oder nicht rechtwinkliges Parallelogramm draus machen.
Der Grund warum es das Dreieck so gibt, ist dass es beim TShape im Symbol drin ist. Delphi kennt meines Wissens kein stTriangle, obwohl das Symbol 'sehr ähnlich' ist. Kann aber sein die leute streiten sich darum, ob es nicht ein Halbverdecktes Karo darstellen soll in dem Symbol.

[br_klaus]

Nch fruchtlosen Versuchen mit TShape (mir ist es nicht gelungen, von TShape abzuleiten, vielleicht kann mir da jemand helfen?) bin ich auf TPaintBox umgestiegen. Da funktioniert es!
Aber wie kann man das Flimmern unterbinden, wenn diese sehr rasch über den Bildschirm gezogen wird?

Code: Alles auswählen

procedure TForm1.PaintBox1Paint(Sender: TObject);
   var p:array of TPoint;
 begin setlength(p,4);
    with PaintBox1 do  // Dreieck mit Spitze nach rechts
     begin
       canvas.pen.color:=clred; // farbiger Rand um das Dreieck
       color:=clblack; // schwarz ausgefüllt
       p[0]:=point(0,0); p[1]:=point(width, height div 2);
            p[2]:=point(0,height); p[3]:=p[0];
            canvas.polygon(p);
     end;
end;

@u-boot:

Habe versucht, in die "Innereien" von Lazarus einzudringen und bei der Definition von TShape drei weitere Dreiecksarten anzufügen. Erst in ExtCtrls die TshapeType erweitert auf

Code: Alles auswählen

TShapeType = (stRectangle, stSquare, stRoundRect, stRoundSquare,
    stEllipse, stCircle, stSquaredDiamond, stDiamond, stTriangle,
    stTriangleU, stTriangleR, stTriangleD, stTriangleL);
    // Triangle points to  Up, Right, Down, Left

dann in Shape.inc die Fälle case FShape of ... entsprechend erweitert:

Code: Alles auswählen

stTriangle,stTriangleU:
      begin
        with Self do
        begin
          P[0].x := (Width - 1) div 2;
          P[0].y := PenInc;
          P[1].x := Width - PenInc - 1;
          P[1].y := Height - PenInc - 1;
          P[2].x := PenInc;
          P[2].y := Height - PenInc - 1;
          P[3].x := P[0].x;
          P[3].y := P[0].y;
          Polygon(P);
        end;
      stTriangleL:
      begin
        with Self do
        begin
          P[0].x := Width - 1- penInc;
          P[0].y := Height -1 - PenInc;
          P[1].x := Width - PenInc - 1;
          P[1].y := PenInc;
          P[2].x := PenInc;
          P[2].y := (Height - 1) div 2;
          P[3].x := P[0].x;
          P[3].y := P[0].y;
          Polygon(P);
        end;
      stTriangleD:
      begin
        with Self do
        begin
          P[0].x := PenInc;
          P[0].y := PenInc;
          P[1].x := Width - PenInc - 1;
          P[1].y := PenInc;
          P[2].x := (Width - 1) div 2;
          P[2].y := Height - PenInc - 1;
          P[3].x := P[0].x;
          P[3].y := P[0].y;
          Polygon(P);
        end;
      stTriangleR:
      begin
        with Self do
        begin
          P[0].x := PenInc;
          P[0].y := PenInc;
          P[1].x := Width - PenInc - 1;
          P[1].y := (Height - 1) div 2;
          P[2].x := PenInc;
          P[2].y := Height - PenInc - 1;
          P[3].x := P[0].x;
          P[3].y := P[0].y;
          Polygon(P);
          end;
      end;

Im Programm selbst wollte ich angeben:

Code: Alles auswählen

shape1.shape := stTriangleR;

Das hat der Compiler nicht akzeptiert (unbekannter Wert), erst als ich schrieb

Code: Alles auswählen

shape1.shape := TshapeType(byte(stTriangle)+2)

hat er es akzeptiert. Er geht dann auch zu dem entsprechenden case of Fshape, aber
- das Shape verschwindet völlig!

Leider kann man die Änderungen auch nicht im Objectinspector sehen.



?????????????????????????????????????????????????????????????????????????????????????????????????????????????????????

Wie macht man das überhaupt, eine eigene Komponente im Objectinspector anzeigen zu lassen?

?????????????????????????????????????????????????????????????????????????????????????????????????????????????????????



Ich hätte den Vorschlag, den TShapeType noch um stNone zu erweitern und in TShape zwei Variablen anzufügen (und dazu die entsprechenden Properties):

Code: Alles auswählen

FPoints: TPoints // = array of TPoint;
  FCount: integer //Anzahl der TPoints für ein beliebiges Polygon)
  procedure SetShape(pp:TPoints) // TPoints mit Prozentangaben von Breite bzw Höhe

mit

Code: Alles auswählen

procedure TShape.SetShape(pp:ppoints);
  var i:integer;
  begin FCount:= length(pp)+1;   // falls pp[count-1] <> pp]0]
          setlength(FPoints, FCount);
          for i:=0 to FCount-2 do 
          begin
              FPoints[i].x := round(pp[i].x*(width-1)/100) + byte(pp[i].x<50)*peninc - byte(pp[i].x>50)*peninc;
              FPoints[i].y := round(pp[i].y*(height-1)/100) + byte(pp[i].y<50)*peninc - byte(pp[i].y>50)*peninc;
          end;
          FPoints[FCount-1]:=pp[0];   
 end;

sodaß dann bei case of Fshape = stNone mit diesen TPoints das Polygon erstellt wird:

Code: Alles auswählen

stNone:
      begin
        with Self do
        begin if FPoints<> nil then
          Polygon(FPoints);
        end;
      end;

und sonst fpoints auf length=0 und nil setzen.

[pluto]

Das Flimmern kannst du meiner Meinung nach am einfachsten verhindern, wenn du ein TImage verwendest, oder selbst zuerst in ein Buffer zeichnest. z.b. von Typ TBitMap.

[br_klaus]

@Pluto:

Wie mache ich so etwas?
Ich habe ja schon ein TImage auf der Form (form1.image) und möchte außerhalb dessen die Dreiecke mit dem Cursor mitlaufen lassen, solange der innerhalb des image ist.
Ich bräuchte also zwei Prozeduren:
getBitmap(x,y,w,h:integer; var tmp) --> die FormPixel[x+i,y+j] (j=0..h-1,i=0..w-1) in den Puffer tmp übertragen.
putBitmap(x,y,w,h:integer; var buffer; alles:boolean) --> die BufferPixel[i,j], (wenn alles=false, dann soweit sie <> weiß) nach FormPixel[x+i,y+j]

Die erste dient dient zum Sichern der originalen Pixel auf der Form, die zweite zum Zeichnen des Dreiecks bzw Wiederherstellung der OriginalPixel, sobald sich die Cursorposition ändert.
Wie läßt sich das programmieren?

Ich denke, in etwa so:

Code: Alles auswählen

procedure Form1.ImageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); 
  const oldx:integer = 0; oldy:integer=0;
  begin if (oldx=0) or (oldy=0) then
       begin getBitmap(x,y,w,h,tmp); oldx:=x; oldy:=y; end;
 
       putBitmap(oldx,oldy,w,h,tmp, true); // altes Original wiederherstellen
       getBitmap(x,y,w,h,tmp); // neues Original speichern
       putBitmap(x,y,w,h,buffer,false); // Dreieck zeichnen
       oldx:=x; oldy:=y;
  end;

Jetzt müßte ich nur wissen, wie ich die Prozeduren programmiere. Mit Form1.canvas.pixel[x,y] ginge es einfach, aber vielleicht gibt es eine schnellere Methode? Wie würde man da eine TBitmap einbauen?

[br_klaus]

@Pluto:

Ich habe einen kleinen Fehler gemacht. Die Position ist natürlich nicht (x,y) sondern außerhalb der image, also (Position (xx,yy) in form1):
xx = x+image.left-w\2 und yy = image.top-3-h bzw yy = image.top+image.height+3 für die beiden waagerechten Ränder (Pfeil nach unten bzw oben), bzw.
yy = y+image.top-h\2 und xx = image.left-3-w bzw. xx = image.left+image.width+3 für senkrecht (Pfeil nach rechts bzw links).
Und für die Buffer könnte man PColorArray nehmen (=^array[word] of TColor) oder PFPColorArray (für 32 Bit TFPColor).

[pluto]

heißt, dass jetzt, dass das Problem gelöst ist? Oder gibt es noch unklarheiten?

Mach mal folgendes:

Code: Alles auswählen

Buffer:TBitmap;
 
//  z.b. bei onFromeCreate
  Buffer:=TBitmap.create;
 
// z.b. bei onresize
 
// Kann sein, dass ich mich hier verschrieben habe
  Buffer.widht:clientwidht;
  Buffer.height:clientheight;
 
// Z.B. bei FromMouseMove 
    buffer.canvas.fillrect(0,0,clientwidht, clientheigt); 
 
    buffer.canvas.brush.color:=clRed; // Damit etwas gesehen werden kann
    buffer.canvas.fillrec(x,y,x+20,y+20);
    buffer.canvas.brush.color:=clwhite;
//  Jetzt braucht es nur noch Sichtbar gemacht zu werden:
  Form1.Canvas.draw(x,y,buffer);

Hinweis: Den Code habe ich nicht getestet. Es kann sein, dass es kleinere Rechtschreib Fehler gibt. Er soll auch nur als Vorlage Verwendung finden.

[br_klaus]

heißt, dass jetzt, dass das Problem gelöst ist? Oder gibt es noch unklarheiten?

Ja, leider funktioniert das nicht mit Form1.canvas.pixels[]. Wenn ich da darauf zugreifen will, erscheint die Meldung Canvas Draw not allowed (obwohl Canvas.line() ohne weiteres geht, da verstehe ich nicht so ganz den Unterschied...).
Ich hab´s dann versucht mit var formIntf:TLazintfImage in der Größe der form1 (.setsize()), und da mit formintf.pixels[]. Immerhin konnte ich die Pixel lesen, aber auch nicht darauf zuweisen (ergab SSEGV-Fehler oder so ähnlich).

Aber nun zu Deinem Vorschlag: was ist denn Clientheight, und wie zeige ich jetzt das Dreieck mit Hilfe des Buffers an? Es sollen ja, genau wie beim Cursor, nur die Pixel zugedeckt werden, die vom Dreieck benötigt werden. Geht das dann mit einem anderen Buffer? und dort mit buffer.canvas.polygon(), oder wie? Mit FillRect zeichne ich ja nur ein Rechteck. Wie kann ich in die TBitmap einzelne Pixel schreiben?

Und ich sehe auch nicht, daß da irgendwo die originalen Pixel gespeichert werden, die dann ja benutzt werden müssen, um wieder den alten Zustand herzustellen, sobald das Dreieck weitergewandert ist. Bräuchte ich da nicht auch wenigstens 2 Buffer (einen zum Speichern und Wiederherstellen des Originals, den anderen zum Zeichnen des Dreiecks)?

[Maik81ftl]

Hmmm Drehbares Dreieck würde ich mit den Befehlen MoveTo und LineTo realisieren. und um die Drehung hinzubekommen, ggf. ein acr in weiß drumlegen.

[br_klaus]

Was ist denn ein acr in Weiß, und wie macht man das, den "drumlegen2?

[u-boot]

Für frei drehbare Dreiecke:

Wegen dem Flimmern würde ich die Technik aus folgendem Beispiel probieren:
http://www.swissdelphicenter.ch/torry/showcode.php?id=429

Wenn da die Komponentenform stört, würde ich das mit shapedcontrols versuchen.
Dabei bitte noch folgendes beachten: http://bugs.freepascal.org/view.php?id=18911


Wegen Veränderung von TShape:
Wenn es darum geht, das TShape zu verändern, wirst du schlichtweg vergessen neu zu kompilieren. Die Veränderungen die zu stTriangle nötig waren, sind in einem kleinen Patch im Bugtracker zu finden.

An böse Konstrukte wie

shape1.shape := TshapeType(byte(stTriangle)+2)

kann ich mich nun gar nicht erinnern. War alles ganz einfach, bis auf irgendwelche Leute davon zu überzeugen, den Patch in Lazarus wirklich zu übernehmen. Meine rein persönliche Einschätzung ist, dass die Entwickler nicht wirklich Freude dran hätten, wenn man ihnen noch paar hundert Shapemöglichkeiten als Patch anbieten würde.