Text to images Generator (Console app generating bitmaps with text)

[barracuda]

In Windows XP, I tried to create new project for console program and I got errors that libraries not found. Why? Are these not present with console apps?

Code: Pascal  [Select][+][-]

1. program project1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. uses
6.   {$IFDEF UNIX}
7.   cthreads,
8.   {$ENDIF}
9.   Classes, SysUtils, CustApp,
10.    Graphics,
11.   LCLType, LCLIntf;
12. { you can add units after this };
13.  
14. type
15.  

[Handoko]

In console mode, many features will be disabled by default.

If you want to enable Graphics unit in console mode, do this:
Lazarus main menu > Project > Project Inspector > Add > New Requirement > type: LCLBase > select the LCLBase and click the OK button

[barracuda]

I am trying to retype the code to console program. An error appeared near first batch of constants:

Code: Pascal  [Select][+][-]

1. constructor TMyApplication.Create(TheOwner: TComponent);
2. inherited Create(TheOwner);
3. // První
4. const
5.   fonts1: array[0..4] of string = ('Verdana', 'Roboto', 'Arial', 'Helvetica', 'sans-serif');
6.  

Originally chatGPT used ahk syntax so I corrected. But the error is begin is expected after
inherited Create(TheOwner);
so there should be the constants defined?

Code: Pascal  [Select][+][-]

