(************************************************************************
*    This File is Part of the AHM Triton Tools                          *
*    for Borland Delphi and C++ Builder.                                *
*************************************************************************
* Copyright © 1995-1999 Alexander H. Mehlhorn (AHM) and Tritontools.com *
* All Rights reserved.                                                  *
*                                                                       *
*    For more Information contact us at                                 *
*    E-Mail : support@tritontools.com                                   *
*    URL : http://www.tritontools.com                                   *
*                                                                       *
*    AHM is copyright by Alexander H. Mehlhorn                          *
*    All Parts of this Collection were developed,                       *
*    designed and implemented by AHM                                    *
*                                                                       *
*    Under no Circumstances may you distribute this file                *
*    in this or any other format. This File is supplied                 *
*    as Evaluation of Source only. No Delphi Components may be developed*
*    using extracts or subsets of this code without expressed permission*
*    by AHM.                                                            *
*                                                                       *
*************************************************************************)
unit AHMTAppStarter;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  AHMSystemConst,AHMSystemClass,ShellApi;
type
  TAHMExeStyle = (osDefault,osOpen,osPrint,osExplore,osNew,osInstall,
                  osEdit,osFind,osTest,osConfigure,osPlay);
  TAHMAppStarter = class;
  TAHMStartItems = class;
  TAHMStartableItem = class(TCollectionItem)
  private
    FAHMAppStarter : TAHMAppStarter;
    FFilename : String;
    FExePath : String;
    FExeParameters : String;
    FWindowstate: TWindowstate;
    FExeStyle : TAHMExeStyle;
    FExeStyleString : String;
    FMode : Word;
    FWait : Boolean;
    procedure SetWindowstate(Value : TWindowstate);
    procedure SetExeStyle(Value : TAHMExeStyle);
  protected
    function GetDisplayName: string; override;
  public
    constructor Create(Collection: TCollection); override;
    procedure Assign(Source: TPersistent); override;
    property Owner : TAHMAppStarter read FAHMAppStarter;
    property DisplayName : String read GetDisplayName;
    Function Execute : Boolean;
  published
    property ExeFile      : String read FFilename write FFilename;
    property Parameters    : String read FExeParameters write FExeParameters;
    property Style         : TAHMExeStyle read FExeStyle write SetExeStyle default osDefault;
    property DefaultPath   : String read FExePath write FExePath;
    property Wait          : Boolean read FWait write FWait default False;
    property Windowstate   : TWindowstate read FWindowstate write SetWindowstate default wsNormal;
  end;
  TAHMStartItems = class(TCollection)
  private
    FAHMAppStarter : TAHMAppStarter;
    function GetAHMStartableItem(Index: Integer): TAHMStartableItem;
    procedure SetAHMStartableItem(Index: Integer; Value: TAHMStartableItem);
  protected
    function GetOwner : TPersistent; override;
  public
    constructor Create(AOwner: TAHMAppStarter);
    function Add : TAHMStartableItem;
    function Delete(Index :Integer) :Boolean;
    property Owner : TAHMAppStarter read FAHMAppStarter;
    property Items[Index: Integer]: TAHMStartableItem
             read GetAHMStartableItem write SetAHMStartableItem; default;
  end;
  TAHMAppStarter = class(TAHMSystemsComponent)
  private
    FAHMStartItems : TAHMStartItems;
    procedure SetAHMStartItems(Value: TAHMStartItems);
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    Function Execute(Index : Integer):Boolean;
  published
    property Programs: TAHMStartItems read FAHMStartItems write SetAHMStartItems;
  end;

implementation

constructor TAHMStartableItem.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FAHMAppStarter :=(((Collection as TAHMStartItems).GetOwner) as TAHMAppStarter);
  FMode := SW_SHOWNORMAL;
  FExeStyle := osDefault;
end;

Function TAHMStartableItem.Execute : Boolean;
var SEI : TShellExecuteInfo;
   Mask : Longint;
