2

TImage の上に配置された一連のコントロールを描画するコードがあります。次に、TImage の MakeScreenshot を取得してファイルを保存します。これで完全に機能するようになりました。私が今苦労しているのは、1 つ以上のラベル/テキスト スタイル コントロールのフォント プロパティを変更することです。どう頑張ってもラベルが変わらない。以下は私のサンプルコードです:-

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;

ラベルが適切に描画され、スクリーンショットに含まれるように、ラベルのフォントを設定するにはどうすればよいですか?

よろしくアンソニー

4

2 に答える 2

9

firemonkey では、TLabel プロパティの Font.Family と Font.Size がスタイル設定されています。コード内のフォント サイズまたはファミリを変更する場合は、このプロパティでスタイル設定を無効にする必要があります。これを変更するには、プロパティ StyledSettings を適切に設定します。

例：

Label1.StyledSettings:=Label1.StyledSettings -[TStyledSetting.ssFamily,TStyledSetting.ssSize]
于 2012-12-28T14:09:10.153 に答える
1

OK、これが私のために働いているものです。
私がする必要があったのは、TRectangle 内の画像に表示したいものをラップし、Rectangle を画像にペイントすることでした。また、Rectangle 内のコントロールの既定のプロパティも変更する必要がありました。たとえば、フォント名とフォント サイズを変更する必要がありました。その後、私はそれらを私が望むものに変更することができました。また、スナップショットを作成する画像を表示するフォームが表示されていることを確認する必要があります (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

これが、この問題を抱えている他の誰かに役立つことを願っています。

よろしくアンソニー

PS: 追加するのを忘れて申し訳ありません。AVConvertor コンポーネントは無視してください。コンポーネントの実際のビデオ (mp4) を作成して、別のコンポーネントとマージできるようにするためのものです。

于 2013-01-03T07:46:58.813 に答える