← Back to branch summary

~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to components/lazreport/source/addons/pdfexport/lr_e_pdf.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
http://bugs.debian.org/708695
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
components/lazreport/source/addons/pdfexport/lr_e_pdf.pas
21
21
uses
22
22
    SysUtils, Classes, Graphics, Forms, StdCtrls, lr_class, lr_BarC,
23
23
    lr_shape, PdfDoc, PdfTypes, PdfFonts, PRJpegImage, PReport, Dialogs,
24
 
    Controls;
 
24
    Controls, lr_rrect;
25
25
 
26
26
type
 
27
    TShapeData = record
 
28
      ShapeType: TfrShapeType;
 
29
      FillColor: TColor;
 
30
      FrameStyle: TfrFrameStyle;
 
31
      FrameWidth: Double;
 
32
      FrameColor: TColor;
 
33
      Radius: Single;
 
34
      Corners: TCornerSet;
 
35
    end;
 
36
 
27
37
    TfrTNPDFExport = class(TComponent) // fake component
28
38
    end;
29
39
 
38
48
        FOutline: TPROutLineEntry;
39
49
        FPageNo : Integer;
40
50
        DummyControl: TForm;
 
51
        procedure AddShape(Data: TShapeData; x, y, h, w: integer);
 
52
        procedure DefaultShowView(View: TfrView; nx, ny, ndy, ndx: Integer);
41
53
    public
42
54
        constructor Create(AStream: TStream); override;
43
55
        destructor Destroy; override;
48
60
        procedure ShowFrame(View: TfrView; x, y, h, w: integer);
49
61
        procedure ShowBarCode(View: TfrBarCodeView; x, y, h, w: integer);
50
62
        procedure ShowPicture(View: TfrPictureView; x, y, h, w: integer);
 
63
        procedure ShowRoundRect(View: TfrRoundRectView; x, y, h, w: integer);
51
64
        procedure ShowShape(View: TfrShapeView; x, y, h, w: integer);
52
65
        procedure OnText(X, Y: Integer; const Text: string; View: TfrView);
53
66
            override;
63
76
    TPRText_ = class(TPRText);
64
77
 
65
78
const
66
 
    PDFEscx = 0.8;
67
 
    PDFEscy = 0.8;
 
79
    PDFEscx = 0.792553191;
 
80
    PDFEscy = 0.785447761;
 
81
 
 
82
procedure TfrTNPDFExportFilter.AddShape(Data: TShapeData; x, y, h, w: integer);
 
83
 
 
84
  function CreateShape(ShapeClass: TPRShapeClass): TPRShape;
 
85
  begin
 
86
    result := ShapeClass.Create(PRPanel);
 
87
    result.Parent := PRPanel;
 
88
    result.FillColor := Data.FillColor;
 
89
    result.Left := x;
 
90
    result.Top := y;
 
91
    result.Height := h;
 
92
    result.Width := w;
 
93
    result.LineStyle := TPenStyle(Data.FrameStyle);
 
94
    result.LineWidth := Data.FrameWidth - 0.5;
 
95
    result.LineColor := Data.FrameColor;
 
96
  end;
 
97
 
 
98
begin
 
99
  case Data.ShapeType of
 
100
    frstRectangle:
 
101
      CreateShape(TPRRect);
 
102
 
 
103
    frstEllipse:
 
104
      CreateShape(TPREllipse);
 
105
 
 
106
    frstRoundRect:
 
107
      with TPRRect(CreateShape(TPRRect)) do begin
 
108
        Radius := Data.Radius;
 
109
        SquaredCorners := TPdfCorners(Data.Corners);
 
110
      end;
 
111
 
 
112
    frstTriangle:
 
113
      with TPRPolygon(CreateShape(TPRPolygon)) do begin
 
114
        SetLength(Points, 3);
 
115
        Points[0] := PRPoint(x+w, y+h);
 
116
        Points[1] := PRPoint(x, y+h);
 
