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;
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 public
constructor Create(AOwner: TComponent); override;
property PPCMX: integer read GetPPCMX; property PPCMY: integer read GetPPCMY; property PPIX: integer read GetPPIX; property PPIY: integer read GetPPIY; 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; property MaxAvailableHeight: single read GetMaxAvailableHeight; property MaxAvailableWidthPx: integer read GetMaxAvailableWidthPx; property MaxAvailableHeightPx: integer read GetMaxAvailableHeightPx; property AvailableWidth: single read GetAvailableWidth; property AvailableHeight: single read GetAvailableHeight; property AvailableWidthPx: integer read GetAvailableWidthPx; property AvailableHeightPx: integer read GetAvailableHeightPx;
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;
property BorderLeftPx: integer read GetBorderLeftPx; property BorderRightPx: integer read GetBorderRightPx; property BorderTopPx: integer read GetBorderTopPx; property BorderBottomPx: integer read GetBorderBottomPx;
property EdgeLeftPx: integer read GetEdgeLeftPx; property EdgeTopPx: integer read GetEdgeTopPx; property EdgeRightPx: integer read GetEdgeRightPx; property EdgeBottomPx: integer read GetEdgeBottomPx;
function ValidateBorders: boolean; 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; FBorderLeft := FBorderLeft*f; FBorderTop := FBorderTop*f; FBorderRight := FBorderRight*f; FBorderBottom := FBorderBottom*f; FMeasureUnits := AMeasureUnits; end; 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; end;
function TPrintHelper.GetGutterTop: single; begin case MeasureUnits of muCM: Result := GutterTopPx / PPCMY; muInch: Result := GutterTopPX /PPIY; end; end;
function TPrintHelper.GetGutterRight: single; begin case MeasureUnits of muCM: Result := GutterRightPx / PPCMX; muInch: Result := GutterRightPX /PPIX; end; end;
function TPrintHelper.GetGutterBottom: single; begin case MeasureUnits of muCM: Result := GutterBottomPx / PPCMY; muInch: Result := GutterBottomPX /PPIY; end; 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. |