begin
  Mask:=SEE_MASK_NOCLOSEPROCESS;
  FillChar(SEI,Sizeof(SEI),#0);
  SEI.cbsize := Sizeof(SEI);
  SEI.wnd    := Application.handle;
  SEI.fmask  := Mask;
  if FExeStyleString<>'' then SEI.LPVERB:=Pchar(FExeStyleString);
  SEI.LPFile := Pchar(FFilename);
  SEI.LPParameters := PChar(FExeParameters);
  SEI.LPDirectory  := PChar(FExepath);
  SEI.nshow:=FMode;
  ShellexecuteEx(@SEI);
  if FWait then WaitforSingleObject(SEI.hProcess,INFINITE);
  result:=true;
end;

procedure TAHMStartableItem.SetExeStyle(Value : TAHMExeStyle);
begin
  case value of
    osDefault : FExeStyleString := '';
    osOpen    : FExeStyleString := ahmscosOpen;
    osPrint   : FExeStyleString := ahmscosPrint;
    osExplore : FExeStyleString := ahmscosexplore;
    osNew     : FExeStyleString := ahmscosnew;
    osEdit    : FExeStyleString := ahmscosedit;
    osFind    : FExeStyleString := ahmscosfind;
    osTest    : FExeStyleString := ahmscosTest;
    osInstall : FExeStyleString := ahmscosInstall;
    osPlay    : FExeStyleString := ahmscosPlay;
  else
    FExeStyleString := ahmscosOpen;
  end;
  FExeStyle:=value;
end;

procedure TAHMStartableItem.SetWindowstate(Value : TWindowstate);
const Mode : array[wsNormal..wsMaximized] of
      Word = (SW_SHOWNORMAL, SW_SHOWMINIMIZED, SW_SHOWMAXIMIZED);
begin
  if FWindowstate <> Value then
  begin
    FMode := Mode[Value];
    FWindowstate := Value;
  end;
end;


function TAHMStartableItem.GetDisplayName: string;
begin
  if FFileName<>'' then
   result:=FExeStyleString+' '+FFileName
  else result:=ahmscprogramnotconfigured;
end;

function TAHMStartItems.GetOwner: TPersistent;
begin
  Result := FAHMAppStarter;
end;

procedure TAHMStartableItem.Assign(Source: TPersistent);
begin
  if Source is TAHMStartableItem then
  begin
    ExeFile := TAHMStartableItem(Source).ExeFile;
    Parameters := TAHMStartableItem(Source).Parameters;
    Style := TAHMStartableItem(Source).Style;
    DefaultPath := TAHMStartableItem(Source).DefaultPath;
    Wait := TAHMStartableItem(Source).Wait;
    Windowstate := TAHMStartableItem(Source).WindowState;
    Exit;
  end;
  inherited Assign(Source);
end;

constructor TAHMStartItems.Create(AOwner: TAHMAppStarter);
begin
  inherited Create(TAHMStartableItem);
  FAHMAppStarter := AOwner;
end;

function TAHMStartItems.Add: TAHMStartableItem;
begin
  Result := TAHMStartableItem(inherited Add);
end;

function TAHMStartItems.GetAHMStartableItem(Index: Integer): TAHMStartableItem;
begin
  Result := TAHMStartableItem(inherited GetItem(Index));
end;

procedure TAHMStartItems.SetAHMStartableItem(Index: Integer; Value: TAHMStartableItem);
begin
  inherited SetItem(Index, Value);
end;

constructor TAHMAppStarter.Create(AOwner: TComponent);
begin
  inherited create(AOwner);
  FAHMStartItems:=TAHMStartItems.Create(self);
end;

destructor TAHMAppStarter.Destroy;
begin
  FAHMStartItems.Free;
  inherited Destroy;
end;

function TAHMAppStarter.Execute(Index: Integer): Boolean;
begin
  result:=FAHMStartItems[Index].Execute;
end;

procedure TAHMAppStarter.SetAHMStartItems(Value: TAHMStartItems);
begin
  FAHMStartItems.Assign(Value);
end;


function TAHMStartItems.Delete(Index: Integer): Boolean;
begin
  result := true;
  Try
    Items[Index].free;
  Except
    result := false;
    Application.handleexception(self);
  End;
end;

end.
