home *** CD-ROM | disk | FTP | other *** search
/ Chip 2003 January / ChipCD_1.03.iso / zkuste / delphi / kolekce / d3456 / GmPrintSuite_2_61_Lite.exe / {app} / GmRtfPreview.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-10-05  |  12.5 KB  |  428 lines

  1. {******************************************************************************}
  2. {                                                                              }
  3. {                          GmRtfPreview.pas v2.61 Pro                          }
  4. {                                                                              }
  5. {           Copyright (c) 2001 Graham Murt  - www.MurtSoft.co.uk               }
  6. {                                                                              }
  7. {   Feel free to e-mail me with any comments, suggestions, bugs or help at:    }
  8. {                                                                              }
  9. {                           graham@murtsoft.co.uk                              }
  10. {                                                                              }
  11. {******************************************************************************}
  12.  
  13. unit GmRtfPreview;
  14.  
  15. interface
  16.  
  17. uses
  18.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  19.   GmPreview, ComCtrls, StdCtrls, RichEdit, GmTypes;
  20.  
  21. type
  22.   TGmRtfNewPageEvent      = procedure (Sender: TObject; var ATopMargin, ABottomMargin: TGmValue) of object;
  23.  
  24.   TGmRtfPreview = class(TGmComponent)
  25.   private
  26.     FPreview: TGmPreview;
  27.     FTextFileFont: TFont;
  28.     FTopMargin: TGmValue;
  29.     FBottomMargin: TGmValue;
  30.     // events...
  31.     FOnNewPage: TGmRtfNewPageEvent;
  32.     FBeforeNewPage: TGmRtfNewPageEvent;
  33.     procedure FormatRichText(ARichEdit: TCustomMemo);
  34.     procedure NextPage;
  35.     procedure SetTextFileFont(AFont: TFont);
  36.     procedure SetPreview(const Value: TGmPreview);
  37.     { Private declarations }
  38.   protected
  39.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  40.     { Protected declarations }
  41.   public
  42.     constructor Create(AOwner: TComponent); override;
  43.     destructor Destroy; override;
  44.  
  45.     // text file method...
  46.     procedure LoadTextFromFile(const AFileName: string);
  47.     procedure LoadTextFromMemo(AMemo: TCustomMemo);
  48.  
  49.     // rich text methods...
  50.     procedure LoadRtfFromRichEdit(ARichEdit: TCustomMemo);
  51.     procedure LoadRtfFromFile(const AFileName: string);
  52.     procedure LoadRtfFromStream(AStream: TStream);
  53.  
  54.     property MarginBottom: TGmValue read FBottomMargin write FBottomMargin;
  55.     property MarginTop: TGmValue read FTopMargin write FTopMargin;
  56.     { Public declarations }
  57.   published
  58.     property Preview: TGmPreview read FPreview write SetPreview;
  59.     property TextFileFont: TFont read FTextFileFont write SetTextFileFont;
  60.     // events...
  61.     property BeforeNewPage: TGmRtfNewPageEvent read FBeforeNewPage write FBeforeNewPage;
  62.     property OnNewPage: TGmRtfNewPageEvent read FOnNewPage write FOnNewPage;
  63.     { Published declarations }
  64.   end;
  65.  
  66. implementation
  67.  
  68. uses GmConst, GmErrors, GmObjects, GmRtfFuncs, Printers;
  69.  
  70. //------------------------------------------------------------------------------
  71.  
  72. function IsTRichEdit(ARichEdit: TObject): Boolean;
  73. var
  74.   AClass: string;
  75. begin
  76.   AClass := LowerCase(ARichEdit.ClassName);
  77.   Result := AClass = 'trichedit';
  78. end;
  79.  
  80. function IsTRxRichEdit(ARichEdit: TObject): Boolean;
  81. var
  82.   AClass: string;
  83. begin
  84.   AClass := LowerCase(ARichEdit.ClassName);
  85.   Result := (AClass = 'trxrichedit') or
  86.             (AClass = 'tjvxrichedit');
  87. end;
  88.  
  89. function IsTRichEdit98(ARichEdit: TObject): Boolean;
  90. var
  91.   AClass: string;
  92. begin
  93.   AClass := LowerCase(ARichEdit.ClassName);
  94.   Result := AClass = 'trichedit98';
  95. end;
  96.  
  97. function IsTMemo(AMemo: TObject): Boolean;
  98. var
  99.   AClass: string;
  100. begin
  101.   AClass := LowerCase(AMemo.ClassName);
  102.   Result := AClass = 'tmemo';
  103. end;
  104.  
  105. //------------------------------------------------------------------------------
  106.  
  107. { TGmRtfPreview }
  108.  
  109. constructor TGmRtfPreview.Create(AOwner: TComponent);
  110. begin
  111.   inherited;
  112.   FTopMargin := TGmValue.Create;
  113.   FTopMargin.AsInches := 1;
  114.   FBottomMargin := TGmValue.Create;
  115.   FBottomMargin.AsInches := 1;
  116.   FTextFileFont := TFont.Create;
  117.   with FTextFileFont do
  118.   begin
  119.     Name := DEFAULT_FONT;
  120.     Size := 12;
  121.   end;
  122. end;
  123.  
  124. destructor TGmRtfPreview.Destroy;
  125. begin
  126.   if Assigned(FPreview) then FPreview.RemoveAssociatedComponent(Self);
  127.   FTopMargin.Free;
  128.   FBottomMargin.Free;
  129.   if Assigned(FTextFileFont) then FTextFileFont.Free;
  130.   inherited;
  131. end;
  132.  
  133. procedure TGmRtfPreview.Notification(AComponent: TComponent; Operation: TOperation);
  134. begin
  135.   inherited Notification(AComponent, Operation);
  136.   if (Operation = opRemove) and (AComponent = FPreview) then
  137.     FPreview := nil;
  138. end;
  139.  
  140. procedure TGmRtfPreview.SetTextFileFont(AFont: TFont);
  141. begin
  142.   FTextFileFont.Assign(AFont);
  143. end;
  144.  
  145. //------------------------------------------------------------------------------
  146.  
  147. procedure TGmRtfPreview.FormatRichText(ARichEdit: TCustomMemo);
  148. var
  149.   printarea: TRect;
  150.   richedit_outputarea: TRect;
  151.   fmtRange: TFormatRange;
  152.   pw, ph: integer;
  153.   TextLenEx: TGetTextLengthEx;
  154.   LastOffset: integer;
  155.   LastChar: integer;
  156.   SaveRect: TRect;
  157.   Ppi: integer;
  158.   MarginRect: TRect;
  159.   DC: THandle;
  160.   FirstPage: Boolean;
  161.   ATwip: Extended;
  162.   StartPage: integer;
  163.   RtfString: string;
  164.   ARtfStringStream: TStringStream;
  165.   RtfPage: integer;
  166.   NewRichEdit: TCustomMemo;
  167.   ICount: integer;
  168. begin
  169.   if not Assigned(FPreview) then
  170.   begin
  171.     ShowGmError(Self, NO_PREVIEW_ASSIGNED);
  172.     Exit;
  173.   end;
  174.   // get the rich text...
  175.  
  176.   if FPreview.GmPrinter.Printers.Count = 0 then
  177.   begin
  178.     ShowGmError(Self, PRINT_DRIVER_NEEDED);
  179.     Exit;
  180.   end;
  181.  
  182.   FPreview.BeginUpdate;
  183.   FPreview.RtfInformation.Clear;
  184.  
  185.   ARtfStringStream := TStringStream.Create('');
  186.   try
  187.     GetRtfText(ARichEdit, ARtfStringStream);
  188.     RtfString := ARtfStringStream.DataString;
  189.   finally
  190.     ARtfStringStream.Free;
  191.   end;
  192.  
  193.   Ppi := GetDeviceCaps(Printer.Handle, LOGPIXELSX);
  194.  
  195.   pw := Round(Ppi * FPreview.PageWidth.AsInches);
  196.   ph := Round(Ppi * FPreview.PageHeight.AsInches);
  197.  
  198.   StartPage := FPreview.CurrentPage;
  199.   RtfPage := FPreview.CurrentPage;
  200.   DC := GetDC(0);
  201.   try
  202.     MarginRect := Rect(Trunc(FPreview.Margins.Left.AsInches * Ppi),
  203.                        Round(Ppi * FTopMargin.AsInches) ,
  204.                        Trunc(FPreview.Margins.Right.AsInches * Ppi),
  205.                        Round((Ppi * FBottomMargin.AsInches)));
  206.     printarea := Rect(0 + MarginRect.Left,
  207.                       0 + MarginRect.Top,
  208.                       pw - MarginRect.Right,
  209.                       ph - MarginRect.Bottom);
  210.  
  211.     {Define a rectangle for the rich edit text. The height is set to the maximum. But
  212.     we need to convert from device units to twips, 1 twip = 1/1440 inch or 1/20 point.}
  213.  
  214.  
  215.     ATwip := 1440 / Ppi;
  216.     richedit_outputarea := Rect(Round(printarea.left * ATwip),
  217.                                 Round(printarea.top * ATwip) ,
  218.                                 Round(printarea.right * ATwip),
  219.                                 Round(printarea.bottom * ATwip));
  220.     SaveRect := richedit_outputarea;
  221.  
  222.     {Tell rich edit to format its text to the printer. First set up data record for message:}
  223.     fmtRange.hDC := dc;  {printer handle}
  224.     fmtRange.hdcTarget := Printer.Handle;  {ditto}
  225.  
  226.     fmtRange.rc := richedit_outputarea;
  227.     fmtRange.rcPage := Rect( 0, 0, pw, ph);
  228.  
  229.     LastChar := 0;
  230.  
  231.     with TextLenEx do
  232.     begin
  233.       flags := GTL_DEFAULT;
  234.       codepage := CP_ACP;
  235.     end;
  236.  
  237.     FirstPage := True;
  238.     try
  239.       with FPreview.RtfInformation do
  240.       begin
  241.         if Assigned(RichEdit) then RichEdit.Free;
  242.         NewRichEdit := nil;
  243.  
  244.         if (Assigned(FPreview.OnNeedRichEdit)) then
  245.           FPreview.OnNeedRichEdit(FPreview, NewRichEdit);
  246.  
  247.         if NewRichEdit = nil then  NewRichEdit := TRichEdit.Create(nil);
  248.  
  249.         RichEdit := NewRichEdit;
  250.         if (IsTRxRichEdit(RichEdit)) then
  251.         begin
  252.           NewRichEdit.Parent := Form;
  253.             NewRichEdit.SetSelTextBuf(PChar(RtfString));
  254.         end
  255.         else
  256.         begin
  257.               RichEdit.Width := 0;
  258.               RichEdit.Height := 0;
  259.             RichEdit.Parent := Application.MainForm;
  260.           Insertrtf(RichEdit, RtfString);
  261.           RichEdit.Visible := False;
  262.           if not IsTRichEdit98(RichEdit) then RichEdit.Parent := Form;
  263.         end;
  264.       end;
  265.       fmtRange.chrg.cpMin := 0;
  266.       fmtRange.chrg.cpMax := NewRichEdit.GetTextLen;
  267.  
  268.       if IsTRxRichEdit(NewRichEdit) then
  269.         LastOffset := NewRichEdit.perform(EM_GETTEXTLENGTHEX, WParam(@TextLenEx), 0)
  270.       else
  271.         LastOffset := NewRichEdit.GetTextLen;
  272.  
  273.       SendMessage(NewRichEdit.Handle, EM_FORMATRANGE, 0, 0);
  274.  
  275.       repeat
  276.         fmtRange.rc := SaveRect;
  277.         fmtRange.chrg.cpMin := LastChar;
  278.         LastChar := SendMessage(NewRichEdit.Handle, EM_FORMATRANGE, 0, Longint(@fmtRange));
  279.  
  280.         if (LastChar < LastOffset) and (LastChar <> -1) then
  281.         begin
  282.           FPreview.RtfInformation.AddOffset(SaveRect, RtfPage, fmtRange.chrg.cpMin, LastChar,
  283.             FTopMargin.AsInches, FBottomMargin.AsInches);
  284.           Inc(RtfPage);
  285.           if not FirstPage then NextPage;
  286.           FirstPage := False;
  287.         end;
  288.       until (LastChar >= LastOffset) or (LastChar = -1);
  289.     finally
  290.         if FirstPage = False then NextPage;
  291.  
  292.       FPreview.RtfInformation.AddOffset(SaveRect, RtfPage, fmtRange.chrg.cpMin, LastChar,
  293.         FTopMargin.AsInches, FBottomMargin.AsInches);
  294.       {Free cached information}
  295.       SendMessage(NewRichEdit.Handle, EM_FORMATRANGE, 0, 0);  // flush buffer
  296.  
  297.     end;
  298.   finally
  299.     ReleaseDc(0, DC);
  300.     FPreview.CurrentPage := StartPage;
  301.     for ICount := StartPage to RtfPage do
  302.     begin
  303.       FPreview.Pages[ICount].HasChanged := True;
  304.     end;
  305.     FPreview.EndUpdate;
  306.   end;
  307. end;
  308.  
  309. procedure TGmRtfPreview.NextPage;
  310. begin
  311.   if Assigned(FBeforeNewPage) then FBeforeNewPage(Self, FTopMargin, FBottomMargin);
  312.   FPreview.Canvas.Page.HasChanged := True;
  313.   if FPreview.CurrentPage = FPreview.NumPages then
  314.     FPreview.NewPage
  315.   else
  316.     FPreview.NextPage;
  317.   if Assigned(FOnNewPage) then FOnNewPage(Self, FTopMargin, FBottomMargin);
  318. end;
  319.  
  320. //------------------------------------------------------------------------------
  321.  
  322.  
  323. procedure TGmRtfPreview.LoadTextFromFile(const AFileName: string);
  324. var
  325.   AMemo: TMemo;
  326. begin
  327.   AMemo := TMemo.Create(nil);
  328.   try
  329.     AMemo.Lines.LoadFromFile(AFileName);
  330.     LoadTextFromMemo(AMemo);
  331.   finally
  332.     AMemo.Free;
  333.   end;
  334. end;
  335.  
  336. procedure TGmRtfPreview.LoadTextFromMemo(AMemo: TCustomMemo);
  337. var
  338.   AForm: TForm;
  339.   ARichEdit: TRichEdit;
  340. begin
  341.   AForm := TForm.Create(nil);
  342.   ARichEdit := TRichEdit.Create(AForm);
  343.   try
  344.     ARichEdit.Parent := AForm;
  345.     ARichEdit.PlainText := True;
  346.     ARichEdit.Font.Assign(FTextFileFont);
  347.     ARichEdit.Lines.Assign(AMemo.Lines);
  348.     FormatRichText(ARichEdit);
  349.   finally
  350.     ARichEdit.Free;
  351.     AForm.Free;
  352.   end;
  353. end;
  354.  
  355. //------------------------------------------------------------------------------
  356.  
  357. // RichEdit functions with OLE support...
  358.  
  359. procedure TGmRtfPreview.LoadRtfFromRichEdit(ARichEdit: TCustomMemo);
  360. begin
  361.   FormatRichText(ARichEdit);
  362. end;
  363.  
  364. procedure TGmRtfPreview.LoadRtfFromFile(const AFileName: string);
  365. var
  366.   AStream: TFileStream;
  367.   FileExt: string;
  368. begin
  369.     FileExt := ExtractFileExt(AFileName);
  370.   if LowerCase(FileExt) = '.txt' then
  371.   begin
  372.     LoadTextFromFile(AFileName);
  373.     Exit;
  374.   end;
  375.  
  376.   if LowerCase(FileExt) = '.rtf' then
  377.   begin
  378.     AStream := TFileStream.Create(AFileName, fmOpenRead);
  379.     try
  380.       LoadRtfFromStream(AStream);
  381.     finally
  382.       AStream.Free;
  383.     end;
  384.   end;
  385. end;
  386.  
  387. procedure TGmRtfPreview.LoadRtfFromStream(AStream: TStream);
  388. var
  389.   AForm: TForm;
  390.   ARichEdit: TCustomMemo;
  391. begin
  392.   if not Assigned(FPreview) then
  393.   begin
  394.     ShowGmError(Self, NO_PREVIEW_ASSIGNED);
  395.     Exit;
  396.   end;
  397.   ARichEdit := nil;
  398.   if Assigned(FPreview.OnNeedRichEdit) then FPreview.OnNeedRichEdit(FPreview, ARichEdit);
  399.   if ARichEdit = nil then ARichEdit := TRichEdit.Create(nil);
  400.   AForm := TForm.Create(nil);
  401.   try
  402.     Screen.Cursor := crHourGlass;
  403.        ARichEdit.Width := 0;
  404.       ARichEdit.Height := 0;
  405.       ARichEdit.Parent := Application.MainForm;
  406.     PutRtfSelection(ARichedit, AStream);
  407.       ARichEdit.Visible := False;
  408.     LoadRtfFromRichEdit(ARichEdit);
  409.   finally
  410.     ARichEdit.Free;
  411.     AForm.Free;
  412.     Screen.Cursor := crDefault;
  413.   end;
  414. end;
  415.  
  416. //------------------------------------------------------------------------------
  417.  
  418. procedure TGmRtfPreview.SetPreview(const Value: TGmPreview);
  419. begin
  420.   if Assigned(FPreview) then
  421.     FPreview.RemoveAssociatedComponent(Self);
  422.   FPreview := Value;
  423.   if Assigned(FPreview) then
  424.     FPreview.AddAssociatedComponent(Self);
  425. end;
  426.  
  427. end.
  428.