home *** CD-ROM | disk | FTP | other *** search
/ Prima Shareware 3 / DuCom_Prima-Shareware-3_cd1.bin / PROGRAMO / PASCAL / ORNTDLL / ORNTDLL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-08-27  |  17.6 KB  |  482 lines
  1. {************************************************************************ }
  2. {                                                                         }
  3. {                            ORNTDLL.PAS  version 1.0                     }
  4. {                                                                         }
  5. {************************************************************************
  6.  
  7.  Programmer: Jeffrey R. Price                 EMail: Price.9@OSU.EDU
  8.              The Ohio State University        Phone: (614) 292-1741
  9.              College of Business                Fax: (614) 292-1651
  10.              Computing Services Center
  11.  
  12. {************************************************************************
  13.  
  14.  This program and the ORNTDLL.DLL files are freeware.  You may use them
  15.  freely.  If you find the program useful, send me some Email......
  16.  
  17. {************************************************************************
  18.  
  19.  This Program is used to create a Dynamic Link Library (DLL) that exists
  20.  solely to control several printer features.
  21.  
  22.  I wrote it using examples from "Turbo Pascal for Windows 3.0 Programming",
  23.  by Tom Swan and from sample code from Borland.
  24.  
  25. {************************************************************************ }
  26.  
  27. LIBRARY DLL;
  28.  
  29.  
  30. USES Winprocs, WinTypes, WObjects, Strings, Print;
  31.  
  32. type
  33.   TDeviceMode   = procedure(HWindow     : HWnd;
  34.                             Module     : THandle;
  35.                             DeviceName     : PChar;
  36.                             OutputName     : PChar);
  37.   TExtDeviceMode = function(HWindow     : HWnd;
  38.                             HDriver     : THandle;
  39.                             DevModeOutput: PDevMode;
  40.                             DeviceName     : PChar;
  41.                             OutPutName     : PChar;
  42.                             DevModeInput : PDevMode;
  43.                             Profile     : PChar;
  44.                             Mode     : Word) : Integer;
  45.  
  46. var
  47.     PrinterType, Driver, Port             : PChar;
  48.     DriverHandle                 : THandle;
  49.     Printer                     : PDevMode;
  50.     ExtDeviceMode                 : TExtDeviceMode;
  51.     DevCaps                              : TDevCaps;
  52.     DeviceMode                     : TDeviceMode;
  53.     PrintDC                     : HDC;
  54.  
  55.  
  56. {************************************************************************
  57.   Retrieves comma separated data from a null terminated string. It
  58.   returns the first data item and advances the pointer S to the next
  59.   data item in the string.
  60. {************************************************************************ }
  61. function GetItem(var S: PChar): PChar;
  62. var
  63.   P: PChar;
  64.   I: Integer;
  65.  
  66. begin
  67.   I:=0;
  68.   while (S[I]<>',') and (S[I]<>#0) do
  69.     inc(I);
  70.   S[I]:=#0;
  71.   GetMem(P, Strlen(S)+1);
  72.   StrCopy(P,S);
  73.   GetItem:=P;
  74.   if S[0]<>#0 then S:=@S[I+1];
  75. end;
  76.  
  77.  
  78. {************************************************************************
  79.   This local message utility just creates a messagebox.  If the value
  80.   of HWindow is zero, then the routine does a GetFocus to make sure
  81.   that there is a parent.
  82. {************************************************************************ }
  83. procedure LocalMessageBox(HWindow: Hwnd; Text, Caption: PChar; TextType: Word);
  84. begin
  85.   if (HWindow = 0)
  86.      then MessageBox(GetFocus, Text, Caption, TextType)
  87.      else MessageBox(HWindow,  Text, Caption, TextType);
  88. end;
  89.  
  90.  
  91. {************************************************************************
  92.   Retrieves all the device types from the WIN.INI and places this
  93.   information into the PStrCollection parameter.}
  94. {************************************************************************ }
  95. procedure GetPrinterTypes(var PrinterTypes: PStrCollection);
  96. var
  97.   Buffer, BufferItem    : PChar;
  98.   Item            : PChar;
  99.   Count, I        : Integer;
  100.  
  101. begin
  102.   New(PrinterTypes, init(5,1));
  103.   GetMem(Buffer, 1024);
  104.   Count        := GetProfileString('devices', nil, ',,', Buffer, 1024);
  105.   BufferItem    := Buffer;
  106.   I        := 0;
  107.   while I<Count do begin
  108.     GetMem(Item, StrLen(BufferItem)+1);
  109.     StrCopy(Item, BufferItem);
  110.     PrinterTypes^.Insert(Item);
  111.     while (BufferItem[i]<>#0) and (I<Count) do
  112.       inc(I);
  113.     inc(I);
  114.     if (BufferItem[I]=#0) then I:=Count;
  115.     if (I < Count) then begin
  116.       BufferItem    := @BufferItem[I];
  117.       Count        := Count-I;
  118.       I            := 0;
  119.     end;
  120.   end;
  121.   FreeMem(Buffer, 1024);
  122. end;
  123.  
  124.  
  125. {************************************************************************
  126.   Given a PrinterType string, this procedure returns the appropriate
  127.   driver and port information.}
  128. {************************************************************************ }
  129. procedure GetPrinter(PrinterType: PChar; var Driver, Port: PChar);
  130. var
  131.   ProfileInfo, CurrentItem: PChar;
  132.  
  133. begin
  134.   GetMem(ProfileInfo, 80+1);
  135.   GetProfileString('devices', PrinterType, ',', ProfileInfo, 80);
  136.   CurrentItem := ProfileInfo;
  137.   Driver      := GetItem(CurrentItem);
  138.   Port        := GetItem(CurrentItem);
  139.   FreeMem(ProfileInfo, 80+1);
  140. end;
  141.  
  142.  
  143. {************************************************************************
  144.   Retrieves the current printing device information from the WIN.INI
  145.   file.
  146. {************************************************************************ }
  147. procedure GetCurrentPrinter(var Driver, PrinterType, Port: PChar);
  148. var
  149.   ProfileInfo, CurrentItem: PChar;
  150. begin
  151.   GetMem(ProfileInfo, 80+1);
  152.   GetProfileString('windows', 'device', ',,', ProfileInfo, 80);
  153.   CurrentItem    := ProfileInfo;
  154.   PrinterType    := GetItem(CurrentItem);
  155.   Driver    := GetItem(CurrentItem);
  156.   Port        := GetItem(CurrentItem);
  157.   FreeMem(ProfileInfo, 80+1);
  158. end;
  159.  
  160.  
  161. {************************************************************************
  162.   Here is the payoff...We must replace the device= line in the WIN.INI
  163.   file with name of the device we want to use 
  164. {************************************************************************ }
  165. procedure SetCurrentPrinter(var PrinterName, Driver, Port: PChar);
  166. var
  167.   ProfileInfo   : PChar;
  168. begin
  169.   GetMem(ProfileInfo, 80+1);
  170.   StrCopy(ProfileInfo, PrinterName);
  171.   StrCat(ProfileInfo, ','); StrCat(ProfileInfo, Driver);
  172.   StrCat(ProfileInfo, ','); StrCat(ProfileInfo, Port);   StrCat(ProfileInfo, ':');
  173.   WriteProfileString('windows', 'device', ProfileInfo);
  174.   FreeMem(ProfileInfo, 80+1);
  175. end;
  176.  
  177.  
  178. {************************************************************************
  179.   We, sometimes, have to bash windows over the skull to let it know that
  180.   a change has been made to the printer.  This is used to change the
  181.   printer options in the WIN.INI file, convincing windows to pay attention!
  182. {************************************************************************ }
  183. procedure SetPrinterOption(var PrinterName, Driver, Port: PChar; OptionName, OptionSetting: PChar);
  184. var
  185.   ProfileInfo   : PChar;
  186.   LocalPort     : PChar;
  187. begin
  188.   GetMem(ProfileInfo, 80+1);
  189.   GetMem(LocalPort, StrLen(Port)+1);
  190.   if (StrPos(Port, ':') <> nil)
  191.      then StrLCopy(LocalPort, Port, StrLen(Port)-1)
  192.      else StrLCopy(LocalPort, Port, StrLen(Port));
  193.   StrCopy(ProfileInfo, PrinterName);
  194.   StrCat(ProfileInfo, ','); StrCat(ProfileInfo, LocalPort);
  195.   WriteProfileString(ProfileInfo, OptionName, OptionSetting);
  196.   FreeMem(LocalPort, StrLen(Port)+1);
  197.   FreeMem(ProfileInfo, 80+1);
  198. end;
  199.  
  200.  
  201. {************************************************************************
  202.   Switch to Portrait mode
  203. {************************************************************************ }
  204. Procedure Portrait(HWindow: HWnd); EXPORT;
  205. var
  206.   I        : Integer;
  207.   FullDriverName: PChar;
  208.   P        : TFarProc;
  209.   Size        : Integer;
  210.   DeviceName,
  211.   DriverName,
  212.   OutputName    : PChar;
  213.   DevModeOutput    : PDevMode;
  214.  
  215. BEGIN
  216.   GetCurrentPrinter(Driver, PrinterType, Port);
  217.  
  218.   { Watch out for no installed printer ********************************** }
  219.   if (StrLen(Driver)      = 0) or
  220.      (StrLen(PrinterType) = 0) or
  221.      (StrLen(Port)        = 0) then begin
  222.      LocalMessageBox(HWindow, 'No Printer Installed', 'Error', mb_IconExclamation or mb_Ok);
  223.      Exit;
  224.   end;
  225.  
  226.   GetMem(FullDriverName, 12+1);
  227.   StrLCat(StrCopy(FullDriverName, Driver), '.DRV', 12);
  228.   DriverHandle:=LoadLibrary(FullDriverName);
  229.  
  230.   { Make sure library is loaded ***************************************** }
  231.   if (DriverHandle < 32) then begin
  232.      LocalMessageBox(HWindow,  'Failed to load driver', 'Error', mb_IconExclamation or mb_Ok);
  233.      Exit;
  234.   end;
  235.  
  236.   P        := GetProcAddress(DriverHandle, 'ExtDeviceMode');
  237.   ExtDeviceMode    := TExtDeviceMode(P);
  238.   Size            := ExtDeviceMode(GetFocus, DriverHandle, nil, FullDriverName, Port, nil, nil, 0);
  239.   GetMem(DevModeOutput, Size);
  240.  
  241.   { Read in the Current Settings **************************************** }
  242.   ExtDeviceMode(GetFocus, DriverHandle, DevModeOutput, Driver, Port, nil, nil, dm_Copy);
  243.  
  244.   { Change settings to Landscape **************************************** }
  245.   DevModeOutput^.dmOrientation := dmOrient_Portrait;
  246.   ExtDeviceMode(GetFocus, DriverHandle, DevModeOutput, FullDriverName, Port, DevModeOutput,nil,dm_Update or dm_Modify);
  247.  
  248.   { Force change in WIN.INI file **************************************** }
  249.   SetPrinterOption(PrinterType, Driver, Port, 'orient', '1');
  250.  
  251.   FreeMem(FullDriverName, 12+1);
  252.   FreeMem(DevModeOutput, Size);
  253.   FreeLibrary(DriverHandle);
  254. END;
  255.  
  256.  
  257. {************************************************************************
  258.   Switch to Landscape mode
  259. {************************************************************************ }
  260. Procedure Landscape(HWindow: HWnd); EXPORT;
  261. var
  262.   I        : Integer;
  263.   FullDriverName: PChar;
  264.   P        : TFarProc;
  265.   Size        : Integer;
  266.   DeviceName, 
  267.   DriverName,
  268.   OutputName    : PChar;
  269.   DevModeOutput    : PDevMode;
  270.  
  271. BEGIN
  272.   GetCurrentPrinter(Driver, PrinterType, Port);
  273.  
  274.   { Watch out for no installed printer ********************************** }
  275.   if (StrLen(Driver)      = 0) or
  276.      (StrLen(PrinterType) = 0) or
  277.      (StrLen(Port)        = 0) then begin
  278.      LocalMessageBox(HWindow, 'No Printer Installed', 'Error', mb_IconExclamation or mb_Ok);
  279.      Exit;
  280.   end;
  281.  
  282.   GetMem(FullDriverName, 12+1);
  283.   StrLCat(StrCopy(FullDriverName, Driver), '.DRV', 12);
  284.   DriverHandle:=LoadLibrary(FullDriverName);
  285.  
  286.   { Make sure library is loaded ***************************************** }
  287.   if (DriverHandle < 32) then begin
  288.      LocalMessageBox(HWindow, 'Failed to load driver', 'Error', mb_IconExclamation or mb_Ok);
  289.      Exit;
  290.   end;
  291.  
  292.   P        := GetProcAddress(DriverHandle, 'ExtDeviceMode');
  293.   ExtDeviceMode    := TExtDeviceMode(P);
  294.   Size            := ExtDeviceMode(GetFocus, DriverHandle, nil, FullDriverName, Port, nil, nil, 0);
  295.   GetMem(DevModeOutput, Size);
  296.  
  297.   { Read in the Current Settings **************************************** }
  298.   ExtDeviceMode(Getfocus, DriverHandle, DevModeOutput, Driver, Port, nil, nil, dm_Copy);
  299.  
  300.   { Change settings to Landscape **************************************** }
  301.   DevModeOutput^.dmOrientation := dmOrient_Landscape;
  302.   ExtDeviceMode(GetFocus, DriverHandle, DevModeOutput, FullDriverName, Port, DevModeOutput,nil,dm_Update or dm_Modify);
  303.  
  304.   { Force change in WIN.INI file **************************************** }
  305.   SetPrinterOption(PrinterType, Driver, Port, 'orient', '2');
  306.  
  307.   FreeMem(FullDriverName, 12+1);
  308.   FreeMem(DevModeOutput, Size);
  309.   FreeLibrary(DriverHandle);
  310. END;
  311.  
  312.  
  313. {************************************************************************
  314.   Set Printer to the value provided....
  315. {************************************************************************ }
  316. Procedure SetPrinterAs(HWindow: HWnd; PrinterName: String; Notify: Integer); EXPORT;
  317. var
  318.   I, Counter       : Integer;
  319.   Matches          : Integer;
  320.   PrinterTypes     : PStrCollection;
  321.   LocalPrinterName : PChar;
  322.   FullDriverName   : PChar;
  323.   ProfileInfo      : PChar;
  324.   P           : TFarProc;
  325.   Size           : Integer;
  326.   DeviceName,
  327.   DriverName,
  328.   OutputName       : PChar;
  329.   DevModeOutput       : PDevMode;
  330.  
  331. BEGIN
  332.   GetPrinterTypes(PrinterTypes);
  333.  
  334.   { Are there any installed printers ? ********************************** }
  335.   if (PrinterTypes^.Count = 0) then begin
  336.      LocalMessageBox(HWindow, 'No Printer Installed', 'Error', mb_IconExclamation or mb_Ok);
  337.      Exit;
  338.   end;
  339.  
  340.   { Did user provide a printer name to switch to? *********************** }
  341.   if (Length(PrinterName) = 0 or Pos(#0, PrinterName)) then begin
  342.      LocalMessageBox(HWindow, 'Printer name not provided', 'Error', mb_IconExclamation or mb_Ok);
  343.      Exit;
  344.   end;
  345.  
  346.   { Attempt to match name, then switch to this printer! ***************** }
  347.   GetMem(LocalPrinterName, 80+1);
  348.   StrPCopy(LocalPrinterName, PrinterName);
  349.   i := 0;
  350.   Matches := -1;
  351.   While ((PrinterTypes^.Count <> i) and
  352.          (Matches <> 0))           do begin { While there are some ****** }
  353.     Matches := StrComp(LocalPrinterName, PrinterTypes^.At(i));
  354.     if (Matches = 0) then begin
  355.        GetPrinter(LocalPrinterName, Driver, Port);
  356.  
  357.        { It's a lot like the others from here *************************** }
  358.        GetMem(FullDriverName, 12+1);
  359.        StrLCat(StrCopy(FullDriverName, Driver), '.DRV', 12);
  360.        DriverHandle:=LoadLibrary(FullDriverName);
  361.  
  362.        { Make sure library is loaded ************************************ }
  363.        if (DriverHandle < 32) then begin
  364.           LocalMessageBox(HWindow, 'Failed to load driver', 'Error', mb_IconExclamation or mb_Ok);
  365.           Exit;
  366.        end;
  367.  
  368.        P        := GetProcAddress(DriverHandle, 'ExtDeviceMode');
  369.        ExtDeviceMode    := TExtDeviceMode(P);
  370.        Size            := ExtDeviceMode(GetFocus, DriverHandle, nil, FullDriverName, Port, nil, nil, 0);
  371.        GetMem(DevModeOutput, Size);
  372.  
  373.        { Read in the Current Settings **************************************** }
  374.        ExtDeviceMode(Getfocus, DriverHandle, DevModeOutput, Driver, Port, nil, nil, dm_Copy);
  375.  
  376.        { Using same setting, make printer current **************************** }
  377.        ExtDeviceMode(GetFocus, DriverHandle, DevModeOutput, FullDriverName, Port,
  378.                      DevModeOutput, nil, dm_Update or dm_Modify);
  379.        SetCurrentPrinter(LocalPrinterName, Driver, Port);
  380.  
  381.        FreeMem(FullDriverName, 12+1);
  382.        FreeMem(DevModeOutput, Size);
  383.        FreeLibrary(DriverHandle);
  384.     end else inc(i);
  385.   end; { while }
  386.  
  387.   { Let user know what (should) have happened if the call wanted us to ******* }
  388.   if ((Notify = 1) and (Matches = 0)) then
  389.      LocalMessageBox(HWindow,  PrinterTypes^.At(i), 'Printer is now', mb_IconExclamation or mb_Ok);
  390.  
  391.   { If we got through all that and there wasn't a match then notify the user
  392.     of the problem *********************************************************** }
  393.   if (Matches <> 0) then
  394.      LocalMessageBox(HWindow, LocalPrinterName, 'Printer Driver not found', mb_IconStop or mb_Ok);
  395.  
  396.   FreeMem(LocalPrinterName, 80+1);
  397.  
  398. END;
  399.  
  400.  
  401. {************************************************************************
  402.   Allow the user to set the number of copies to be generated directly
  403.   by the printer.  Note that not all printer have the capability to
  404.   generate copies automatically.  Generally, Laser printers can and
  405.   dot matrix printers can't.
  406. {************************************************************************ }
  407. Procedure SetPrinterCopies(HWindow: HWnd; Copies, Notify: Integer); EXPORT;
  408. var
  409.   I, ReturnCode : Integer;
  410.   FullDriverName: PChar;
  411.   P        : TFarProc;
  412.   Size        : Integer;
  413.   S             : String;
  414.   DeviceName, PS, 
  415.   DriverName,
  416.   OutputName    : PChar;
  417.   DevModeOutput    : PDevMode;
  418.   DC_Output     : PChar;
  419.  
  420. BEGIN
  421.   { The user must not supply a copies number larger than 999; also the
  422.     number must be greater than or = 1 }
  423.   if ((Copies > 999) or (Copies <= 0)) then begin
  424.      LocalMessageBox(HWindow, 'Number of copies must be between 1 and 999',
  425.                      'Error', mb_IconExclamation or mb_Ok);
  426.      Exit;
  427.   end;
  428.  
  429.   GetCurrentPrinter(Driver, PrinterType, Port);
  430.  
  431.   { Watch out for no installed printer ********************************** }
  432.   if (StrLen(Driver)      = 0) or
  433.      (StrLen(PrinterType) = 0) or
  434.      (StrLen(Port)        = 0) then begin
  435.      LocalMessageBox(HWindow, 'No Printer Installed', 'Error', mb_IconExclamation or mb_Ok);
  436.      Exit;
  437.   end;
  438.  
  439.   GetMem(FullDriverName, 12+1);
  440.   StrLCat(StrCopy(FullDriverName, Driver), '.DRV', 12);
  441.   DriverHandle:=LoadLibrary(FullDriverName);
  442.  
  443.   { Make sure library is loaded ***************************************** }
  444.   if (DriverHandle < 32) then begin
  445.      LocalMessageBox(HWindow, 'Failed to load driver', 'Error', mb_IconExclamation or mb_Ok);
  446.      Exit;
  447.   end;
  448.  
  449.   P        := GetProcAddress(DriverHandle, 'ExtDeviceMode');
  450.   ExtDeviceMode    := TExtDeviceMode(P);
  451.   Size            := ExtDeviceMode(GetFocus, DriverHandle, nil, FullDriverName, Port, nil, nil, 0);
  452.   GetMem(DevModeOutput, Size);
  453.  
  454.   { Read in the Current Settings **************************************** }
  455.   ExtDeviceMode(Getfocus, DriverHandle, DevModeOutput, Driver, Port, nil, nil, dm_Copy);
  456.  
  457.   { Force change in WIN.INI file **************************************** }
  458.   GetMem(PS,4); Str(Copies, S); StrPcopy(PS,S);
  459.   SetPrinterOption(PrinterType, Driver, Port, 'Copies', PS); FreeMem(PS,4);
  460.  
  461.   { Change settings to appropriate number of copies ********************* }
  462.   DevModeOutput^.dmCopies := Copies;
  463.   ExtDeviceMode(GetFocus, DriverHandle, DevModeOutput, FullDriverName, Port, DevModeOutput,nil,dm_Update or dm_Modify);
  464.   if (Notify >= 1) then begin
  465.      GetMem(PS, 36);
  466.      Str(Copies, S);  StrLCat(StrPCopy(PS, S), ' :', StrLen(PS) - 1);
  467.      LocalMessageBox(HWindow, PS, 'Printer: Copies set to', mb_IconInformation or mb_Ok);
  468.      FreeMem(PS, 36);
  469.   end;
  470.  
  471.   FreeMem(FullDriverName, 12+1);
  472.   FreeMem(DevModeOutput, Size);
  473.   FreeLibrary(DriverHandle);
  474. END;
  475.  
  476.  
  477. EXPORTS Portrait           INDEX 1,
  478.         Landscape          INDEX 2,
  479.         SetPrinterAs       INDEX 3,
  480.         SetPrinterCopies   INDEX 4;
  481. BEGIN
  482. END.