mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-08 20:18:16 +02:00
52 lines
994 B
ObjectPascal
52 lines
994 B
ObjectPascal
unit lclsemiautotests;
|
|
|
|
{$mode objfpc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils,
|
|
Interfaces, LCLType, LCLIntf, Forms, Graphics,
|
|
testglobals, semiautotest;
|
|
|
|
type
|
|
|
|
{ TTestLCLFormCanvas }
|
|
|
|
TTestLCLFormCanvas = class(TSemiAutomaticTest)
|
|
private
|
|
APt: TPoint;
|
|
procedure TestOneHandlePaint(Sender: TObject);
|
|
published
|
|
procedure TestOne;
|
|
end;
|
|
|
|
implementation
|
|
|
|
{ TTestIdeNew }
|
|
|
|
procedure TTestLCLFormCanvas.TestOneHandlePaint(Sender: TObject);
|
|
begin
|
|
FDialog.Canvas.Pen.Color := clRed;
|
|
FDialog.Canvas.Brush.Color := clBlue;
|
|
FDialog.Canvas.Rectangle(Bounds(APt.X, APt.Y, 100, 100));
|
|
end;
|
|
|
|
procedure TTestLCLFormCanvas.TestOne;
|
|
var
|
|
Str: string;
|
|
lDialog: TForm;
|
|
begin
|
|
Str := 'Please verify is a rectangle with a red frame and blue contents is drawn'
|
|
;
|
|
lDialog := GetCanvasDialog(APt);
|
|
lDialog.OnPaint := @TestOneHandlePaint;
|
|
AssertTrue(ShowCanvasDialog('TTestLCLFormCanvas.TestOne', Str));
|
|
end;
|
|
|
|
initialization
|
|
AddToSemiAutoTestSuite(TTestLCLFormCanvas);
|
|
|
|
end.
|
|
|