summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--examples/apps/fpcunit/fpg_guitestrunner.pas149
-rw-r--r--examples/apps/fpcunit/images/treeimages.inc105
-rw-r--r--src/corelib/fpgfx.pas2
-rw-r--r--src/corelib/gfx_imagelist.pas46
-rw-r--r--src/corelib/gfx_imgfmt_bmp.pas17
-rw-r--r--src/corelib/x11/gfx_x11.pas1
-rw-r--r--src/gui/gui_tree.pas36
-rw-r--r--unittests/fpcunitproject.lpi60
-rw-r--r--unittests/fpcunitproject.lpr30
-rw-r--r--unittests/treeview_test.pas68
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.
+
generated by cgit v1.2.3-70-g09d2 (git 2.47.1) at 2024-12-27 15:03:49 +0000