117
        Points[2] := PRPoint(x+w/2, y);
 
118
      end;
 
119
 
 
120
    frstDiagonal1:
 
121
      with TPRPolygon(CreateShape(TPRPolygon)) do begin
 
122
        SetLength(Points, 2);
 
123
        Points[0] := PRPoint(x,y);
 
124
        Points[1] := PRPoint(x+w,y+h);
 
125
      end;
 
126
 
 
127
    frstDiagonal2:
 
128
      with TPRPolygon(CreateShape(TPRPolygon)) do begin
 
129
        SetLength(Points, 2);
 
130
        Points[0] := PRPoint(x,y+h);
 
131
        Points[1] := PRPoint(x+w,y);
 
132
      end;
 
133
  end;
 
134
end;
 
135
 
 
136
procedure TfrTNPDFExportFilter.DefaultShowView(View: TfrView;
 
137
  nx, ny, ndy, ndx: Integer);
 
138
begin
 
139
  if (View.FillColor <> clNone)
 
140
     and not (View is TfrBarCodeView)
 
141
     and not (View is TfrPictureView)
 
142
  then
 
143
    ShowBackGround(View, nx, ny, ndy, ndx);
 
144
 
 
145
  if View is TfrBarCodeView then
 
146
      ShowBarCode(TfrBarCodeView(View), nx, ny, ndy, ndx)
 
147
  else if View is TfrPictureView then
 
148
      ShowPicture(TfrPictureView(View), nx, ny, ndy, ndx);
 
149
 
 
150
  if (View.Frames<>[]) and not (View is TfrBarCodeView) then
 
151
     ShowFrame(View, nx, ny, ndy, ndx);
 
152
end;
68
153
 
69
154
constructor TfrTNPDFExportFilter.Create(AStream: TStream);
70
155
begin
99
184
    PPage.MarginLeft := 0;
100
185
    PPage.MarginRight := 0;
101
186
 
102
 
    PPage.Height := trunc(CurReport.EMFPages[FPageNo - 1]^.PrnInfo.Pgh*PDFEscy);
103
 
    PPage.Width := trunc(CurReport.EMFPages[FPageNo - 1]^.PrnInfo.Pgw*PDFEscx);
 
187
    PPage.Height := trunc(CurReport.EMFPages[FPageNo - 1]^.PrnInfo.Pgh*PDFEscy + 0.5);
 
188
    PPage.Width := trunc(CurReport.EMFPages[FPageNo - 1]^.PrnInfo.Pgw*PDFEscx + 0.5);
104
189
 
105
190
    PRPanel := TPRPanel.Create(PPage);
106
191
    PRPanel.Parent := PPage;
191
276
 
192
277
    Bitmap := TfrBarCodeView(View).GenerateBitmap;
193
278
    try
194
 
        w := Round(Bitmap.Width * PDFEscx + 1) ;
195
 
        h := Round(Bitmap.Height * PDFEscy + 1) ;
 
279
        w := trunc(Bitmap.Width * PDFEscx + 1.5) ;
 
280
        h := trunc(Bitmap.Height * PDFEscy + 1.5) ;
196
281
 
197
282
        PRImage := TPRImage.Create(PRPanel);
198
283
        PRImage.Parent := PRPanel;
216
301
    w: integer);
217
302
var
218
303
  PRImage: TPRImage;
 
304
  r: Double;
 
305
  L: Integer;
 
306
  pw, ph: Integer;
219
307
begin
220
308
 
221
309
  if View.Picture.Graphic is TJpegImage then
222
310
    PRImage := TPRJpegImage.Create(PRPanel)
223
311
  else
224
312
    PRImage := TPRImage.Create(PRPanel);
 
313
 
225
314
  PRImage.Parent := PRPanel;
226
 
  PRImage.Stretch := True;
 
315
 
 
316
  ph := h;
 
317
  pw := w;
 
318
 
 
319
  if view.Stretched then
 
320
  begin
 
321
    if (View.Flags and flPictRatio<>0) and
 