1. program project1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. uses
6.   {$IFDEF UNIX}
7.   cthreads,
8.   {$ENDIF}
9.   Classes, SysUtils, CustApp,
10.   Graphics,
11.   LCLType, LCLIntf;
12.  
13. type
14.  
15.   { TMyApplication }
16.  
17.   TMyApplication = class(TCustomApplication)
18.   protected
19.     procedure DoRun; override;
20.   private
21.     { Private declarations }
22.     procedure GenerateImages(fonts: array of string; texts: array of string; fontSize: Integer; folderName: string);
23.   public
24.     constructor Create(TheOwner: TComponent); override;
25.     destructor Destroy; override;
26.     procedure WriteHelp; virtual;
27.   end;
28.  
29. { TMyApplication }
30.  
31. procedure TMyApplication.DoRun;
32.   var ErrorMsg: String;
33. begin
34.   // quick check parameters
35.   ErrorMsg:=CheckOptions('h', 'help');
36.   if ErrorMsg<>'' then begin
37.     ShowException(Exception.Create(ErrorMsg));
38.     Terminate;
39.     Exit;
40.   end;
41.  
42.   // parse parameters
43.   if HasOption('h', 'help') then begin
44.     WriteHelp;
45.     Terminate;
46.     Exit;
47.   end;
48.  
49.   { add your program here }
50.  
51.   // stop program loop
52.   Terminate;
53. end;
54.  
55. constructor TMyApplication.Create(TheOwner: TComponent);
56. inherited Create(TheOwner);
57. // První
58. const
59.   fonts1: array[0..4] of string = ('Verdana', 'Roboto', 'Arial', 'Helvetica', 'sans-serif');
60.   texts1: array[0..5] of string = ('Psalm 91:1', 'Slovo', 'AHK pro', 'Vygenerování zkušebních obrázků.', 'Vygenerování zkušebních obrázků.', 'Včera ráno, dnes odpoledne a v neděli večer');
61.   fontSize1: Integer = 22;
62.   folderName1: string = 'TestImages_22.4px';
63.  
64. // Druhý
65. const
66.   fonts2: array[0..4] of string = ('Verdana', 'Roboto', 'Arial', 'Helvetica', 'sans-serif');
67.   texts2: array[0..5] of string = ('Text analysis', 'Slovo', 'AHK pro', 'Vygenerování zkušebních obrázků.', 'Vygenerování zkušebních obrázků.', 'Včera ráno, dnes odpoledne a v neděli večer');
68.   fontSize2: Integer = 16;
69.   folderName2: string = 'TestImages_16px';
70.  
71. // Třetí
72. const
73.   fonts3: array[0..2] of string = ('Arial', 'Helvetica', 'Sans-serif');
74.   texts3: array[0..8] of string = ('Strong''s', 'Hebrew', 'English', 'Morphology', 'Slovo', 'AHK pro', 'Vygenerování zkušebních obrázků.', 'Vygenerování zkušebních obrázků.', 'Včera ráno, dnes odpoledne a v neděli večer');
75.   fontSize3: Integer = 12;
76.   folderName3: string = 'TestImages_12px';
77. const
78. const
79.   fonts4: array[0..2] of string = ('Arial', 'Helvetica', 'Sans-serif');
80.   texts4: array[0..5] of string = ('Go to Parallel Hebrew', 'Slovo', 'AHK pro', 'Vygenerování zkušebních obrázků.', 'Vygenerování zkušebních obrázků.', 'Včera ráno, dnes odpoledne a v neděli večer');
81.   fontSize4: Integer = 16;
82.   folderName4: string = 'TestImages_16px';
83.  
84.   StopOnException:=True;
85.   GenerateImages(fonts1, texts1, fontSize1, folderName1);
86.   ShowMessage('První dávka zkušebních obrázků (22.4px) byla uložena do složky "' + folderName1 + '".');
87.   GenerateImages(fonts2, texts2, fontSize2, folderName2);
88.   ShowMessage('Druhá dávka zkušebních obrázků (16px) byla uložena do složky "' + folderName2 + '".');
89.   GenerateImages(fonts3, texts3, fontSize3, folderName3);
90.   ShowMessage('Třetí dávka zkušebních obrázků (12px) byla uložena do složky "' + folderName3 + '".');
91.   GenerateImages(fonts4, texts4, fontSize4, folderName4);
92.   ShowMessage('Čtvrtá dávka zkušebních obrázků (16px) byla uložena do složky "' + folderName4 + '".');
93. end;
94.  
95. destructor TMyApplication.Destroy;
96. begin
97.   inherited Destroy;
98. end;
99.  
100. procedure TMyApplication.WriteHelp;
101. begin
102.   { add your help code here }
103.   writeln('Usage: ', ExeName, ' -h');
104. end;
105.  
106. procedure TMyApplication.GenerateImages(fonts: array of string; texts: array of string; fontSize: Integer; folderName: string);
107.   var
108.     bmp: TBitmap;
109.     rect: TRect;
110.     fileName: string;
111.     i, j: Integer;
112. begin
113.   bmp := TBitmap.Create;
114.   try
115.     for i := 0 to High(fonts) do
116.     begin
117.       for j := 0 to High(texts) do
118.       begin
119.         bmp.Width := 500;
120.         bmp.Height := 100;
121.         bmp.Canvas.Font.Name := fonts[i];
122.         bmp.Canvas.Font.Size := fontSize;
123.  
124.         fileName := IncludeTrailingPathDelimiter(folderName) + fonts[i] + ' ' + Copy(texts[j], 1, Pos(' ', texts[j]) - 1) + '.bmp';
125.  
126.         bmp.Canvas.Brush.Color := clWhite;
127.         bmp.Canvas.FillRect(bmp.Canvas.ClipRect);
128.         bmp.Canvas.TextOut(0, 0, texts[j]);
129.         bmp.SaveToFile(fileName);
130.       end;
131.     end;
132.   finally
133.     bmp.Free;
134.   end;
135. end;
136.  
137. var
138.   Application: TMyApplication;
139. begin
140.   Application:=TMyApplication.Create(nil);
141.   Application.Title:='My Application';
142.   Application.Run;
143.   Application.Free;
144. end.
145.  

[Handoko]

For making easier to understand, below I provide 2 examples:

Example 1 (the buggy code):

Code: Pascal  [Select][+][-]

1. constructor TMyApplication.Create(TheOwner: TComponent);
2. inherited Create(TheOwner);
3. const
4.   fontSize1: Integer = 22;
5. end;

Example 2 (the correct code):

Code: Pascal  [Select][+][-]

1. constructor TMyApplication.Create(TheOwner: TComponent);
2. const
3.   fontSize1: Integer = 22;
4. begin
5.   inherited Create(TheOwner);
6. end;

Can you see the differences?

