2

I have some code that paints a set of controls laid on top of a TImage. I then grab the TImage's MakeScreenshot to save out the file. This now works perfectly. What I am now struggling with is changing the font properties of one or more labels / text style controls. No matter what I try, the label does not change. Below is my sample code :-

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;

How do I set the fonts of the labels so that they are painted properly and thus included in the screenshot ?

Regards Anthoni

Improve this question
5
  • It's hard to say without seeing your full project, but I don't understand why you don't simply place the controls on (say) a TPanel and call MakeScreenshot on the panel. Commented Dec 14, 2012 at 22:00
  • Surely adding them onto any control and calling MakeScreenshot will work yes? I tried adding them directly onto the Image (the image as parent) and then calling MakeScreenshot. That works as long as don't want to alter any of the control properties. As soon as I come to try and change the font, it gets ignored. Commented Dec 16, 2012 at 11:33
  • Like I said, without seeing more code it's hard to tell. Can you upload a full sample project which shows the issue? Commented Dec 16, 2012 at 17:33
  • OK, I have kind of solved this after relentlessly banging my head against the wall. I do not like how I have had to go around it like. Do I just post and update the code, or do I upload it somewhere and post a link here ? Commented Dec 29, 2012 at 21:00
  • If you have a solution, post it as an answer and you can then mark the answer as correct. Commented Dec 29, 2012 at 23:23

2 Answers 2

Reset to default
10

In firemonkey TLabel properties Font.Family and Font.Size are styled. If you want change font size or family in the code, you need to disable styling on this properties. To change this, set properly property StyledSettings.

example:

Label1.StyledSettings:=Label1.StyledSettings -[TStyledSetting.ssFamily,TStyledSetting.ssSize]
Improve this answer
Sign up to request clarification or add additional context in comments.

5 Comments

I think you'll find StyledSettings is updated automatically to reflect any manually changed properties overriding the style.
StyledSetting are updated automatically, if you change font property in Object Inspector. If you do this in the code, StyledSettings are not updated and changes are not reflected on the form.
I will add to this:- When I change the font properties of a TLabel or similar control I have to then call Repaint in order to have it show up.
@Mike I am trying to use StyledSettings for TButton, however the compiler says "[dcc32 Error] : E2018 Record, object or class type required", I am not understand why does not work. This is a runtime created TButton and this property does not show up (xe6).
@eelias, In XE6 use Button1.StyledSettings := Button1.StyledSettings - [TStyledSetting.Family]; etc (i.e. leave out the 'ss' prefix).
1

OK, so here is what is working for me.
What I needed to do was wrap what ever I wanted to display in the image inside a TRectangle and then paint the Rectangle onto the image. I also had to change the default properties of the control inside the Rectangle, for example I had to change the font name and font size. Then I could alter them to what ever I wanted after that. Also need to make sure the form displaying the image want to snapshot is visible (form.show)

This works for me and is in Public use and I have had no faults with it.

Pascal Source Code:

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.

Form Source Code:

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

Hope this helps someone else who is having this problem.

Regards Anthoni

PS: Sorry forgot to add, please ignore the AVConvertor component, that is there to allow me to create an actual video of the component (mp4) so that I can merge it with another.

Improve this answer

Comments

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.