unit startup;

{#freeware}
{#version 1.0.0601}
{#Date 01 Jun 1998}
{#Author Frank Zimmer}
{#description
 Copyright © 1998, Frank Zimmer, f.zimmer@gmx.net

 Any comments and enhancements are welcome, if the're sended to
 f.zimmer@gmx.net or fzimmer@csi.com.
 This Source is freeware, have fun :-)
 }

interface

uses
  windows, sysutils, classes, Messages, Graphics, ShellAPI,
  forms, controls;

  { easy access of the system metrics }
type
  TSystemMetric = class
  private
    FColorDepth,
    FMenuHeight,
    FCaptionHeight : Integer;
    FBorder,
    FFrame,
    FDlgFrame,
    FBitmap,
    FHScroll,
    FVScroll,
    FThumb,
    FFullScreen,
    FMin,
    FMinTrack,
    FCursor,
    FIcon,
    FDoubleClick,
    FIconSpacing : TPoint;
  protected
    constructor Create;
    procedure Update;
  public
    property MenuHeight: Integer read FMenuHeight;
    property CaptionHeight: Integer read FCaptionHeight;
    property Border: TPoint read FBorder;
    property Frame: TPoint read FFrame;
    property DlgFrame: TPoint read FDlgFrame;
    property Bitmap: TPoint read FBitmap;
    property HScroll: TPoint read FHScroll;
    property VScroll: TPoint read FVScroll;
    property Thumb: TPoint read FThumb;
    property FullScreen: TPoint read FFullScreen;
    property Min: TPoint read FMin;
    property MinTrack: TPoint read FMinTrack;
    property Cursor: TPoint read FCursor;
    property Icon: TPoint read FIcon;
    property DoubleClick: TPoint read FDoubleClick;
    property IconSpacing: TPoint read FIconSpacing;
    property ColorDepth: Integer read FColorDepth;
  end;

  TDOSEnvironment = class
  private
    FKeys: TStringlist;
    FValues: TStringlist;
    function GetCount: Integer;
    function GetKey(Index: Integer): string;
    function GetValue(Index: Integer): string;
    procedure ReadEnvironment;
{$ifdef win32}
    Procedure WMWinINIChange(var message: TWMWinINIChange); message WM_WININICHANGE;
 {$ENDIF}
  protected
  public
    constructor Create;
    destructor Destroy; override;
    function GetEnv(const Key: string): string;
    property EnvCount: Integer read GetCount;
    property EnvStr[Index: Integer]: string read GetKey;
    property Value[Index: Integer]: string read GetValue;
  end;

  TDesktopCanvas = class(TCanvas)
  private
    DC          : hDC;
  public
    constructor Create;
    destructor Destroy; override;
  end;


{$ifndef Ver70}
const
  alFNone      = $0;
  alFTop       = $1;
  alFBottom    = $2;
  alFLeft      = $4;
  alFRight     = $8;
  alVCenter    = $10;
  alHCenter    = $20;
  alFCenter    = alVCenter+alHCenter;
  alFTopOut    = $40;
  alFBottomOut = $80;
  alFLeftOut   = $100;
  alFRightOut  = $200;

// make visible property = true for all components in the array
procedure ShowAll(const ar : array of tcontrol);

// make visible property = false for all components in the array
procedure HideAll(const ar : array of tcontrol);

// make enable property = true for all components in the array
procedure EnableAll(const ar : array of tcontrol);

// make enable property = false all components in the array
// eg.  DisableAll([edit1,edit2,checkbox1,label1]);

procedure DisableAll(const ar : array of tcontrol);



// Center the dialog in the bounds from Mainform
// e.g. CenterDialog(screen.activeform,form1);
procedure CenterDialog(mainform,dialog:tform);

// Align the dialog in with the bounds of Mainform
// e.g. CenterDialog(screen.activeform,form1,);
procedure AlignDialog(mainform,dialog:tform;Al:integer);

{$ENDIF}

function sysColorDepth: Integer;

var
 SysMetric      : TSystemMetric;
 IsWin95        : Boolean;
 IsWinNT        : boolean;
 IsNewShell     : boolean;
 Environment    : tdosenvironment;
 WindowsVersion : string;

{*****************************************}
implementation
{*****************************************}
var osv : tosversioninfo;

procedure AlignDialog(mainform,dialog:tform;Al:integer);
var
  mt,ml,mw,mh : integer;    // mainform
//  dt,dl,dw,dh : integer;    // dialog
  rt,rl : integer;          // result
begin
  mt := mainform.top;
  ml := mainform.left;
  mw := mainform.width;
  mh := mainform.height;
  rt := dialog.top;
  rl := dialog.left;
  if (al and alFbottom         = alFbottom)    then rt := mt+mh-dialog.height
  else if (al and alFtop       = alFtop)       then rt := mt
  else if (al and alvcenter    = alvcenter)    then rt := mt + (mh-dialog.height) div 2
  else if (al and alFbottomOut = alFbottomOut) then rt := mt+mh
  else if (al and alFtopOut    = alFtopOut)    then rt := mt - dialog.height;

  if (al and alFleft          = alfleft)       then rl := ml
  else if (al and alFright    = alfright)      then rl := ml+mw-dialog.width
  else if (al and alhcenter   = alhcenter)     then rl := ml + (mw-dialog.width) div 2
  else if (al and alFleftOut  = alFleftOut)    then rl := ml-dialog.width
  else if (al and alFrightOut = alFrightOut)   then rl := ml + mw;

  dialog.setbounds(rl,rt,dialog.width,dialog.height);
end;

procedure CenterDialog(mainform,dialog:tform);
begin
  aligndialog(mainform,dialog,alfcenter);
end;

{**************************
 * TDOSEnvironment
 **************************}
constructor TDOSEnvironment.Create;
begin
  FKeys := tstringlist.Create;
  FValues := tstringlist.Create;
  readenvironment;
end;

destructor TDOSEnvironment.Destroy;
begin
  FKeys.Free;
  FValues.Free;
end;

{$ifdef win32}
Procedure TDOSEnvironment.WMWinINIChange(var message:TWMWinINIChange);
begin
  ReadEnvironment;
  inherited;
end;
{$ENDIF}

procedure TDOSEnvironment.ReadEnvironment;
var
  EnvStrings: PChar;
  S: string;
begin
  fkeys.clear;
  fvalues.clear;
  Envstrings := GetEnvironmentStrings;
  while EnvStrings[0] <> #0 do
    begin
      S := StrPas(EnvStrings);
      if envstrings[0] <> '=' then
      begin
        FKeys.Add(Copy(S,1,Pos('=',S)-1));
        FValues.Add(Copy(S,Pos('=',S)+1,length(s)));
      end else
      begin
        FKeys.Add(Copy(S,2,2));
        FValues.Add(Copy(S,5,length(s)));
      end;
      Inc(EnvStrings,StrLen(EnvStrings)+1);
    end;
end;

function TDOSEnvironment.GetEnv(const Key: string): string;
var
  I: Integer;
begin
  I := FKeys.IndexOf(Key);
  if I >= 0 then
    Result := FValues.Strings[I]
  else
    Result := '';
end;

function TDOSEnvironment.GetCount: Integer;
begin
  Result := FKeys.Count;
end;

function TDOSEnvironment.GetKey(Index: Integer): string;
begin
  Result := FKeys.Strings[Index];
end;

function TDOSEnvironment.GetValue(Index: Integer): string;
begin
  Result := FValues.Strings[Index];
end;


{ TSystemMetric }
function sysColorDepth: Integer;
var
  aDC: hDC;
begin
  try
    aDC := GetDC (0);
    Result := 1 Shl (GetDeviceCaps (aDC,PLANES) * GetDeviceCaps (aDC, BITSPIXEL));
  finally
    ReleaseDC (0, aDC);
  end;
end;

constructor TSystemMetric.Create;
begin
  inherited Create;
  Update;
end;

procedure TSystemMetric.Update;

  function GetSystemPoint(ax,ay: Integer):TPoint;
  begin
    Result:=Point(GetSystemMetrics(ax),GetSystemMetrics(ay));
  end;

begin
  FMenuHeight    :=GetSystemMetrics(SM_CYMENU);
  FCaptionHeight :=GetSystemMetrics(SM_CYCAPTION);
  FBorder        :=GetSystemPoint(SM_CXBORDER,SM_CYBORDER);
  FFrame         :=GetSystemPoint(SM_CXFRAME,SM_CYFRAME);
  FDlgFrame      :=GetSystemPoint(SM_CXDLGFRAME,SM_CYDLGFRAME);
  FBitmap        :=GetSystemPoint(SM_CXSIZE,SM_CYSIZE);
  FHScroll       :=GetSystemPoint(SM_CXHSCROLL,SM_CYHSCROLL);
  FVScroll       :=GetSystemPoint(SM_CXVSCROLL,SM_CYVSCROLL);
  FThumb         :=GetSystemPoint(SM_CXHTHUMB,SM_CYVTHUMB);
  FFullScreen    :=GetSystemPoint(SM_CXFULLSCREEN,SM_CYFULLSCREEN);
  FMin           :=GetSystemPoint(SM_CXMIN,SM_CYMIN);
  FMinTrack      :=GetSystemPoint(SM_CXMINTRACK,SM_CYMINTRACK);
  FCursor        :=GetSystemPoint(SM_CXCURSOR,SM_CYCURSOR);
  FIcon          :=GetSystemPoint(SM_CXICON,SM_CYICON);
  FDoubleClick   :=GetSystemPoint(SM_CXDOUBLECLK,SM_CYDOUBLECLK);
  FIconSpacing   :=GetSystemPoint(SM_CXICONSPACING,SM_CYICONSPACING);
  FColorDepth    :=sysColorDepth;
end;

{ TDesktopCanvas }

constructor TDesktopCanvas.Create;
begin
  inherited Create;
  DC:=GetDC(0);
  Handle:=DC;
end;

destructor  TDesktopCanvas.Destroy;
begin
  Handle:=0;
  ReleaseDC(0, DC);
  inherited Destroy;
end;

procedure HideShow(const ar : array of tcontrol;const visibled:boolean);
var i :integer;
begin
  try
    for i := 0 to high(ar) do tcontrol(ar[i]).visible := visibled;
  except
  end;
end;

procedure EnDisable(const ar : array of tcontrol; const enable:boolean);
var i :integer;
begin
  try
    for i := 0 to high(ar) do tcontrol(ar[i]).enabled := enable;
  except
  end;
end;

procedure ShowAll(const ar : array of tcontrol);
begin
  hideshow(ar,true);
end;

procedure HideAll(const ar : array of tcontrol);
begin
  hideshow(ar,false);
end;

procedure EnableAll(const ar : array of tcontrol);
begin
  EnDisable(ar,true);
end;

procedure DisableAll(const ar : array of tcontrol);
begin
  EnDisable(ar,true);
end;

INITIALIZATION
  Environment := tdosenvironment.create;
  osv.dwosversioninfosize := sizeof(osv);
  getversionex(osv);
  with osv do
  begin
    if not getversionex(osv) then
    begin
     case getversion of
       0: WindowsVersion := 'Microsoft Windows NT';
       1: WindowsVersion := 'Microsoft Win32s with Windows 3.1'
     end
    end else
    begin
      case dwplatformid of
        ver_platform_win32s : WindowsVersion := 'Win32s, Windows 3.1 ';
        ver_platform_win32_windows : WindowsVersion := 'Windows 95 ';
        ver_platform_win32_nt : WindowsVersion := 'Windows NT ';
      end;
      // appendstr(WindowsVersion,inttostr(dwmajorversion)+'.'+inttostr(dwminorversion));
      // appendstr(WindowsVersion,', Build ');
      // appendstr(WindowsVersion,inttostr(dwbuildnumber));
    end
  end;
  IsWin95   := osv.dwplatformid = ver_platform_win32_windows;
  IsWinNT   := osv.dwplatformid = ver_platform_win32_nt;
  IsNewShell := (iswinNT and (osv.dwMajorVersion >= 4)) or IsWin95;
FINALIZATION

  SysMetric.Free;
  Environment.free;

end.