home *** CD-ROM | disk | FTP | other *** search
/ Delphi Developer's Kit 1996 / Delphi Developer's Kit 1996.iso / power / twinenv / uwinenv.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1995-12-22  |  2.8 KB  |  119 lines
  1. unit UWinEnv;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs;
  8.  
  9. type
  10.   TWinEnv = class(TComponent)
  11.   private
  12.     { Private declarations }
  13.     FWinDir: String;
  14.     FSysDir: String;
  15.     FSWidth: longint;
  16.     FSHeight: longint;
  17.     FColorDepth: integer;
  18.     procedure SetWinDir(Value: string);
  19.     procedure SetSysDir(Value: string);
  20.     procedure SetSWidth(Value: longint);
  21.     procedure SetSHeight(Value: longint);
  22.     procedure SetColorDepth(Value: integer);
  23.   protected
  24.     { Protected declarations }
  25.   public
  26.     { Public declarations }
  27.     constructor Create(AOwner: TComponent); override;
  28.   published
  29.     { Published declarations }
  30.     property WindowsDir: string read FWinDir write SetWinDir;
  31.     property SystemDir: string read FSysDir write SetSysDir;
  32.     property ScreenWidth: longint read FSWidth write SetSWidth;
  33.     property ScreenHeight: longint read FSHeight write SetSHeight;
  34.     property ColorDepth: integer read FColorDepth write SetColorDepth;
  35.   end;
  36.  
  37. procedure Register;
  38.  
  39. implementation
  40.  
  41. procedure Register;
  42. begin
  43.   RegisterComponents('Add Ons', [TWinEnv]);
  44. end;
  45.  
  46. constructor TWinEnv.Create(AOwner: TComponent);
  47. var
  48.   szWindows: PChar;
  49.   szSystem: PChar;
  50.   BitsPerPlane: integer;
  51.   ColorPlanes: integer;
  52.   BitsPerPixel: integer;
  53.   TempHandle: HWND;
  54.   TempDC: HDC;
  55. begin
  56.   inherited Create(AOwner);
  57.  
  58.   {Set the WinDir Property}
  59.     szWindows := strAlloc(255);
  60.     GetWindowsDirectory(szWindows, 255);
  61.     FWinDir := strPas(szWindows);
  62.     strDispose(szWindows);
  63.  
  64.   {Set the SysDir Property}
  65.     szSystem := strAlloc(255);
  66.     GetSystemDirectory(szSystem, 255);
  67.     FSysDir := strPas(szSystem);
  68.     strDispose(szSystem);
  69.  
  70.   {Set the SysDir Property}
  71.     FSWidth := Screen.Width;
  72.  
  73.   {Set the SysDir Property}
  74.     FSHeight := Screen.Height;
  75.  
  76.   {Get the Color Depth of the Device}
  77.   TempHandle:= Application.Handle;
  78.   TempDC := GetDC(TempHandle);
  79.   BitsPerPlane := GetDeviceCaps(TempDC, BITSPIXEL);
  80.   ColorPlanes := GetDeviceCaps(TempDC, PLANES);
  81.   BitsPerPixel := BitsPerPlane * ColorPlanes;
  82.   if ReleaseDC(TempHandle, TempDC) <> 1 then
  83.     messagedlg('DC not released', mtInformation, [mbOk],0);
  84.   FColorDepth := BitsPerPixel;
  85.  
  86. end;
  87.  
  88. procedure TWinEnv.SetWinDir(Value: string);
  89. begin
  90.   if FWinDir <> Value then
  91.     FWinDir := Value;
  92. end;
  93.  
  94. procedure TWinEnv.SetSysDir(Value: string);
  95. begin
  96.   if FSysDir <> Value then
  97.     FSysDir := Value;
  98. end;
  99.  
  100. procedure TWinEnv.SetSWidth(Value: longint);
  101. begin
  102.   if FSWidth <> Value then
  103.     FSWidth := Value;
  104. end;
  105.  
  106. procedure TWinEnv.SetSHeight(Value: longint);
  107. begin
  108.   if FSHeight <> Value then
  109.     FSHeight := Value;
  110. end;
  111.  
  112. procedure TWinEnv.SetColorDepth(Value: integer);
  113. begin
  114.   if FColorDepth <> Value then
  115.     FColorDepth := Value;
  116. end;
  117.  
  118. end.
  119.