home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 December / Chip_2001-12_cd1.bin / zkuste / delphi / kompon / d3456 / POWERPDF.ZIP / PowerPdf / PRAnnotation.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-09-15  |  4.2 KB  |  165 lines
  1. {*
  2.  * << P o w e r P d f >> -- PRAnnotation.pas
  3.  *
  4.  * Copyright (c) 1999-2001 Takezou. <takeshi_kanno@est.hi-ho.ne.jp>
  5.  *
  6.  * This library is free software; you can redistribute it and/or modify it
  7.  * under the terms of the GNU Library General Public License as published
  8.  * by the Free Software Foundation; either version 2 of the License, or any
  9.  * later version.
  10.  *
  11.  * This library is distributed in the hope that it will be useful, but WITHOUT
  12.  * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  13.  * FOR A PARTICULAR PURPOSE. See the GNU Library general Public License for more
  14.  * details.
  15.  *
  16.  * You should have received a copy of the GNU Library General Public License
  17.  * along with this library.
  18.  *
  19.  * 2001.07.07 Create
  20.  * 2001.08.12 Changed the implementation of annotation.
  21.  *
  22.  *}
  23. unit PRAnnotation;
  24.  
  25. interface
  26.  
  27. uses
  28.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  29.   PReport, PdfDoc, PdfFonts, PdfTypes;
  30.  
  31. type
  32.   TPRAnnotation = class(TPRItem)
  33.   private
  34.     FLines: TStrings;
  35.     FOpened: boolean;
  36.     procedure SetLines(Value: TStrings);
  37.     procedure SetText(Value: string);
  38.     function GetText: string;
  39.     function GetLines: TStrings;
  40.   protected
  41.     procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  42.     procedure Paint; override;
  43.     procedure Print(ACanvas: TPRCanvas; ARect: TRect); override;
  44.   public
  45.     constructor Create(AOwner: TComponent); override;
  46.     destructor Destroy; override;
  47.     property Text: string read GetText write SetText;
  48.   published
  49.     property Caption;
  50.     property Lines: TStrings read GetLines write SetLines;
  51.     property Opened: boolean read FOpened write FOpened;
  52.   end;
  53.  
  54. implementation
  55.  
  56. { TPRAnnotation }
  57.  
  58. // SetLines
  59. procedure TPRAnnotation.SetLines(Value: TStrings);
  60. begin
  61.   FLines.Assign(Value);
  62.   Invalidate;
  63. end;
  64.  
  65. // GetLines
  66. function TPRAnnotation.GetLines: TStrings;
  67. begin
  68.   result := FLines;
  69. end;
  70.  
  71. // SetText
  72. procedure TPRAnnotation.SetText(Value: string);
  73. begin
  74.   FLines.Text := Value;
  75. end;
  76.  
  77. // GetText
  78. function TPRAnnotation.GetText: string;
  79. begin
  80.   result := Trim(FLines.Text);
  81. end;
  82.  
  83. // Create
  84. constructor TPRAnnotation.Create(AOwner: TComponent);
  85. begin
  86.   inherited Create(AOwner);
  87.   FLines := TStringList.Create;
  88. end;
  89.  
  90. // Destroy
  91. destructor TPRAnnotation.Destroy;
  92. begin
  93.   FLines.Free;
  94.   inherited;
  95. end;
  96.  
  97. // CMTextChanged
  98. procedure TPRAnnotation.CMTextChanged(var Message: TMessage);
  99. begin
  100.   Invalidate;
  101. end;
  102.  
  103. procedure TPRAnnotation.Paint;
  104. var
  105.   W: Integer;
  106.   tmpRect: TRect;
  107. const
  108.   PDF_ANNOT_TITLE_HEIGHT = 15;
  109. begin
  110.   with Canvas do
  111.   begin
  112.     tmpRect := GetClientRect;
  113.     tmpRect.Top := PDF_ANNOT_TITLE_HEIGHT;
  114.     InflateRect(tmpRect, -5, -1);
  115.     tmpRect.Right := tmpRect.Right - 24;
  116.     Brush.Color := clWindow;
  117.     Font.Size := 10;
  118.     Font.Style := [];
  119.     Rectangle(0, PDF_ANNOT_TITLE_HEIGHT, Width, Height);
  120.     DrawText(Handle, PChar(Text), -1, TmpRect, DT_WORDBREAK);
  121.  
  122.     Brush.Color := clYellow;
  123.     Rectangle(0, 0, Width, PDF_ANNOT_TITLE_HEIGHT + 1);
  124.     Font.Size := 8;
  125.     Font.Style := [fsBold];
  126.     W := TextWidth(Caption);
  127.     TextOut((Width - W) div 2, 4, Caption);
  128.   end;
  129. end;
  130.  
  131. procedure TPRAnnotation.Print(ACanvas: TPRCanvas; ARect: TRect);
  132. var
  133.   FAnnotation: TPdfDictionary;
  134.   S: string;
  135.   APos: integer;
  136.   NewRect: TRect;
  137. begin
  138.   // omitting LF charactors from CRLF sequence.
  139.   S := Text;
  140.   APos := pos(#13#10, S);
  141.   while APos > 0 do
  142.   begin
  143.     S := Copy(S, 1, APos) + Copy(S, APos+2, Length(S) - APos-2);
  144.     APos := pos(#13#10, S);
  145.   end;
  146.  
  147.   // creating annotation object and setting properties.
  148.   with NewRect do
  149.   begin
  150.     Top := Page.ClientHeight - ARect.Bottom;
  151.     Bottom := Page.ClientHeight - ARect.Top;
  152.     Left := ARect.Left;
  153.     Right := ARect.Right;
  154.   end;
  155.   with NewRect do
  156.     FAnnotation := ACanvas.PdfCanvas.Doc.CreateAnnotation(asTextNotes,
  157.                                             _PdfRect(Left, Top, Right, Bottom));
  158.   FAnnotation.AddItem('Contents', TPdfText.CreateText(S));
  159.   FAnnotation.AddItem('S', TPdfText.CreateText(Caption));
  160.   if Opened then
  161.     FAnnotation.AddItem('Open', TPdfBoolean.CreateBoolean(true));
  162. end;
  163.  
  164. end.
  165.