AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Multimedia Delphi Timage Rect und Canvas Position
Thema durchsuchen
Ansicht
Themen-Optionen

Timage Rect und Canvas Position

Ein Thema von usjr0070 · begonnen am 4. Nov 2013 · letzter Beitrag vom 6. Nov 2013
Antwort Antwort
usjr0070

Registriert seit: 5. Aug 2005
10 Beiträge
 
Delphi 7 Enterprise
 
#1

Timage Rect und Canvas Position

  Alt 4. Nov 2013, 23:38
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
Miniaturansicht angehängter Grafiken
320_479.jpg   709_472.jpg  
  Mit Zitat antworten Zitat
Blup

Registriert seit: 7. Aug 2008
Ort: Brandenburg
1.477 Beiträge
 
Delphi 12 Athens
 
#2

AW: Timage Rect und Canvas Position

  Alt 6. Nov 2013, 10:10
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);

Geändert von Blup ( 6. Nov 2013 um 12:34 Uhr)
  Mit Zitat antworten Zitat
usjr0070

Registriert seit: 5. Aug 2005
10 Beiträge
 
Delphi 7 Enterprise
 
#3

AW: Timage Rect und Canvas Position

  Alt 6. Nov 2013, 18:59
Hallo Blup,

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

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

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
Miniaturansicht angehängter Grafiken
nr3_709_472.jpg  
  Mit Zitat antworten Zitat
Antwort Antwort


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 11:52 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