Copiar TLabel.Canvas sobre TBitmap.Canvas
 

Hola,

Necesito escribir un texto en un bitmap en vertical, centrado, la fuente en posición natural, no girada y grabarlo en disco como fichero bmp.

El texto quedaría así:

T

E

X

T

O

Resulta que si creo un TLabel en tiempo de diseño y le doy los ajustes necesarios para que se vea tal cual puedo copiar sin problemas su Canvas sobre un TBitmap creado en tiempo de ejecución. Pero si creo el TLabel en tiempo de ejecución esto no funciona.

El código es el siguiente:

bmp := tbitmap.Create;
bmp.Width := label2.Width; // label2 creada en tiempo de diseño y con el formato descrito
bmp.Height := label2.Height;
rect1 := rect(0,0,label2.width,label2.height);
rect2 := rect1;
bmp.canvas.CopyRect(rect1,label2.Canvas,rect2);
Bmp.SaveToFile('c:\Label.bmp');
bmp.free;

Pero si Label2 la creo en tiempo de ejecución esto no funciona (lease LabelTxt como Label2)

LabelTxt := TLabel.Create(nil);
LabelTxt.Parent := FrmMain; // <- Es esto correcto?
LabelTxt.Alignment := taCenter;
LabelTxt.Layout := tlCenter;
LabelTxt.AutoSize := True;
LabelTxt.Transparent := False;
LabelTxt.Font.Name := 'Arial';
LabelTxt.Font.Size := 30;
LabelTxt.Font.Color := clBlack;

LabelTxt.Caption := 'H'+#13#10+'O'+#13#10+'L'+#13#10+'A';

Algo hago mal evidentemente pero qué es?


Salut!

Hola @CSE1970.


Por favor cuando incluyas código en tus mensaje utiliza TAG's para darle más legibilidad:



De este modo se guarda correctamente:

Código Delphi [-]
... 
implementation

var
  LabelX : TLabel;

procedure TFrmMain.btnCreateLabelClick(Sender: TObject);
begin
  LabelX := TLabel.Create(Self);
  with LabelX do
  begin
    Name        := 'LabelX';
    Alignment   := taCenter;
    Layout      := tlCenter;
    AutoSize    := True;
    Transparent := False;
    Font.Name   := 'Arial';
    Font.Size   := 30;
    Font.Color  := clBlack;
    Caption     := 'H'+#13#10+'O'+#13#10+'L'+#13#10+'A';
    Parent      := FrmMain;
  end;
end;

procedure TFrmMain.btnSaveLabelClick(Sender: TObject);
var
  R1 : TRect;
begin
  if Assigned(LabelX) then
    with TBitmap.Create do
    try
      Width  := LabelX.Width;
      Height := LabelX.Height;
      R1     := Rect(0, 0, LabelX.Width, LabelX.Height);
      Canvas.CopyRect(R1, LabelX.Canvas, R1);
      SaveToFile(ExtractFilePath(Application.ExeName) + 'LABEL.BMP');
    finally
      Free;
    end;
end;

Saludos :)

Muchas gracias ecfisa. Tu código funcionó bien.