1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:

unit PrintHelper;

{ PrintHelper Version 0.8

  Copyright:
    © 2002, Marko Broghammer, Fürth, Germany


    Die Benutzung und Modifikation im privaten Bereich ist ohne Einschränkung.
    Bei Änderungen und Erweiterungen ist der Author an den Ergebnissen
    interessiert.

    Die Benutzung in kommerzieller Software ist nur nach Genehmigung
    durch den Autor gestattet.

    Weitergabe dieses Quelltextes nur in vollständiger und unveränderter Form
    mit allen Dateien.

  Kontakt: webmaster@dr-broghammer.de }

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Printers;

type
  TMeasureUnits = (muCM,muInch);

  TPrintHelper = class(TComponent)
  private

  FMeasureUnits: TMeasureUnits;

  FPPCMX: integer;
  FPPCMY: integer;
  FPPIX: integer;
  FPPIY: integer;
  FPaperWidthPx: integer;
  FPaperHeightPx: integer;
  FPaperWidth: real;
  FPaperHeight: real;
  FMaxAvailableWidth: single;
  FMaxAvailableHeight: single;
  FMaxAvailableWidthPx: integer;
  FMaxAvailableHeightPx: integer;
  FAvailableWidth: single;
  FAvailableHeight: single;
  FAvailableWidthPx: integer;
  FAvailableHeightPx: integer;

  FGutterLeft: single;
  FGutterTop: single;
  FGutterRight: single;
  FGutterBottom: single;
  FGutterLeftPx: integer;
  FGutterTopPx: integer;
  FGutterRightPx: integer;
  FGutterBottomPx: integer;

  FBorderLeft: single;
  FBorderRight: single;
  FBorderTop: single;
  FBorderBottom: single;
  FBorderLeftPx: integer;
  FBorderRightPx: integer;
  FBorderTopPx: integer;
  FBorderBottomPx: integer;

  FEdgeLeftPx: integer;
  FEdgeTopPx: integer;
  FEdgeRightPx: integer;
  FEdgeBottomPx: integer;

  procedure SetMeasureUnits(AMeasureUnits: TMeasureUnits);
  procedure SetBorderLeft(ABorder: single);
  procedure SetBorderRight(ABorder: single);
  procedure SetBorderTop(ABorder: single);
  procedure SetBorderBottom(ABorder: single);

  function GetPPCMX: integer;
  function GetPPCMY: integer;
  function GetPPIX: integer;
  function GetPPIY: integer;
  function GetPaperWidthPx: integer;
  function GetPaperHeightPx: integer;
  function GetPaperWidth: real;
  function GetPaperheight: real;
  function GetMaxAvailableWidth: single;
  function GetMaxAvailableHeight: single;
  function GetMaxAvailableWidthPx: integer;
  function GetMaxAvailableHeightPx: integer;
  function GetAvailableWidth: single;
  function GetAvailableHeight: single;
  function GetAvailableWidthPx: integer;
  function GetAvailableHeightPx: integer;

  function GetGutterLeft: single;
  function GetGutterTop: single;
  function GetGutterRight: single;
  function GetGutterBottom: single;
  function GetGutterLeftPx: integer;
  function GetGutterTopPx: integer;
  function GetGutterRightPx: integer;
  function GetGutterBottomPx: integer;

  function GetBorderLeftPx: Integer;
  function GetBorderTopPx: integer;
  function GetBorderRightPx: integer;
  function GetBorderBottomPx: integer;

  function GetEdgeLeftPx: integer;
  function GetEdgeTopPx: integer;
  function GetEdgeRightPx: integer;
  function GetEdgeBottomPx: integer;


  protected
    { Protected-Deklarationen }
  public

  constructor Create(AOwner: TComponent); override;

  property PPCMX: integer read GetPPCMX;    // Logische Pixel pro cm X
  property PPCMY: integer read GetPPCMY;    // Logische Pixel pro cm Y
  property PPIX: integer read GetPPIX;      // Logische Pixel pro Inch X
  property PPIY: integer read GetPPIY;      // Logische Pixel pro Inch Y
  property PaperWidthPx: integer read GetPaperWidthPx;
  property PaperHeightPx: integer read GetPaperHeightPx;
  property PaperWidth: real read GetPaperWidth;
  property PaperHeight: real read GetPaperHeight;

  property MaxAvailableWidth: single read GetMaxAvailableWidth;  // maximal bedruckbare Breite
  property MaxAvailableHeight: single read GetMaxAvailableHeight;
  property MaxAvailableWidthPx: integer read GetMaxAvailableWidthPx; // dito in Px
  property MaxAvailableHeightPx: integer read GetMaxAvailableHeightPx;
  property AvailableWidth: single read GetAvailableWidth;    // bedruckbare Breite unter Berücksichtigung des Randes
  property AvailableHeight: single read GetAvailableHeight;
  property AvailableWidthPx: integer read GetAvailableWidthPx;    // dito in Px
  property AvailableHeightPx: integer read GetAvailableHeightPx;

  {Gutter: Unbedruckbarer RAnd}
  property GutterLeft: single read GetGutterLeft;
  property GutterTop: single read GetGutterTop;
  property GutterRight: single read GetGutterRight;
  property GutterBottom: single read GetGutterBottom;
  property GutterLeftPx: integer read GetGutterLeftPx;
  property GutterTopPx: integer read GetGutterTopPx;
  property GutterRightPx: integer read GetGutterRightPx;
  property GutterBottomPx: integer read GetGutterBottomPx;

  {Border: Druckrand, von Papierkante aus gemessen}
  property BorderLeftPx: integer read GetBorderLeftPx;
  property BorderRightPx: integer read GetBorderRightPx;
  property BorderTopPx: integer read GetBorderTopPx;
  property BorderBottomPx: integer read GetBorderBottomPx;

  {Edge: Druckrand, vom unbedruckbaren Bereich aus gemessen (Border - Gutter)}
  property EdgeLeftPx: integer read GetEdgeLeftPx;
  property EdgeTopPx: integer read GetEdgeTopPx;
  property EdgeRightPx: integer read GetEdgeRightPx;
  property EdgeBottomPx: integer read GetEdgeBottomPx;

  function ValidateBorders: boolean;      // Prüft, ob der Rand innerhalb des
                                          // bedruckbaren Bereiches liegt.

  published
  property MeasureUnits: TMeasureUnits read FMeasureUnits write SetMeasureUnits default muCM;
  property BorderLeft: single read FBorderLeft write SetBorderLeft;
  property BorderRight: single read FBorderRight write SetBorderRight;
  property BorderTop: single read FBorderTop write SetBorderTop;
  property BorderBottom: single read FBorderBottom write SetBorderBottom;

  end;

