home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 March / Chip_2002-03_cd1.bin / zkuste / delphi / kolekce / d3456 / gmprintsuite_eval.exe / {app} / GmMultipageImage.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-01-02  |  12.3 KB  |  384 lines
  1. {******************************************************************************}
  2. {                                                                              }
  3. {                          TGmMultipageImage 2.3                              }
  4. {                                                                              }
  5. {           Copyright (c) 2001 Graham Murt  - www.MurtSoft.com                 }
  6. {                                                                              }
  7. {   Feel free to e-mail me with any comments, suggestions, bugs or help at:    }
  8. {                                                                              }
  9. {                           graham@murtsoft.com                                }
  10. {                                                                              }
  11. {******************************************************************************}
  12.  
  13. unit GmMultipageImage;
  14.  
  15. interface
  16.  
  17. uses
  18.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, GmConst,
  19.   GmPreview, Buttons, GmTypes;
  20.  
  21. type
  22.   TGmMultiPrintPage = class(TGmCustomPage)
  23.   private
  24.     FOrientation: TGmOrientation;
  25.     FPagesPerSheet: TGmPagesPerSheet;
  26.     FShowHeaderFooter: Boolean;
  27.     procedure SetPagesPerSheet(APagesPerSheet: TGmPagesPerSheet);
  28.     procedure DrawHeaderFooter(Canvas: TCanvas; AArea: TRect; Border: integer);
  29.   protected
  30.     procedure Paint; override;
  31.   public
  32.     constructor Create(AOwner: TComponent); override;
  33.     property PagesPerSheet: TGmPagesPerSheet read FPagesPerSheet write SetPagesPerSheet default gmFourPage;
  34.   end;
  35.  
  36.  
  37.   TGmMultipageImage = class(TWinControl)
  38.   private
  39.     FBtnOnePage : TSpeedButton;
  40.     FBtnTwoPage : TSpeedButton;
  41.     FBtnFourPage: TSpeedButton;
  42.     FPagesPerSheet: TGmPagesPerSheet;
  43.     FPreview: TGmPreview;
  44.     FPageImage: TGmMultiPrintPage;
  45.     FShowButtons: Boolean;
  46.     FShowHeaderFooter: Boolean;
  47.     // events...
  48.     FOnClickOnePage : TNotifyEvent;
  49.     FOnClickTwoPage : TNotifyEvent;
  50.     FOnClickFourPage: TNotifyEvent;
  51.     procedure BtnClick(Sender: TObject);
  52.     procedure SetGmPreview(APreview: TGmPreview);
  53.     procedure SetPagesPerSheet(APagesPerSheet: TGmPagesPerSheet);
  54.     procedure SetShadow(AShadow: TGmShadow);
  55.     procedure SetShowButtons(AValue: Boolean);
  56.     procedure SetShowHeaderFooter(AValue: Boolean);
  57.     function GetShadow: TGmShadow;
  58.  
  59.     { Private declarations }
  60.   protected
  61.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  62.     // update messages...
  63.     procedure MultiPageChanged(var Message: TMessage); message GM_MULTIPAGE_CHANGED;
  64.     procedure OrientationChanged(var Message: TMessage); message GM_ORIENTATION_CHANGED;
  65.     procedure ComponentResize(var Message: TMessage); message WM_SIZE;
  66.     { Protected declarations }
  67.   public
  68.     constructor Create(AOwner: TComponent); override;
  69.     destructor Destroy; override;
  70.     { Public declarations }
  71.   published
  72.     property PagesPerSheet: TGmPagesPerSheet read FPagesPerSheet write SetPagesPerSheet default gmOnePage;
  73.     property Preview: TGmPreview read FPreview write SetGmPreview;
  74.     property ShowHint;
  75.     property Shadow: TGmShadow read GetShadow write SetShadow;
  76.     property ShowButtons: Boolean read FShowButtons write SetShowButtons default True;
  77.     property ShowHeaderFooter: Boolean read FShowHeaderFooter write SetShowHeaderFooter default True;
  78.     property Visible;
  79.     property Color;
  80.     // enents...
  81.     property OnClickOnePage: TNotifyEvent read FOnClickOnePage write FOnClickOnePage;
  82.     property OnClickTwoPage: TNotifyEvent read FOnClickTwoPage write FOnClickTwoPage;
  83.     property OnClickFourPage: TNotifyEvent read FOnClickFourPage write FOnClickFourPage;
  84.     { Published declarations }
  85.   end;
  86.  
  87. //procedure Register;
  88.  
  89. implementation
  90.  
  91. {$R MultiRes.RES}
  92.  
  93. //------------------------------------------------------------------------------
  94.  
  95. constructor TGmMultiPrintPage.Create(AOwner: TComponent);
  96. begin
  97.   inherited;
  98.   FPagesPerSheet := gmFourPage;
  99. end;
  100.  
  101. procedure TGmMultiPrintPage.SetPagesPerSheet(APagesPerSheet: TGmPagesPerSheet);
  102. var
  103.   AHeight: integer;
  104.   AWidth: integer;
  105. begin
  106.   begin
  107.     if FOrientation = gmPortrait then
  108.     begin
  109.       AHeight := 60;
  110.       AWidth := 45;
  111.     end
  112.     else
  113.     begin
  114.       AHeight := 45;
  115.       AWidth := 60;
  116.     end;
  117.     FPagesPerSheet := APagesPerSheet;
  118.     // resize page...
  119.     if FPagesPerSheet = gmTwoPage then
  120.     begin
  121.       Height := AWidth;
  122.       Width := AHeight;
  123.     end
  124.     else
  125.     begin
  126.       Height := AHeight;
  127.       Width := AWidth;
  128.     end;
  129.     Top := (TWinControl(Owner).Height - Height) div 2;
  130.     Invalidate;
  131.   end;
  132. end;
  133.  
  134. procedure TGmMultiPrintPage.DrawHeaderFooter(Canvas: TCanvas; AArea: TRect; Border: integer);
  135. begin
  136.   if FShowHeaderFooter then
  137.   begin
  138.     Canvas.Pen.Color := $00777777;
  139.     Canvas.Polyline([Point(AArea.Left+Border, AArea.Top+Border)   , Point(AArea.Right-Border, AArea.Top+Border)]);
  140.     Canvas.Polyline([Point(AArea.Left+Border, AArea.Bottom-Border), Point(AArea.Right-Border, AArea.Bottom-Border)]);
  141.   end;
  142. end;
  143.  
  144. procedure TGmMultiPrintPage.Paint;
  145. var
  146.   PageArea: TRect;
  147.   CurrentRect: TRect;
  148. begin
  149.   inherited;
  150.  
  151.   Canvas.Pen.Style := psSolid;
  152.   if FPagesPerSheet = gmOnePage then
  153.   begin
  154.     PageArea := Rect(0,0,((Width-Shadow.Width)), ((Height-Shadow.Width)-2));
  155.     DrawHeaderFooter(Canvas, PageArea, 6);
  156.   end
  157.   else
  158.   if FPagesPerSheet = gmTwoPage then
  159.   begin
  160.     PageArea := Rect(0,0,((Width-Shadow.Width)), ((Height-Shadow.Width)-2));
  161.     if FOrientation = gmPortrait then
  162.       CurrentRect := Rect(PageArea.Left, PageArea.Top, PageArea.Right div 2, PageArea.Bottom)
  163.     else
  164.       CurrentRect := Rect(PageArea.Left, PageArea.Top, PageArea.Right, PageArea.Bottom div 2);
  165.     DrawHeaderFooter(Canvas, CurrentRect, 5);
  166.       
  167.     if FOrientation = gmPortrait then
  168.       CurrentRect := Rect(PageArea.Right div 2, PageArea.Top, PageArea.Right, PageArea.Bottom)
  169.     else
  170.       CurrentRect := Rect(PageArea.Left, PageArea.Bottom div 2, PageArea.Right, PageArea.Bottom);
  171.     DrawHeaderFooter(Canvas, CurrentRect, 5);
  172.  
  173.     Canvas.Pen.Color := clSilver;
  174.     if FOrientation = gmPortrait then
  175.       Canvas.PolyLine([Point(PageArea.Right div 2 , 1), Point(PageArea.Right div 2 , PageArea.Bottom)])
  176.     else
  177.       Canvas.PolyLine([Point(1 , PageArea.Bottom div 2), Point(PageArea.Right, PageArea.Bottom div 2)])
  178.   end
  179.   else
  180.   if FPagesPerSheet = gmFourPage then
  181.   begin
  182.     PageArea := Rect(0,0,((Width-Shadow.Width)), ((Height-Shadow.Width)-2));
  183.     CurrentRect := Rect(PageArea.Left, PageArea.Top, PageArea.Right div 2, PageArea.Bottom div 2);
  184.     DrawHeaderFooter(Canvas, CurrentRect, 4);
  185.     CurrentRect := Rect(PageArea.Right div 2, PageArea.Top, PageArea.Right, PageArea.Bottom div 2);
  186.     DrawHeaderFooter(Canvas, CurrentRect, 4);
  187.     CurrentRect := Rect(PageArea.Left, PageArea.Bottom div 2, PageArea.Right div 2, PageArea.Bottom);
  188.     DrawHeaderFooter(Canvas, CurrentRect, 4);
  189.     CurrentRect := Rect(PageArea.Right div 2, PageArea.Bottom div 2, PageArea.Right, PageArea.Bottom);
  190.     DrawHeaderFooter(Canvas, CurrentRect, 4);
  191.     Canvas.Pen.Color := clSilver;
  192.     Canvas.PolyLine([Point(PageArea.Right div 2 , 1), Point(PageArea.Right div 2 , PageArea.Bottom)]);
  193.     Canvas.PolyLine([Point(1 , PageArea.Bottom div 2), Point(PageArea.Right , PageArea.Bottom div 2)]);
  194.   end;  
  195. end;
  196.  
  197. //------------------------------------------------------------------------------
  198.  
  199.  
  200. constructor TGmMultipageImage.Create(AOwner: TComponent);
  201. begin
  202.   inherited Create(AOwner);
  203.   Width := 105;
  204.   Height := 81;
  205.   FPageImage := TGmMultiPrintPage.Create(Self);
  206.     FPageImage.FShowHeaderFooter := True;
  207.  
  208.   FShowHeaderFooter := True;
  209.   with FPageImage do
  210.   begin
  211.     Left := 40;
  212.     Width := 45;
  213.     Height := 60;
  214.     Shadow.Width := 2;
  215.     Parent := Self;
  216.   end;
  217.   FShowButtons := False;
  218.   PagesPerSheet := gmOnePage;
  219.   SetShowButtons(True);
  220. end;
  221.  
  222. destructor TGmMultipageImage.Destroy;
  223. begin
  224.   //if Assigned(FPreview) then SendMessage(FPreview.Handle, GM_UNREGISTER_COMPONENT, Handle, 0);
  225.   if Assigned(FBtnOnePage) then FBtnOnePage.Free;
  226.   if Assigned(FBtnTwoPage) then FBtnTwoPage.Free;
  227.   if Assigned(FBtnFourPage) then FBtnFourPage.Free;
  228.   FPageImage.Free;
  229.   inherited Destroy;
  230. end;
  231.  
  232. procedure TGmMultipageImage.Notification(AComponent: TComponent; Operation: TOperation);
  233. begin
  234.   inherited Notification(AComponent, Operation);
  235.   if (Operation = opRemove) and (AComponent = FPreview) then
  236.     FPreview := nil;
  237.   //if (Operation = opRemove) and (AComponent = FPreview) then
  238. end;
  239.  
  240. procedure TGmMultipageImage.MultiPageChanged(var Message: TMessage);
  241. begin
  242.   if PagesPerSheet <> FPreview.PagesPerSheet then
  243.     PagesPerSheet := FPreview.PagesPerSheet;
  244. end;
  245.  
  246. procedure TGmMultiPageImage.OrientationChanged(var Message: TMessage);
  247. begin
  248.   SetPagesPerSheet(FPagesPerSheet);
  249. end;
  250.  
  251. procedure TGmMultiPageImage.ComponentResize(var Message: TMessage);
  252. begin
  253.   Width := 105;
  254.   Height := 81;
  255. end;
  256.  
  257. procedure TGmMultipageImage.BtnClick(Sender: TObject);
  258. begin
  259.   if (Sender = FBtnOnePage) and (PagesPerSheet <> gmOnePage) then
  260.   begin
  261.     PagesPerSheet := gmOnePage;
  262.     if Assigned(FOnClickOnePage) then FOnClickOnePage(Self);
  263.   end
  264.   else
  265.   if (Sender = FBtnTwoPage) and (PagesPerSheet <> gmTwoPage) then
  266.   begin
  267.     PagesPerSheet := gmTwoPage;
  268.     if Assigned(FOnClickTwoPage) then FOnClickTwoPage(Self);
  269.   end
  270.   else
  271.   if (Sender = FBtnFourPage) and (PagesPerSheet <> gmFourPage) then
  272.   begin
  273.     PagesPerSheet := gmFourPage;
  274.     if Assigned(FOnClickFourPage) then FOnClickFourPage(Self);
  275.   end;
  276. end;
  277.  
  278. procedure TGmMultiPageImage.SetGmPreview(APreview: TGmPreview);
  279. begin
  280.   if Assigned(APreview) then
  281.   begin
  282.     FPreview := APreview;
  283.     if Assigned(FPreview) then FPreview.AddAssociatedComponent(Self);
  284.     //SendMessage(FPreview.Handle, GM_REGISTER_COMPONENT, Handle, 0);
  285.     PagesPerSheet := FPreview.PagesPerSheet;
  286.   end
  287.   else
  288.     FPreview := nil;
  289. end;
  290.  
  291. procedure TGmMultipageImage.SetPagesPerSheet(APagesPerSheet: TGmPagesPerSheet);
  292. begin
  293.   FPagesPerSheet := APagesPerSheet;
  294.   if Assigned(FPreview) then FPageImage.FOrientation := FPreview.Orientation;
  295.   FPageImage.PagesPerSheet := APagesPerSheet;
  296.   // select the correct button...
  297.   if FShowButtons then
  298.   begin
  299.     FBtnOnePage.Down  := APagesPerSheet = gmOnePage;
  300.     FBtnTwoPage.Down  := APagesPerSheet = gmTwoPage;
  301.     FBtnFourPage.Down := APagesPerSheet = gmFourPage;
  302.   end;  
  303.   if Assigned(FPreview) then FPreview.PagesPerSheet := APagesPerSheet;
  304.   Invalidate;
  305. end;
  306.  
  307. procedure TGmMultipageImage.SetShadow(AShadow: TGmShadow);
  308. begin
  309.   FPageImage.Shadow := AShadow;
  310.   FPageImage.Invalidate;
  311. end;
  312.  
  313. procedure TGmMultipageImage.SetShowButtons(AValue: Boolean);
  314. begin
  315.   if FShowButtons <> AValue then
  316.   begin
  317.     if AValue = True then
  318.     begin
  319.       FPageImage.Left := 40;
  320.       FBtnOnePage := TSpeedButton.Create(Self);
  321.       with FBtnOnePage do
  322.       begin
  323.         Top := 4;
  324.         Left := 8;
  325.         Glyph.LoadFromResourceName(HInstance, 'ONE');
  326.         GroupIndex := 1;
  327.         Down := True;
  328.         OnClick := BtnClick;
  329.       end;
  330.       FBtnTwoPage := TSpeedButton.Create(Self);
  331.       with FBtnTwoPage do
  332.       begin
  333.         Top := 28;
  334.         Left := 8;
  335.         Glyph.LoadFromResourceName(HInstance, 'TWO');
  336.         GroupIndex := 1;
  337.         OnClick := BtnClick;
  338.       end;
  339.       FBtnFourPage := TSpeedButton.Create(Self);
  340.       with FBtnFourPage do
  341.       begin
  342.         Top := 52;
  343.         Left := 8;
  344.         Glyph.LoadFromResourceName(HInstance, 'FOUR');
  345.         GroupIndex := 1;
  346.         OnClick := BtnClick;
  347.       end;
  348.       FBtnOnePage.Parent := Self;
  349.       FBtnTwoPage.Parent := Self;
  350.       FBtnFourPage.Parent := Self;
  351.     end
  352.     else
  353.     begin
  354.       FPageImage.Left := 4;
  355.       FBtnOnePage.Free;
  356.       FBtnTwoPage.Free;
  357.       FBtnFourPage.Free;
  358.       FBtnOnePage := nil;
  359.       FBtnTwoPage := nil;
  360.       FBtnFourPage := nil;
  361.     end;
  362.     FShowButtons := AValue;
  363.   end;
  364. end;
  365.  
  366. procedure TGmMultipageImage.SetShowHeaderFooter(AValue: Boolean);
  367. begin
  368.   FShowHeaderFooter := AValue;
  369.   FPageImage.FShowHeaderFooter := AValue;
  370.   FPageImage.Repaint;
  371. end;
  372.  
  373. function TGmMultipageImage.GetShadow: TGmShadow;
  374. begin
  375.   Result := FPageImage.Shadow;
  376. end;
  377.  
  378. {procedure Register;
  379. begin
  380.   RegisterComponents('GmPrintSuite', [TGmMultipageImage]);
  381. end;}
  382.  
  383. end.
  384.