322
       (View.Picture.Width>0) and (View.Picture.Height>0) then
 
323
    begin
 
324
      r  := View.Picture.Width/View.Picture.Height;
 
325
      if (w/h) < r then
 
326
      begin
 
327
        L := h;
 
328
        ph := trunc(w/r + 0.5);
 
329
        if (View.Flags and flPictCenter<>0) then
 
330
          y := y + (L-ph) div 2;
 
331
      end
 
332
      else
 
333
      begin
 
334
        L := w;
 
335
        pw := trunc(h*r + 0.5);
 
336
        if (View.Flags and flPictCenter<>0) then
 
337
          x := x + (L-pw) div 2;
 
338
      end;
 
339
    end;
 
340
  end
 
341
  else begin
 
342
    PRImage.ScaleX := PDFEscX;
 
343
    PRImage.ScaleY := PDFEscY;
 
344
    if (View.Flags and flPictCenter<>0) then begin
 
345
      pw := trunc(View.Picture.Width * PDFEscX + 1.5);
 
346
      ph := trunc(View.Picture.Height * PDFEscY + 1.5);
 
347
       x := x + (w - pw) div 2 - 1;
 
348
       y := y + (h - ph) div 2 - 1;
 
349
    end;
 
350
  end;
 
351
 
 
352
  PRImage.Stretch := View.Stretched;
227
353
  PRImage.SharedName := View.SharedName;
228
354
  PRImage.SharedImage := (View.SharedName<>'');
229
355
 
230
356
  PRImage.Left := x;
231
357
  PRImage.Top := y;
232
 
  PRImage.Height := h;
233
 
  PRImage.Width := w;
 
358
  PRImage.Height := ph;
 
359
  PRImage.Width := pw;
234
360
 
235
361
  PRImage.Picture.Graphic := View.Picture.Graphic;
236
362
end;
237
363
 
238
 
procedure TfrTNPDFExportFilter.ShowShape(View: TfrShapeView; x, y, h, w: integer
239
 
  );
240
 
 
241
 
  function CreateShape(ShapeClass: TPRShapeClass): TPRShape;
 
364
procedure TfrTNPDFExportFilter.ShowRoundRect(View: TfrRoundRectView; x, y, h,
 
365
  w: integer);
 
366
var
 
367
  Data: TShapeData;
 
368
  SWidth: Integer;
 
369
begin
 
370
 
 
371
  if view.ShowGradian then
 
372
    // not supported yet
 
373
    DefaultShowView(View, x, y, h, w)
 
374
 
 
375
  else
242
376
  begin
243
 
    result := ShapeClass.Create(PRPanel);
244
 
    result.Parent := PRPanel;
245
 
    result.FillColor := view.FillColor;
246
 
    result.Left := x;
247
 
    result.Top := y;
248
 
    result.Height := h;
249
 
    result.Width := w;
250
 
    result.LineStyle := TPenStyle(View.FrameStyle);
251
 
    result.LineWidth := View.FrameWidth - 0.5;
252
 
    result.LineColor := View.FrameColor;
 
377
 
 
378
    SWidth := trunc((View.RoundRectCurve/2) * PDFEscx + 0.5);
 
379
    if View.RoundRect then
 
380
      Data.Radius := SWidth
 
381
    else
 
382
      Data.Radius := 0.0;
 
383
    Data.Corners:=View.SquaredCorners;
 
384
 
 
385
    // draw shadow
 
386
    Data.ShapeType := frstRoundRect;
 
387
    Data.FillColor := ColorToRGB(View.ShadowColor);
 
388
    Data.FrameColor := Data.FillColor; //ColorToRGB(View.FrameColor);
 
389
    Data.FrameWidth := 0;
 
390
    Data.FrameStyle := frsSolid;
 
391
    SWidth := trunc(View.ShadowWidth * PDFEscx + 0.5);
 
392
    if View.ShadowWidth>0 then
 
