home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2 - Developers' Solutions / Delphi 2 Developers' Solutions.iso / dds / comps / widgets / delphi10 / fexecbtn / fexecbtn.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-06-18  |  3.2 KB  |  126 lines
  1. unit Fexecbtn;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, Buttons, ShellAPI;
  8.  
  9. type
  10.   TFileExecButton = class(TBitBtn)
  11.   private
  12.     { Private declarations }
  13.     FTheFileName : String;
  14.     FTheIcon : TIcon;
  15.     FTheBitmap : TBitmap;
  16.     FOnExecute : TNotifyEvent;
  17.   protected
  18.     { Protected declarations }
  19.   public
  20.     { Public declarations }
  21.     constructor Create( AOwner : TComponent ); override;
  22.     destructor Destroy; override;
  23.     procedure Loaded; override;
  24.     procedure ExecuteFile;
  25.   published
  26.     { Published declarations }
  27.     Property TheFileName : String read FTheFileName write FTheFileName;
  28.     Property OnExecute : TNotifyEvent read FOnExecute write FOnExecute;
  29.   end;
  30.  
  31. procedure Register;
  32.  
  33. implementation
  34.  
  35. function ShellExec(const PathStr, CmdStr, DirStr: string;
  36.   PrintIt: boolean; Show: word; Wait: boolean): boolean;
  37. var
  38.   Inst: THandle;
  39.   Path, CmdLine, Dir: PChar;
  40.   Op: array[0..5] of Char;
  41. begin
  42.   if PrintIt then StrPCopy(Op, 'print') else StrPCopy(Op, 'open');
  43.   { Get memory for PChars }
  44.   GetMem(Path, Length(PathStr)+1);
  45.   GetMem(CmdLine, Length(CmdStr)+1);
  46.   GetMem(Dir, Length(DirStr)+1);
  47.   try
  48.     { Copy strings to PChars }
  49.     StrPCopy(Path, PathStr);
  50.     StrPCopy(CmdLine, CmdStr);
  51.     StrPCopy(Dir, DirStr);
  52.     { Execute file }
  53.     Inst := ShellExecute(0, Op, Path, CmdLine, Dir, Show);
  54.     { If 32 or less, an error occurred }
  55.     if Inst <= 32 then Result := False else
  56.     begin
  57.       Result := True;
  58.     end;
  59.   finally
  60.     { Ensure memory is freed }
  61.     FreeMem(Path, Length(PathStr)+1);
  62.     FreeMem(CmdLine, Length(CmdStr)+1);
  63.     FreeMem(Dir, Length(DirStr)+1);
  64.   end;
  65. end;
  66.  
  67. constructor TFileExecButton.Create( AOwner : TComponent );
  68. begin
  69.   inherited Create( AOwner );
  70.   FTheIcon := TIcon.Create;
  71.   FTheBitmap := TBitmap.Create;
  72. end;
  73.  
  74. destructor TFileExecButton.Destroy;
  75. begin
  76.   FTheIcon.Free;
  77.   FTheBitmap.Free;
  78.   inherited Destroy;
  79. end;
  80.  
  81. procedure TFileExecButton.Loaded;
  82. var ThePChar : PChar;
  83. begin
  84.   inherited Loaded;
  85.   if not FileExists( TheFileName ) then exit;
  86.   GetMem( ThePChar , 256 );
  87.   FTheBitmap.Height := 32;
  88.   FTheBitmap.Width := 32;
  89.   StrPCopy( ThePChar , TheFileName );
  90.   FTheIcon.Handle := ExtractIcon( hInstance , ThePChar , 0 );
  91.   if FTheIcon.Handle <> 0 then
  92.   begin
  93.     FTheBitmap.Canvas.Draw( 1,1,FTheIcon );
  94.   end;
  95.   Glyph := FTheBitmap;
  96.   Caption := ExtractFileName( TheFileName );
  97.   Freemem( ThePChar , 256 );
  98.   if Height < 40 then Height := 40;
  99.   if Width < ( 60 + FTheBitmap.Canvas.TextWidth( TheFileName ) ) then
  100.    Width := 60 + FTheBitmap.Canvas.TextWidth( TheFileName );
  101. end;
  102.  
  103. procedure TFileExecButton.ExecuteFile;
  104. var
  105.   TheActiveWindow    : HWnd;
  106.   TheWindowList      : Pointer;
  107. begin
  108.   TheWindowList := DisableTaskWindows( 0 );
  109.   TheActiveWindow := GetActiveWindow;
  110.   try
  111.     if not ShellExec( TheFileName , '' , '', false ,
  112.       SW_SHOWNORMAL , false ) then
  113.     MessageDlg('Could not Execute Task!', mtInformation, [mbOK], 0);
  114.   finally
  115.     EnableTaskWindows( TheWindowList );
  116.     SetActiveWindow( TheActiveWindow );
  117.   end;
  118. end;
  119.  
  120. procedure Register;
  121. begin
  122.   RegisterComponents('Widgets', [TFileExecButton]);
  123. end;
  124.  
  125. end.
  126.