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 thenbeginif F <> nilthen
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);
endEnd;
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 dobeginif GetFocused = Control then
EXIT;
Tab;
end;
Fail(Format('%s: Could not Tab to control "%s"', [Msg, Control.Name]), CallerAddr);
End;
procedure TGUITestCase.ClickLeftMouseButtonOn(Control: TControl);
var
P :TSmallPoint;
begin
Assert(Control <> nil, 'No control');
Control := FindParentWinControl(Control);
if Control <> nilthenbegin
{:@ 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;
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 <> nilthenbeginfor i := 1 to Length(Text) dobegin
PostMessage(TWinControl(Control).Handle, WM_CHAR, Ord(Text[i]), 0);
Sleep(ActionDelay);
end;
end;
Application.ProcessMessages;
End;
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) dobeginwith C dobeginif (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;
Declaration Function FindParentWinControl(Control :TControl): TWinControl;
Implementation
function TGUITestCase.FindParentWinControl(Control: TControl): TWinControl;
beginwhile (Control <> nil) andnot (Control is TWinControl) do
Control := Control.Parent;
Result := TWinControl(Control);
End;
function TGUITestCase.GetFocused: TControl;
var
i :Integer;
begin
Assert(GUI <> nil, 'GUI variable not set');
if GUI is TCustomForm then
Result := TCustomForm(GUI).ActiveControl
elsebegin
Result := nil;
for i := 0 to GUI.ComponentCount-1 dobeginif (GUI.Components[i] is TWinControl)
and TWinControl(GUI.Components[i]).Focused thenbegin
Result := TControl(GUI.Components[i]);
BREAK;
endend;
end;
End;
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;
procedure TGUITestCase.Tab(n: Integer);
var
i :Integer;
s :TShiftState;
begin
Assert(GUI <> nil, 'GUI variable not set');
s := [];
if n < 0 thenbegin
s := [ssShift];
n := -n;
end;
for i := 1 to n do
EnterKey(VK_TAB);
Application.ProcessMessages;
Sleep(ActionDelay);
End;