paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-12 16:09:41 +02:00
Code Issues Packages Projects Releases Wiki Activity

fpcunit gui test runner: improved painting progres text in progresbar, now uses transparent background.

Browse Source 
git-svn-id: trunk@27859 -
This commit is contained in:
vincents 2010-10-25 17:37:53 +00:00
parent ccff36f638
commit 4b2a2eca8a
1 changed files with 10 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
components/fpcunit/guitestrunner.pas
View File

@ -395,6 +395,7 @@ procedure TGUITestRunner.pbBarPaint(Sender: TObject);
var var
msg: string; msg: string;
alltests: integer; alltests: integer;
OldStyle: TBrushStyle;
begin begin
with (Sender as TPaintBox) do with (Sender as TPaintBox) do
begin begin
@ -404,18 +405,22 @@ begin
Canvas.Font.Color := clWhite; Canvas.Font.Color := clWhite;
if Assigned(TestSuite) then if Assigned(TestSuite) then
begin begin
alltests := TestSuite.CountTestCases;
if FailureCounter + ErrorCounter = 0 then
barColor := clGreen;
Canvas.Brush.Color := barColor;
if TestsCounter <> 0 then if TestsCounter <> 0 then
begin begin
alltests := TestSuite.CountTestCases;
if FailureCounter + ErrorCounter = 0 then
barColor := clGreen;
Canvas.Brush.Color := barColor;
Canvas.Rectangle(0, 0, round(TestsCounter / (alltests - skipsCounter) * Width), Height); Canvas.Rectangle(0, 0, round(TestsCounter / (alltests - skipsCounter) * Width), Height);
msg := Format(rsRuns, [IntToStr(TestsCounter), IntToStr(alltests - msg := Format(rsRuns, [IntToStr(TestsCounter), IntToStr(alltests -
skipsCounter)]); skipsCounter)]);
msg := Format(rsErrors, [msg, IntToStr(ErrorCounter)]); msg := Format(rsErrors, [msg, IntToStr(ErrorCounter)]);
msg := Format(rsFailures, [msg, IntToStr(FailureCounter)]); msg := Format(rsFailures, [msg, IntToStr(FailureCounter)]);
Canvas.Textout(10, 10, msg) //Canvas.Brush.Color := clNone;
OldStyle := Canvas.Brush.Style;
Canvas.Brush.Style := bsClear;
Canvas.Textout(10, 10, msg);
Canvas.Brush.Style := OldStyle;
end; end;
end; end;
Canvas.UnLock; Canvas.UnLock;