GUITesting Unit
Classes Const
DUnit: An XTreme testing framework for Delphi programs.

Classes
TGUITestCase 

Global Constants
rcs_id 

Author
The DUnit Group.


HTML generated by Time2HELP
http://www.time2help.com
TGUITestCase Object
Methods

Unit
GUITesting

Declaration
TGUITestCase = class(TTestCase)

Introduced Methods
CheckFocused
CheckTabTo
Click
ClickLeftMouseButtonOn
Create
EnterKey
EnterKeyInto
EnterText
EnterTextInto
FindControl
FindParentWinControl
GetFocused
Hide
ShiftStateToKeyData
Show
Tab


HTML generated by Time2HELP
http://www.time2help.com
ActionDelay property

Applies to
TGUITestCase

Declaration
Property ActionDelay : Integer Read FActionDelay Write FActionDelay;


HTML generated by Time2HELP
http://www.time2help.com
GUI property

Applies to
TGUITestCase

Declaration
Property GUI : TControl Read FGUI Write FGUI;


HTML generated by Time2HELP
http://www.time2help.com
CheckFocused method

Applies to
TGUITestCase

Declaration
Procedure CheckFocused(Control :TControl);

Implementation

procedure TGUITestCase.CheckFocused(Control: TControl);
var
  F :TControl;
begin
  Assert(Control <> nil, 'No control');

  Check(Control is TWinControl,
        Format('Expected a TWinControl, but %s is a %s',
               [Control.Name, Control.ClassName])
        );
  Check(TWinControl(Control).CanFocus,
        Format('Control %s cannot focus', [Control.ClassName])
        );
  if (Control.Owner <> nil) and (Control.Owner is TCustomForm) then
    F := TCustomForm(Control.Owner).ActiveControl
  else
    F := GetFocused;
  if  F <> Control then
  begin
    if F <> nil then
      Fail(Format('Expected control %s to have focus, but %s had it.', [Control.Name, F.Name]), CallerAddr)
    else
      Fail(Format('Expected control %s to have focus', [Control.Name]), CallerAddr);
  end
End;


HTML generated by Time2HELP
http://www.time2help.com
CheckTabTo method

Applies to
TGUITestCase

Declaration
Procedure CheckTabTo(Control :TControl; Msg :string = '');

Implementation

procedure TGUITestCase.CheckTabTo(Control: TControl; Msg :string = '');
var
  i :Integer;
begin
  Assert(GUI <> nil, 'GUI variable not set');

  Check(Control is TWinControl,
        Format('%s: Expected a TWinControl, but %s is a %s',
               [msg, Control.Name, Control.ClassName])
        );
  Check(TWinControl(Control).CanFocus,
        Format('%s: Control %s:%s cannot focus', [msg, Control.Name, Control.ClassName])
        );

  for i := 1 to GUI.ComponentCount do
  begin
     if GetFocused = Control then
       EXIT;
     Tab;
  end;
  Fail(Format('%s: Could not Tab to control "%s"', [Msg, Control.Name]), CallerAddr);
End;


HTML generated by Time2HELP
http://www.time2help.com
Click method

Applies to
TGUITestCase

Declaration
Procedure Click;

Implementation

procedure TGUITestCase.Click;
begin
  Assert(GUI <> nil, 'GUI variable not set');
  Click(GUI);
End;


HTML generated by Time2HELP
http://www.time2help.com
ClickLeftMouseButtonOn method

Applies to
TGUITestCase

Declaration
Procedure ClickLeftMouseButtonOn(Control: TControl);

Implementation

procedure TGUITestCase.ClickLeftMouseButtonOn(Control: TControl);
var
  P      :TSmallPoint;
begin
  Assert(Control <> nil, 'No control');

  Control := FindParentWinControl(Control);
  if Control <> nil then
  begin
    {:@ todo consider if this method should have X,Y parameters.
      @todo This doesn't work if the original control is not a TWinControl and is not in
       the middle of its parent. }
    P   := SmallPoint(Control.Width  div 2, Control.Height div 2);
    PostMessage(TWinControl(Control).Handle, WM_LBUTTONDOWN, 0, Longint(P));
    PostMessage(TWinControl(Control).Handle, WM_LBUTTONUP, 0,   Longint(P));
    Sleep(ActionDelay);
  end;
  Application.ProcessMessages;
End;


HTML generated by Time2HELP
http://www.time2help.com
Create method

Applies to
TGUITestCase

Declaration
Constructor Create(MethodName :string);

Implementation

constructor TGUITestCase.Create(MethodName :string);
begin
  inherited Create(MethodName);
  FActionDelay := 100;
End;


HTML generated by Time2HELP
http://www.time2help.com
EnterKey method

Applies to
TGUITestCase

Declaration
Procedure EnterKey(Key :Word; const ShiftState :TShiftState = []);


HTML generated by Time2HELP
http://www.time2help.com
EnterKeyInto method

Applies to
TGUITestCase

Declaration
Procedure EnterKeyInto(Control :TControl; Key :Word; const ShiftState :TShiftState = []);


