home *** CD-ROM | disk | FTP | other *** search
/ Delphi 4 Bible / Delphi_4_Bible_Tom_Swan_IDG_Books_1998.iso / source / PRINTGR / MAIN.PAS < prev    next >
Pascal/Delphi Source File  |  1998-04-13  |  2KB  |  101 lines
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, Windows, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, Menus, Printers;
  8.  
  9. type
  10.   TMainForm = class(TForm)
  11.     MainMenu1: TMainMenu;
  12.     File1: TMenuItem;
  13.     Print1: TMenuItem;
  14.     N1: TMenuItem;
  15.     Exit1: TMenuItem;
  16.     PrintDialog1: TPrintDialog;
  17.     procedure Print1Click(Sender: TObject);
  18.     procedure FormPaint(Sender: TObject);
  19.     procedure Exit1Click(Sender: TObject);
  20.   private
  21.     procedure PaintGraphics(C: TCanvas; ScaleX, ScaleY: Integer);
  22.   public
  23.     { Public declarations }
  24.   end;
  25.  
  26. var
  27.   MainForm: TMainForm;
  28.  
  29. implementation
  30.  
  31. {$R *.DFM}
  32.  
  33. procedure TMainForm.PaintGraphics(C: TCanvas;
  34.   ScaleX, ScaleY: Integer);
  35. var
  36.   R: TRect;
  37.   P: TPoint;
  38.  
  39.   function ScalePoint(X, Y: Integer): TPoint;
  40.   begin
  41.     Result := Point(X * ScaleX, Y * ScaleY);
  42.   end;
  43.  
  44.   function ScaleRect(L, T, R, B: Integer): TRect;
  45.   begin
  46.     Result := Rect(L * ScaleX, T * ScaleY, R * ScaleX, B * ScaleY);
  47.   end;
  48.  
  49. begin
  50.   with C do
  51.   begin
  52.     Pen.Color := clBlue;
  53.     Brush.Color := clRed;
  54.     Brush.Style := bsCross;
  55.     Font.Name := 'Courier New';
  56.     Font.Size := 8;
  57.     Font.Style := [fsBold, fsItalic];
  58.     R := ScaleRect(12, 12, 57, 57);
  59.     Ellipse(R.Left, R.Top, R.Right, R.Bottom);
  60.     R := ScaleRect(100, 85, 160, 174);
  61.     Rectangle(R.Left, R.Top, R.Right, R.Bottom);
  62.     P := ScalePoint(12, 60);
  63.     TextOut(P.X, P.Y, 'Ellipse');
  64.     P := ScalePoint(12, 110);
  65.     TextOut(P.X, P.Y, 'Rectangle');
  66.     Font.Size := 24;
  67.     Font.Style := [fsBold, fsItalic];
  68.     P := ScalePoint(200, 75);
  69.     TextOut(P.X, P.Y, 'Graphics!');
  70.   end;
  71. end;
  72.  
  73. procedure TMainForm.Print1Click(Sender: TObject);
  74. var
  75.   ScaleX, ScaleY: Integer;
  76. begin
  77.   if PrintDialog1.Execute then
  78.   Printer.BeginDoc;
  79.   try
  80.     ScaleX := GetDeviceCaps(Printer.Canvas.Handle,
  81.       logPixelsX) div PixelsPerInch;
  82.     ScaleY := GetDeviceCaps(Printer.Canvas.Handle,
  83.       logPixelsY) div PixelsPerInch;
  84.     PaintGraphics(Printer.Canvas, ScaleX, ScaleY);
  85.   finally
  86.     Printer.EndDoc;
  87.   end;
  88. end;
  89.  
  90. procedure TMainForm.FormPaint(Sender: TObject);
  91. begin
  92.   PaintGraphics(Canvas, 1, 1);
  93. end;
  94.  
  95. procedure TMainForm.Exit1Click(Sender: TObject);
  96. begin
  97.   Close;
  98. end;
  99.  
  100. end.
  101.