bestlong 怕失憶論壇

標題: 新增報表紙張格式的需求 [打印本頁]
作者: bestlong    時間: 2010-5-26 21:14     標題: 新增報表紙張格式的需求

From http://jasper-dale.spaces.live.c ... E92E2726C!244.entry

如果公司有用到特別紙張的規格，而作業系統本身並沒有的時候，希望藉由系統的執行時建立系統已知會使用到的紙張格式。在這邊會用到Window API中的AddForm, SetForm, DeleteForm, GetForm, DeviceCapabilities等方法，以下提供給大家作參考。
  1. interface

  3. uses Windows, Classes;

  5. type
  6.   TPaperName = array[0..63] of Char;
  7.   TPaperNameArray =
  8.     array[1..(High(Word) div Sizeof(TPaperName))] of TPaperName;
  9.   PPapernameArray = ^TPaperNameArray;

  11. procedure AddPrinterPaper(const vName: string; vWidth, vLength: integer);
  12. procedure SetPrinterPaper(const vName: string; vWidth, vLength: integer);
  13. procedure GetPrinterPaper(const vName: string; var vWidth, vLength: integer);
  14. procedure DelPrinterPaper(const vName: string);
  15. procedure GetPrinterPapers(vStrs: TStrings);
  16. procedure ReplacePrinterPaper(const vName: string; vWidth, vLength: integer);
  17. function PrinterPaperExists(const vName: string): Boolean;

  19. implementation

  21. uses Printers, WinSpool, SysUtils;

  23. procedure AddPrinterPaper(const vName: string; vWidth, vLength: integer);
  24. var
  25.   PrintDevice, PrintDriver, PrintPort: array[0..255] of Char;
  26.   hDMode: THandle;
  27.   hPrinter: THandle;
  28.   FormInfo: TFormInfo1;
  29.   PaperSize: TSize;
  30.   PaperRect: TRect;
  31.   errcode: integer;
  32.   s: string;
  33. begin
  34.   Printer.GetPrinter(PrintDevice, PrintDriver, PrintPort, hDMode);
  35.   OpenPrinter(PrintDevice, hPrinter, nil);
  36.   if (hPrinter = 0) then
  37.   begin
  38.     raise Exception.Create('Failed to open printer!');
  39.     Exit;
  40.   end;
  41.   FormInfo.Flags := FORM_USER;
  42.   FormInfo.pName := PChar(vName);
  43.   PaperSize.cx := vWidth * 100;
  44.   PaperSize.cy := vLength * 100;
  45.   PaperRect.Left := 0;
  46.   PaperRect.Top := 0;
  47.   PaperRect.Right := vWidth * 100;
  48.   PaperRect.Bottom := vLength * 100;
  49.   FormInfo.Size := PaperSize;
  50.   FormInfo.ImageableArea := PaperRect;
  51.   if (not AddForm(hPrinter, 1, @FormInfo)) then
  52.   begin
  53.     errcode := GetLastError;
  54.     if (errcode <> ERROR_FILE_EXISTS) then // Form name exists?
  55.     begin
  56.       case errcode of
  57.         ERROR_ACCESS_DENIED: s := 'Access is denied';
  58.         ERROR_INVALID_HANDLE: s := 'The handle is invalid';
  59.         ERROR_NOT_READY: s := 'The device is not ready';
  60.         ERROR_CALL_NOT_IMPLEMENTED:
  61.           s := 'Function "AddForm" is not supported on this system';
  62.       else
  63.         s := 'Failed to add a Form (paper) name!';
  64.       end;
  65.       raise Exception.Create(s);
  66.     end;
  67.   end;
  68.   ClosePrinter(hPrinter);
  69. end;

  71. procedure SetPrinterPaper(const vName: string; vWidth, vLength: integer);
  72. var
  73.   PrintDevice, PrintDriver, PrintPort: array[0..255] of Char;
  74.   hDMode: THandle;
  75.   hPrinter: THandle;
  76.   FormInfo: TFormInfo1;
  77.   PaperSize: TSize;
  78.   PaperRect: TRect;
  79.   errcode: integer;
  80.   s: string;
  81. begin
  82.   Printer.GetPrinter(PrintDevice, PrintDriver, PrintPort, hDMode);
  83.   OpenPrinter(PrintDevice, hPrinter, nil);
  84.   if (hPrinter = 0) then
  85.   begin
  86.     raise Exception.Create('Failed to open printer!');
  87.     Exit;
  88.   end;
  89.   FormInfo.Flags := FORM_USER;
  90.   FormInfo.pName := PChar(vName);
  91.   PaperSize.cx := vWidth * 100;
  92.   PaperSize.cy := vLength * 100;
  93.   PaperRect.Left := 0;
  94.   PaperRect.Top := 0;
  95.   PaperRect.Right := vWidth * 100;
  96.   PaperRect.Bottom := vLength * 100;
  97.   FormInfo.Size := PaperSize;
  98.   FormInfo.ImageableArea := PaperRect;
  99.   if not SetForm(hPrinter, PChar(vName), 1, @FormInfo) then
  100.   begin
  101.     errcode := GetLastError;
  102.     if (errcode <> ERROR_FILE_EXISTS) then // Form name exists?
  103.     begin
  104.       case errcode of
  105.         ERROR_ACCESS_DENIED: s := 'Access is denied';
  106.         ERROR_INVALID_HANDLE: s := 'The handle is invalid';
  107.         ERROR_NOT_READY: s := 'The device is not ready';
  108.         ERROR_CALL_NOT_IMPLEMENTED:
  109.           s := 'Function "SetForm" is not supported on this system';
  110.       else
  111.         s := 'Failed to set a Form (paper) name!';
  112.       end;
  113.       raise Exception.Create(s);
  114.     end;
  115.   end;
  116.   ClosePrinter(hPrinter);
  117. end;

  119. procedure GetPrinterPaper(const vName: string; var vWidth, vLength: integer);
  120. var
  121.   PrintDevice, PrintDriver, PrintPort: array[0..255] of Char;
  122.   hDMode: THandle;
  123.   hPrinter: THandle;
  124.   FormInfo: TFormInfo1;
  125.   PaperSize: TSize;
  126.   errcode: integer;
  127.   s: string;
  128.   cbBuf: DWORD;
  129.   pcbNeeded: DWORD;
  130. begin
  131.   Printer.GetPrinter(PrintDevice, PrintDriver, PrintPort, hDMode);
  132.   OpenPrinter(PrintDevice, hPrinter, nil);
  133.   if (hPrinter = 0) then
  134.   begin
  135.     raise Exception.Create('Failed to open printer!');
  136.     Exit;
  137.   end;
  138.   cbBuf := sizeof(TPaperName);
  139.   cbBuf := cbBuf + sizeof(TFormInfo1);
  140.   if GetForm(hPrinter, PChar(vName), 1, @FormInfo, cbBuf, pcbNeeded) then
  141.   begin
  142.     PaperSize := FormInfo.Size;
  143.     vWidth := Trunc(PaperSize.cx / 100);
  144.     vLength := Trunc(PaperSize.cy / 100);
  145.   end
  146.   else
  147.   begin
  148.     errcode := GetLastError;
  149.     if (errcode <> ERROR_FILE_EXISTS) then // Form name exists?
  150.     begin
  151.       case errcode of
  152.         ERROR_ACCESS_DENIED: s := 'Access is denied';
  153.         ERROR_INVALID_HANDLE: s := 'The handle is invalid';
  154.         ERROR_NOT_READY: s := 'The device is not ready';
  155.         ERROR_CALL_NOT_IMPLEMENTED:
  156.           s := 'Function "GetForm" is not supported on this system';
  157.         ERROR_INSUFFICIENT_BUFFER:
  158.           s := 'The data area passed to a system call is too small.';
  159.       else
  160.         s := 'Failed to get a Form (paper) name!';
  161.       end;
  162.       raise Exception.Create(s);
  163.     end;
  164.   end;
  165.   ClosePrinter(hPrinter);
  166. end;

  168. procedure DelPrinterPaper(const vName: string);
  169. var
  170.   PrintDevice, PrintDriver, PrintPort: array[0..255] of Char;
  171.   hDMode: THandle;
  172.   hPrinter: THandle;
  173.   FormName: string;
  174.   errcode: integer;
  175.   s: string;
  176. begin
  177.   Printer.GetPrinter(PrintDevice, PrintDriver, PrintPort, hDMode);
  178.   OpenPrinter(PrintDevice, hPrinter, nil);
  179.   if (hPrinter = 0) then
  180.   begin
  181.     raise Exception.Create('Failed to open printer!');
  182.     Exit;
  183.   end; //if...end!!
  184.   if not DeleteForm(hPrinter, PChar(vName)) then
  185.   begin
  186.     errcode := GetLastError;
  187.     if (errcode <> ERROR_FILE_EXISTS) then // Form name exists?
  188.     begin
  189.       case errcode of
  190.         ERROR_ACCESS_DENIED: s := 'Access is denied';
  191.         ERROR_INVALID_HANDLE: s := 'The handle is invalid';
  192.         ERROR_NOT_READY: s := 'The device is not ready';
  193.         ERROR_CALL_NOT_IMPLEMENTED:
  194.           s := 'Function "GetForm" is not supported on this system';
  195.       else
  196.         s := 'Failed to get a Form (paper) name!';
  197.       end; //case...end!!
  198.       raise Exception.Create(s);
  199.     end; //if...end!!
  200.   end;
  201.   ClosePrinter(hPrinter);
  202. end;

  204. procedure GetPrinterPapers(vStrs: TStrings);
  205. var
  206.   Device, Driver, Port: array[0..255] of Char;
  207.   hDevMode: THandle;
  208.   j, numPaperformats: Integer;
  209.   pPaperFormats: PPapernameArray;
  210.   vPrinter: TPrinter;
  211. begin
  212.   vPrinter := TPrinter.Create;
  213.   vPrinter.PrinterIndex := -1;
  214.   vPrinter.GetPrinter(Device, Driver, Port, hDevmode);
  215.   numPaperformats :=
  216.     WinSpool.DeviceCapabilities(Device, Port, DC_PAPERNAMES, nil, nil);
  217.   if numPaperformats > 0 then
  218.   begin
  219.     GetMem(pPaperformats,
  220.       numPaperformats * Sizeof(TPapername));
  221.     vStrs.clear;
  222.     try
  223.       WinSpool.DeviceCapabilities
  224.         (Device, Port, DC_PAPERNAMES,
  225.         Pchar(pPaperFormats), nil);
  226.       for j := 1 to numPaperformats do
  227.         vStrs.add(pPaperformats^[j]);
  228.     finally
  229.       FreeMem(pPaperformats);
  230.     end;
  231.   end;
  232. end;

  234. procedure ReplacePrinterPaper(const vName: string; vWidth, vLength: integer);
  235. begin
  236.   if PrinterPaperExists(vName) then
  237.     SetPrinterPaper(vName, vWidth, vLength)
  238.   else
  239.     AddPrinterPaper(vName, vWidth, vLength)
  240. end;

  242. function PrinterPaperExists(const vName: string): Boolean;
  243. var
  244.   vStrs: TStrings;
  245. begin
  246.   vStrs := TStringList.Create;
  247.   GetPrinterPapers(vStrs);
  248.   Result := (vStrs.IndexOf(vName) >= 0);
  249.   vStrs.Free;
  250. end;
  251. end.
複製代碼




歡迎光臨 bestlong 怕失憶論壇 (http://www.bestlong.idv.tw/) Powered by Discuz! X1.5