home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PROG_PAS / AJCPRT.ZIP / AJCPRNTW.PAS < prev    next >
Pascal/Delphi Source File  |  1994-01-16  |  6KB  |  200 lines

  1. {************************************************}
  2. {                                                }
  3. {   AJC Printer Unit for Windows                 }
  4. {                                                }
  5. {   Printer control constants/functions          }
  6. {                                                }
  7. {   Author:  Andrew J. Cook                      }
  8. {            Omaha, NE                           }
  9. {            CompuServe ID:  71331,501           }
  10. {                                                }
  11. {   Written: January 1994                        }
  12. {                                                }
  13. {   Copyright:  None!  I hereby commit this unit }
  14. {                      to the public domain.     }
  15. {                                                }
  16. {************************************************}
  17.  
  18. unit AJCPrntW;
  19.  
  20. {$F+,O+,S-}
  21.  
  22. interface
  23.  
  24. uses WinTypes, WinProcs, OPrinter;
  25.  
  26. type
  27.   PAJCPrinter = ^TAJCPrinter;
  28.   TAJCPrinter = object(TPrinter)
  29.     function SetPageOrientation(Orientation:  Integer): Integer; virtual;
  30.   end;
  31.  
  32. const
  33.   pm_Size = 1;
  34.   pm_Print = 2;
  35.  
  36. type
  37.   PAJCPrintOut = ^TAJCPrintOut;
  38.   TAJCPrintOut = object(TPrintOut)
  39.     VUnitsPerInch:  Integer;
  40.     HUnitsPerInch:  Integer;
  41.     LMarginUnits:  Integer;
  42.     TMarginUnits:  Integer;
  43.     OriginalAlignmentOptions:  Word;
  44.     constructor Init(ATitle:  PChar);
  45.     destructor Done; virtual;
  46.     procedure SetPrintParams(ADC: HDC; ASize: TPoint); virtual;
  47.     function VLogPos(Pos:  Integer): Integer; virtual;
  48.     function HLogPos(Pos:  Integer): Integer; virtual;
  49.     function VInches(Inches: Real): Integer; virtual;
  50.     function HInches(Inches: Real): Integer; virtual;
  51.     function Points(APoints:  Integer): Integer; virtual;
  52.     function PrintHeader(Mode, Page:  Word): Integer; virtual;
  53.     function PrintFooter(Mode, Page:  Word): Integer; virtual;
  54.     procedure JustifyLeft;
  55.     procedure JustifyCenter;
  56.     procedure JustifyRight;
  57.   end;
  58.  
  59.  
  60. implementation
  61.  
  62. function TAJCPrinter.SetPageOrientation(Orientation: Integer): Integer;
  63. var
  64.   DevMode:  PDevMode;
  65.   Result:  Integer;
  66. begin
  67.   SetPageOrientation := -1;
  68.   if (Orientation <> dmOrient_Portrait) and
  69.      (Orientation <> dmOrient_Landscape) then
  70.        exit;
  71.   if @ExtDeviceMode = nil then exit;
  72.   if DevSettings^.dmFields or dm_Orientation = 0 then exit;
  73.  
  74.   if DevSettings^.dmOrientation = Orientation then
  75.     begin
  76.       SetPageOrientation := 1;
  77.       exit;
  78.     end;
  79.  
  80.   GetMem(DevMode, DevSettingSize);
  81.   Move(DevSettings^, DevMode^, DevSettingSize);
  82.   DevMode^.dmOrientation := Orientation;
  83.   Result := ExtDeviceMode(0, DeviceModule, DevSettings^, Device, Port,
  84.                           DevMode^, nil, dm_In_Buffer or dm_Out_Buffer);
  85.   FreeMem(DevMode, DevSettingSize);
  86.   if Result = IDOK then
  87.     SetPageOrientation := 0;
  88. end;
  89.  
  90. constructor TAJCPrintOut.Init(ATitle:  PChar);
  91. begin
  92.   inherited Init(ATitle);
  93.   OriginalAlignmentOptions := 0;
  94. end;
  95.  
  96. destructor TAJCPrintOut.Done;
  97. begin
  98.   if OriginalAlignmentOptions <> 0 then
  99.     SetTextAlign(DC, OriginalAlignmentOptions);
  100.  
  101.   inherited Done;
  102. end;
  103.  
  104. procedure TAJCPrintOut.SetPrintParams(ADC: HDC; ASize: TPoint);
  105. begin
  106.   inherited SetPrintParams(ADC, ASize);
  107.  
  108.   OriginalAlignmentOptions := GetTextAlign(DC);
  109.  
  110.   VUnitsPerInch := GetDeviceCaps(DC, LogPixelsY);
  111.   HUnitsPerInch := GetDeviceCaps(DC, LogPixelsX);
  112.  
  113.   if (1.0*Size.Y)/VUnitsPerInch > (1.0*Size.X)/HUnitsPerInch then
  114.     begin
  115.       TMarginUnits := (VInches(11) - Size.Y) div 2;
  116.       LMarginUnits := (HInches(8.5) - Size.X) div 2;
  117.     end
  118.   else
  119.     begin
  120.       TMarginUnits := (VInches(8.5) - Size.Y) div 2;
  121.       LMarginUnits := (HInches(11) - Size.X) div 2;
  122.     end;
  123. end;
  124.  
  125. function TAJCPrintOut.VLogPos(Pos: Integer): Integer;
  126. begin
  127.   if Pos < 0 then
  128.     VLogPos := Size.Y + Pos + TMarginUnits
  129.   else
  130.     VLogPos := Pos - TMarginUnits;
  131. end;
  132.  
  133.  
  134. function TAJCPrintOut.HLogPos(Pos: Integer): Integer;
  135. begin
  136.   if Pos < 0 then
  137.     HLogPos := Size.X + Pos + LMarginUnits
  138.   else
  139.     HLogPos := Pos - LMarginUnits;
  140. end;
  141.  
  142. function TAJCPrintOut.VInches(Inches: Real): Integer;
  143. begin
  144.   VInches := round(Inches * VUnitsPerInch);
  145. end;
  146.  
  147. function TAJCPrintOut.HInches(Inches: Real): Integer;
  148. begin
  149.   HInches := round(Inches * HUnitsPerInch);
  150. end;
  151.  
  152. function TAJCPrintOut.Points(APoints:  Integer): Integer;
  153. begin
  154.   Points := APoints * (VUnitsPerInch) div 72;
  155. end;
  156.  
  157. function TAJCPrintOut.PrintHeader(Mode, Page:  Word):  Integer;
  158. begin
  159.   PrintHeader := 0;
  160. end;
  161.  
  162. function TAJCPrintOut.PrintFooter(Mode, Page:  Word):  Integer;
  163. begin
  164.   PrintFooter := 0;
  165. end;
  166.  
  167. procedure TAJCPrintOut.JustifyLeft;
  168. var
  169.   AlignmentOptions:  Word;
  170. begin
  171.   AlignmentOptions := GetTextAlign(DC);
  172.   AlignmentOptions := AlignmentOptions and not (ta_left or ta_center or ta_right);
  173.   AlignmentOptions := AlignmentOptions or ta_left;
  174.   SetTextAlign(DC, AlignmentOptions);
  175. end;
  176.  
  177. procedure TAJCPrintOut.JustifyCenter;
  178. var
  179.   AlignmentOptions:  Word;
  180. begin
  181.   AlignmentOptions := GetTextAlign(DC);
  182.   AlignmentOptions := AlignmentOptions and not (ta_left or ta_center or ta_right);
  183.   AlignmentOptions := AlignmentOptions or ta_center;
  184.   SetTextAlign(DC, AlignmentOptions);
  185. end;
  186.  
  187. procedure TAJCPrintOut.JustifyRight;
  188. var
  189.   AlignmentOptions:  Word;
  190. begin
  191.   AlignmentOptions := GetTextAlign(DC);
  192.   AlignmentOptions := AlignmentOptions and not (ta_left or ta_center or ta_right);
  193.   AlignmentOptions := AlignmentOptions or ta_right;
  194.   SetTextAlign(DC, AlignmentOptions);
  195. end;
  196.  
  197.  
  198. begin
  199. end.
  200.