home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / cprog / blx21.zip / OWLPRT.ARJ / PRTPAS.ARJ / RULER.PAS < prev    next >
Pascal/Delphi Source File  |  1991-12-12  |  5KB  |  190 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal for Windows                     }
  4. {   RULER.PAS                                    }
  5. {   Copyright (c) 1991 by Borland International  }
  6. {   Author: Tom Swan                             }
  7. {                                                }
  8. {************************************************}
  9.  
  10. {$R ruler.res}
  11.  
  12. program Ruler;
  13.  
  14. uses WinTypes, WinProcs, WObjects, Strings, Printer, IDs;
  15.  
  16. type
  17.  
  18.   TRulerApp = object(TApplication)
  19.     procedure InitMainWindow; virtual;
  20.   end;
  21.  
  22.   PRulerWin = ^TRulerWin;
  23.   TRulerWin = object(TWindow)
  24.     Printer: PPrinter;    { Pointer to a TPrinter object }
  25.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  26.     destructor Done; virtual;
  27.     procedure CMFilePrint(var Msg: TMessage);
  28.       virtual cm_First + cm_FilePrint;
  29.     procedure CMFilePrinterSetup(var Msg: TMessage);
  30.       virtual cm_First + cm_FilePrinterSetup;
  31.     procedure CMFileExit(var Msg: TMessage);
  32.       virtual cm_First + cm_FileExit;
  33.     procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
  34.       virtual;
  35.   end;
  36.  
  37.   PRulerOut = ^TRulerOut;
  38.   TRulerOut = object(TPrintout)
  39.     procedure PrintPage(DC: HDC; Page: Word; Size: TPoint;
  40.       var Rect: TRect; Flags: Word); virtual;
  41.   end;
  42.  
  43.  
  44. { Display or print a ruler }
  45.  
  46. procedure ShowRuler(DC: HDC);
  47. const
  48.   UnitsPerInch = 100;          { Display scale 0.01 inches per unit }
  49.   NumInches = 6;               { Size of ruler in inches }
  50.   MarksPerInch = 4;            { Number of markers for each inch }
  51.   LargeMarkerSize = Round(0.50 * UnitsPerInch);  { Size of labeled markers }
  52.   SmallMarkerSize = Round(0.25 * UnitsPerInch);  { Size of small markers }
  53. var
  54.   I: Integer;                  { For-loop control variable }
  55.   X, X1, Y1, X2, Y2: Integer;  { Coordinates for displaying ruler }
  56.   S: array[0 .. 2] of Char;    { Holds ruler digits in text form }
  57. begin
  58.   SaveDC(DC);
  59.   SetMapMode(DC, mm_LoEnglish);
  60.   X1 := Round(0.50 * UnitsPerInch);
  61.   Y1 := X1;
  62.   X2 := X1 + Round(NumInches * UnitsPerInch);
  63.   Y2 := Y1 + Round(1 * UnitsPerInch);
  64.   Rectangle(DC, X1, -Y1, X2, -Y2);
  65.   Y2 := Y1 + LargeMarkerSize;
  66.   for I := 1 to NumInches - 1 do
  67.   begin
  68.     X := X1 + (I * UnitsPerInch);
  69.     MoveTo(DC, X, -Y1);
  70.     LineTo(DC, X, -Y2);
  71.     Str(I, S);
  72.     TextOut(DC, X, -Y2, S, StrLen(S));
  73.   end;
  74.   Y2 := Y1 + SmallMarkerSize;
  75.   for I := 0 to ((NumInches * MarksPerInch) - 1) do
  76.   begin
  77.     X := X1 + ((I * UnitsPerInch) div MarksPerInch);
  78.     MoveTo(DC, X, -Y1);
  79.     LineTo(DC, X, -Y2);
  80.   end;
  81.   RestoreDC(DC, -1);
  82. end;
  83.  
  84.  
  85. { TRulerApp }
  86.  
  87.  
  88. { Initialize TRulerApp's main window }
  89.  
  90. procedure TRulerApp.InitMainWindow;
  91. begin
  92.   MainWindow := New(PRulerWin, Init(nil, 'Ruler Demonstration'));
  93. end;
  94.  
  95.  
  96. { TRulerWin }
  97.  
  98.  
  99. { Construct a TRulerWin object }
  100.  
  101. constructor TRulerWin.Init(AParent: PWindowsObject; ATitle: PChar);
  102. begin
  103.   TWindow.Init(AParent, ATitle);
  104.   with Attr do
  105.   begin
  106.     Menu := LoadMenu(HInstance, PChar(id_Menu));
  107.     X := GetSystemMetrics(sm_CXScreen) div 8;
  108.     Y := GetSystemMetrics(sm_CYScreen) div 8;
  109.     H := Y * 6;
  110.     W := X * 6;
  111.   end;
  112.   Printer := New(PPrinter, Init);
  113. end;
  114.  
  115.  
  116. { Destroy a TRulerWin object }
  117.  
  118. destructor TRulerWin.Done;
  119. begin
  120.   Dispose(Printer, Done);
  121.   TWindow.Done;
  122. end;
  123.  
  124.  
  125. { Execute File:Print command }
  126.  
  127. procedure TRulerWin.CMFilePrint(var Msg: TMessage);
  128. var
  129.   Printout: PRulerOut;
  130. begin
  131.   if Printer <> nil then
  132.   begin
  133.     Printout := New(PRulerOut, Init('Ruler Test'));
  134.     if Printout <> nil then
  135.     begin
  136.       Printout^.Banding := true;
  137.       Printer^.Print(@Self, Printout);
  138.       Dispose(Printout, Done);
  139.     end;
  140.   end;
  141. end;
  142.  
  143.  
  144. { Execute File:Printer-setup command }
  145.  
  146. procedure TRulerWin.CMFilePrinterSetup(var Msg: TMessage);
  147. begin
  148.   if Printer <> nil then Printer^.Setup(@Self);
  149. end;
  150.  
  151.  
  152. { Execute File:Exit command }
  153.  
  154. procedure TRulerWin.CMFileExit(var Msg: TMessage);
  155. begin
  156.   CloseWindow;
  157. end;
  158.  
  159.  
  160. { Paint window's contents on screen }
  161.  
  162. procedure TRulerWin.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
  163. begin
  164.   ShowRuler(PaintDC);
  165. end;
  166.  
  167.  
  168. { TRulerOut }
  169.  
  170.  
  171. { Print page (or pages) }
  172.  
  173. procedure TRulerOut.PrintPage(DC: HDC; Page: Word; Size: TPoint;
  174.   var Rect: TRect; Flags: Word);
  175. begin
  176.   ShowRuler(DC);
  177. end;
  178.  
  179.  
  180. var
  181.  
  182.   RulerApp: TRulerApp;
  183.  
  184.  
  185. begin
  186.   RulerApp.Init('Ruler');
  187.   RulerApp.Run;
  188.   RulerApp.Done;
  189. end.
  190.