• It must have a begin statement, see Example 2 Line #4.

• The inherited statement must place between begin - end block, see Example 2 Line #5.

[barracuda]

OK, fine. I didn't know what was the original code.

[barracuda]

Code: Pascal  [Select][+][-]

1. function TForm1.FontIsAvailable(const FontName: string): Boolean;
2. begin
3.   Result := Screen.Fonts.IndexOf(FontName) >= 0;
4. end;
5.  

What do I must to include to have the Screen a part of the console project?

[Handoko]

Screen object is provided by Forms unit, and Forms unit is provided by LCL package.

So you need to add LCL package as required packaged in the Object Inspector and then add Forms in the uses clause.

[barracuda]

Now I have this warning when I try to compile, this is dialoge window warning.
The (console) project does not use the LCL unit interfaces which is required by LCL base. You will get strange linker errors if you use it without LCL unit interfaces.

Code: Pascal  [Select][+][-]

1. LCL base is added.
2.  
3. program project1;
4.  
5. {$mode objfpc}{$H+}
6.  
7. uses
8.   {$IFDEF UNIX}
9.   cthreads,
10.   {$ENDIF}
11.   Classes, SysUtils, CustApp,
12.   Graphics,
13.   LCLType, LCLIntf,
14.   Forms; // required for Screen unit
15.  

Is there different way to check if the font exists in console app?

[Handoko]

In console mode, as I already said earlier, many features will be disabled. Is there any reason you want to write the program in console mode?

I rarely write console programs, I am not familiar how to solve you problem. But hey, you can modify the 'normal' application to behave like a console program:

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Graphics, StdCtrls, Types;
9.  
10. type
11.  
12.   { TForm1 }
13.  
14.   TForm1 = class(TForm)
15.     procedure FormActivate(Sender: TObject);
16.   private
17.     function  FontIsAvailable(const FontName: string): Boolean;
18.     procedure Generate(const FontName: string; FontSize: Integer;
19.       MarginX, MarginY: Integer; const Message, FileName: string);
20.   end;
21.  
22. var
23.   Form1: TForm1;
24.  
25. implementation
26.  
27. {$R *.lfm}
28.  
29. { TForm1 }
30.  
31. procedure TForm1.FormActivate(Sender: TObject);
32. begin
33.   Hide;
34.   Generate('Arial', 22, 4, 2, 'Test', 'test.bmp');
35.   Close;
36. end;
37.  
38. function TForm1.FontIsAvailable(const FontName: string): Boolean;
39. begin
40.   Result := Screen.Fonts.IndexOf(FontName) >= 0;
41. end;
42.  
43. procedure TForm1.Generate(const FontName: string; FontSize: Integer; MarginX,
44.   MarginY: Integer; const Message, FileName: string);
45. var
46.   Output: TBitmap;
47.   Size:   TSize;
48.   SizeX:  Integer;
49.   SizeY:  Integer;
50. begin
51.   Output := TBitmap.Create;
52.   Output.SetSize(100, 100);
53.   Output.Canvas.Brush.Style := bsClear;
54.   Output.Canvas.Font.Name := FontName;
55.   Output.Canvas.Font.Size := FontSize;
56.   Size  := Output.Canvas.TextExtent(Message);
57.   SizeX := MarginX + Size.Width + MarginX;
58.   SizeY := MarginY + Size.Height + MarginY;
59.   Output.SetSize(SizeX, SizeY);
60.   Output.Canvas.Brush.Color := clWhite;
61.   Output.Canvas.FillRect(0, 0, SizeX, SizeY);
62.   Output.Canvas.TextOut(MarginX, MarginY, Message);
63.   Output.SaveToFile(FileName);
64.   Output.Free;
65. end;
66.  
67. end.

To make a normal application to behave like a console program:

• Add an event for Form.Activate, see line #31.

• At the beginning of the block, put Hide; command, see line #33.

• At the end of the block, put Close; command, see line #35.

Tested on Linux only, but I believe it should work on Windows too.

[bytebites]

Alternativeliy. this is lpr-file. Dont create form at all.

Code: Pascal  [Select][+][-]

