home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 December / Chip_2001-12_cd1.bin / zkuste / delphi / kolekce / d56 / DM2KVCL.ZIP / PAGEDLG.PAS < prev    next >
Pascal/Delphi Source File  |  2000-09-25  |  6KB  |  158 lines
  1. {****************************************************************************}
  2. {                            Data Master 2000                                }
  3. {****************************************************************************}
  4. unit PageDlg;
  5. {$B-}
  6. interface
  7.  
  8. uses
  9.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  10.   StdCtrls, Spin, ExtCtrls, Buttons, Printers;
  11.  
  12. type
  13.   TPageSetupForm = class(TForm)
  14.     MainBevel: TBevel;
  15.     OkBitBtn: TBitBtn;
  16.     CancelBitBtn: TBitBtn;
  17.     HelpBitBtn: TBitBtn;
  18.     PreviewPB: TPaintBox;
  19.     GroupBox: TGroupBox;
  20.     Label1: TLabel;
  21.     Label2: TLabel;
  22.     Label3: TLabel;
  23.     Label4: TLabel;
  24.     LeftSE: TSpinEdit;
  25.     TopSE: TSpinEdit;
  26.     WidthSE: TSpinEdit;
  27.     HeightSE: TSpinEdit;
  28.     procedure PreviewPBPaint(Sender: TObject);
  29.     procedure PreviewPBMouseDown(Sender: TObject; Button: TMouseButton;
  30.       Shift: TShiftState; X, Y: Integer);
  31.     procedure PreviewPBMouseMove(Sender: TObject; Shift: TShiftState; X,
  32.       Y: Integer);
  33.     procedure PreviewPBMouseUp(Sender: TObject; Button: TMouseButton;
  34.       Shift: TShiftState; X, Y: Integer);
  35.     procedure SEChange(Sender: TObject);
  36.     procedure FormCreate(Sender: TObject);
  37.   private
  38.     { Private declarations }
  39.     PageW,PageH: integer;                            {printer's props buffers}
  40.     sizing: boolean;                 {true when user resizes frame with mouse}
  41.     FXo,FYo,FPlotWidth,FPlotHeight: integer;              {coordinate buffers}
  42.     Org,Temp: TPoint;                                     {for mouse resizing}
  43.     x0,y0,x1,y1,g,fw,fh,fx,fy: longint;       {used in paint & mouse handlers}
  44.     function InPage(X,Y: integer): boolean;       {true when x,y belongs leaf}
  45.   public
  46.     { Public declarations }
  47.     Xo,Yo,PlotWidth,PlotHeight: integer;          {coords of plot on the page}
  48.     procedure Execute;
  49.   end;
  50.  
  51. var PageSetupForm: TPageSetupForm;
  52.  
  53. implementation                      // this unit is exact copy of version 9.0!
  54.  
  55. {$R *.DFM}
  56.  
  57. procedure TPageSetupForm.Execute;
  58. begin
  59.   with PreviewPB do Width:=Height;                    {!!!! must be square!!!}
  60.   if (PageW=Printer.PageWidth) and (PageH=Printer.PageHeight) then
  61.   begin           {set current frame coords to previous ONLY if W,H are same!}
  62.     LeftSE.Value:=round(Xo/PageW*100); TopSE.Value:=round(Yo/PageH*100);
  63.     WidthSE.Value:=round(PlotWidth/PageW*100);
  64.     HeightSE.Value:=round(PlotHeight/PageH*100);
  65.   end else
  66.   begin PageW:=Printer.PageWidth; PageH:=Printer.PageHeight; end;
  67.   SEChange(Self);                                  {copy once more to Fxxx...}
  68.   if ShowModal=mrOk then
  69.   begin Xo:=FXo; Yo:=FYo; PlotWidth:=FPlotWidth; PlotHeight:=FPlotHeight; end;
  70. end;
  71.  
  72. procedure TPageSetupForm.PreviewPBPaint(Sender: TObject);
  73. begin                           {using ONLY X0,Y0,PlotWidth,PlotHeight values}
  74.   g:=round(PreviewPB.Width*0.03);
  75.   with PreviewPB.Canvas do
  76.   begin
  77.     if PageH>PageW then                                            {portrait?}
  78.     begin
  79.       y0:=g; y1:=PreviewPB.Height;
  80.       x0:=round(PreviewPB.Width*(1-PageW/PageH)/2); x1:=PreviewPB.Width-x0;
  81.     end else                                                      {landscape?}
  82.     begin
  83.       x0:=g; x1:=PreviewPB.Width;
  84.       y0:=round(PreviewPB.Width*(1-PageH/PageW)/2); y1:=PreviewPB.Height-y0;
  85.     end;
  86.     Brush.Color:=clBlack; Rectangle(x0,y0,x1,y1);                {paint shade}
  87.     Brush.Color:=clWhite; y0:=y0-g; y1:=y1-g; x0:=x0-g; x1:=x1-g;
  88.     Rectangle(x0,y0,x1,y1);                                       {paint leaf}
  89.     fx:=round((x1-x0)*FXo/PageW); fw:=round((x1-x0)*FPlotWidth/PageW); {frame}
  90.     fy:=round((y1-y0)*FYo/PageH); fh:=round((y1-y0)*FPlotHeight/PageH);{coord}
  91.     Brush.Color:=clBlack; FrameRect(Rect(x0+fx,y0+fy,x0+fx+fw,y0+fy+fh));
  92.   end;
  93. end;
  94.  
  95. function CorRect(x1,y1,x2,y2: integer): TRect;           {check: x1<x2, y1,y2}
  96. var i: integer;
  97. begin                                                    {TAKEN FROM WINGRAF!}
  98.   if x1>x2 then begin i:=x1; x1:=x2; x2:=i; end;
  99.   if y1>y2 then begin i:=y1; y1:=y2; y2:=i; end;
  100.   Result:=Rect(x1,y1,x2,y2);
  101. end;
  102.  
  103. function TPageSetupForm.InPage(X,Y: integer): boolean;
  104. begin Result:=(x0<X) and (x1>X) and (y0<Y) and (y1>Y); end;
  105.  
  106. procedure TPageSetupForm.PreviewPBMouseDown(Sender: TObject;
  107.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  108. begin
  109.   if Sizing or (not InPage(X,Y)) then Exit;
  110.   Org:=Point(X,Y); Temp:=Org; Sizing:=true;
  111. end;
  112.  
  113. procedure TPageSetupForm.PreviewPBMouseMove(Sender: TObject; 
  114.   Shift: TShiftState; X, Y: Integer);
  115. begin
  116.   if Sizing and InPage(X,Y) then
  117.   begin
  118.     PreviewPB.Canvas.Brush.Color:=clWhite;
  119.     PreviewPB.Canvas.DrawFocusRect(CorRect(Org.X, Org.Y, Temp.X, Temp.Y));
  120.     Temp:=Point(X,Y);
  121.     PreviewPB.Canvas.DrawFocusRect(CorRect(Org.X, Org.Y, Temp.X, Temp.Y));
  122.   end;
  123. end;
  124.  
  125. procedure TPageSetupForm.PreviewPBMouseUp(Sender: TObject;
  126.   Button:TMouseButton; Shift: TShiftState; X, Y: Integer);
  127. var R: TRect; w,h: integer;
  128. begin
  129.   if Sizing and InPage(X,Y) then
  130.   begin
  131.     Sizing:=false; R:=CorRect(Org.X, Org.Y, Temp.X, Temp.Y);
  132.     w:=round((R.Right-R.Left)/(x1-x0)*100);
  133.     if w>WidthSE.MinValue then WidthSE.Value:=w;
  134.     h:=round((R.Bottom-R.Top)/(y1-y0)*100);
  135.     if h>HeightSE.MinValue then HeightSE.Value:=h;
  136.     LeftSE.Value:=round((R.Left-x0)/(x1-x0)*100);
  137.     TopSE.Value:=round((R.Top-y0)/(y1-y0)*100);
  138.     PreviewPB.Refresh;
  139.   end;
  140. end;
  141.  
  142. procedure TPageSetupForm.SEChange(Sender: TObject);
  143. begin
  144.   FXo:=round(LeftSE.Value*PageW/100); FYo:=round(TopSE.Value*PageH/100);
  145.   FPlotWidth:=round(WidthSE.Value*PageW/100);
  146.   FPlotHeight:=round(HeightSE.Value*PageH/100); PreviewPB.Refresh;
  147. end;
  148.  
  149. procedure TPageSetupForm.FormCreate(Sender: TObject);
  150. begin                                      {set initial values from spinedits}
  151.   if Printer.Printers.Count=0 then Exit;{else error if no printers installed!}
  152.   PageW:=Printer.PageWidth; PageH:=Printer.PageHeight;
  153.   SEChange(Self);
  154.   Xo:=FXo; Yo:=FYo; PlotWidth:=FPlotWidth; PlotHeight:=FPlotHeight;
  155. end;
  156.  
  157. end.
  158.