Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Multimedia (https://www.delphipraxis.net/16-multimedia/)
-   -   Delphi TImage Canvas merkwürdiges Verhalten (https://www.delphipraxis.net/177776-timage-canvas-merkwuerdiges-verhalten.html)

Blamaster 26. Nov 2013 17:35

TImage Canvas merkwürdiges Verhalten
 
Liste der Anhänge anzeigen (Anzahl: 2)
Hi,

für ein aktuelles Projekt leite ich eine Klasse von TImage ab und erweiter sie um ein paar Funktionen.
Allerdings bin ich dabei auf ein Problem gestoßen das sich mir einfach nicht erklären will.

Delphi-Quellcode:
unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TForm2 = class(TForm)
    btn1: TButton;
    procedure btn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  TTextElement = class(TImage)
  private
    FTxt: string;
    procedure RepaintElement;
  public
    //
    constructor Create(txt: string);
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

constructor TTextElement.Create(txt: string);
begin
  inherited Create(nil);
  FTxt := txt;

  RepaintElement;
end;

procedure TTextElement.RepaintElement;
var
  x, y: integer;
begin
  //Canvas.Font.Name := 'Arial'; // uncomment this line to produce failure

  // Resize Image
  Width := 200;
  Height := 120;

  Canvas.Brush.Color := clBtnShadow;
  Canvas.FillRect(ClientRect);
  Canvas.Brush.Color := clWindow;
  Canvas.FillRect(Rect(3, Height - 3, Width - 3, 3));

  Canvas.Pen.Color := clBtnShadow;
  Canvas.Brush.Color := clBtnShadow;
  Canvas.Brush.Style := bsClear;
  Canvas.Font.Name := 'Arial';
  Canvas.Font.Style := [fsBold];

  // Write text to canvas
  x := (Width - Canvas.TextWidth(FTxt)) div 2;
  y := (Height - Canvas.TextHeight(FTxt)) div 2;
  Canvas.TextOut(x, y, FTxt);

  Canvas.Font.Color := clBlack;
end;

procedure TForm2.btn1Click(Sender: TObject);
var
  element: TTextElement;
begin
  element := TTextElement.Create('test');
  element.Parent := Self;
end;

end.
Lässt man die Zeile "Canvas.Font.Name := 'Arial';" in der obersten Zeile der RepaintElement procedure auskommentiert Funktioniert alles so wie es soll. Kommentiert man die Zeile allerdings ein, dann wird die Größe mit Width und Hight scheinbar nicht mehr korrekt gesetzt. Zumindest ist die Grafik dann keine 200px breit und wirkt abgeschnitten.

Im Anhang zwei Bilder einmal mit ein- und einmal mit aukommentierter Zeile.

Jemand eine Idee wo das Problem liegt ?

himitsu 26. Nov 2013 19:06

AW: TImage Canvas merkwürdiges Verhalten
 
Bei Zugriff auf das Canvas wird intern das Bitmap schon erstellt
und war mit der Größe der TImage-Komponente.

Width und Height ändert aber nur die Größe der Kompoente und nicht des Bitmaps.

Die Zugriffe danach erstellen also, aber nur, wenn es vorher nicht schon erstlelt wurde, das interne Bitmap, mit der neu gesetzen Größe.

Lösung:
- entweder auch die Größe des internen Bitmaps anpassen (Graphic.Width)
- oder auch den Font erst setzen, nachdem die Größe geändert wurde

Ich würde aber zu Ersterem raten.

Blamaster 26. Nov 2013 20:03

AW: TImage Canvas merkwürdiges Verhalten
 
Super funktioniert vielen Dank :)


Alle Zeitangaben in WEZ +1. Es ist jetzt 13:02 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