393
      AddShape(Data, x + SWidth, y + SWidth, h - SWidth, w - SWidth);
 
394
 
 
395
    // draw roundrect
 
396
    Data.ShapeType := frstRoundRect;
 
397
    if View.FillColor=clNone then
 
398
      Data.FillColor := clNone
 
399
    else
 
400
      Data.FillColor := ColorToRGB(View.FillColor);
 
401
    if View.Frames=[] then
 
402
      Data.FrameColor := Data.FillColor
 
403
    else
 
404
      Data.FrameColor := ColorToRGB(View.FrameColor);
 
405
    Data.FrameWidth := View.FrameWidth;
 
406
    Data.FrameStyle := View.FrameStyle;
 
407
    AddShape(Data, x, y, h - SWidth, w - SWidth);
253
408
  end;
 
409
end;
254
410
 
 
411
procedure TfrTNPDFExportFilter.ShowShape(View: TfrShapeView; x, y, h, w: integer);
 
412
var
 
413
  Data: TShapeData;
255
414
begin
256
 
  case View.ShapeType of
257
 
    frstRectangle:
258
 
      CreateShape(TPRRect);
259
 
 
260
 
    frstEllipse:
261
 
      CreateShape(TPREllipse);
262
 
 
263
 
    frstRoundRect:
264
 
      with TPRRect(CreateShape(TPRRect)) do begin
265
 
        Radius := -1.0;
266
 
      end;
267
 
 
268
 
    frstTriangle:
269
 
      with TPRPolygon(CreateShape(TPRPolygon)) do begin
270
 
        SetLength(Points, 3);
271
 
        Points[0] := PRPoint(x+w, y+h);
272
 
        Points[1] := PRPoint(x, y+h);
273
 
        Points[2] := PRPoint(x+w/2, y);
274
 
      end;
275
 
 
276
 
    frstDiagonal1:
277
 
      with TPRPolygon(CreateShape(TPRPolygon)) do begin
278
 
        SetLength(Points, 2);
279
 
        Points[0] := PRPoint(x,y);
280
 
        Points[1] := PRPoint(x+w,y+h);
281
 
      end;
282
 
 
283
 
    frstDiagonal2:
284
 
      with TPRPolygon(CreateShape(TPRPolygon)) do begin
285
 
        SetLength(Points, 2);
286
 
        Points[0] := PRPoint(x,y+h);
287
 
        Points[1] := PRPoint(x+w,y);
288
 
      end;
289
 
  end;
 
415
  Data.ShapeType := View.ShapeType;
 
416
  Data.FillColor := View.FillColor;
 
417
  Data.FrameColor := View.FrameColor;
 
418
  Data.FrameStyle := View.FrameStyle;
 
419
  Data.FrameWidth := View.FrameWidth;
 
420
  Data.Radius := -1.0;
 
421
  Data.Corners := [];
 
422
  AddShape(Data, x, y, h, w);
290
423
end;
291
424
 
292
425
procedure TfrTNPDFExportFilter.OnData(x, y: Integer; View: TfrView);
293
426
var
294
427
    nx, ny, ndx, ndy: Integer;
295
428
begin
296
 
    nx := Round(x * PDFEscx);
297
 
    ny := Round(y * PDFEscy);
298
 
    ndx := Round((View.dx) * PDFEscx + 1) ;
299
 
    ndy := Round((View.dy) * PDFEscy + 1) ;
 
429
    nx := trunc(x * PDFEscx + 0.5);
 
430
    ny := trunc(y * PDFEscy + 0.5);
 
431
    ndx := trunc((View.dx) * PDFEscx + 1.5) ;
 
432
    ndy := trunc((View.dy) * PDFEscy + 1.5) ;
300
433
 
301
434
    if View is TfrShapeView then begin
302
435
 
303
436
      ShowShape(TfrShapeView(View), nx, ny, ndy, ndx);
304
437
 
305
 
    end else begin
306
 
 
307
 
      if (View.FillColor <> clNone)