1. program Project1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. uses
6.   {$IFDEF UNIX}
7.   cthreads,
8.   {$ENDIF}
9.   {$IFDEF HASAMIGA}
10.   athreads,
11.   {$ENDIF}
12.   Interfaces, // this includes the LCL widgetset
13.   Forms, Graphics, StdCtrls, Types
14.   { you can add units after this };
15.  
16. {$R *.res}
17.  
18. //begin
19. //  RequireDerivedFormResource:=True;
20. //  Application.Scaled:=True;
21. //  Application.Initialize;
22. //  //Application.CreateForm(TForm1, Form1);
23. //  Application.Run;
24. //end.
25.  
26. function FontIsAvailable(const FontName: string): Boolean;
27. begin
28.   Result := Screen.Fonts.IndexOf(FontName) >= 0;
29. end;
30.  
31. procedure Generate(const FontName: string; FontSize: Integer; MarginX,
32.   MarginY: Integer; const Message, FileName: string);
33. var
34.   Output: TBitmap;
35.   Size:   TSize;
36.   SizeX:  Integer;
37.   SizeY:  Integer;
38. begin
39.   Output := TBitmap.Create;
40.   Output.SetSize(100, 100);
41.   Output.Canvas.Brush.Style := bsClear;
42.   Output.Canvas.Font.Name := FontName;
43.   Output.Canvas.Font.Size := FontSize;
44.   Size  := Output.Canvas.TextExtent(Message);
45.   SizeX := MarginX + Size.Width + MarginX;
46.   SizeY := MarginY + Size.Height + MarginY;
47.   Output.SetSize(SizeX, SizeY);
48.   Output.Canvas.Brush.Color := clWhite;
49.   Output.Canvas.FillRect(0, 0, SizeX, SizeY);
50.   Output.Canvas.TextOut(MarginX, MarginY, Message);
51.   Output.SaveToFile(FileName);
52.   Output.Free;
53. end;
54.  
55. begin
56.   Generate('Arial', 22, 4, 2, 'Test', 'test.bmp');
57. end.
58.  
59.  

[wp]

bytebites was faster...

Nevertheless I am adding my own solution which is practically identical with bytebites' code, except for the loops over all fonts and all texts.

Please note that displaying utf8-encoded text on the Windows console is always some kind of adventure, and some older versions of Windows do not handle utf8 at all. I am on Windows-11 where it is working flawlessly (although the command "mode con" lists codepage 850 to be active - I gave up trying to understand all this chaos...).

[barracuda]

Thank you for your answers, today I am exhausted and I would like to react and try your code tomorow.

The reason why I try to write a console program is that that takes less resources and in Mint I have small memory. So this would be new experience for me. I think I never wrote console program in Delphi 7 and not with FreePascal/Lazarus either. I still learn.

[wp]

The reason why I try to write a console program is that that takes less resources and in Mint I have small memory.

But the approach of using the LCL discussed so far means that memory usage will be quite high.  The ImagesOfTexts program that I posted above has almost 2 MB on the disk (after stripping the debug information), and this is almost as large as a GUI application. If low memory usage is a key requirement you must address the project in a different way: do not use the LCL, but use the units of the fcl-image package which is part of the FPC installation. An example for drawing text by this library is given in the wiki: https://wiki.freepascal.org/fcl-image#Drawing_text. Based on this example I modified my earlier sample code to use fcl-image rather than LCL. The exe now is only 300 kB...

Tested on Windows, Linux Mint and macOS Mojave (you may have to review the list of fonts and font directories).

[barracuda]

Guys now I cannot check your code, I think I will be back on friday, some urgent issues I have to solve. If the approach is bad and high memory consumption so maybe lets go back to the Window application. But I will enjoy to check both approaches.

[barracuda]

Alternativeliy. this is lpr-file. Dont create form at all.

Code: Pascal  [Select][+][-]

1. program Project1;
2. ...
3.  

Stupid question, but why the code is saved in .lpr file and not in .pas? Does .lpr mean that this is the main .pas file, the main app code? I dont know the meaning of LPR abbr. Sorry.