home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 November / Chip_2002-11_cd1.bin / zkuste / delphi / unity / d56 / DW / DW10242.ZIP / PrinterWorks.pas < prev    next >
Pascal/Delphi Source File  |  2002-04-21  |  4KB  |  147 lines
  1. (*------------------------------PrinterWorks.pas------------------------
  2.  V1.0.236 - 09.04.2002 current release
  3. ------------------------------------------------------------------------*)
  4. unit PrinterWorks;
  5.  
  6. interface
  7.  
  8. uses Windows, SysUtils, Messages, Printers, StringWorks, WinSpool;
  9.  
  10. function GetDefaultPaperBin: Integer;
  11.  
  12. procedure SetDefaultPrinter(NewDefPrinter : string);
  13. function GetPrinterStrFromIndex(index : integer) : string;
  14. function PRN_PXLPERMM_X(MM: Integer): Integer;
  15. function PRN_PXLPERMM_Y(MM: Integer): Integer;
  16. function PRN_MMToPixelX(Millimeters: Integer): Integer;
  17. function PRN_MMToPixelY(Millimeters: Integer): Integer;
  18. procedure SendASCII(Str, JobName: string);
  19.  
  20. implementation
  21.  
  22. function GetDefaultPaperBin: Integer;
  23. var
  24.   Device: array[0..cchDevicename-1] of Char;
  25.   Driver: array[0..(MAX_PATH)-1] of Char;
  26.   Port: array[0..32] of Char;
  27.   hDMode: THandle;
  28.   pDMode: PDevMode;
  29. begin
  30.   result:= -1; //Errorcode 
  31.   Printer.GetPrinter(Device, Driver, Port, hDMode);
  32.   if (hDMode<>0) then
  33.   begin
  34.     pDMode:=GlobalLock(hDMode);
  35.     if pDMode<>nil then result:= pDMode^.dmDefaultSource;
  36.   end;
  37. end;
  38.  
  39. function GetPrinterStrFromIndex(index : integer) : string;
  40. var
  41.    pri : integer;
  42.    hDeviceMode : THandle;
  43.    Device,Driver,Port : array[0..255] of char;
  44.    s,ResStr : array[0..255] of char;
  45. begin
  46.    pri:=Printer.PrinterIndex;
  47.    Printer.PrinterIndex:=index;
  48.    Printer.GetPrinter(Device,Driver,Port,hDeviceMode);
  49.    GetProfileString('Devices',Device,'',ResStr,255);
  50.    StrCopy (s, Device);
  51.    StrCat (s, ',');
  52.    StrCat (s, ResStr);
  53.    Result:=String(s);
  54.    Printer.PrinterIndex:=pri;
  55. end;
  56.  
  57. procedure SetDefaultPrinter(NewDefPrinter : string);
  58. var
  59.    ResStr : array[0..255] of char;
  60. begin
  61.    StrPCopy(ResStr,NewdefPrinter);
  62.    WriteProfileString ('windows', 'device', ResStr);
  63.    StrCopy (ResStr, 'windows');
  64.    SendMessage (HWND_BROADCAST, WM_WININICHANGE, 0, LongInt (@ResStr));
  65. end;
  66.  
  67. function PRN_PXLPERMM_X(MM: Integer): Integer;
  68. var
  69.    xPelsPerInch, xPelsPerMM, xPelsOffset: Extended;
  70. begin
  71.    xPelsPerInch:= GetDeviceCaps(Printer.Canvas.Handle, LOGPIXELSX);
  72.    xPelsPerMM:= (xPelsPerInch / 25.4);
  73.    xPelsOffset:= GetDeviceCaps(Printer.Canvas.Handle, PHYSICALOFFSETX);
  74.    result:= Abs(Round(MM * xPelsPerMM - xPelsOffset));
  75. end;
  76.  
  77. function PRN_PXLPERMM_Y(MM: Integer): Integer;
  78. var
  79.    yPelsPerInch, yPelsPerMM, yPelsOffset: Extended;
  80. begin
  81.    yPelsPerInch:= GetDeviceCaps(Printer.Canvas.Handle, LOGPIXELSY);
  82.    ShowInteger(Round(yPelsPerInch));
  83.    yPelsPerMM:= (yPelsPerInch / 25.4);
  84.    yPelsOffset:= GetDeviceCaps(Printer.Canvas.Handle, PHYSICALOFFSETY);
  85.    result:= Abs(Round(MM * yPelsPerMM - yPelsOffset));
  86. end;
  87.  
  88. function PRN_MMToPixelX(Millimeters: Integer): Integer;
  89. begin
  90.    result:= PRN_PXLPERMM_X(Millimeters);
  91. end;
  92.  
  93. function PRN_MMToPixelY(Millimeters: Integer): Integer;
  94. begin
  95.    result:= PRN_PXLPERMM_Y(Millimeters);
  96. end;
  97.  
  98. procedure SendASCII(Str, JobName: string);
  99. var Printer : array [0..255] of char;
  100.     p       : Integer;
  101.   function RawDataToPrinter(const szPrinterName : string;
  102.                             const data:string;
  103.                             dwCount : DWORD) : boolean;
  104.   var
  105.     hPrinter       : THandle;
  106.     DocInfo        : TDocInfo1;
  107.     dwJOB          : DWORD;
  108.     dwBytesWritten : DWORD;
  109.   begin
  110.     Result := False;
  111.     if OpenPrinter (pchar (szPrinterName), hPrinter, Nil) then
  112.       try
  113.         DocInfo.pDocName := PChar(JobName);
  114.         DocInfo.pOutputFile := Nil;
  115.         DocInfo.pDatatype := 'RAW';
  116.         dwJob := StartDocPrinter (hPrinter, 1, @docInfo);
  117.         if dwJob <> 0 then
  118.           try
  119.             if StartPagePrinter (hPrinter) then
  120.               try
  121.                 if WritePrinter (hPrinter, Pchar(data), dwCount, dwBytesWritten) then
  122.                   Result := dwBytesWritten = dwCount;
  123.               finally
  124.                 EndPagePrinter (hPrinter)
  125.               end
  126.           finally
  127.             EndDocPrinter (hPrinter);
  128.           end
  129.       finally
  130.         ClosePrinter (hPrinter)
  131.       end
  132.   end;
  133. begin
  134.   GetProfileString ('windows',
  135.                     'device',
  136.                     ',,,',
  137.                     Printer,
  138.                     sizeof(Printer));
  139.   p := Pos (',', Printer);
  140.   if p > 0 then
  141.     Printer [p - 1] := #0;
  142.   RawDataToPrinter (Printer, Str, length(Str));
  143. end;
  144.  
  145.  
  146. end.
  147.