如何以编程方式改变Firemonkey控制字体属性(How to programmatically

2019-07-05 08:07发布

站内文章 / 后端开发
73 0 0

我有一些代码，绘制了一组放在一个TImage中的顶级控件。 然后我抢的TImage的MakeScreenshot要保存的文件。 现在，这完美的作品。 什么我现在挣扎是改变一个或多个标签/文本样式控件的字体属性。 不管我怎么努力，标签不改变。 下面是我的示例代码： - 

procedure TfrmSnapshot.Process;
var
  LRect1, LRect2, LRect3, LRect4: TRectF;
  X, Y, W, H: Integer;

begin
//
X := Round(Label1.Position.X);
Y := Round(Label1.Position.Y);
W := Round(X + Label1.Width);
H := Round(Y + Label1.Height);
LRect1.Create(X, Y, W, H);

X := Round(Label2.Position.X);
Y := Round(Label2.Position.Y);
W := Round(X + Label2.Width);
H := Round(Y + Label2.Height);
LRect2.Create(X, Y, W, H);

X := Round(Label3.Position.X);
Y := Round(Label3.Position.Y);
W := Round(X + Label3.Width);
H := Round(Y + Label3.Height);
LRect3.Create(X, Y, W, H);

X := Round(Rect1.Position.X);
Y := Round(Rect1.Position.Y);
W := Round(X + Rect1.Width);
H := Round(Y + Rect1.Height);
LRect4.Create(X, Y, W, H);

Label1.Text := fTitle;
Label1.Font.Size := 40.0;
Label2.Text := fSub;
Label3.Text := fSite;

With imgSnap.Bitmap Do
Begin
  Label1.Font.Size = 40; //Does not work
  Label1.Font.Family = 'Arial'; //Does not work
  Label1.PaintTo(Canvas, LRect1);
  Label2.PaintTo(Canvas, LRect2);
  Label3.PaintTo(Canvas, LRect3);
  Rect1.PaintTo(Canvas, LRect4);
End;

imgSnap.MakeScreenshot.SaveToFile('test.jpg');
end;

如何设置标签的字体，使他们正确地画，并因此包括在画面？

问候Anthoni

Answer 1:

在firemonkey的TLabel性能Font.Family和Font.Size的风格。 如果你想改变字体大小或家庭中的代码，你需要在这个特性禁用的造型。 要改变这种情况，正确设置属性StyledSettings。

例： 

Label1.StyledSettings:=Label1.StyledSettings -[TStyledSetting.ssFamily,TStyledSetting.ssSize]


Answer 2:

好了，这里是为我工作。
我需要做的是换我想要一个TRectangle内的图像中显示，然后绘制矩形到图像什么都。 我也不得不改变矩形内部控制的默认属性，例如我不得不更改字体名称和字号。 然后，我可能改变他们对什么都我以后想。 还需要确保的形式显示图像要快照可见（form.show）

这个工作对我来说，是公共使用，我曾与它没有任何故障。

帕斯卡尔源代码： 

unit FormSnap;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.UIConsts, System.Rtti, System.Classes,
  System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Objects, FMX.Layouts, AVConverter;

type
  TfrmSnapshot = class(TForm)
    lblMainTitle: TLabel;
    lblSubTitle: TLabel;
    lblWebsite: TLabel;
    imgSnap: TImage;
    RectMainTitle: TRectangle;
    RectSubTitle: TRectangle;
    RectWebsite: TRectangle;
    AVConvert: TAVConverter;

    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
    procedure FormDestroy(Sender: TObject);
    procedure AVConvertComplete(Sender: TObject);

  private
    fBitmap: TBitmap;
    fSub: String;
    fTitle: String;
    fSite: String;
    fShown, fProcessingVideo: Boolean;
    fSaveTo, fSaveVideoTo: String;
    fColorBack: Cardinal;
    fColorSub: Cardinal;
    fColorTitle: Cardinal;
    fColorSite: Cardinal;
    fOnReady, fOnFinished: TNotifyEvent;

    Procedure zp_CreateImage;
    Function zp_GetLRect(Const AControl: TControl): TRectF;
  public
    Property ColorBack: Cardinal read fColorBack write fColorBack;
    Property ColorTitle: Cardinal read fColorTitle write fColorTitle;
    Property ColorSub: Cardinal read fColorSub write fColorSub;
    Property ColorWebsite: Cardinal read fColorSite write fColorSite;
    Property SaveTo: String read fSaveTo write fSaveTo;
    Property SaveVideoTo: String read fSaveVideoTo write fSaveVideoTo;
    Property SlideTitle: String read fTitle write fTitle;
    Property SlideSubTitle: String read fSub write fSub;
    Property SlideWebsite: String read fSite write fSite;

    Procedure Process;
    Procedure ProcessVideo;
    Property OnFinished: TNotifyEvent read fOnFinished write fOnFinished;
    Property OnReady: TNotifyEvent read fOnReady write fOnReady;
  end;

var
  frmSnapshot: TfrmSnapshot;

implementation
Uses uShared.Project, AVCodec, AVLib;

{$R *.fmx}
procedure TfrmSnapshot.AVConvertComplete(Sender: TObject);
begin
  //
  if Pos('temp', Lowercase(fSaveTo)) <> 0 then
    DeleteFile(fSaveTo);

  if Assigned(fOnFinished) then
    fOnFinished(Self);
end;

procedure TfrmSnapshot.FormCreate(Sender: TObject);
begin
  //
  imgSnap.Bitmap := TBitmap.Create(Round(imgSnap.Width), Round(imgSnap.Height));
  fColorBack := claYellow;
  fColorSub := claBlack;
  fColorTitle := claBlack;
  fColorSite := claBlue;
  fTitle := 'Simple slide';
  fSub := 'Another slide';
  fSite := '';

  fBitmap := TBitmap.Create(0, 0);
  Height := 360;
  Width := 640;
end;

procedure TfrmSnapshot.FormDestroy(Sender: TObject);
begin
  //
  fBitmap.Free;
end;

procedure TfrmSnapshot.FormPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
begin
  //
  if (Assigned(fOnReady)) AND (NOT fShown) then
  Begin
    fOnReady(Self);
    fShown := True;
  End;
end;

procedure TfrmSnapshot.Process;
begin
  //
  fProcessingVideo := False;
  zp_CreateImage;
  if Assigned(fOnFinished) then
    fOnFinished(Self);
end;

procedure TfrmSnapshot.ProcessVideo;
begin
  //
  fProcessingVideo := True;
  fSaveTo := Project.FolderTemp + 'snap.jpg';

  With AVConvert Do
  Begin
    if State <> csRunning then
    Begin
      zp_CreateImage;
      fBitmap.LoadFromFile(fSaveTo);

      ConvertOptions.InputFormats.Text:='bmpcap';
      InputFiles.Add(IntToStr(Integer(fBitmap)));
      OutputFiles.Text:= fSaveVideoTo;
      ConvertOptions.RecordingTime:=30*AV_TIME_BASE;
      Convert();
    End;
  End;
end;

procedure TfrmSnapshot.zp_CreateImage;
begin
  //
  RectMainTitle.Fill.Color := fColorBack;
  RectSubTitle.Fill.Color := fColorBack;
  RectWebsite.Fill.Color := fColorBack;

  With lblMainTitle Do
  Begin
    FontColor := fColorTitle;
    Text := fTitle;
  End;

  With lblSubTitle Do
  Begin
    FontColor := fColorSub;
    Text := fSub;
  End;

  With lblWebsite Do
  Begin
    FontColor := fColorSite;
    Text := fSite;
  End;

  With imgSnap.Bitmap Do
  Begin
    Clear(fColorBack);
    RectMainTitle.PaintTo(Canvas, zp_GetLRect(RectMainTitle));
    RectSubTitle.PaintTo(Canvas, zp_GetLRect(RectSubTitle));
    RectWebsite.PaintTo(Canvas, zp_GetLRect(RectWebsite));
  End;

  imgSnap.MakeScreenshot.SaveToFile(fSaveTo);
end;

function TfrmSnapshot.zp_GetLRect(const AControl: TControl): TRectF;
var
  X, Y, W, H: Single;

begin
  //
  X := AControl.Position.X;
  Y := AControl.Position.Y;
  W := X + AControl.Width;
  H := Y + AControl.Height;
  Result := TRectF.Create(X, Y, W, H);
end;

end.

形成源代码： 

object frmSnapshot: TfrmSnapshot
  Left = 0
  Top = 0
  BorderStyle = bsNone
  ClientHeight = 360
  ClientWidth = 640
  Position = poScreenCenter
  FormFactor.Width = 1920
  FormFactor.Height = 1080
  FormFactor.Devices = [dkDesktop]
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  OnPaint = FormPaint
  object imgSnap: TImage
    Align = alClient
    Height = 360.000000000000000000
    Width = 640.000000000000000000
  end
  object RectMainTitle: TRectangle
    Height = 90.000000000000000000
    Position.X = 8.000000000000000000
    Position.Y = 60.000000000000000000
    Stroke.Kind = bkNone
    Width = 625.000000000000000000
    object lblMainTitle: TLabel
      Align = alClient
      Font.Family = 'Impact'
      Font.Size = 40.000000000000000000
      FontColor = claAliceblue
      StyledSettings = []
      Height = 90.000000000000000000
      Text = 'I am just some silly information. Testing Wordwrap'
      TextAlign = taCenter
      Width = 625.000000000000000000
    end
  end
  object RectSubTitle: TRectangle
    Height = 90.000000000000000000
    Position.X = 8.000000000000000000
    Position.Y = 200.000000000000000000
    Stroke.Kind = bkNone
    Width = 625.000000000000000000
    object lblSubTitle: TLabel
      Align = alClient
      Font.Family = 'Impact'
      Font.Size = 20.000000000000000000
      FontColor = claAliceblue
      StyledSettings = []
      Height = 90.000000000000000000
      Text = 'More Information'
      TextAlign = taCenter
      Width = 625.000000000000000000
    end
  end
  object RectWebsite: TRectangle
    Height = 17.000000000000000000
    Position.Y = 340.000000000000000000
    Stroke.Kind = bkNone
    Width = 640.000000000000000000
    object lblWebsite: TLabel
      Align = alClient
      Font.Family = 'Impact'
      FontColor = claAliceblue
      StyledSettings = [ssSize]
      Height = 17.000000000000000000
      Text = 'Just a website'
      TextAlign = taCenter
      Width = 640.000000000000000000
    end
  end
  object AVConvert: TAVConverter
    ConvertOptions.LimitFileSize = 9223372036854775807
    ConvertOptions.AudioOptions.AudioChannels = 0
    ConvertOptions.AudioOptions.AudioSampleRate = 0
    ConvertOptions.AudioOptions.AudioVolume = 256
    ConvertOptions.AudioOptions.AudioSyncMethod = 0
    ConvertOptions.AudioOptions.AudioDisable = False
    ConvertOptions.AudioOptions.AudioSampleFmt = sfAuto
    ConvertOptions.AudioOptions.AudioStreamCopy = False
    ConvertOptions.AudioOptions.AudioCodecTag = 0
    ConvertOptions.AudioOptions.AudioQScale = -99999.000000000000000000
    ConvertOptions.AudioOptions.AudioDriftThreshold = 0.100000001490116100
    ConvertOptions.AudioOptions.Bitrate = 0
    ConvertOptions.AudioOptions.MaxFrames = 9223372036854775807
    ConvertOptions.SubtitleOptions.SubtitleDisable = False
    ConvertOptions.SubtitleOptions.SubtitleCodecTag = 0
    ConvertOptions.VideoOptions.FrameWidth = 0
    ConvertOptions.VideoOptions.FrameHeight = 0
    ConvertOptions.VideoOptions.VideoDisable = False
    ConvertOptions.VideoOptions.VideoStreamCopy = False
    ConvertOptions.VideoOptions.VideoCodecTag = 0
    ConvertOptions.VideoOptions.IntraOnly = False
    ConvertOptions.VideoOptions.TopFieldFirst = -1
    ConvertOptions.VideoOptions.ForceFPS = False
    ConvertOptions.VideoOptions.FrameRate.num = 0
    ConvertOptions.VideoOptions.FrameRate.den = 0
    ConvertOptions.VideoOptions.MeThreshold = 0
    ConvertOptions.VideoOptions.Deinterlace = False
    ConvertOptions.VideoOptions.Pass = 0
    ConvertOptions.VideoOptions.MaxFrames = 2147483647
    ConvertOptions.VideoOptions.Bitrate = 0
    ConvertOptions.MuxerOptions.MuxPreload = 0.500000000000000000
    ConvertOptions.StartTime = 0
    ConvertOptions.RecordingTime = 9223372036854775807
    OnComplete = AVConvertComplete
    Left = 304
    Top = 200
  end
end

希望这可以帮助别人谁是有这个问题。

问候Anthoni

PS：对不起忘了补充，请忽略AVConvertor组件，也就是有让我创建组件（MP4）的实际视频，这样我可以与其他合并。



文章来源: How to programmatically alter Font properties in Firemonkey controls
标签： delphi fonts firemonkey firemonkey-fm2
举报

收藏的人(0)

Ta的文章 更多文章
登录 后发表评论
0条评论
还没有人评论过~