unit PropertiesDemo; {$MODE Delphi} // Virtual Treeview sample form demonstrating following features: // - Property page like string tree with individual node editors. // - Incremental search. // Written by Mike Lischke. interface uses LCLIntf, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, VirtualTrees, ExtCtrls, LResources, LMessages; const // Helper message to decouple node change handling from edit handling. WM_STARTEDITING = LM_USER + 778; type TPropertiesForm = class(TForm) VST3: TVirtualStringTree; Label9: TLabel; Label10: TLabel; TreeImages: TImageList; RadioGroup1: TRadioGroup; procedure FormCreate(Sender: TObject); procedure VST3Change(Sender: TBaseVirtualTree; Node: PVirtualNode); procedure VST3CreateEditor(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink); procedure VST3Editing(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean); procedure VST3GetHint(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: String); procedure VST3GetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var Index: Integer); procedure VST3GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: String); procedure VST3InitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal); procedure VST3InitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); procedure VST3PaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType); procedure VST3IncrementalSearch(Sender: TBaseVirtualTree; Node: PVirtualNode; const Text: String; var Result: Integer); procedure RadioGroup1Click(Sender: TObject); procedure VST3StateChange(Sender: TBaseVirtualTree; Enter, Leave: TVirtualTreeStates); private procedure WMStartEditing(var Message: TLMessage); message WM_STARTEDITING; end; var PropertiesForm: TPropertiesForm; //---------------------------------------------------------------------------------------------------------------------- implementation uses Editors, Math, Main, States; //----------------- TPropertiesForm ------------------------------------------------------------------------------------ procedure TPropertiesForm.FormCreate(Sender: TObject); begin // Always tell the tree how much data space per node it must allocated for us. We can do this here, in the // object inspector or in the OnGetNodeDataSize event. VST3.NodeDataSize := SizeOf(TPropertyData); end; //---------------------------------------------------------------------------------------------------------------------- procedure TPropertiesForm.VST3InitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal); begin case Node.Index of 0: ChildCount := 13; 1: ChildCount := 8; end; end; //---------------------------------------------------------------------------------------------------------------------- procedure TPropertiesForm.VST3InitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); var Data: PPropertyData; begin if ParentNode = nil then InitialStates := InitialStates + [ivsHasChildren, ivsExpanded] else begin Data := Sender.GetNodeData(Node); Data.ValueType := ValueTypes[ParentNode.Index, Node.Index]; if Data.ValueType = vtDate then Data.Value := DateToStr(Now) else Data.Value := DefaultValue[ParentNode.Index, Node.Index]; end; end; //---------------------------------------------------------------------------------------------------------------------- procedure TPropertiesForm.VST3GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: String); var Data: PPropertyData; begin if TextType = ttNormal then case Column of 0: if Node.Parent = Sender.RootNode then begin // root nodes if Node.Index = 0 then CellText := 'Description' else CellText := 'Origin'; end else CellText := PropertyTexts[Node.Parent.Index, Node.Index, ptkText]; 1: begin Data := Sender.GetNodeData(Node); CellText := Data.Value; end; end; end; //---------------------------------------------------------------------------------------------------------------------- procedure TPropertiesForm.VST3GetHint(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: String); begin // Add a dummy hint to the normal hint to demonstrate multiline hints. if (Column = 0) and (Node.Parent <> Sender.RootNode) then HintText := PropertyTexts[Node.Parent.Index, Node.Index, ptkHint] + LineEnding + '(Multiline hints are supported too).'; end; //---------------------------------------------------------------------------------------------------------------------- procedure TPropertiesForm.VST3GetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var Index: Integer); var Data: PPropertyData; begin if (Kind in [ikNormal, ikSelected]) and (Column = 0) then begin if Node.Parent = Sender.RootNode then Index := 12 // root nodes, this is an open folder else begin Data := Sender.GetNodeData(Node); if Data.ValueType <> vtNone then Index := 14 else Index := 13; end; end; end; //---------------------------------------------------------------------------------------------------------------------- procedure TPropertiesForm.VST3Editing(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean); var Data: PPropertyData; begin with Sender do begin Data := GetNodeData(Node); Allowed := (Node.Parent <> RootNode) and (Column = 1) and (Data.ValueType <> vtNone); end; end; //---------------------------------------------------------------------------------------------------------------------- procedure TPropertiesForm.VST3Change(Sender: TBaseVirtualTree; Node: PVirtualNode); begin with Sender do begin // Start immediate editing as soon as another node gets focused. if Assigned(Node) and (Node.Parent <> RootNode) and not (tsIncrementalSearching in TreeStates) then begin // We want to start editing the currently selected node. However it might well happen that this change event // here is caused by the node editor if another node is currently being edited. It causes trouble // to start a new edit operation if the last one is still in progress. So we post us a special message and // in the message handler we then can start editing the new node. This works because the posted message // is first executed *after* this event and the message, which triggered it is finished. PostMessage(Self.Handle, WM_STARTEDITING, PtrInt(Node), 0); end; end; end; //---------------------------------------------------------------------------------------------------------------------- procedure TPropertiesForm.VST3CreateEditor(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink); // This is the callback of the tree control to ask for an application defined edit link. Providing one here allows // us to control the editing process up to which actual control will be created. // TPropertyEditLink implements an interface and hence benefits from reference counting. We don't need to keep a // reference to free it. As soon as the tree finished editing the class will be destroyed automatically. begin EditLink := TPropertyEditLink.Create; end; //---------------------------------------------------------------------------------------------------------------------- procedure TPropertiesForm.VST3PaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType); var Data: PPropertyData; begin // Make the root nodes underlined and draw changed nodes in bold style. if Node.Parent = Sender.RootNode then TargetCanvas.Font.Style := [fsUnderline] else begin Data := Sender.GetNodeData(Node); if Data.Changed then TargetCanvas.Font.Style := [fsBold] else TargetCanvas.Font.Style := []; end; end; //---------------------------------------------------------------------------------------------------------------------- procedure TPropertiesForm.VST3IncrementalSearch(Sender: TBaseVirtualTree; Node: PVirtualNode; const Text: String; var Result: Integer); var S, PropText: string; begin S := Text; SetStatusbarText('Searching for: ' + S); if Node.Parent = Sender.RootNode then begin // root nodes if Node.Index = 0 then PropText := 'Description' else PropText := 'Origin'; end else begin PropText := PropertyTexts[Node.Parent.Index, Node.Index, ptkText]; end; // By using StrLIComp we can specify a maximum length to compare. This allows us to find also nodes // which match only partially. Don't forget to specify the shorter string length as search length. Result := StrLIComp(PChar(S), PChar(PropText), Min(Length(S), Length(PropText))) end; //---------------------------------------------------------------------------------------------------------------------- procedure TPropertiesForm.RadioGroup1Click(Sender: TObject); begin with Sender as TRadioGroup do if ItemIndex = 0 then VST3.IncrementalSearchDirection := sdForward else VST3.IncrementalSearchDirection := sdBackward; end; //---------------------------------------------------------------------------------------------------------------------- procedure TPropertiesForm.VST3StateChange(Sender: TBaseVirtualTree; Enter, Leave: TVirtualTreeStates); begin if tsIncrementalSearching in Enter then SetStatusbarText('Searching for: ' + Sender.SearchBuffer); if tsIncrementalSearching in Leave then SetStatusbarText(''); if not (csDestroying in ComponentState) then UpdateStateDisplay(Sender.TreeStates, Enter, Leave); end; //---------------------------------------------------------------------------------------------------------------------- procedure TPropertiesForm.WMStartEditing(var Message: TLMessage); // This message was posted by ourselves from the node change handler above to decouple that change event and our // intention to start editing a node. This is necessary to avoid interferences between nodes editors potentially created // for an old edit action and the new one we start here. var Node: PVirtualNode; begin Node := Pointer(Message.WParam); // Note: the test whether a node can really be edited is done in the OnEditing event. VST3.EditNode(Node, 1); end; //---------------------------------------------------------------------------------------------------------------------- initialization {$i PropertiesDemo.lrs} end.