home *** CD-ROM | disk | FTP | other *** search
/ Delphi Developer's Kit 1996 / Delphi Developer's Kit 1996.iso / power / crystgt / crystgt.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-12-22  |  4.1 KB  |  159 lines
  1. unit Crystgt;
  2.  
  3. interface
  4.  
  5. uses
  6.   Crpe, Dsgnintf, Forms, Controls,
  7.   SysUtils, WinTypes, WinProcs, Messages, Classes, TypInfo;
  8.  
  9.  
  10. type
  11.   TOutputToList = ( ToScreen, ToPrinter );
  12.  
  13.   TWindowStyleList = ( MDIDefault, MDIChild);
  14.  
  15.   ECrystalError=Class(Exception);
  16.  
  17.   TCrystalGT = class(TComponent)
  18.   private
  19.     { Private declarations }
  20.     FCrystalBar: Boolean;
  21.     FReportFile, FCaptionWindow, FSelectionFormula,
  22.     FGrpSelectFormula: string;
  23.     FRepTop, FRepLeft, FRepWidth, FRepHeight, FPrintCopies: Integer;
  24.     FWindowStyle: TWindowStyleList;
  25.     FOutputTo: TOutputToList;
  26.   protected
  27.     procedure FSetOutputTo( Value : TOutputToList );
  28.     procedure FSetWindowStyle( Value : TWindowStyleList );
  29.  
  30.   public
  31.     { Public declarations }
  32.     Constructor Create(AOwner:TComponent); override;
  33.     Function Print: Integer;
  34.     Destructor Free;
  35.   published
  36.     property ReportFile: string read FReportFile write FReportFile;
  37.     property CaptionWindow: string read FCaptionWindow write FCaptionWindow;
  38.     Property WindowTop: Integer read FRepTop write FRepTop;
  39.     Property WindowLeft: Integer read FRepLeft write FRepLeft;
  40.     Property WindowWidth: Integer read FRepWidth write FRepWidth;
  41.     Property WindowHeight: Integer read FRepHeight write FRepHeight;
  42.     Property OutputTo: TOutputToList read FOutputTo write FSetOutputTo;
  43.     Property PrintCopies: Integer read FPrintCopies write FPrintCopies;
  44.     Property WindowStyle: TWindowStyleList read FWindowStyle write FSetWindowStyle;
  45.     property CrystalBar: boolean read FCrystalBar write FCrystalBar;
  46.     property SelectionFormula: string read FSelectionFormula write FSelectionFormula;
  47.     property GrpSelectFormula: string read FGrpSelectFormula write FGrpSelectFormula;
  48.  
  49.   end;
  50.  
  51. Procedure Register;
  52.  
  53. implementation
  54.  
  55. Constructor TCrystalGT.Create(AOwner:TComponent);
  56. begin
  57.   Inherited Create(AOwner);
  58.   FCaptionWindow := 'Screen Preview';
  59.   FRepTop := 10;
  60.   FRepLeft := 10;
  61.   FRepWidth := 540;
  62.   FRepHeight := 380;
  63.   FPrintCopies := 1;
  64.   FCrystalBar := true;
  65.  
  66.   if not PEOpenEngine then
  67.      raise ECrystalError.Create('Unable to open Crystal Engine');
  68. end;
  69.  
  70. Destructor TCrystalGT.Free;
  71. begin
  72.   PECloseEngine;
  73.   Inherited Free;
  74. end;
  75.  
  76. Function TCrystalGT.Print: Integer;
  77. var
  78. RepName: array[0..79] of Char;
  79. RepTitle: array[0..79] of Char;
  80. RepPrntFile: array[0..79] of Char;
  81. SFormula: array[0..79] of Char;
  82. GroupSFormula: array[0..79] of Char;
  83.  
  84. JobHandle: hWnd;
  85. RepWin: hWnd;
  86. Job: Integer;
  87.  
  88. begin
  89.      Screen.Cursor := crHourglass;
  90.  
  91.      StrPCopy(RepTitle,FCaptionWindow);
  92.      StrPCopy(RepName,FReportFile);
  93.      StrPCopy(SFormula,FSelectionFormula);
  94.  
  95.      PEOpenEngine;
  96.  
  97.      Job := PEOpenPrintJob(RepName);
  98.      JobHandle := PEGetWindowHandle(Job);
  99.      RepWin := GetActiveWindow;
  100.  
  101.      PEShowPrintControls(job,FCrystalBar) ;
  102.      PESetSelectionFormula(job,SFormula);
  103.      PESetGroupSelectionFormula(job,GroupSFormula);
  104.  
  105.      if FOutPutTo = ToScreen then
  106.      begin
  107.      If FWindowStyle = MDIChild then
  108.         begin
  109.           PEOutputToWindow(Job,RepTitle,FRepTop,FRepLeft,FRepWidth,FRepHeight,
  110.                  WS_VISIBLE OR WS_CAPTION OR WS_THICKFRAME
  111.                  OR WS_SYSMENU OR WS_MINIMIZEBOX OR WS_MAXIMIZEBOX, RepWin);
  112.          end
  113.      else
  114.          begin
  115.          PEOutputToWindow(Job,RepTitle,FRepTop,FRepLeft,FRepWidth,FRepHeight,
  116.                  WS_VISIBLE OR WS_CAPTION OR WS_THICKFRAME
  117.                  OR WS_SYSMENU OR WS_MINIMIZEBOX OR WS_MAXIMIZEBOX, 0);
  118.         
  119.      end;
  120.      end;
  121.  
  122.     if FOutPutTo = ToPrinter then
  123.      begin
  124.           PEOutputToPrinter(job,FPrintCopies)
  125.      end;
  126.  
  127.      PEStartPrintJob(Job,True);
  128.      PECloseEngine;
  129.      Screen.Cursor := crDefault;
  130.  
  131. end;
  132.  
  133.  procedure TCrystalGT.FSetOutputTo( Value : TOutputToList );
  134.   begin
  135.     if Value <> FOutputTo then
  136.     begin
  137.       FOutputTo := Value;
  138.      end;
  139.   end;
  140.  
  141.  procedure TCrystalGT.FSetWindowStyle( Value : TWindowStyleList);
  142.   begin
  143.   if Value <> FWindowStyle then
  144.     begin
  145.       FWindowStyle := Value;
  146.  
  147.     end;
  148.   end;
  149.  
  150.  
  151.  
  152. Procedure Register;
  153. begin
  154.   RegisterComponents('Data Access',[TCrystalGT]);
  155.   
  156.    end;
  157.  
  158. end.
  159.