program treeviewtest; {$mode objfpc}{$H+} uses {$IFDEF UNIX}{$IFDEF UseCThreads} cthreads, {$ENDIF}{$ENDIF} Classes, SysUtils, fpg_base, fpg_main, fpg_form, fpg_tree, fpg_checkbox, fpg_button, fpg_imagelist, fpg_label, fpg_dialogs, fpg_combobox, fpg_utils; type TMainForm = class(TfpgForm) private {@VFD_HEAD_BEGIN: MainForm} tree: TfpgTreeView; cbShowImages: TfpgCheckBox; cbIndentNode: TfpgCheckBox; btnClear: TfpgButton; Label1: TfpgLabel; Label2: TfpgLabel; Label3: TfpgLabel; Label4: TfpgLabel; Label5: TfpgLabel; lblSource: TfpgLabel; lblDestination: TfpgLabel; btnSource: TfpgButton; btnDest: TfpgButton; btnMoveTo: TfpgButton; cbMoveToTypes: TfpgComboBox; Label6: TfpgLabel; Label7: TfpgLabel; Label8: TfpgLabel; btnCollapseAll: TfpgButton; btnExpandAll: TfpgButton; {@VFD_HEAD_END: MainForm} FImagelist: TfpgImageList; FSrcNode: TfpgTreeNode; FDestnode: TfpgTreeNode; procedure cbShowImagesChange(Sender: TObject); procedure cbIndentNodeChange(Sender: TObject); procedure btnClearClicked(Sender: TObject); procedure TreeNodeChanged(Sender: TObject); procedure PopulateTree; procedure btnSourceClicked(Sender: TObject); procedure btnDestinationClicked(Sender: TObject); procedure btnMoveToClicked(Sender: TObject); procedure btnCollapseAllClicked(Sender: TObject); procedure btnExpandAllClicked(Sender: TObject); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure AfterCreate; override; end; { TMainForm } procedure TMainForm.cbIndentNodeChange(Sender: TObject); begin tree.IndentNodeWithNoImage := cbIndentNode.Checked; end; procedure TMainForm.btnClearClicked(Sender: TObject); var n: TfpgTreeNode; begin if tree.Selection <> nil then begin n := tree.Selection; tree.Selection.Clear; tree.Invalidate; tree.Selection := n; end; end; procedure TMainForm.TreeNodeChanged(Sender: TObject); const cParent = 'Parent = %s'; cPrev = 'Prev = %s'; cNext = 'Next = %s'; cFirstSubNode = 'FirstSubnode = %s'; cLastSubNode = 'LastSubnode = %s'; var n: TfpgTreeNode; procedure PrintNodeInfo(ALabel: TfpgLabel; AFormat: string; ANode: TfpgTreeNode); begin if ANode = nil then ALabel.Text := Format(AFormat, ['nil']) else ALabel.Text := Format(AFormat, [ANode.Text]); end; begin n := Tree.Selection; PrintNodeInfo(Label1, cParent, n.Parent); PrintNodeInfo(Label2, cPrev, n.Prev); PrintNodeInfo(Label3, cNext, n.Next); PrintNodeInfo(Label4, cFirstSubNode, n.FirstSubNode); PrintNodeInfo(Label5, cLastSubNode, n.LastSubNode); end; procedure TMainForm.PopulateTree; var n: TfpgTreeNode; i: integer; n2: TfpgTreeNode; s: TfpgString; begin n := tree.RootNode.AppendText('Node 1'); n.ImageIndex := 0; n.AppendText('Node 1.1').ImageIndex := 1; n.AppendText('Node 1.2').ImageIndex := 1; n := tree.RootNode.AppendText('Node 2'); n.ImageIndex := 0; n.AppendText('Node 2.1').ImageIndex := 1; n := n.AppendText('Node 2.2 The quick brownfox jumps over the...'); n.ImageIndex := 1; for i := 1 to 3 do begin s := Format('Node 2.2.%d', [i]); if i = 2 then n2 := n.AppendText(s) else n.AppendText(s); end; n.Parent.AppendText('Node 2.3'); tree.RootNode.FirstSubNode.Next.Collapse; tree.RootNode.AppendText('Node 3').ImageIndex := 0; tree.Selection := n; // n := tree.RootNode.FindSubNode('Node 2.2.2', True); if Assigned(n2) then begin n2.AppendText('Child 1').AppendText('Child 2'); n2.Collapsed := False; end; TreeNodeChanged(nil); end; procedure TMainForm.btnSourceClicked(Sender: TObject); begin FSrcNode := tree.Selection; if Assigned(FSrcNode) then lblSource.Text := FSrcNode.Text else lblSource.Text := '--'; end; procedure TMainForm.btnDestinationClicked(Sender: TObject); begin FDestNode := tree.Selection; if Assigned(FDestNode) then lblDestination.Text := FDestNode.Text else lblDestination.Text := '--'; end; procedure TMainForm.btnMoveToClicked(Sender: TObject); const cEmpty = '--'; var i: integer; begin if FSrcNode = FDestNode then begin TfpgMessageDialog.Warning('', 'Source and Destination may not be the same'); exit; end; if (FSrcNode = nil) or (FDestnode = nil) then begin TfpgMessageDialog.Warning('', 'Both Source and Destintation needs to be set first'); exit; end; i := cbMoveToTypes.FocusItem; FSrcNode.MoveTo(FDestnode, TfpgNodeAttachMode(i)); // This cast is a hack! Do not do this in real-world apps!! tree.FullExpand; tree.Invalidate; // reset values FSrcNode := nil; FDestnode := nil; lblSource.Text := cEmpty; lblDestination.Text := cEmpty; TreeNodeChanged(nil); end; procedure TMainForm.cbShowImagesChange(Sender: TObject); begin tree.ShowImages := cbShowImages.Checked; end; constructor TMainForm.Create(AOwner: TComponent); begin inherited Create(AOwner); // create a image list FImagelist := TfpgImageList.Create; if fpgFileExists('../../../images/folder_16.bmp') then FImagelist.AddItemFromFile(SetDirSeparators('../../../images/folder_16.bmp'), 0); if fpgFileExists('../../../images/menu_preferences_16.bmp') then begin FImagelist.AddItemFromFile(SetDirSeparators('../../../images/menu_preferences_16.bmp'), 1); FImagelist.Items[1].Image.CreateMaskFromSample(0, 0); FImagelist.Items[1].Image.UpdateImage; end; end; destructor TMainForm.Destroy; begin tree.ImageList := nil; FImagelist.Free; inherited Destroy; end; procedure TMainForm.AfterCreate; begin inherited AfterCreate; {@VFD_BODY_BEGIN: MainForm} Name := 'MainForm'; SetPosition(399, 184, 709, 333); WindowTitle := 'Treeview Test'; Hint := ''; WindowPosition := wpScreenCenter; tree := TfpgTreeView.Create(self); with tree do begin Name := 'tree'; SetPosition(8, 8, 284, 267); Anchors := [anLeft,anTop,anBottom]; FontDesc := '#Label1'; Hint := ''; ScrollWheelDelta := 30; ShowImages := True; TabOrder := 0; ImageList := FImagelist; OnChange := @TreeNodeChanged; end; cbShowImages := TfpgCheckBox.Create(self); with cbShowImages do begin Name := 'cbShowImages'; SetPosition(8, 283, 109, 20); Anchors := [anLeft,anBottom]; Checked := True; FontDesc := '#Label1'; Hint := ''; TabOrder := 1; Text := 'Show images'; OnChange := @cbShowImagesChange; end; cbIndentNode := TfpgCheckBox.Create(self); with cbIndentNode do begin Name := 'cbIndentNode'; SetPosition(120, 283, 179, 20); Anchors := [anLeft,anBottom]; Checked := True; FontDesc := '#Label1'; Hint := ''; TabOrder := 2; Text := 'Indent node with no image'; OnChange := @cbIndentNodeChange; end; btnClear := TfpgButton.Create(self); with btnClear do begin Name := 'btnClear'; SetPosition(8, 305, 144, 23); Anchors := [anLeft,anBottom]; Text := 'Clear Selected Node'; FontDesc := '#Label1'; Hint := ''; ImageName := ''; TabOrder := 3; OnClick := @btnClearClicked; end; Label1 := TfpgLabel.Create(self); with Label1 do begin Name := 'Label1'; SetPosition(316, 24, 292, 16); FontDesc := '#Label1'; Hint := ''; Text := 'Label'; end; Label2 := TfpgLabel.Create(self); with Label2 do begin Name := 'Label2'; SetPosition(316, 40, 288, 16); FontDesc := '#Label1'; Hint := ''; Text := 'Label'; end; Label3 := TfpgLabel.Create(self); with Label3 do begin Name := 'Label3'; SetPosition(316, 56, 272, 16); FontDesc := '#Label1'; Hint := ''; Text := 'Label'; end; Label4 := TfpgLabel.Create(self); with Label4 do begin Name := 'Label4'; SetPosition(316, 72, 300, 16); FontDesc := '#Label1'; Hint := ''; Text := 'Label'; end; Label5 := TfpgLabel.Create(self); with Label5 do begin Name := 'Label5'; SetPosition(316, 88, 320, 16); FontDesc := '#Label1'; Hint := ''; Text := 'Label'; end; lblSource := TfpgLabel.Create(self); with lblSource do begin Name := 'lblSource'; SetPosition(316, 172, 140, 16); FontDesc := '#Label1'; Hint := ''; Text := '--'; end; lblDestination := TfpgLabel.Create(self); with lblDestination do begin Name := 'lblDestination'; SetPosition(468, 172, 128, 16); FontDesc := '#Label1'; Hint := ''; Text := '--'; end; btnSource := TfpgButton.Create(self); with btnSource do begin Name := 'btnSource'; SetPosition(316, 144, 80, 24); Text := 'Source'; FontDesc := '#Label1'; Hint := ''; ImageName := ''; TabOrder := 11; OnClick := @btnSourceClicked; end; btnDest := TfpgButton.Create(self); with btnDest do begin Name := 'btnDest'; SetPosition(468, 144, 80, 24); Text := 'Destination'; FontDesc := '#Label1'; Hint := ''; ImageName := ''; TabOrder := 12; OnClick := @btnDestinationClicked; end; btnMoveTo := TfpgButton.Create(self); with btnMoveTo do begin Name := 'btnMoveTo'; SetPosition(612, 144, 80, 24); Text := 'MoveTo'; FontDesc := '#Label1'; Hint := ''; ImageName := ''; TabOrder := 13; OnClick := @btnMoveToClicked; end; cbMoveToTypes := TfpgComboBox.Create(self); with cbMoveToTypes do begin Name := 'cbMoveToTypes'; SetPosition(612, 172, 96, 22); FontDesc := '#List'; Hint := ''; Items.Add('naAdd'); Items.Add('naAddFirst'); Items.Add('naAddChild'); Items.Add('naAddChildFirst'); Items.Add('naInsert'); TabOrder := 14; FocusItem := 0; end; Label6 := TfpgLabel.Create(self); with Label6 do begin Name := 'Label6'; SetPosition(300, 4, 348, 16); FontDesc := '#Label2'; Hint := ''; Text := 'Selected Node Information'; end; Label7 := TfpgLabel.Create(self); with Label7 do begin Name := 'Label7'; SetPosition(300, 120, 348, 16); FontDesc := '#Label2'; Hint := ''; Text := 'Reorder Nodes (testing MovoTo() function)'; end; Label8 := TfpgLabel.Create(self); with Label8 do begin Name := 'Label8'; SetPosition(300, 200, 308, 16); FontDesc := '#Label2'; Hint := ''; Text := 'Test various Tree functions'; end; btnCollapseAll := TfpgButton.Create(self); with btnCollapseAll do begin Name := 'btnCollapseAll'; SetPosition(316, 224, 92, 24); Text := 'Collapse All'; FontDesc := '#Label1'; Hint := ''; ImageName := ''; TabOrder := 19; OnClick := @btnCollapseAllClicked; end; btnExpandAll := TfpgButton.Create(self); with btnExpandAll do begin Name := 'btnExpandAll'; SetPosition(416, 224, 92, 24); Text := 'Expand All'; FontDesc := '#Label1'; Hint := ''; ImageName := ''; TabOrder := 20; OnClick := @btnExpandAllClicked; end; {@VFD_BODY_END: MainForm} PopulateTree; end; procedure TMainForm.btnCollapseAllClicked(Sender: TObject); begin tree.FullCollapse; end; procedure TMainForm.btnExpandAllClicked(Sender: TObject); begin tree.FullExpand; end; procedure MainProc; var frm: TMainForm; begin fpgApplication.Initialize; frm := TMainForm.Create(nil); try frm.Show; fpgApplication.Run; finally frm.Free; end; end; begin MainProc; end.