308
 
         and not (View is TfrBarCodeView)
309
 
         and not (View is TfrPictureView)
310
 
      then
311
 
        ShowBackGround(View, nx, ny, ndy, ndx);
312
 
 
313
 
      if View is TfrBarCodeView then
314
 
          ShowBarCode(TfrBarCodeView(View), nx, ny, ndy, ndx)
315
 
      else if View is TfrPictureView then
316
 
          ShowPicture(TfrPictureView(View), nx, ny, ndy, ndx);
317
 
 
318
 
      if (View.Frames<>[]) and not (View is TfrBarCodeView) then
319
 
         ShowFrame(View, nx, ny, ndy, ndx);
320
 
    end;
 
438
    end else
 
439
    if View is TfrRoundRectView then begin
 
440
 
 
441
      ShowRoundRect(TfrRoundRectView(View), nx, ny, ndy, ndx);
 
442
 
 
443
    end else
 
444
      DefaultShowView(View, nx, ny, ndy, ndx);
321
445
end;
322
446
 
323
447
procedure TfrTNPDFExportFilter.OnText(X, Y: Integer; const Text: string;
324
448
    View: TfrView);
325
449
var
326
 
    PRTLabel: TPRText;
327
 
    nx, ny,
328
 
        ndx, ndy: Integer;
 
450
    PRTLabel: TPRLabel;
 
451
    nx, ny, ndx, ndy: Integer;
 
452
    gapx, gapy: integer;
329
453
begin
330
 
    nx := Round(x  * PDFEscx) + 1;
331
 
    ny := Round(y * PDFEscy) + 1;
332
 
    ndx := Round(View.dx * PDFEscx);
333
 
    ndy := Round(View.dy * PDFEscy);
 
454
    gapx := trunc(View.FrameWidth / 2 + 0.5) + 2;
 
455
    gapy := trunc(View.FrameWidth / 4 + 0.5) + 1;
 
456
    nx := trunc((x+gapx)  * PDFEscx + 0.5);
 
457
    ny := trunc((y+gapy) * PDFEscy + 0.5);
 
458
    ndx := trunc((View.dx-gapx) * PDFEscx + 1.5);
 
459
    ndy := trunc((View.dy-gapy) * PDFEscy + 1.5);
334
460
 
335
 
    PRTLabel := TPRText.Create(PRPanel);
 
461
    PRTLabel := TPRLabel.Create(PRPanel);
336
462
    PRTLabel.Parent := PRPanel;
 
463
    PRTLabel.Clipping := true;
337
464
    try
338
 
        PRTLabel.Text := Text;
 
465
        PRTLabel.Caption := Text;
339
466
        PRTLabel.Left := nx;
340
467
        PRTLabel.Top := ny;
341
468
        PRTLabel.Width := ndx;
342
469
        PRTLabel.Height := ndy;
343
470
        if View is TfrMemoView then
344
471
        begin
 
472
            PRTLabel.Alignment :=  TfrMemoView_(View).Alignment;
345
473
            if Pos('Arial', TfrMemoView_(View).Font.Name) > 0 then
346
474
                PRTLabel.FontName := fnArial
347
475
            else if Pos('Courier', TfrMemoView_(View).Font.Name) > 0 then
353
481
            PRTLabel.FontItalic := fsItalic in TfrMemoView_(View).Font.Style;
354
482
            PRTLabel.FontColor := TfrMemoView_(View).Font.Color;
355
483
            PRTLabel.FontUnderline := fsUnderline in TfrMemoView_(View).Font.Style;
 
484
            PRTLabel.Angle:= (View as TfrMemoView).Angle;
356
485
        end;
357
486
 
358
487
    finally
359
488
    end;
360
489
end;
361
490
 
 
491
 
 
492
 
362
493
initialization
363
494
    frRegisterExportFilter(TfrTNPDFExportFilter, 'Adobe Acrobat PDF ' + ' (*.pdf)',
364
495
        '*.pdf');