procedure Register;

implementation

procedure TPrintHelper.SetMeasureUnits(AMeasureUnits: TMeasureUnits);
var f: real;
begin
 if FMeasureUnits <> AMeasureUnits then begin
   case AMeasureUnits of
   muInch: f := 1/2.54;
   muCM: f := 2.54;
   end; // case
   FBorderLeft := FBorderLeft*f;
   FBorderTop := FBorderTop*f;
   FBorderRight := FBorderRight*f;
   FBorderBottom := FBorderBottom*f;
   FMeasureUnits := AMeasureUnits;
  end; // if
end;

procedure TPrintHelper.SetBorderLeft(ABorder: single);
begin
  if ABorder >= 0 then FBorderLeft := ABorder;
end;

procedure TPrintHelper.SetBorderRight(ABorder: single);
begin
  if ABorder >= 0 then FBorderRight := ABorder;
end;

procedure TPrintHelper.SetBorderTop(ABorder: single);
begin
  if ABorder >= 0 then FBorderTop := ABorder;
end;

procedure TPrintHelper.SetBorderBottom(ABorder: single);
begin
  if ABorder >= 0 then FBorderBottom := ABorder;
end;

function TPrintHelper.GetPPCMX: integer;
begin
  Result := Trunc(GetDeviceCaps(Printer.Handle,LogPixelsX)*(1/2.54));
end;

function TPrintHelper.GetPPCMY: integer;
begin
  Result := Trunc(GetDeviceCaps(Printer.Handle,LogPixelsY)*(1/2.54));
end;

function TPrintHelper.GetPPIX: integer;
begin
  Result := GetDeviceCaps(Printer.Handle,LogPixelsX);
end;

function TPrintHelper.GetPPIY: integer;
begin
  Result := GetDeviceCaps(Printer.Handle,LogPixelsY);
end;

function TPrintHelper.GetPaperWidthPx: integer;
begin
  Result := GetDeviceCAps(Printer.HAndle, PhysicalWidth);
end;

function TPrintHelper.GetPaperHeightPx: integer;
begin
  Result := GetDeviceCAps(Printer.HAndle, PhysicalHeight);
end;

function TPrintHelper.GetPaperWidth: real;
begin
  case MeasureUnits of
  muCM: Result := PaperWidthPx / PPCMX ;
  muInch: Result := PaperWidthPx / PPIX ;
  end;
end;

function TPrintHelper.GetPaperheight: real;
begin
  case MeasureUnits of
  muCM: Result := PaperHeightPx / PPCMY ;
  muInch: Result := PaperHeightPx / PPIY ;
  end;
end;

function TPrintHelper.GetMaxAvailableWidth: single;
begin
 case MeasureUnits of
 muCM: Result := GetDeviceCaps(Printer.Handle,HORZSIZE)/10;
 muInch: Result := GetDeviceCaps(Printer.Handle,HORZSIZE) / 25.4;
 end;
