PageRenderTime 34ms CodeModel.GetById 18ms app.highlight 6ms RepoModel.GetById 3ms app.codeStats 0ms

/components/printers/unix/framepagesetup.pas

http://github.com/graemeg/lazarus
Pascal | 320 lines | 262 code | 41 blank | 17 comment | 22 complexity | 2729cb1c7fa75c1361ca1c3b8ae3ade3 MD5 | raw file
  1unit framePageSetup;
  2
  3{$mode objfpc}{$H+}
  4
  5interface
  6
  7uses
  8  Classes, SysUtils, Graphics, FileUtil, LResources, Forms, ExtCtrls, StdCtrls,
  9  Printers, OsPrinters, LCLIntf, LCLProc, Controls, CupsLCL;
 10
 11type
 12  TPageSetupMode = (psmFull, psmPapers, psmMargins);
 13  TPageSetupOption = (
 14    psoMargins,         // margins and preview are visible
 15    psoPapers,          // papers group visible
 16    psoOrientation      // orientation group visible
 17  );
 18  TPageSetupOptions = set of TPageSetupOption;
 19
 20  { TframePageSetup }
 21
 22  TframePageSetup = class(TFrame)
 23    cbPaper: TComboBox;
 24    cbSource: TComboBox;
 25    panMargins: TPanel;
 26    txtLeft: TEdit;
 27    txtRight: TEdit;
 28    txtTop: TEdit;
 29    txtBottom: TEdit;
 30    gpPaper: TGroupBox;
 31    gpOrientation: TGroupBox;
 32    gpMargins: TGroupBox;
 33    lblSource: TLabel;
 34    lblPaper: TLabel;
 35    lblLeft: TLabel;
 36    lblRight: TLabel;
 37    lblTop: TLabel;
 38    lblBottom: TLabel;
 39    pbPreview: TPaintBox;
 40    panSetup: TPanel;
 41    panPreview: TPanel;
 42    radLandscape: TRadioButton;
 43    radPortrait: TRadioButton;
 44    procedure cbPaperChange(Sender: TObject);
 45    procedure panPreviewResize(Sender: TObject);
 46    procedure pbPreviewMouseDown(Sender: TObject; Button: TMouseButton;
 47      {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer);
 48    procedure pbPreviewMouseWheelDown(Sender: TObject; {%H-}Shift: TShiftState;
 49      {%H-}MousePos: TPoint; var Handled: Boolean);
 50    procedure pbPreviewMouseWheelUp(Sender: TObject; {%H-}Shift: TShiftState;
 51      {%H-}MousePos: TPoint; var Handled: Boolean);
 52    procedure pbPreviewPaint(Sender: TObject);
 53    procedure radPortraitClick(Sender: TObject);
 54  private
 55    { private declarations }
 56    FHeightTallest: Integer;
 57    FHardMargins: TRect;
 58    FKw,FKh,FZoom: Double;
 59    FOptions: TPageSetupOptions;
 60  public
 61    { public declarations }
 62    procedure Initialize(AMode: TPageSetupMode);
 63    procedure UpdatePageSize;
 64  end;
 65
 66implementation
 67
 68{$R framepagesetup.lfm}
 69
 70{ TframePageSetup }
 71
 72procedure TframePageSetup.pbPreviewPaint(Sender: TObject);
 73var
 74  R: TRect;
 75  procedure DrawMargin(AIndex: Integer; ASize: Integer);
 76  begin
 77    with pbPreview do
 78    case AIndex of
 79      0: // Left
 80        begin
 81          Canvas.MoveTo(ASize, 1);
 82          Canvas.LineTo(ASize, Height-1);
 83        end;
 84      1: //Top
 85        begin
 86          Canvas.MoveTo(1,ASize);
 87          Canvas.LineTo(Width-1, ASize);
 88        end;
 89      2: // Right
 90        begin
 91          Canvas.MoveTo(Width-1-ASize, 1);
 92          Canvas.LineTo(Width-1-ASize,Height-1);
 93        end;
 94      3: // Bottom
 95        begin
 96          Canvas.MoveTo(1,Height-1-Asize);
 97          Canvas.LineTo(Width-1, Height-1-ASize);
 98        end;
 99    end;
100  end;
101begin
102
103  if Sender=nil then ;
104
105  if not (psoMargins in FOptions) then
106    exit;
107
108  with pbPreview do
109  begin
110
111    // page frame
112    R := Rect(0,0,Width,Height);
113    Canvas.Pen.Color := clBlack;
114    Canvas.Brush.Color:=clWhite;
115    Canvas.Rectangle(R);
116
117    // hard margins
118    Canvas.Pen.Color := RGBToColor(255,204,204);
119    DrawMargin(0, FHardMargins.Left  );
120    DrawMargin(1, FHardMargins.Top   );
121    DrawMargin(2, FHardMargins.Right );
122    DrawMargin(3, FHardMargins.Bottom);
123  end;
124end;
125
126procedure TframePageSetup.radPortraitClick(Sender: TObject);
127begin
128  if sender=nil then ;
129
130  if radPortrait.Checked then
131    Printer.Orientation := poPortrait
132  else
133    Printer.Orientation := poLandsCape;
134  UpdatePageSize;
135end;
136
137procedure TframePageSetup.cbPaperChange(Sender: TObject);
138begin
139  if Printer.PaperSize.DefaultPapers then
140  begin
141    if cbPaper.ItemIndex>=0 then
142      Printer.PaperSize.PaperName := cbPaper.Items[cbPaper.ItemIndex];
143  end else
144    Printer.PaperSize.PaperName := GetCupsComboKeyValue(cbPaper);
145  UpdatePageSize;
146end;
147
148procedure TframePageSetup.panPreviewResize(Sender: TObject);
149var
150  TallH: Integer;
151begin
152  if not (psoMargins in FOptions) then
153    exit;
154
155  TallH := Round(FheightTallest * FKh);
156
157  with PanPreview do
158  if (Height<>C_BOTHSPACES) and (TallH>(Height-C_BOTHSPACES)) then
159    FZoom := (Height-C_BOTHSPACES)/TallH
160  else
161    FZoom := 1.0;
162end;
163
164procedure TframePageSetup.pbPreviewMouseDown(Sender: TObject;
165  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
166begin
167  if Button=mbMiddle then
168  begin
169    FZoom := 1;
170    UpdatePageSize;
171  end;
172end;
173
174procedure TframePageSetup.pbPreviewMouseWheelDown(Sender: TObject;
175  Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
176begin
177  FZoom := FZoom - 0.2;
178  if FZoom<0.5 then
179    FZoom := 0.5;
180  UpdatePageSize;
181  Handled := true;
182end;
183
184procedure TframePageSetup.pbPreviewMouseWheelUp(Sender: TObject;
185  Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
186begin
187  FZoom := FZoom + 0.2;
188  UpdatePageSize;
189  Handled := true;
190end;
191
192procedure TframePageSetup.UpdatePageSize;
193begin
194  if not (psoMargins in FOptions) then
195    exit;
196
197  with Printer.PaperSize.PaperRect.PhysicalRect do
198  begin
199    PbPreview.Width := Round(Fkw * (Right - Left) * FZoom) + 2;
200    PbPreview.Height := Round(FKh * (Bottom - Top) * FZoom) + 2;
201  end;
202
203  with Printer.PaperSize.PaperRect do
204  begin
205    FHardMargins.Left := Round(Fkw * (WorkRect.Left-PhysicalRect.Left) * FZoom);
206    FHardMargins.Right := Round(Fkw * (Physicalrect.Right-WorkRect.Right) * FZoom);
207    FHardMargins.Top := Round(FkH * (WorkRect.Top-PhysicalRect.Top) * FZoom);
208    FHardMargins.Bottom := Round(FkH * (PhysicalRect.Bottom-WorkRect.Bottom) * FZoom);
209  end;
210
211  {$IFDEF DebugCUPS}
212  with FHardMargins do
213  begin
214    DebugLn(' Kh=%.2f Kw=%.2f',[FKh,FKw]);
215    DebugLn(' BoxLimits L=0 T=0 R=%d B=%d',[PbPreview.Width-1,PbPreview.Height-1]);
216    DebugLn('OrgMargins L=%d T=%d R=%d B=%d',[Left,Top,Right,Bottom]);
217  end;
218  {$ENDIF}
219end;
220
221procedure TframePageSetup.Initialize(AMode: TPageSetupMode);
222var
223  i,j:Integer;
224  R: TPaperRect;
225begin
226  case AMode of
227    psmMargins:
228      FOptions := [psoMargins];
229    psmPapers:
230      FOptions := [psoPapers,psoOrientation];
231    else
232      FOptions := [psoMargins,psoPapers,psoOrientation];
233  end;
234
235  if [psoMargins,psoPapers]*FOptions<>[] then
236  begin
237    SetupCupsCombo(cbPaper, nil, 'PageSize');
238    if (cbPaper.Items.Count=0) then
239    begin
240      // no cups printer papers, use default ones
241      cbPaper.Items := Printer.PaperSize.SupportedPapers;
242      cbPaper.ItemIndex:= cbPaper.Items.IndexOf(Printer.PaperSize.PaperName);
243      cbPaper.Enabled:=true;
244    end;
245  end;
246
247  if psoPapers in FOptions then
248    SetupCupsCOmbo(cbSource, nil, 'InputSlot')
249  else
250    gpPaper.Visible := false;
251
252  //TODO: support reverse variants too?
253  gpOrientation.Visible := (psoOrientation in FOptions);
254  case Printer.Orientation of
255    poPortrait,poReversePortrait:
256      radPortrait.Checked := true;
257    poLandscape,poReverseLandscape:
258      radLandscape.Checked := true;
259  end;
260
261  if psoMargins in FOptions then
262  begin
263    // assume 100 pix = 8.5 inch (IOW, letter size width = 100 pixels)
264    with ScreenInfo do
265    begin
266      FKw := (100/8.5)/Printer.XDPI;
267      FKh := (100/8.5)*(PixelsPerInchY/PixelsPerInchX)/Printer.YDPI;
268    end;
269
270    // find the tallest paper
271    FHeightTallest := 0;
272    j := -1;
273    if cbPaper.Enabled then
274    for i:=0 to cbPaper.Items.Count-1 do
275    begin
276      if Printer.PaperSize.DefaultPapers then
277        R := Printer.PaperSize.PaperRectOf[cbPaper.Items[i]]
278      else
279        R := Printer.PaperSize.PaperRectOf[GetCupsComboKeyValue(cbPaper, i)];
280      with R.PhysicalRect do
281      if FHeightTallest<(Bottom-Top) then
282      begin
283        FHeightTallest := (Bottom-Top);
284        j := i;
285      end;
286    end;
287
288    if j>=0 then
289    begin
290      {$IFDEF DebugCUPS}
291      DebugLn(' Tallest Paper is: %s Height=%d %.2f Inch',
292       [cbPaper.Items[j],FHeightTallest,FHeightTallest/Printer.YDPI]);
293      {$ENDIF}
294    end;
295
296    // zoom factor
297    FZoom := 1.0;
298    UpdatePageSize;
299
300  end else
301  begin
302    panPreview.Visible:=false;
303    gpMargins.Visible:=false;
304  end;
305
306  if AMode=psmPapers then
307  begin
308    gpOrientation.Anchors:=[akTop,akRight,akBottom];
309    gpOrientation.Align:=alRight;
310    gpPaper.Anchors:=[akTop,akLeft];
311    gpPaper.Align:=alClient;
312    PanSetup.Align:=alClient;
313  end else
314  if AMode=psmMargins then
315    PanSetup.Height:=gpMargins.Height+C_BOTHSPACES;
316
317end;
318
319end.
320