unit Appactiv;
{
  Delphi Procedure Unit (For Delphi 1.0)
             Copyright (c) 1996, makoto Muramatsu
�@
  This Component provide the function like "AppActivate" statement in
   Microsoft Visual Basic.
  It activate the window that have the title string matched "Title" 
  argument.
  It arrow to use wildcard('*') in fast position or last position of 
  "Title".
  It ignore case.
  It return which found or not.
  GetWindowHandlebyTitle return the handle of window, not Activate.
                         Information To : PXK04012@niftyserve.or.jp
}
interface

uses WinTypes;

function AppActivate(const title : string ):Boolean;
function GetWindowHandleByTitle( const title: String) :HWND;

implementation

uses  SysUtils, WinProcs{, Dialogs} ;

type
  TDirection = (Head, Tail, None );
  TWindowObj = class( TObject )
  private
    targetTitle : PChar;
    compareLength : Integer;
    direction : TDirection;
    windowHandle : HWND;
  public
    constructor Create;
    destructor Destroy;
    function  Equal( currentTitle: PChar ):Boolean;
    function SetTitle( title: String ): boolean; { ok then true }
    procedure SetWindowHandle( hWnd: HWND );
    function GetWindowHandle: hWnd;
  end;

{======================= Common CallBack ================================}
function  EnumWindowsProc( hWnd: HWND; lParam: LongInt ):Bool;export;
var
   ContinueEnumerate : Boolean;
   HObj : TWindowObj;
   Ptitle : PChar;
   titleLength : integer;
   title : string;
   continueFlg : boolean;

begin
     continueFlg := True;
     titleLength :=  GetWindowTextlength( hWnd );
     if titleLength > 0 then begin
         HObj := TWindowObj( lParam );
         Ptitle := StrAlloc( titleLength + 3 );
         GetwindowText( hWnd, Ptitle, titleLength + 2 );
         if HObj.Equal( Ptitle ) then begin
            SetActiveWindow( hWnd );
            HObj.SetWindowHandle( hWnd );
            continueFlg := false;
         end;
     end;
     result := continueFlg;     { Stop Enumerate}
end;


{======================= AppActivate ================================}
function AppActivate(const title : String ): Boolean;
var
   EnumFunc : TFarProc;
   Param : LongInt;
   proc: TFarProc;
   ok : Boolean;
   hObj :  TWindowObj;

begin
    Proc := @EnumWindowsProc;
    EnumFunc := MakeProcInstance( proc, HInstance );
{    If Not Assigned(EnumFunc ) then begin
       MessageDlg( 'MakeprocInstanceFail', mtError, [mbOK],0 );
       exit;
    end; }
    hObj := TWindowObj.Create;
    hObj.SetTitle( title );
    Param := LongInt( hObj );
    try
       ok := EnumWindows( EnumFunc, Param );
    finally
      FreeProcInstance( EnumFunc );
      hObj.Free;
    end;
    if HObj.GetWindowHandle = 0 then begin
       result := false;
    end
    else begin
       result := true;
    end;
end;

{======================= GetWindowHandleByTitle =======================}
function GetWindowHandleByTitle( const title: String) :HWND;
var
   EnumFunc : TFarProc;
   Param : LongInt;
   proc: TFarProc;
   ok : Boolean;
   hObj :  TWindowObj;

begin
    result := 0;
    Proc := @EnumWindowsProc;
    EnumFunc := MakeProcInstance( proc, HInstance );
{    If Not Assigned(EnumFunc ) then begin
       MessageDlg( 'MakeprocInstanceFail', mtError, [mbOK],0 );
       exit;
    end;  }
    hObj := TWindowObj.Create;
    if not hObj.SetTitle( title ) then begin
       exit;
    end;
    Param := LongInt( hObj );
    try
       ok := EnumWindows( EnumFunc, Param );
       result := hObj.GetWindowHandle;
    finally
      FreeProcInstance( EnumFunc );
      hObj.Free;
    end;
end;

{================ TWindowObj =============================}
constructor TWindowObj.Create;
begin
     TargetTitle := nil;
     Windowhandle := 0;
end;

destructor TWindowObj.Destroy;
begin
     if Assigned( TargetTitle ) then begin
        StrDispose( TargetTitle ) ;
     end;
end;

function TWindowObj.Equal( currentTitle: PChar ):Boolean;
var
   p : Pchar;
   stringLength : integer;
begin
     result := false;
     if TargetTitle = nil then begin
        exit;
     end;
     if direction = None then begin
        result := true;
     end
     else if direction = Head then begin
         if StrLIComp( currentTitle, TargetTitle, compareLength) = 0 then begin
            result := true;
         end;
     end
     else begin
          stringlength := Strlen(currentTitle);
          p := @currentTitle[ stringlength - compareLength ];
          if StrLIComp( p, Targettitle, compareLength ) = 0 then begin
             result := true;
          end;
     end;
end;


function TWindowObj.SetTitle( title: String ): boolean;
var
   pTitle: PChar;
   p : PChar;
begin
     result := false;
     pTitle := StrAlloc( Length( title ) + 1 );
     StrPCopy( pTitle, title );
     p := StrScan( pTitle, '*');
     if Assigned( p ) then begin
        if Strlen( pTitle ) = 1 then begin  {full matching }
           direction := None;
           compareLength := 0;
           Targettitle := nil;
           StrDispose( ptitle );
        end
        else if p = pTitle then begin   {tail matching }
             inc(p);
             if StrScan(p, '*') <> nil then begin
                {MessageDlg( 'Please 1 wild char ', mtError, [mbOK],0 ); }
                StrDispose( pTitle);
                TargetTitle := nil;
                direction := None;
                Comparelength := 0;
                exit;
             end;
             direction := Tail;
             Comparelength := StrLen(PTitle) - 1;
             TargetTitle := StrAlloc( strlen(p) + 1 );
             StrCopy( targetTitle, p );
             StrDispose( PTitle );
        end
        else begin
            p^ := #0;
            direction := Head;
            CompareLength := Strlen( pTitle );
            Targettitle := pTitle;
        end;
     end
     else begin
        direction := Head;
        compareLength := Strlen( pTitle );
        TargetTitle := pTitle;
     end;
     result := true;
end;

procedure TWindowObj.SetWindowHandle( hWnd: HWND );
begin
     windowHandle := hWnd;
end;

function TWindowObj.GetWindowHandle: hWnd;
begin
     result := windowHandle;
end;

end.