HTML generated by Time2HELP
http://www.time2help.com
EnterText method

Applies to
TGUITestCase

Declaration
Procedure EnterText(Text :string);

Implementation

procedure TGUITestCase.EnterText(Text: string);
begin
  Assert(GUI <> nil, 'GUI variable not set');
  EnterTextInto(GUI, Text);
End;


HTML generated by Time2HELP
http://www.time2help.com
EnterTextInto method

Applies to
TGUITestCase

Declaration
Procedure EnterTextInto(Control :TControl; Text :string);

Implementation

procedure TGUITestCase.EnterTextInto(Control: TControl; Text: string);
var
  i :Integer;
begin
  Assert(Control <> nil, 'No control');
  Control := FindParentWinControl(Control);
  if Control <> nil then
  begin
    for i := 1 to Length(Text) do
    begin
      PostMessage(TWinControl(Control).Handle, WM_CHAR, Ord(Text[i]), 0);
      Sleep(ActionDelay);
    end;
  end;
  Application.ProcessMessages;
End;


HTML generated by Time2HELP
http://www.time2help.com
FindControl method

Applies to
TGUITestCase

Declaration
Function FindControl(Comp: TComponent; const CtlName: string): TControl;

Implementation

function TGUITestCase.FindControl(Comp: TComponent; const CtlName: string): TControl;

  function DoFind(C :TComponent; const CName :string) :TControl;
  var
    i: Integer;
  begin
    Result := nil;
    i := 0;
    while (Result = nil) and (i < C.ComponentCount) do
    begin
      with C do
      begin
        if (Components[i] is TControl)
        and (UpperCase(Components[i].Name) = CName) then
          Result := Components[I] as TControl
        else
          Result := DoFind(Components[I], CName);
      end;
      Inc(i);
    end;
  end;
begin
  Assert(Trim(CtlName) <> '', 'No control name');

  Result := DoFind(Comp, UpperCase(CtlName));

  Assert(Result <> nil, Format('Control named "%s" not found', [CtlName]));
End;


HTML generated by Time2HELP
http://www.time2help.com
FindParentWinControl method

Applies to
TGUITestCase

Declaration
Function FindParentWinControl(Control :TControl): TWinControl;

Implementation

function TGUITestCase.FindParentWinControl(Control: TControl): TWinControl;
begin
  while (Control <> nil) and not (Control is TWinControl) do
    Control := Control.Parent;
  Result := TWinControl(Control);
End;


HTML generated by Time2HELP
http://www.time2help.com
GetFocused method

Applies to
TGUITestCase

Declaration
Function GetFocused: TControl;

Implementation

function TGUITestCase.GetFocused: TControl;
var
  i :Integer;
begin
  Assert(GUI <> nil, 'GUI variable not set');

  if GUI is TCustomForm then
    Result := TCustomForm(GUI).ActiveControl
  else
  begin
    Result := nil;
    for i := 0 to GUI.ComponentCount-1 do
    begin
       if (GUI.Components[i] is TWinControl)
       and TWinControl(GUI.Components[i]).Focused then
       begin
         Result := TControl(GUI.Components[i]);
         BREAK;
       end
    end;
  end;
End;


HTML generated by Time2HELP
http://www.time2help.com
Hide method

Applies to
TGUITestCase

Declaration
Procedure Hide(OnOff :boolean = true);


HTML generated by Time2HELP
http://www.time2help.com
ShiftStateToKeyData method

Applies to
TGUITestCase

Declaration
Function ShiftStateToKeyData(ShiftState :TShiftState): Longint;

Implementation

function TGUITestCase.ShiftStateToKeyData(ShiftState :TShiftState):Longint;
const
  AltMask = $20000000;
begin
  Result := 0;
  if ssShift in ShiftState then
    Result := Result or VK_SHIFT;
  if ssCtrl in ShiftState then
    Result := Result or VK_CONTROL;
  if ssAlt in ShiftState then
    Result := Result or AltMask;
End;


HTML generated by Time2HELP
http://www.time2help.com
Show method

Applies to
TGUITestCase

Declaration
Procedure Show(OnOff :boolean = true);


HTML generated by Time2HELP
http://www.time2help.com
Tab method

Applies to
TGUITestCase

Declaration
Procedure Tab(n :Integer =1);

Implementation

procedure TGUITestCase.Tab(n: Integer);
var
  i :Integer;
  s :TShiftState;
begin
  Assert(GUI <> nil, 'GUI variable not set');

  s := [];
  if n < 0 then
  begin
    s := [ssShift];
    n := -n;
  end;

  for i := 1 to n do
    EnterKey(VK_TAB);

  Application.ProcessMessages;
  Sleep(ActionDelay);
End;


HTML generated by Time2HELP
http://www.time2help.com
rcs_id Global Constant

Unit
GUITesting

Declaration
rcs_id : string = '#(@)$Id: GUITesting.pas,v 1.2 2000/12/05 01:15:40 juanco Exp $';


HTML generated by Time2HELP
http://www.time2help.com