diff options
author | graemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf> | 2008-07-11 13:42:39 +0000 |
---|---|---|
committer | graemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf> | 2008-07-11 13:42:39 +0000 |
commit | 34abe19ad2877ca470c75cbad2e9189ba346d54f (patch) | |
tree | dc0a3a787ef1f1e6931026f93d918531dcca9868 | |
parent | 3920a40d796da321010cc456fc864e552b97e398 (diff) | |
download | fpGUI-34abe19ad2877ca470c75cbad2e9189ba346d54f.tar.xz |
* Removed many compiler warnings from the gfx_imgfmt_bmp unit.
* Minor fix in the ImageList class.
* Minor fixes in the Tree and TreeNode classes.
* GUI Test Runner: Added image support in the test treeview.
* Started a project for unit testing fpGUI components - starting with the treeview.
-rw-r--r-- | examples/apps/fpcunit/fpg_guitestrunner.pas | 149 | ||||
-rw-r--r-- | examples/apps/fpcunit/images/treeimages.inc | 105 | ||||
-rw-r--r-- | src/corelib/fpgfx.pas | 2 | ||||
-rw-r--r-- | src/corelib/gfx_imagelist.pas | 46 | ||||
-rw-r--r-- | src/corelib/gfx_imgfmt_bmp.pas | 17 | ||||
-rw-r--r-- | src/corelib/x11/gfx_x11.pas | 1 | ||||
-rw-r--r-- | src/gui/gui_tree.pas | 36 | ||||
-rw-r--r-- | unittests/fpcunitproject.lpi | 60 | ||||
-rw-r--r-- | unittests/fpcunitproject.lpr | 30 | ||||
-rw-r--r-- | unittests/treeview_test.pas | 68 |
10 files changed, 424 insertions, 90 deletions
diff --git a/examples/apps/fpcunit/fpg_guitestrunner.pas b/examples/apps/fpcunit/fpg_guitestrunner.pas index 2f52ba38..dab2e5fd 100644 --- a/examples/apps/fpcunit/fpg_guitestrunner.pas +++ b/examples/apps/fpcunit/fpg_guitestrunner.pas @@ -27,11 +27,7 @@ type temptest: TTest; barColor: TfpgColor; FImagelist: TfpgImageList; - img0: TfpgImage; - img1: TfpgImage; - img2: TfpgImage; - img3: TfpgImage; - img4: TfpgImage; + FPopupMenu: TfpgPopupMenu; // ITestListener procedure AddFailure(ATest: TTest; AFailure: TTestFailure); procedure AddError(ATest: TTest; AError: TTestFailure); @@ -51,6 +47,11 @@ type function FindNode(ATest: TTest): TfpgTreeNode; procedure ResetNodeColors(ANode: TfpgTreeNode; var AFound: boolean); procedure PopulateImageList; + procedure CreatePopupMenu; + procedure miCollapseAll(Sender: TObject); + procedure miExpandAll(Sender: TObject); + procedure miCollapseNode(Sender: TObject); + procedure miExpandNode(Sender: TObject); public {@VFD_HEAD_BEGIN: GUITestRunnerForm} bvlTree: TfpgBevel; @@ -84,25 +85,32 @@ uses {@VFD_NEWFORM_IMPL} +resourcestring + uiCollapseAll = 'Collapse All'; + uiExpandAll = 'Expand All'; + uiCollapse = 'Collapse'; + uiExpand = 'Expand'; + +// used images {$I treeimages.inc} + procedure TGUITestRunnerForm.AddFailure(ATest: TTest; AFailure: TTestFailure); var FailureNode, node: TfpgTreeNode; begin MemoLog('failed - ' + ATest.TestName); FailureNode := FindNode(ATest); + FailureNode.ImageIndex := 3; if not Assigned(FailureNode) then memolog(' Failed to find node'); if Assigned(FailureNode) then begin node := FailureNode.AppendText('Message: ' + AFailure.ExceptionMessage); -// node.ImageIndex := 4; -// node.SelectedIndex := 4; + node.ImageIndex := 4; node.TextColor := clFuchsia; node := FailureNode.AppendText('Exception: ' + AFailure.ExceptionClassName); -// node.ImageIndex := 4; -// node.SelectedIndex := 4; + node.ImageIndex := 4; node.TextColor := clFuchsia; // PaintNodeFailure(FailureNode); end; @@ -119,32 +127,28 @@ var begin MemoLog('error - ' + ATest.TestName); ErrorNode := FindNode(ATest); + ErrorNode.ImageIndex := 2; if Assigned(ErrorNode) then begin node := ErrorNode.AppendText('Exception message: ' + AError.ExceptionMessage); node.TextColor := clRed; -// node.ImageIndex := 4; -// node.SelectedIndex := 4; + node.ImageIndex := 4; node := ErrorNode.AppendText('Exception class: ' + AError.ExceptionClassName); node.TextColor := clRed; -// node.ImageIndex := 4; -// node.SelectedIndex := 4; + node.ImageIndex := 4; if (AError.SourceUnitName <> '') and (AError.FailedMethodName <> '') then begin node := ErrorNode.AppendText('Unit name: ' + AError.SourceUnitName); node.TextColor := clRed; -// node.ImageIndex := 11; -// node.SelectedIndex := 11; + node.ImageIndex := 5; node := ErrorNode.AppendText('Method name: ' + AError.FailedMethodName); node.TextColor := clRed; -// node.ImageIndex := 11; -// node.SelectedIndex := 11; + node.ImageIndex := 5; node := ErrorNode.AppendText('Line number: ' + IntToStr(AError.LineNumber)); node.TextColor := clRed; -// node.ImageIndex := 11; -// node.SelectedIndex := 11; + node.ImageIndex := 5; end; // PaintNodeError(ErrorNode); end; @@ -152,23 +156,24 @@ begin barColor := clRed; tvTests.Invalidate; + fpgApplication.ProcessMessages; end; procedure TGUITestRunnerForm.StartTest(ATest: TTest); var Node: TfpgTreeNode; begin -// MemoLog('StartTest'); - +// writeln(ATest.TestName, '...'); Node := FindNode(ATest); if Assigned(Node) then begin Node.Clear; -// Node.TextColor := clBlue; + Node.ImageIndex := 1; // green tvTests.Invalidate; fpgApplication.ProcessMessages; - end; - + end + else + writeln(' Failed to find Node for test'); end; procedure TGUITestRunnerForm.EndTest(ATest: TTest); @@ -252,9 +257,12 @@ var n: TfpgTreeNode; begin n := tvTests.RootNode.AppendText('All Tests'); + n.ImageIndex := 6; BuildTree(n, GetTestRegistry); n.Data := GetTestRegistry; -// n.Text := 'All Tests (count=' + IntToStr(GetTestRegistry.CountTestCases) + ')'; + + // Popup Menu support is still experimental +// CreatePopupMenu; end; procedure TGUITestRunnerForm.btnQuitClicked(Sender: TObject); @@ -265,7 +273,10 @@ end; procedure TGUITestRunnerForm.btnClearClicked(Sender: TObject); begin memName1.Lines.Clear; - tvTests.RootNode.FindSubNode(@ResetNodeColors); +// tvTests.RootNode.FindSubNode(@ResetNodeColors); + + tvTests.RootNode.FirstSubNode.Clear; + BuildTree(tvTests.RootNode.FirstSubNode, GetTestRegistry); tvTests.Invalidate; fpgApplication.ProcessMessages; end; @@ -288,6 +299,7 @@ end; procedure TGUITestRunnerForm.FindByData(ANode: TfpgTreeNode; var AFound: boolean); begin + writeln('...', ANode.Text); AFound := TTest(ANode.Data) = temptest; // if AFound then // MemoLog('Found Node ' + ANode.Text); @@ -300,16 +312,17 @@ begin result := nil; // short circut test - if (tvTests.Selection.Next <> nil) and (tvTests.Selection.Next.Data <> nil) and (TTest(tvTests.Selection.Next.Data) = ATest) then - begin - result := tvTests.Selection.Next; - Exit; //==> - end; - + //if (tvTests.Selection.Next <> nil) and (tvTests.Selection.Next.Data <> nil) and (TTest(tvTests.Selection.Next.Data) = ATest) then + //begin + //result := tvTests.Selection.Next; + //Exit; //==> + //end; + // recursive search try temptest := ATest; - result := tvTests.RootNode.FindSubNode(@FindByData); + //result := tvTests.RootNode.FindSubNode(@FindByData); + result := tvTests.RootNode.FindSubNode(ATest.TestName, True); finally temptest := nil; end; @@ -321,21 +334,67 @@ begin end; procedure TGUITestRunnerForm.PopulateImageList; +var + img: TfpgImage; begin - img0 := CreateImage_BMP(@fpcunit_circle_grey, sizeof(fpcunit_circle_grey) ); - FImagelist.AddImage(img0, 0); + img := CreateImage_BMP(@fpcunit_circle_grey, sizeof(fpcunit_circle_grey) ); + FImagelist.AddImage(img, 0); + + img := CreateImage_BMP(@fpcunit_circle_green, sizeof(fpcunit_circle_green) ); + FImagelist.AddImage(img, 1); - img1 := CreateImage_BMP(@fpcunit_circle_green, sizeof(fpcunit_circle_green) ); - FImagelist.AddImage(img1, 1); + img := CreateImage_BMP(@fpcunit_circle_red, sizeof(fpcunit_circle_red) ); + FImagelist.AddImage(img, 2); - img2 := CreateImage_BMP(@fpcunit_circle_red, sizeof(fpcunit_circle_red) ); - FImagelist.AddImage(img2, 2); + img := CreateImage_BMP(@fpcunit_circle_fuchsia, sizeof(fpcunit_circle_fuchsia) ); + FImagelist.AddImage(img, 3); - img3 := CreateImage_BMP(@fpcunit_information, sizeof(fpcunit_information) ); - FImagelist.AddImage(img3, 3); + img := CreateImage_BMP(@fpcunit_bug, sizeof(fpcunit_bug) ); + FImagelist.AddImage(img, 4); - img4 := CreateImage_BMP(@fpcunit_bug, sizeof(fpcunit_bug) ); - FImagelist.AddImage(img4, 4); + img := CreateImage_BMP(@fpcunit_information, sizeof(fpcunit_information) ); + FImagelist.AddImage(img, 5); + + img := CreateImage_BMP(@fpcunit_xtao_16, sizeof(fpcunit_xtao_16) ); + FImagelist.AddImage(img, 6); +end; + +procedure TGUITestRunnerForm.CreatePopupMenu; +var + itm: TfpgMenuItem; +begin + FPopupMenu := TfpgPopupMenu.Create(nil); + + itm := FPopupMenu.AddMenuItem(uiCollapseAll, '', @miCollapseAll); + itm.Name := 'pmCollapseAll'; + itm := FPopupMenu.AddMenuItem(uiExpandAll, '', @miExpandAll); + itm.Name := 'pmExpandAll'; + itm := FPopupMenu.AddMenuItem(uiCollapse, '', @miCollapseNode); + itm.Name := 'pmCollapse'; + itm := FPopupMenu.AddMenuItem(uiExpand, '', @miExpandNode); + itm.Name := 'pmExpand'; + + tvTests.PopupMenu := FPopupMenu; +end; + +procedure TGUITestRunnerForm.miCollapseAll(Sender: TObject); +begin + tvTests.RootNode.Collapse; +end; + +procedure TGUITestRunnerForm.miExpandAll(Sender: TObject); +begin + tvTests.RootNode.Expand; +end; + +procedure TGUITestRunnerForm.miCollapseNode(Sender: TObject); +begin + tvTests.Selection.Collapse; +end; + +procedure TGUITestRunnerForm.miExpandNode(Sender: TObject); +begin + tvTests.Selection.Expand; end; constructor TGUITestRunnerForm.Create(AOwner: TComponent); @@ -482,8 +541,8 @@ begin Anchors := [anLeft,anRight,anTop,anBottom]; FontDesc := '#Label1'; TabOrder := 3; -// ImageList := FImagelist; -// ShowImages := True; + ImageList := FImagelist; + ShowImages := True; end; memName1 := TfpgMemo.Create(bvlResults); diff --git a/examples/apps/fpcunit/images/treeimages.inc b/examples/apps/fpcunit/images/treeimages.inc index f42f1b55..86553af7 100644 --- a/examples/apps/fpcunit/images/treeimages.inc +++ b/examples/apps/fpcunit/images/treeimages.inc @@ -156,6 +156,58 @@ Const 255,255,255,255,255,255); Const + fpcunit_circle_fuchsia : Array[0..821] of byte = ( + 66, 77, 54, 3, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, + 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, + 0, 3, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,254,222,251,238,146, + 226,242, 29,255,204, 1,255,188, 0,250,235, 15,255,234,138,219,254, + 216,249,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,250,182,241,232, 35,255,177, 9,255,233, 97, + 253,236,140,242,236,140,242,232, 89,253,161, 0,244,209, 0,254,247, + 169,233,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 251,185,244,221, 31,255,216, 61,255,242,159,247,227,119,247,205, 69, + 255,204, 65,255,228,116,248,241,156,246,207, 41,255,174, 0,238,247, + 169,233,255,255,255,255,255,255,255,255,255,255,227,252,243, 59,255, + 218, 69,255,242,159,247,190, 65,255,188, 59,255,182, 55,255,186, 53, + 255,181, 51,255,191, 55,255,241,156,246,218, 43,255,210, 1,255,254, + 218,249,255,255,255,255,255,255,244,162,237,191, 39,255,243,160,248, + 192, 71,255,186, 65,255,182, 55,255,182, 55,255,182, 55,255,182, 55, + 255,181, 51,255,192, 57,255,242,157,247,163, 0,248,234,136,219,255, + 255,255,255,255,255,247, 83,253,228,124,244,223,126,248,200, 81,255, + 182, 55,255,182, 55,255,182, 55,255,182, 55,255,182, 55,255,182, 55, + 255,187, 57,255,225,116,248,239, 92,252,230, 17,255,255,255,255,255, + 255,255,235, 65,255,241,159,249,211,112,248,205,101,249,182, 55,255, + 182, 55,255,182, 55,255,182, 55,255,182, 55,255,182, 55,255,182, 55, + 255,205, 71,255,238,149,243,187, 0,248,255,255,255,255,255,255,236, + 71,255,246,174,250,223,128,250,215,105,247,190, 65,255,190, 65,255, + 190, 65,255,182, 55,255,182, 55,255,182, 55,255,182, 55,255,203, 77, + 255,238,149,243,197, 0,254,255,255,255,255,255,255,241,102,250,242, + 163,247,239,157,251,218,116,244,190, 65,255,190, 65,255,190, 65,255, + 190, 65,255,190, 65,255,190, 65,255,209, 88,254,224,129,245,231,104, + 250,242, 33,255,255,255,255,255,255,255,248,174,243,234,112,248,252, + 205,253,231,139,251,220,126,248,221,112,244,209,106,248,209,106,248, + 209,106,248,209,106,248,205, 88,254,242,163,249,173, 15,255,239,147, + 227,255,255,255,255,255,255,255,231,253,244, 95,253,242,161,245,253, + 212,254,227,136,250,224,126,242,221,121,243,221,128,248,222,127,249, + 216,118,248,242,167,249,223, 71,255,237, 39,255,254,224,251,255,255, + 255,255,255,255,255,255,255,253,201,250,237, 81,255,244,167,245,253, + 216,254,245,173,251,234,145,251,231,139,251,239,156,252,249,185,253, + 224, 94,252,227, 35,255,250,184,241,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,253,201,250,244, 95,253,235,139,241,249, + 188,250,252,202,252,250,195,251,243,168,246,227, 73,255,239, 59,255, + 250,188,244,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,231,253,248,174,244,245,102,250,236, + 73,255,235, 69,255,243, 85,253,245,165,239,255,227,252,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255); + +Const fpcunit_information : Array[0..821] of byte = ( 66, 77, 54, 3, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, @@ -258,3 +310,56 @@ Const 255,255,255,255,255,255,255,255,255,255,255,255,255, 58,183, 63,205, 236,206,255,255,255,191,229,193, 60,175, 66,255,255,255,255,255,255, 255,255,255,255,255,255); + +Const + fpcunit_xtao_16 : Array[0..821] of byte = ( + 66, 77, 54, 3, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, + 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, + 0, 3, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0,255,255,255,255,255,255,255,255,255,255,255,255,254,255, + 254,212,238,216,186,188,198,212,123,223,228, 95,244,242,125,253,243, + 194,253,254,254,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,217,240,221,109,199,124,130,108, + 158,252, 2,253,255, 0,255,255, 0,255,255, 0,255,255, 0,255,249, + 49,254,244,201,253,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,197,233,204, 75,186, 94, 96,150,119,248, 4,252,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,247, + 9,254,247,166,254,255,255,255,255,255,255,255,255,255,217,240,221, + 74,185, 93, 68,183, 88,155, 91,173,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,250, + 6,254,242,199,253,255,255,255,254,255,254,109,199,124, 68,183, 88, + 68,183, 88,168, 78,185,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,246, + 47,254,254,253,255,214,239,218, 68,183, 88, 68,183, 88, 68,183, 88, + 124,120,146,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,246, + 190,254,160,219,171, 68,183, 88, 68,183, 88, 68,183, 88, 70,179, 92, + 199, 45,215,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,240,123,253,135, + 209,148, 68,183, 88, 68,183, 88, 68,183, 88, 68,183, 88, 73,175, 96, + 157, 85,178,226, 23,234,240, 9,247,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,253, 86,255,135,209,148, 68, + 183, 88, 68,183, 88, 68,183, 88, 68,183, 88, 68,183, 88, 68,183, 88, + 68,183, 88, 69,177, 94,104,140,128,197, 46,214,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 84,255,160,218,170, 68,183, 88, 68, + 183, 88, 68,183, 88, 68,183, 88, 68,183, 88, 68,183, 88, 68,183, 88, + 68,183, 88, 68,183, 88, 73,176, 94,207, 40,219,255, 0,255,255, 0, + 255,255, 0,255,245,118,253,212,238,216, 68,183, 88, 68,183, 88, 68, + 183, 88, 68,183, 88, 68,183, 88, 68,183, 88, 68,183, 88, 68,183, 88, + 68,183, 88, 68,183, 88,104,139,130,255, 0,255,255, 0,255,255, 0, + 255,244,188,253,254,255,254,104,197,120, 68,183, 88, 68,183, 88, 68, + 183, 88, 68,183, 88, 68,183, 88, 68,183, 88, 68,183, 88, 68,183, 88, + 68,183, 88, 68,174, 97,247, 5,251,255, 0,255,243, 44,253,254,253, + 255,255,255,255,215,239,219, 74,185, 93, 68,183, 88, 68,183, 88, 68, + 183, 88, 68,183, 88, 68,183, 88, 68,183, 88, 68,183, 88, 68,183, 88, + 74,169,101,249, 3,252,254, 4,255,242,197,253,255,255,255,255,255, + 255,255,255,255,188,229,195, 72,184, 91, 68,183, 88, 68,183, 88, 68, + 183, 88, 68,183, 88, 68,183, 88, 68,183, 88, 68,183, 88,134,110,156, + 250, 6,254,243,161,253,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,210,238,215,102,196,118, 68,183, 88, 68,183, 88, 68, + 183, 88, 68,183, 88, 68,183, 88, 91,148,121,220, 57,240,245,195,253, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,254,254,254,203,235,209,154,216,165,130,207,144,129, + 202,148,153,194,186,234,191,249,254,253,255,255,255,255,255,255,255, + 255,255,255,255,255,255); + diff --git a/src/corelib/fpgfx.pas b/src/corelib/fpgfx.pas index 59054a59..ddbee4d5 100644 --- a/src/corelib/fpgfx.pas +++ b/src/corelib/fpgfx.pas @@ -1736,7 +1736,7 @@ var i: integer; img: TfpgImage; begin - for i := FImages.Count-1 downto 0 do + for i := FImages.Count-1 downto 0 do begin img := TfpgImage(FImages.Objects[i]); FImages.Delete(i); diff --git a/src/corelib/gfx_imagelist.pas b/src/corelib/gfx_imagelist.pas index 044f951e..123cb09a 100644 --- a/src/corelib/gfx_imagelist.pas +++ b/src/corelib/gfx_imagelist.pas @@ -28,6 +28,7 @@ interface uses Classes, SysUtils, + gfxbase, fpgfx; type @@ -48,12 +49,12 @@ type public constructor Create; overload; constructor Create(AImageList: TfpgImageList; AIndex: integer; AImage: TfpgImage); overload; - constructor Create(AFileName: string; AIndex: integer); overload; + constructor Create(AFileName: TfpgString; AIndex: integer); overload; destructor Destroy; override; property Index: integer read FIndex write SetIndex; property Image: TfpgImage read FImage write SetImage; property ImageList: TfpgImageList read FImageList write SetImageList; - procedure LoadFromFile(AFileName: String); + procedure LoadFromFile(AFileName: TfpgString); end; @@ -66,7 +67,7 @@ type public constructor Create; destructor Destroy; override; - procedure AddItemFromFile(AFileName: String; AIndex: integer = -1); + procedure AddItemFromFile(AFileName: TfpgString; AIndex: integer = -1); procedure AddImage(AImage: TfpgImage; AIndex: integer = -1); procedure RemoveIndex(AIndex: integer); function GetMaxItem: integer; @@ -78,22 +79,23 @@ type implementation uses - gfx_imgfmt_bmp; + gfx_imgfmt_bmp, + gfx_utils; { TfpgImageList } function TfpgImageList.GetFListIndex(AIndex: Integer): Integer; var - ACounter: integer; + i: integer; begin {$IFDEF DEBUG} writeln('TfpgImageList.GetFListIndex'); {$ENDIF} result := -1; - for ACounter := 0 to FList.Count - 1 do - if TfpgImageItem(FList[ACounter]).Index = AIndex then + for i := 0 to FList.Count - 1 do + if TfpgImageItem(FList[i]).Index = AIndex then begin - result := ACounter; + result := i; Break; //==> end; end; @@ -133,13 +135,13 @@ destructor TfpgImageList.Destroy; var i: integer; begin - for i := 0 to FList.Count - 1 do + for i := FList.Count-1 downto 0 do TfpgImageItem(FList[i]).Destroy; // frees images FList.Destroy; inherited Destroy end; -procedure TfpgImageList.AddItemFromFile(AFileName: String; AIndex: integer); +procedure TfpgImageList.AddItemFromFile(AFileName: TfpgString; AIndex: integer); var AImageItem: TfpgImageItem; begin @@ -147,8 +149,8 @@ begin writeln('TfpgImageList.AddItemFromFile'); {$ENDIF} - if not FileExists(AFileName) then - Exit; + if not fpgFileExists(AFileName) then + Exit; //==> AImageItem := TfpgImageItem.Create; AImageItem.LoadFromFile(AFileName); @@ -191,12 +193,12 @@ end; function TfpgImageList.GetMaxItem: integer; var - ACounter: integer; + i: integer; begin result := -1; - for ACounter := 0 to FList.Count - 1 do - if TfpgImageItem(FList[ACounter]).Index > result then - result := TfpgImageItem(FList[ACounter]).Index; + for i := 0 to FList.Count - 1 do + if TfpgImageItem(FList[i]).Index > result then + result := TfpgImageItem(FList[i]).Index; end; { TfpgImageItem } @@ -234,17 +236,13 @@ begin {$IFDEF DEBUG} writeln('TfpgImageItem.SetImage'); {$ENDIF} - if AImage <> FImage then - begin - FImage := AImage; - FImage.CreateMaskFromSample(0,0); - end; + FImage := AImage; end; constructor TfpgImageItem.Create; begin ImageList := nil; - FIndex := 0; + FIndex := -1; FImage := nil; end; @@ -259,7 +257,7 @@ begin ImageList := AImageList; end; -constructor TfpgImageItem.Create(AFileName: string; AIndex: integer); +constructor TfpgImageItem.Create(AFileName: TfpgString; AIndex: integer); begin {$IFDEF DEBUG} writeln('TfpgImageItem.Create(', AFileName, ',', AIndex, ')'); @@ -275,7 +273,7 @@ begin inherited Destroy; end; -procedure TfpgImageItem.LoadFromFile(AFileName: String); +procedure TfpgImageItem.LoadFromFile(AFileName: TfpgString); begin {$IFDEF DEBUG} writeln('TfpgImageItem.LoadFromFile'); diff --git a/src/corelib/gfx_imgfmt_bmp.pas b/src/corelib/gfx_imgfmt_bmp.pas index 54d4bfd3..46e5f0a8 100644 --- a/src/corelib/gfx_imgfmt_bmp.pas +++ b/src/corelib/gfx_imgfmt_bmp.pas @@ -15,7 +15,7 @@ uses gfxbase{, fpcanvas}; procedure ReadImage_BMP(img: TfpgImage; bmp: Pointer; bmpsize: longword); -function LoadImage_BMP(const AFileName: string): TfpgImage; +function LoadImage_BMP(const AFileName: String): TfpgImage; function CreateImage_BMP(bmp: Pointer; bmpsize: longword): TfpgImage; implementation @@ -26,11 +26,11 @@ begin ReadImage_BMP(Result, bmp, bmpsize); end; -function LoadImage_BMP(const AFileName: string): TfpgImage; +function LoadImage_BMP(const AFileName: String): TfpgImage; var AFile: file of char; AImageData: Pointer; - AImageDataSize: longint; + AImageDataSize: integer; begin Result := nil; if not FileExists(AFileName) then @@ -40,6 +40,7 @@ begin FileMode := fmOpenRead; // read-only Reset(AFile); AImageDataSize := FileSize(AFile); + AImageData := nil; GetMem(AImageData, AImageDataSize); try BlockRead(AFile, AImageData^, AImageDataSize); @@ -92,10 +93,6 @@ type // Every line padded to 32 bits // The lines stored bottom-up -type - PByte = ^byte; - Pword = ^word; - Plongword = ^longword; procedure ReadImage_BMP(img: TfpgImage; bmp: Pointer; bmpsize: longword); var @@ -109,8 +106,8 @@ var b: byte; bit: byte; bcnt: byte; - linecnt: longword; - pixelcnt: longword; + linecnt: integer; + pixelcnt: integer; pdest: Plongword; depth: integer; @@ -168,7 +165,7 @@ begin pcol := ppal; pixelcnt := 0; - while integer(p) < integer(pdata) do + while (p) < (pdata) do begin pcol^ := Plongword(p)^; //Writeln('color: ',HexStr(pcol^,8)); diff --git a/src/corelib/x11/gfx_x11.pas b/src/corelib/x11/gfx_x11.pas index 1b5209c0..d485762c 100644 --- a/src/corelib/x11/gfx_x11.pas +++ b/src/corelib/x11/gfx_x11.pas @@ -650,6 +650,7 @@ function TfpgApplicationImpl.StartComposing(const Event: TXEvent): TKeySym; var l: integer; begin + // Xutf8LookupString returns the size of FComposeBuffer in bytes. l := Xutf8LookupString(InputContext, @Event.xkey, @FComposeBuffer[1], SizeOf(FComposeBuffer) - 1, @Result, @FComposeStatus); SetLength(FComposeBuffer, l); diff --git a/src/gui/gui_tree.pas b/src/gui/gui_tree.pas index db6e9e33..e308d77f 100644 --- a/src/gui/gui_tree.pas +++ b/src/gui/gui_tree.pas @@ -41,7 +41,8 @@ uses gfxbase, fpgfx, gfx_imagelist, - gui_scrollbar; + gui_scrollbar, + gui_menu; type @@ -169,9 +170,11 @@ type function GetNodeHeightSum: integer; function MaxNodeWidth: integer; function GetNodeHeight: integer; - function GetNodeWidth(ANode: TfpgTreeNode): integer; // width of a node inclusive image + // width of a node inclusive image + function GetNodeWidth(ANode: TfpgTreeNode): integer; function NodeIsVisible(ANode: TfpgTreeNode): boolean; - function GetAbsoluteNodeTop(ANode: TfpgTreeNode): integer; // returns the node-top in pixels + // returns the node-top in pixels + function GetAbsoluteNodeTop(ANode: TfpgTreeNode): integer; function GetColumnLeft(AIndex: integer): integer; procedure PreCalcColumnLeft; procedure VScrollbarScroll(Sender: TObject; position: integer); @@ -182,9 +185,11 @@ type procedure FreeAllTreeNodes; protected FColumnLeft: TList; + FPopupMenu: TfpgPopupMenu; procedure HandleResize(awidth, aheight: TfpgCoord); override; procedure HandleLMouseUp(x, y: integer; shiftstate: TShiftState); override; procedure HandleLMouseDown(x, y: integer; shiftstate: TShiftState); override; + procedure HandleRMouseDown(x, y: integer; shiftstate: TShiftState); override; procedure HandleDoubleClick(x, y: integer; button: word; shiftstate: TShiftState); override; procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override; procedure HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); override; @@ -195,17 +200,21 @@ type procedure DoExpand(ANode: TfpgTreeNode); virtual; function NextVisualNode(ANode: TfpgTreeNode): TfpgTreeNode; function PrevVisualNode(ANode: TfpgTreeNode): TfpgTreeNode; - function SpaceToVisibleNext(aNode: TfpgTreeNode): integer; // the nodes between the given node and the direct next node + // the nodes between the given node and the direct next node + function SpaceToVisibleNext(aNode: TfpgTreeNode): integer; function StepToRoot(aNode: TfpgTreeNode): integer; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure SetColumnWidth(AIndex, AWidth: word); - function GetColumnWidth(AIndex: word): word; // the width of a column - aIndex of the rootnode = 0 + // the width of a column - aIndex of the rootnode = 0 + function GetColumnWidth(AIndex: word): word; property Font: TfpgFont read FFont; + // Invisible node that starts the tree property RootNode: TfpgTreeNode read GetRootNode; property Selection: TfpgTreeNode read FSelection write SetSelection; property ImageList: TfpgImageList read FImageList write FImageList; + property PopupMenu: TfpgPopupMenu read FPopupMenu write FPopupMenu; published property DefaultColumnWidth: word read FDefaultColumnWidth write SetDefaultColumnWidth default 15; property FontDesc: string read GetFontDesc write SetFontDesc; @@ -393,6 +402,7 @@ begin h := FirstSubNode; while h <> nil do begin +// writeln('h.Text = ', h.Text); if h.Text = AText then begin result := h; @@ -529,8 +539,8 @@ begin i := 0; while h <> nil do begin - h := h.next; inc(i); + h := h.next; end; result := i; end; @@ -544,9 +554,9 @@ begin i := 0; while h <> nil do begin + inc(i); // current node i := i + h.CountRecursive; // increases i by the count of the subnodes of the subnode h := h.next; - inc(i); // and the subnode... end; result := i; end; @@ -1201,6 +1211,13 @@ begin RePaint; end; +procedure TfpgTreeView.HandleRMouseDown(x, y: integer; shiftstate: TShiftState); +begin + inherited HandleRMouseDown(x, y, shiftstate); + if Assigned(PopupMenu) then + PopupMenu.ShowAt(self, x, y); +end; + procedure TfpgTreeview.HandleDoubleClick(x, y: integer; button: word; shiftstate: TShiftState); begin @@ -1762,11 +1779,10 @@ end; destructor TfpgTreeView.Destroy; begin - ClearColumnLeft; + if Assigned(FColumnLeft) then + ClearColumnLeft; FFont.Free; - FreeAllTreeNodes; - inherited Destroy; end; diff --git a/unittests/fpcunitproject.lpi b/unittests/fpcunitproject.lpi new file mode 100644 index 00000000..af7c6d5d --- /dev/null +++ b/unittests/fpcunitproject.lpi @@ -0,0 +1,60 @@ +<?xml version="1.0"?> +<CONFIG> + <ProjectOptions> + <PathDelim Value="/"/> + <Version Value="6"/> + <General> + <Flags> + <SaveOnlyProjectUnits Value="True"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <TargetFileExt Value=""/> + </General> + <VersionInfo> + <ProjectVersion Value=""/> + </VersionInfo> + <PublishOptions> + <Version Value="2"/> + <IgnoreBinaries Value="False"/> + <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> + <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + </local> + </RunParams> + <RequiredPackages Count="2"> + <Item1> + <PackageName Value="guitestrunner_fpgui"/> + </Item1> + <Item2> + <PackageName Value="FCL"/> + </Item2> + </RequiredPackages> + <Units Count="2"> + <Unit0> + <Filename Value="fpcunitproject.lpr"/> + <IsPartOfProject Value="True"/> + <UnitName Value="fpcunitproject"/> + </Unit0> + <Unit1> + <Filename Value="treeview_test.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="treeview_test"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="5"/> + <CodeGeneration> + <Generate Value="Faster"/> + </CodeGeneration> + <Other> + <CustomOptions Value="-FUunits"/> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> +</CONFIG> diff --git a/unittests/fpcunitproject.lpr b/unittests/fpcunitproject.lpr new file mode 100644 index 00000000..d40ea108 --- /dev/null +++ b/unittests/fpcunitproject.lpr @@ -0,0 +1,30 @@ +program fpcunitproject; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Classes, + fpgfx, fpg_guitestrunner, treeview_test; + +procedure MainProc; + +var + frm: TGUITestRunnerForm; + +begin + fpgApplication.Initialize; + frm := TGUITestRunnerForm.Create(nil); + try + frm.Show; + fpgApplication.Run; + finally + frm.Free; + end; +end; + +begin + MainProc; +end. diff --git a/unittests/treeview_test.pas b/unittests/treeview_test.pas new file mode 100644 index 00000000..78028b5e --- /dev/null +++ b/unittests/treeview_test.pas @@ -0,0 +1,68 @@ +unit treeview_test; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, fpcunit, testregistry, gui_tree; + +type + + TTestTreeview= class(TTestCase) + private + FTree: TfpgTreeview; + protected + procedure SetUp; override; + procedure TearDown; override; + published + procedure TestCount; + procedure TestNext; + procedure TestPrev; + end; + +implementation + +procedure TTestTreeview.SetUp; +begin + FTree := TfpgTreeview.Create(nil); +end; + +procedure TTestTreeview.TearDown; +begin + FTree.Free; +end; + +procedure TTestTreeview.TestCount; +var + n: TfpgTreeNode; +begin + AssertEquals('Failed on 1', 0, FTree.RootNode.Count); + FTree.RootNode.AppendText('n1'); + AssertEquals('Failed on 2', 1, FTree.RootNode.Count); + n := FTree.RootNode.AppendText('n2'); + AssertEquals('Failed on 3', 2, FTree.RootNode.Count); + FTree.RootNode.Remove(n); + AssertEquals('Failed on 4', 1, FTree.RootNode.Count); +end; + +procedure TTestTreeview.TestNext; +var + n: TfpgTreeNode; +begin + AssertTrue('Failed on 1', FTree.RootNode.Next = nil); + n := FTree.RootNode.AppendText('n1'); + AssertTrue('Failed on 2', FTree.RootNode.Next = n); + AssertTrue('Failed on 3', n.Next = nil); +end; + +procedure TTestTreeview.TestPrev; +begin + raise Exception.Create('Implement this'); +end; + +initialization + + RegisterTest(TTestTreeview); +end. + |