home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 December / Chip_2001-12_cd1.bin / zkuste / delphi / kolekce / d3456 / ALEXSOFT.ZIP / STDUTILS.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  2001-09-04  |  6.6 KB  |  181 lines
  1. (*////////////////////////////////////////////////////////////////////////////
  2. //   Part of AlexSoft VCL/DLL Library.                                      //
  3. //   All rights reserved. (c) Copyright 1998.                               //
  4. //   Created by: Alex Rabichooc                                             //
  5. //**************************************************************************//
  6. //  Users of this unit must accept this disclaimer of warranty:             //
  7. //    "This unit is supplied as is. The author disclaims all warranties,    //
  8. //    expressed or implied, including, without limitation, the warranties   //
  9. //    of merchantability and of fitness for any purpose.                    //
  10. //    The author assumes no liability for damages, direct or                //
  11. //    consequential, which may result from the use of this unit."           //
  12. //                                                                          //
  13. //  This Unit is donated to the public as public domain.                    //
  14. //                                                                          //
  15. //  This Unit can be freely used and distributed in commercial and          //
  16. //  private environments provided this notice is not modified in any way.   //
  17. //                                                                          //
  18. //  If you do find this Unit handy and you feel guilty for using such a     //
  19. //  great product without paying someone - sorry :-)                        //
  20. //                                                                          //
  21. //  Please forward any comments or suggestions to Alex Rabichooc at:        //
  22. //                                                                          //
  23. //  a_rabichooc@yahoo.com or alex@carmez.mldnet.com                         //
  24. /////////////////////////////////////////////////////////////////////////////*)
  25.  
  26. unit StdUtils;
  27.  
  28. interface
  29.  
  30. uses Classes, Graphics, Forms, Windows;
  31.  
  32. type
  33.   TPrinterType = (ptText, ptGraphics);
  34.  
  35. const
  36.   CN_ALEXSOFT = $9F00;
  37.   CN_ACTIVECHANGED   = CN_ALEXSOFT;
  38.   CN_STYLECHANGED    = CN_ALEXSOFT + 1;
  39.   CN_MASTERCHANGED   = CN_ALEXSOFT + 2;
  40.   CN_PANELACTIVATED  = CN_ALEXSOFT + 3;
  41.   CN_REPLACEFIELD    = CN_ALEXSOFT + 4;
  42.   CN_CLOSEDBFORM     = CN_ALEXSOFT + 5;
  43.   CN_LABELRESIZE     = CN_ALEXSOFT + 6;
  44.   CN_SHOWMAINFORM    = CN_ALEXSOFT + 7;
  45.   OrgName: String = '';
  46. function GetShiftState: TShiftState;
  47. function GetDefaultWidth(Font: TFont; NumChar: Integer): Integer;
  48. function FindCreateForm(FormClass: TFormClass; Caption: string;
  49.                                                      Owner: TComponent): TForm;
  50. procedure GetPrinter(var DeviceMode, DeviceNames: THandle);
  51. procedure SetPrinter(DeviceMode, DeviceNames: THandle);
  52. function PrinterType: TPrinterType;
  53.  
  54. implementation
  55.  
  56. uses Controls, dbForms, Printers, SysUtils, CommDlg;
  57.  
  58. procedure GetPrinter(var DeviceMode, DeviceNames: THandle);
  59. var
  60.   Device, Driver, Port: array[0..79] of char;
  61.   DevNames: PDevNames;
  62.   Offset: PChar;
  63. begin
  64.   Printer.GetPrinter(Device, Driver, Port, DeviceMode);
  65.   if DeviceMode <> 0 then
  66.   begin
  67.     DeviceNames := GlobalAlloc(GHND, SizeOf(TDevNames) +
  68.      StrLen(Device) + StrLen(Driver) + StrLen(Port) + 3);
  69.     DevNames := PDevNames(GlobalLock(DeviceNames));
  70.     try
  71.       Offset := PChar(DevNames) + SizeOf(TDevnames);
  72.       with DevNames^ do
  73.       begin
  74.         wDriverOffset := Longint(Offset) - Longint(DevNames);
  75.         Offset := StrECopy(Offset, Driver) + 1;
  76.         wDeviceOffset := Longint(Offset) - Longint(DevNames);
  77.         Offset := StrECopy(Offset, Device) + 1;
  78.         wOutputOffset := Longint(Offset) - Longint(DevNames);;
  79.         StrCopy(Offset, Port);
  80.       end;
  81.     finally
  82.       GlobalUnlock(DeviceNames);
  83.     end;
  84.   end;
  85. end;
  86.  
  87. procedure SetPrinter(DeviceMode, DeviceNames: THandle);
  88. var
  89.   Device, Driver, Port: array[0..79] of char;
  90.   DevNames: PDevNames;
  91. begin
  92.   Printer.GetPrinter(Device, Driver, Port, DeviceMode);
  93.   DevNames := PDevNames(GlobalLock(DeviceNames));
  94.   try
  95.     with DevNames^ do
  96.       if Win32Platform = VER_PLATFORM_WIN32_NT then
  97.         Printer.SetPrinter(PChar(DevNames) + wDeviceOffset, Driver, Port, DeviceMode)
  98.       else
  99.         Printer.SetPrinter(PChar(DevNames) + wDeviceOffset, Driver, PChar(DevNames) + wOutputOffset, DeviceMode);
  100.   finally
  101.     GlobalUnlock(DeviceNames);
  102.     GlobalFree(DeviceNames);
  103.   end;
  104. end;
  105.  
  106. function PrinterType: TPrinterType;
  107. begin
  108.    if (Pos('GENERIC', UpperCase(Printer.Printers[Printer.PrinterIndex])) <> 0) or
  109.       (Pos('TEXT', UpperCase(Printer.Printers[Printer.PrinterIndex])) <> 0) then
  110.       Result := ptText
  111.      else
  112.       Result := ptGraphics;
  113. end;
  114.  
  115. function FindCreateForm(FormClass: TFormClass; Caption: string;
  116.                                                      Owner: TComponent): TForm;
  117. var
  118.   i: Integer;
  119.   ParentForm: TCustomForm;
  120. begin
  121.   Result := nil;
  122.   for i := 0 to Screen.FormCount - 1 do
  123.   begin
  124.     if Screen.Forms[i] is FormClass then
  125.       if Caption = Screen.Forms[i].Caption then
  126.       begin
  127.         if (Screen.Forms[i] is TDBForm) and
  128.            (Screen.Forms[i].Owner <> Owner) then
  129.            Screen.Forms[i].Free
  130.          else
  131.            Result := Screen.Forms[i];
  132.         break;
  133.       end;
  134.   end;
  135.   if Result = nil then
  136.   begin
  137.     Result := FormClass.Create(Owner);
  138.     if Caption <> '' then
  139.        Result.Caption := Caption;
  140.     if FormClass = TDefaultForm then
  141.     begin
  142.        if (Owner is TWinControl) then
  143.        begin
  144.           ParentForm := GetParentForm(Owner as TWinControl);
  145.           if ParentForm <> nil then
  146.             Result.Font := ParentForm.Font;
  147.        end;
  148.     end;
  149.   end;
  150.   with Result do
  151.     if (WindowState = wsMinimized) then WindowState := wsNormal;
  152. end;
  153.  
  154. function GetShiftState: TShiftState;
  155. begin
  156.   Result := [];
  157.   if GetKeyState(VK_SHIFT) < 0 then Include(Result, ssShift);
  158.   if GetKeyState(VK_CONTROL) < 0 then Include(Result, ssCtrl);
  159.   if GetKeyState(VK_MENU) < 0 then Include(Result, ssAlt);
  160. end;
  161.  
  162. function GetDefaultWidth(Font: TFont; NumChar: Integer): Integer;
  163. var ACanvas: TCanvas;
  164.     TM: TTextMetric;
  165. begin
  166.    ACanvas := TCanvas.Create;
  167.    ACanvas.Handle := GetDC(0);
  168.    ACanvas.Font := Font;
  169.    GetTextMetrics(ACanvas.Handle, TM);
  170.    if NumChar = 1 then
  171.       Result := TM.tmMaxCharWidth+TM.tmOverhang+4
  172.      else
  173.       Result := NumChar * (ACanvas.TextWidth('0') - TM.tmOverhang) +
  174.                                                            TM.tmOverhang + 4;
  175.    //Result := (NumChar + 1)* ACanvas.TextWidth('0');
  176.    ReleaseDC(0, ACanvas.Handle);
  177.    ACanvas.Handle := 0;
  178.    ACanvas.Free;
  179. end;
  180.  
  181. end.