mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-17 23:02:36 +02:00
321 lines
11 KiB
ObjectPascal
321 lines
11 KiB
ObjectPascal
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, Laz.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: TLazVirtualStringTree;
|
|
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
|
|
|
|
{$R *.lfm}
|
|
|
|
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;
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
|
|
|
|
end.
|