Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Multimedia (https://www.delphipraxis.net/16-multimedia/)
-   -   Delphi Timage Rect und Canvas Position (https://www.delphipraxis.net/177400-timage-rect-und-canvas-position.html)

usjr0070 4. Nov 2013 22:38

Timage Rect und Canvas Position
 
Liste der Anhänge anzeigen (Anzahl: 2)
Hallo Delphi Gemeinde,
vielleicht kann mir hierbei einer einen Tipp geben.

Folgendes Problem.

Ich lade in ein Timage (Größe 320 x 479 -- Bild1) aus Platzgründen ein Bild(Originalgröße 472 x 709-- Bild2) das dann Proportional und Center dargestellt wird.
Darüber befindet sich ein Panel, in diesem sich auch ein TImage befindet.Aus der Procedure unten schreibe ich dann mit
DrawOutlinedText einen oder mehrere Buchstaben in das Timage des Panels.Wenn nötig kann ich die Buchstaben vorher auch drehen und spiegeln.
Das klappt so weit, so gut. Wenn ich das Panel bewege oder die Größe ändere funktioniert das auch. Der oder die Buchstaben werden dann
in das untere TImage an der richtigen Position eingefügt.

Dieses TImage (Größe 320 x 479) verliert ja an Qualität und so habe ich mir gedacht,da ja das ganze auch wieder gespeichert werden soll
lege bei laden noch ein Timage(savepic 472 x 709) unsichtbar an und schreibe dann wenn die Benutzerin per DrawOutlinedText Text einfügt, auch
den Text in das Canvas des Timage Proportional an die Position ein.

Tja und ab dann habe ich das Problem, ich müsste das Rect und Mysize siehe unten
Proportional anpassen. Der erste Buchstabe siehe Bild 2 wird im Moment fast so wie im verkleinerten Timage positioniert.
Die Proportion müsste wahrscheinlich auch angepasst werden. Nur sicher bin ich nicht.

Und wenn die Panelposition verändert wird geht das schief mit
dem Positionieren... auf dem großen TImage ... siehe unten



Delphi-Quellcode:
var
  pp,r,t: TRect;
  MyFont : TFont ;
  b: TBitmap;
  h,w:integer;
  estr: string;
  tx, ty ,rx,ry, fx,fy: Integer;
  P: TPoint;
begin
  P := Point(imglevel1.Left, imglevel1.Top); // imglevel1 liegt im Panel und kann verschoben werden.

  {Button1's coordinates are expressed relative to it's parent. Using Parent.ClientToScreen converts
   these client coordinates to screen coordinates, which are absolute, not relative.}

  P := imglevel1.Parent.ClientToScreen(P);

  {Using ScreenToClient here is the same as Self.ScreenToClient. Since Self is the current instance
  of TForm1, this statement converts the absolute screen coordinates back to coordinates relative to Self.}

  P := ScreenToClient(P);

  estr:=edit1.Text; //Buchstabe der eingefügt wird
  b := TBitmap.Create;
  b.PixelFormat:=pf24bit;
  b.Width := 472;
  b.Height := 709;

  pp := imglevel1.BoundsRect;//.ClientToScreen(Point(0,0));

  r:=imglevel0.ClientRect;
  t:=savepic.ClientRect;

  tx := ((t.Right - t.Left) div 2) - (b.Canvas.TextWidth(estr) div 2) ;
  ty := ((t.Bottom - t.Top) div 2) - (b.Canvas.TextHeight(estr) div 2);

  rx := (Pp.Right - Pp.Left) div 2 ;
  ry := (Pp.Bottom - Pp.Top) div 2 ;

  fx := ((p.x + Round(rx*2.54)) *  472) div 320   ;
  fy := ((p.y + Round(ry*2.54)) *  709) div 479   ;

  // falls benötigt:
  MyFont := TFont.Create;
  try
    with MyFont do
    begin
      Name := MyFontName;//'Pirate';
      color := myColor; //'clred'
      style := style + mystyle; //nichts
      size := mysize //(mysize *  320) div 472 ; //240 px beim Start imglevel1 im savepic 162 px [COLOR="Red"][B]<---- das hier bekomme ich nicht hin[/B][/COLOR]
    end;

   //ShowMessage(Format('x: %d, y: %d, rx: %d, ry: %d, fx: %d, fy: %d, size: %d, tx: %d, ty: %d, p.x: %d, p.y: %d', [P.X, P.Y,rx,ry,fx,fy,(mysize *  320) div 472,tx,ty,p.x,p.y]));
   //showmessage(format('rx: %d, ry: %d',[ry-(rx-(p.y)+20) ,rx+(ry-(p.y)-20)]));

   DrawOutlinedText (savepic.Picture.Bitmap.Canvas, // Orginalbild
                    rect(ry-(rx-(p.y)+20) ,rx+(ry-(p.y)-20) , fx ,fy),  //    [COLOR="Red"][B]<---- das hier bekomme ich nicht hin[/B][/COLOR]
                    estr, // Buchstabe der ausgegeben wird-
                    myFont,//'Pirate'
                    imfill.Canvas.Brush.Color, //clred
                    imboard.Canvas.Brush.Color, // clblack
                    strtoint(edit2.text)); // Rahmenstärke Start=2

   finally
     MyFont.Free;
     b.Free;
  end;
Ich würde mich über jeden Tipp freuen.

Mfg
Jürgen

Blup 6. Nov 2013 09:10

AW: Timage Rect und Canvas Position
 
Ungetestet:
Delphi-Quellcode:
{ImgLevel0}
dx0 := ImgLevel0.Picture.Bitmap.Width;
dy0 := ImgLevel0.Picture.Bitmap.Height;
dx1 := ImgLevel0.ClientWidth;
dy1 := ImgLevel0.ClientHeight;

{Den tatsächlichen Zoomfaktor bestimmen.}
zx := dx1/dx0;
zy := dy1/dy0;
z := IfThen(zx < zy, zx, zy);

{Die Größe der Abbildung auf dem Bildschirm.}
dx := Round(z * dx0);
dy := Round(z * dy0);

{Die Position der Abbildung auf dem Image.}
p0.x := (dx1 - dx) div 2;
p0.y := (dy1 - dy) div 2;

{Umrechnung in Bildschirmkoordinaten}
p0 := ImgLevel0.ClientToScreen(p0);

{ImgLevel1}
p1 := ImgLevel1.ClientRect.TopLeft;
dx := ImgLevel1.ClientWidth;
dy := ImgLevel1.ClientHeight;

{Umrechnung in Bildschirmkoordinaten}
p1 := ImgLevel1.ClientToScreen(p1);

{p0 wird zum Koordinatenursprung(0,0) für p1}
p1.x := p1.x - p0.x;
p1.y := p1.y - p0.y;

{Zoom von ImgLevel1 auf ImgLevel0.Picture.Bitmap}
p1.x := Round(p1.x / z);
p1.y := Round(p1.y / z);
dx  := Round(dx / z);
dy  := Round(dy / z);

{Das Rechteck für die Ausgabe.}
savepic.Picture.Bitmap.Canvas.Rect(p1.x, p1.y, p1.x + dx, p1.y + dy);

usjr0070 6. Nov 2013 17:59

AW: Timage Rect und Canvas Position
 
Liste der Anhänge anzeigen (Anzahl: 1)
Hallo Blup,

danke erst mal für deine schnelle Hilfe.
Also deine Routine scheint so wie gewollt zu laufen wenn ich verschiedene Positionen mit

Delphi-Quellcode:
savepic.Picture.Bitmap.Canvas.DrawFocusRect(rect(p1.x, p1.y, p1.x + dx, p1.y + dy));


durchlaufe sieht das ganze sehr gut aus, nur wenn ich dein Rect nochmal durch meine DrawOutlinedText laufen lass ist das Blödsinn.
Also dachte ich mit

Delphi-Quellcode:
savepic.Canvas.CopyRect(rect(p1.x, p1.y, p1.x + dx, p1.y + dy),imglevel1.Picture.Bitmap.Canvas,rect(p1.x, p1.y, p1.x + dx, p1.y + dy));

könnte ich das Problem lösen aber ich bekomme das nicht gebacken.
Siehe Bild und die Transparenz ist auch hin

Noch nee Idee ?

Mfg
Jürgen


Alle Zeitangaben in WEZ +1. Es ist jetzt 11:55 Uhr.

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