paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-07 18:58:04 +02:00
Code Issues Packages Projects Releases Wiki Activity

PNG test: add a groupbox for radiobuttons (did not work with QT). Improve anchors.

Browse Source 
git-svn-id: trunk@41021 -
This commit is contained in:
juha 2013-05-04 10:28:52 +00:00
parent de9cb3d016
commit ca6c8aeee8
2 changed files with 82 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

118
test/manual/png/unit1.lfm
View File

@ -1,11 +1,11 @@
object frmPNGTestSuite: TfrmPNGTestSuite
Left = 411
Height = 313
Top = 171
Width = 761
Left = 309
Height = 430
Top = 112
Width = 776
Caption = 'PNG load test suite'
ClientHeight = 313
ClientWidth = 761
ClientHeight = 430
ClientWidth = 776
OnDestroy = FormDestroy
Position = poScreenCenter
LCLVersion = '1.1'
@ -18,23 +18,27 @@ object frmPNGTestSuite: TfrmPNGTestSuite
ParentColor = False
WordWrap = True
end
object RadioGroup1: TRadioGroup
Left = 140
Height = 231
Top = 76
Width = 152
AutoFill = True
object rgTestGroups: TRadioGroup
AnchorSideTop.Control = gbPicType
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = gbPicType
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Side = asrBottom
Left = 144
Height = 305
Top = 119
Width = 224
Anchors = [akTop, akLeft, akRight, akBottom]
AutoFill = False
Caption = 'Test groups'
ChildSizing.LeftRightSpacing = 6
ChildSizing.TopBottomSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 213
ClientWidth = 148
ClientHeight = 276
ClientWidth = 218
Items.Strings = (
'Basic'
'Interlaced'
@ -49,14 +53,20 @@ object frmPNGTestSuite: TfrmPNGTestSuite
'Zlib compression level'
'Corrupted files'
)
OnClick = RadioGroup1Click
OnClick = rgTestGroupsClick
TabOrder = 0
end
object ListBox1: TListBox
Left = 297
Height = 288
Top = 16
Width = 453
AnchorSideLeft.Control = gbPicType
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = gbPicType
AnchorSideBottom.Control = rgTestGroups
AnchorSideBottom.Side = asrBottom
Left = 368
Height = 423
Top = 1
Width = 403
Anchors = [akTop, akLeft, akRight, akBottom]
ItemHeight = 0
OnSelectionChange = ListBox1SelectionChange
TabOrder = 1
@ -227,33 +237,47 @@ object frmPNGTestSuite: TfrmPNGTestSuite
Caption = 'Got'
ParentColor = False
end
object rbRefGIF: TRadioButton
Left = 143
Height = 19
object gbPicType: TGroupBox
Left = 144
Height = 118
Top = 1
Width = 151
Caption = 'Reference GIF (no Alpha)'
Checked = True
OnClick = rbRefGIFClick
TabOrder = 6
TabStop = True
end
object rbConvGIF: TRadioButton
Left = 143
Height = 19
Top = 24
Width = 95
Caption = 'Converted GIF'
OnClick = rbRefGIFClick
Width = 224
Caption = 'gbPicType'
ClientHeight = 89
ClientWidth = 218
TabOrder = 4
end
object rbConvPNG: TRadioButton
Left = 143
Height = 19
Top = 48
Width = 102
Caption = 'Converted PNG'
OnClick = rbRefGIFClick
TabOrder = 5
object rbRefGIF: TRadioButton
Left = 14
Height = 21
Top = 3
Width = 180
Caption = 'Reference GIF (no Alpha)'
Checked = True
OnClick = rbRefGIFClick
TabOrder = 0
TabStop = True
end
object rbConvGIF: TRadioButton
AnchorSideTop.Control = rbRefGIF
AnchorSideTop.Side = asrBottom
Left = 15
Height = 21
Top = 24
Width = 112
Caption = 'Converted GIF'
OnClick = rbRefGIFClick
TabOrder = 1
end
object rbConvPNG: TRadioButton
AnchorSideTop.Control = rbConvGIF
AnchorSideTop.Side = asrBottom
Left = 15
Height = 21
Top = 45
Width = 119
Caption = 'Converted PNG'
OnClick = rbRefGIFClick
TabOrder = 2
end
end
end

24
test/manual/png/unit1.pas
View File

@ -16,6 +16,7 @@ type
{ TfrmPNGTestSuite }
TfrmPNGTestSuite = class(TForm)
gbPicType: TGroupBox;
imgCheckboard: TImage;
imgCheckboardExpected: TImage;
imgTestSuite: TImage;
@ -26,24 +27,23 @@ type
ListBox1: TListBox;
Panel1: TPanel;
PanelExpected: TPanel;
rbRefGIF: TRadioButton;
rgTestGroups: TRadioGroup;
rbConvGIF: TRadioButton;
rbConvPNG: TRadioButton;
RadioGroup1: TRadioGroup;
rbRefGIF: TRadioButton;
procedure FormDestroy(Sender: TObject);
procedure imgExpectedResize(Sender: TObject);
procedure imgTestSuiteResize(Sender: TObject);
procedure ListBox1SelectionChange(Sender: TObject; User: boolean);
procedure Panel1Resize(Sender: TObject);
procedure PanelExpectedResize(Sender: TObject);
procedure RadioGroup1Click(Sender: TObject);
procedure rgTestGroupsClick(Sender: TObject);
procedure rbRefGIFClick(Sender: TObject);
private
{ private declarations }
FTestFiles: TStringList;
procedure LoadTest(const aTestName: ansistring);
public
{ public declarations }
end;
var
@ -99,11 +99,10 @@ begin
end else begin
exit;
end;
if FileExists(AsItShouldLook) then begin
imgExpected.Picture.LoadFromFile(AsItShouldLook);
end else begin
if FileExists(AsItShouldLook) then
imgExpected.Picture.LoadFromFile(AsItShouldLook)
else
imgExpected.Picture.Clear;
end;
TestFile:=format('%s%s%s.png',['testsuite',PathDelim,TestFile]);
try
imgTestSuite.Picture.LoadFromFile(TestFile);
@ -126,9 +125,9 @@ begin
imgCheckboardExpected.BoundsRect:=pnl.ClientRect;
end;
procedure TfrmPNGTestSuite.RadioGroup1Click(Sender: TObject);
procedure TfrmPNGTestSuite.rgTestGroupsClick(Sender: TObject);
begin
case RadioGroup1.ItemIndex of
case rgTestGroups.ItemIndex of
0: LoadTest('basic');
1: LoadTest('interlacing');
2: LoadTest('oddsizes');
@ -146,9 +145,8 @@ end;
procedure TfrmPNGTestSuite.rbRefGIFClick(Sender: TObject);
begin
if ListBox1.ItemIndex<>-1 then begin
if ListBox1.ItemIndex<>-1 then
ListBox1.OnSelectionChange(ListBox1,false);
end;
end;
procedure TfrmPNGTestSuite.LoadTest(const aTestName: ansistring);