end;

function TPrintHelper.GetMaxAvailableHeight: single;
begin
 case MeasureUnits of
 muCM: Result := GetDeviceCaps(Printer.Handle,VERTSIZE)/10;
 muInch: Result := GetDeviceCaps(Printer.Handle,VERTSIZE) / 25.4;
 end;
end;

function TPrintHelper.GetMaxAvailableWidthPx: integer;
begin
 Result := GetDeviceCaps(Printer.Handle,HORZRES);
end;

function TPrintHelper.GetMaxAvailableHeightPx: integer;
begin
 Result := GetDeviceCaps(Printer.Handle,VERTRES);
end;

function TPrintHelper.GetAvailableWidth: single;
begin
 Result := PaperWidth - (BorderLeft+BorderRight);
end;

function TPrintHelper.GetAvailableHeight: single;
begin
 Result := PaperHeight -(BorderTop+BorderBottom);
end;

function TPrintHelper.GetAvailableWidthPx: integer;
begin
 Result := PaperWidthPx - (BorderLeftPx+BorderRightPx);
end;

function TPrintHelper.GetAvailableHeightPx: integer;
begin
 Result := PaperHeightPx - (BorderTopPx+BorderBottomPx);
end;

function TPrintHelper.GetGutterLeft: single;
begin
 case MeasureUnits of
 muCM: Result := GutterLeftPx / PPCMX;
 muInch: Result := GutterLeftPX /PPIX;
 end; //case
end;

function TPrintHelper.GetGutterTop: single;
begin
  case MeasureUnits of
  muCM: Result := GutterTopPx / PPCMY;
  muInch: Result := GutterTopPX /PPIY;
  end; //case
end;

function TPrintHelper.GetGutterRight: single;
begin
  case MeasureUnits of
  muCM: Result := GutterRightPx / PPCMX;
  muInch: Result := GutterRightPX /PPIX;
  end; //case
end;

function TPrintHelper.GetGutterBottom: single;
begin
 case MeasureUnits of
 muCM: Result := GutterBottomPx / PPCMY;
 muInch: Result := GutterBottomPX /PPIY;
 end; //case
end;

function TPrintHelper.GetGutterLeftPx: integer;
begin
 Result := GetDeviceCAps(Printer.Handle, PhysicalOffsetX);
end;

function TPrintHelper.GetGutterTopPx: integer;
begin
 Result := GetDeviceCAps(Printer.Handle, PhysicalOffsetY);
end;

function TPrintHelper.GetGutterRightPx: integer;
begin
 Result := PaperWidthPx - (GutterLeftPx+MaxAvailableWidthPx);
end;

function TPrintHelper.GetGutterBottomPx: integer;
begin
 Result := PaperHeightPx - (GutterTopPx+MaxAvailableHeightPx);
end;

function TPrintHelper.GetBorderLeftPx: Integer;
begin
  case MeasureUnits of
  muCM: Result := Round(BorderLeft * PPCMX);
  muInch: Result := Round(BorderLeft * PPIX);
  end;
end;

function TPrintHelper.GetBorderTopPx: integer;
begin
  case MeasureUnits of
  muCM: Result := Round(BorderTop * PPCMY);
  muInch: Result := Round(BorderTop * PPIY);
  end;
end;

function TPrintHelper.GetBorderRightPx: integer;
begin
  case MeasureUnits of
  muCM: Result := Round(BorderRight * PPCMX);
  muInch: Result := Round(BorderRight * PPIX);
  end;
end;

function TPrintHelper.GetBorderBottomPx: integer;
begin
  case MeasureUnits of
  muCM: Result := Round(BorderBottom * PPCMY);
  muInch: Result := Round(BorderBottom * PPIY);
  end;
end;

function TPrintHelper.GetEdgeLeftPx: integer;
begin
 Result := BorderLeftPx - GutterLeftPx;
end;

function TPrintHelper.GetEdgeTopPx: integer;
begin
 Result := BorderTopPx - GutterTopPx;
end;

function TPrintHelper.GetEdgeRightPx: integer;
begin
 Result := BorderRightPx - GutterRightPx;
end;

function TPrintHelper.GetEdgeBottomPx: integer;
begin
 Result := BorderBottomPx - GutterBottomPx;
end;

function TPrintHelper.ValidateBorders: boolean;
begin
 Result := true;
 If (BorderLeftPx < GutterLeftPx) or (BorderTopPx < GutterTopPx) or
    (BorderRightPx < GutterRightPx) or (BorderBottomPx < GutterBottomPx)
    then Result := false;
end;

constructor TPrintHelper.Create(AOwner: TComponent);
begin
  inherited;
  MeasureUnits := muCM;
end;

procedure Register;
begin
  RegisterComponents('System', [TPrintHelper]);
end;

end.