File: main.pas

package info (click to toggle)
lazarus 2.0.0%2Bdfsg-2
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 214,460 kB
  • sloc: pascal: 1,862,622; xml: 265,709; cpp: 56,595; sh: 3,008; java: 609; makefile: 535; perl: 297; sql: 222; ansic: 137
file content (323 lines) | stat: -rw-r--r-- 10,571 bytes parent folder | download | duplicates (8)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
unit main;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LR_Class, LR_Shape, LR_BarC, lr_e_pdf, Forms,
  Graphics, Dialogs, ExtCtrls, StdCtrls, LR_CodeReport;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    frBarCodeObject1: TfrBarCodeObject;
    frShapeObject1: TfrShapeObject;
    frTNPDFExport1: TfrTNPDFExport;
    Image1: TImage;
    CodeReport1: TlrCodeReport;
    SaveDialog1: TSaveDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure CodeReport1BeginReport(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
  with CodeReport1 do
  begin
    Report.Clear;   // restart the report (delete existing pages)
    RunReport;      // execute code and show report
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  SaveDialog1.FileName := 'mycodereport.pdf';
  if SaveDialog1.Execute then
    with CodeReport1 do
    begin
      Report.Clear;                         // reset report
      RunReport(false);                     // execute code
      Report.PrepareReport;
      Report.ExportTo(TfrTNPDFExportFilter, SaveDialog1.FileName);
    end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  with CodeReport1 do
  begin
    Report.Clear;                         // reset report
    RunReport(false);                     // execute code
    Report.PrepareReport;
    Report.PrintPreparedReport('', 1);    // empty string print all the pages
    // '1-5' print pages from 1 to 5
    // '1,3,5' print pages 1, 3 and 5
  end;
end;

procedure TForm1.CodeReport1BeginReport(Sender: TObject);
var
  BoxText: TlrTextRectStyle;
  n: integer;
  X: double;
begin
  with Sender as TlrCodeReport do
  begin
    // Important. Before drawing, add a page
    NewPage;
    // Set paper...  1=Letter 9=A4....
    //SetPaper(1, poLandscape);    // try uncomment this line to test another paper size
    // Set up a custom style
    BoxText := GetDefaultTextRectStyle;
    BoxText.FontName := 'Times';
    BoxText.FontSize := 12;
    BoxText.FontStyle := [fsBold, fsItalic];
    BoxText.FontColor := clBlue;
    BoxText.FillColor := clYellow;
    BoxText.Line.LColor := clRed;
    BoxText.Line.LWidth := 2;
    BoxText.BorderLines := [frbLeft, frbTop, frbRight, frbBottom];
    BoxText.Alignment := taRightJustify;
    //*******************************************************************
    //SetRatio(1, 1);  // working with pixels
    //NOTE: by default values are in pixels
    LineStyle.LColor := clBlue;
    DrawHLine(0, 5, GetPageWidth);
    DrawVLine(5, 0, GetPageHeight);

    // check values   uncomment to try
    //ShowMessage('Width: ' + FormatFloat('0.00', GetPageWidth) +
    //  'pixels' + 'Height: ' + FormatFloat('0.00', GetPageHeight) + 'pixels.');

    //  working with mm
    EnableMillimeters; // workign in millimeters

    //// check values   uncomment to try
    //ShowMessage('Width: ' + FormatFloat('0.00', GetPageWidth) +
    //  ' mm.' + 'Height: ' + FormatFloat('0.00', GetPageHeight) + ' mm.');

    // Draw text
    DrawText(0, 0, GetPageWidth, 10, 'Text example áéóâ € jgÑ€', BoxText);
    DrawText(0, 15, GetPageWidth, 10, 'Text example áéóâ E jgNE', BoxText);
    DrawText(0, 30, GetPageWidth, 10, '1234', BoxText);

    // Testing cursor
    // Set AutoSize
    BoxText.Autosize := True;
    DrawText(0, Cursor.YBottom, GetPageWidth, 6, 'Testing cursors', BoxText);
    DrawText(0, Cursor.YBottom, GetPageWidth, 6, 'next line', BoxText);
    DrawText(0, Cursor.YBottom, GetPageWidth, 6, 'another line', BoxText);
    // Align Left
    BoxText.Alignment := taLeftJustify;
    DrawText(0, Cursor.YBottom, GetPageWidth, 6, 'Testing cursors', BoxText);
    DrawText(0, Cursor.YBottom, GetPageWidth, 6, 'next line', BoxText);
    DrawText(0, Cursor.YBottom, GetPageWidth, 6, 'another line', BoxText);
    // center it
    BoxText.FontName := 'Arial';
    BoxText.Alignment := taCenter;
    BoxText.Autosize := False;
    DrawText(0, Cursor.YBottom, GetPageWidth, 6, 'Testing cursors', BoxText);
    DrawText(0, Cursor.YBottom, GetPageWidth, 6, 'next line', BoxText);
    DrawText(0, Cursor.YBottom, GetPageWidth, 6, 'another line', BoxText);
    // Layout
    x := Cursor.YBottom + 5;
    BoxText.FillColor := clSilver;
    BoxText.Line.LColor := clGreen;
    BoxText.FontColor := clRed;
    BoxText.Layout := tlTop;
    BoxText.Alignment := taLeftJustify;
    DrawText(20, x, 50, 15, 'TopLeft', BoxText);
    BoxText.Alignment := taCenter;
    DrawText(70, x, 50, 15, 'TopCenter', BoxText);
    BoxText.Alignment := taRightJustify;
    DrawText(120, x, 50, 15, 'TopRight', BoxText);
    x := Cursor.YBottom;
    BoxText.Layout := tlCenter;
    BoxText.Alignment := taLeftJustify;
    DrawText(20, x, 50, 15, 'CenterLeft', BoxText);
    BoxText.Alignment := taCenter;
    DrawText(70, x, 50, 15, 'CenterCenter', BoxText);
    BoxText.Alignment := taRightJustify;
    DrawText(120, x, 50, 15, 'CenterRight', BoxText);
    x := Cursor.YBottom;
    BoxText.Layout := tlBottom;
    BoxText.Alignment := taLeftJustify;
    DrawText(20, x, 50, 15, 'BottomLeft', BoxText);
    BoxText.Alignment := taCenter;
    DrawText(70, x, 50, 15, 'BottomCenter', BoxText);
    BoxText.Alignment := taRightJustify;
    DrawText(120, x, 50, 15, 'BottomRight', BoxText);

    LineStyle.LColor := clMaroon;
    LineStyle.LWidth := 1;
    LineStyle.LStyle := frsDashDotDot;
    DrawHLine(0, 15, GetPageWidth);
    DrawVLine(15, 0, GetPageHeight);
    NewPage;
    LineStyle.LColor := clRed;
    LineStyle.LStyle := frsDash;
    DrawHLine(0, 15, GetPageWidth);
    DrawVLine(15, 0, GetPageHeight);

    NewPage;
    LineStyle.LColor := clYellow;
    DrawHLine(0, 15, GetPageWidth);
    DrawVLine(15, 0, GetPageHeight);

    NewPage;
    // Testing TextOutRectXY
    ResetTextRectStyle;   // restart default style
    TextOutRectXY(10, 10, 15, 5, 'This text will be cut');
    TextRectStyle.FontName := 'Times';
    TextRectStyle.FontSize := 10;
    TextRectStyle.FontStyle := [fsBold];
    TextOutRectXY(10, 50, 15, 45, 'This is a non clipping test', taCenter, False);
    ResetTextRectStyle;

    // TextOut* testing. write/writeln equivalent
    NewPage;
    PageMargin.Top := 10;
    PageMargin.Bottom := 10;
    PageMargin.Left := 10;
    PageMargin.Right := 10;
    TextOut('World World ');
    TextOut('World');
    TextOut('!');
    TextOut('___');
    TextOutLn('.');
    TextOutLn('Hello');
    TextRectStyle.FontSize := 12;
    TextOutLn('World - Size 12');
    TextRectStyle.FontSize := 10;
    TextOutLn('End! - Size 10');
    for n := 0 to 250 do
    begin
      TextOutLn('Line ' + IntToStr(n));
    end;
    NewLine;
    TextOutLn('1 line below');
    NewLine(3);
    TextOutLn('3 lines below');

    NewPage;
    // Testing TextOutXY
    TextOutXY(0, 0, 'UL Corner');    // default is left aligned
    TextOutXY(GetPageWidth, 0, 'UR Corner', taRightJustify);
    TextOutXY(GetPageWidth / 2, 0, 'Center', taCenter);
    TextOutXY(GetPageWidth / 2, 13, 'LLLL');
    TextOutXY(GetPageWidth / 2, 13, 'RRRR', taRightJustify);
    TextOutXY(0, GetPageHeight - 4, 'LL Corner');    // default is left aligned
    TextOutXY(GetPageWidth, GetPageHeight - 4, 'LR Corner', taRightJustify);
    TextOutXY(GetPageWidth / 2, GetPageHeight - 4, 'Center', taCenter);
    NewPage;

    // Testing rotated up text
    TextOutXYUp(5, 1, 'Rotated Text UL Corner', taRightJustify);
    TextOutXYUp(5, GetPageHeight / 2, 'Rotated Text Center', taCenter);
    TextOutXYUp(5, GetPageHeight - 1, 'Rotated Text LL Corner', taLeftJustify);

    NewPage;
    // Testing frames
    DrawFrame(10, 10, 25, 10);
    FrameStyle.FillColor := clYellow;
    FrameStyle.Line.LColor := clBlue;
    DrawFrame(10, 35, 25, 10);
    FrameStyle.Line.LColor := clNavy;
    FrameStyle.FillColor := clNavy; // No borders
    DrawFrame(15, 40, 25, 10);
    ResetFrameStyle;   // start new default style
    FrameStyle.FillColor := clRed;
    FrameStyle.Line.LColor := clGreen;
    FrameStyle.Line.LWidth := 2;
    FrameStyle.BorderLines := [frbLeft, frbTop, frbBottom];  // no line right side
    DrawFrame(150, 10, 25, 10);
    ResetFrameStyle;
    DrawFrame(10, 100, 24, 10);
    DrawFrame(34, 100, 24, 10);
    DrawFrame(58, 100, 24, 10);
    DrawFrame(82, 100, 24, 10);

    NewPage;
    // Testing image
    // using sharedname, this allows us to define one image and reuse it
    // resulting in less resources usage
    DrawImage(10, 10, 60, 60, Image1, 'logo1');
    DrawImage(10, 80, 60, 30, Image1, 'logo1');
    // keepaspect=false
    DrawImage(71, 80, 60, 30, Image1, 'logo1', True, False, False);

    NewPage;
    // Testing shapes
    DrawShape(10, 10, 50, 20, ShapeStyle);  // full power procedure
    ShapeStyle.FillColor := clYellow;
    ShapeStyle.FrameColor := clBlue;
    DrawRectangle(10, 30, 50, 20);
    DrawRoundRectangle(10, 50, 50, 20);
    DrawDiagonalDownRight(10, 70, 50, 20);
    DrawDiagonalUpRight(10, 90, 50, 20);
    DrawEllipse(10, 110, 50, 20);
    DrawTriangle(10, 130, 50, 20);

    NewPage;
    // Testing BarCodes
    DrawBarCode(10, 10, 0, 15, 'lazarus-123456789', BarCodeStyle); // Default is Code39
    BarCodeStyle.Angle := 90;
    DrawBarCode(10, 30, 15, 0, 'lazarus-123456789', BarCodeStyle);
    ResetBarCodeStyle;
    BarCodeStyle.BorderLines := [frbLeft, frbTop, frbRight, frbBottom];
    BarCodeStyle.FrameColor := clYellow;
    DrawBarCode(10, 90, 0, 15, 'lazarus-123456789', BarCodeStyle);

    // Testing active page change
    ResetTextRectStyle;
    TextRectStyle.FontSize := 7;
    TextRectStyle.FontColor := clDkGray;
    for n := 1 to PageCount do
    begin
      SetActivePage(n);  // move to page n
      if (n mod 2) = 0 then
      begin
        X := PageMargin.Left;
        TextOutXY(X, GetPageHeight - PageMargin.Bottom,
          Format('Page %d of %d', [GetActivePage, PageCount]), taLeftJustify);
      end
      else
      begin
        X := GetPageWidth - PageMargin.Right;
        TextOutXY(X, GetPageHeight - PageMargin.Bottom,
          Format('Page %d of %d', [GetActivePage, PageCount]), taRightJustify);
      end;
    end;

    // For a really big report (10015 pages), try uncommenting next lines

    //for n:= 1 to 10000 do
    //begin
    //  NewPage;
    //  TextOut(Format('Page %d', [GetActivePage]));
    //end;
  end;
end;

end.