propertiesdemo.pas

来自「本系统前端界面采用WINDOWS 窗口风格」· PAS 代码 · 共 298 行

unit PropertiesDemo;

// Virtual Treeview sample form demonstrating following features:
//   - Property page like string tree with individual node editors.
//   - Incremental search.
// Written by Mike Lischke.

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, VirtualTrees, ImgList, ExtCtrls;

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; TextType: TVSTTextType;
      var Text: WideString);
    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 Text: WideString);
    procedure VST3InitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal);
    procedure VST3InitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
      var InitialStates: TVirtualNodeInitStates);
    procedure VST3PaintText(Sender: TBaseVirtualTree; const Canvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
      TextType: TVSTTextType);
    procedure VST3IncrementalSearch(Sender: TBaseVirtualTree; Node: PVirtualNode; const Text: WideString;
      var Result: Integer);
    procedure RadioGroup1Click(Sender: TObject);
    procedure VST3StateChange(Sender: TBaseVirtualTree; Enter, Leave: TVirtualTreeStates);
  end;

var
  PropertiesForm: TPropertiesForm;

//----------------------------------------------------------------------------------------------------------------------

implementation

uses
  Editors, Math, Main, States;

{$R *.DFM}

//----------------- 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
  // property inspector or in the OnGetNodeDataSize event.
  VST3.NodeDataSize := SizeOf(TPropertyData);
  // The VCL (D7 and lower) still uses 16 color image lists. We create a high color version explicitely because it
  // looks so much nicer.
  ConvertToHighColor(TreeImages);
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 Text: WideString);

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
            Text := 'Description'
          else
            Text := 'Origin';
        end
        else
          Text := PropertyTexts[Node.Parent.Index, Node.Index, ptkText];
      1:
        begin
          Data := Sender.GetNodeData(Node);
          Text := Data.Value;
        end;
    end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TPropertiesForm.VST3GetHint(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
  TextType: TVSTTextType; var Text: WideString);

begin
  // Add a dummy hint to the normal hint to demonstrate multiline hints.
  if (Column = 0) and (Node.Parent <> Sender.RootNode) then
    Text := PropertyTexts[Node.Parent.Index, Node.Index, ptkHint] + #13 + '(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
      // Note: the test whether a node can really be edited is done in the OnEditing event.
      EditNode(Node, 1);
    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 Canvas: 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
    Canvas.Font.Style := [fsUnderline]
  else
  begin
    Data := Sender.GetNodeData(Node);
    if Data.Changed then
      Canvas.Font.Style := [fsBold]
    else
      Canvas.Font.Style := [];
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TPropertiesForm.VST3IncrementalSearch(Sender: TBaseVirtualTree; Node: PVirtualNode; const Text: WideString;
  var Result: Integer);

var
  S,
  PropText: string;

begin
  // Note: This code requires a proper Unicode/WideString comparation routine which I did not want to link here for
  // size and clarity reasons. For now strings are (implicitely) converted to ANSI to make the comparation work.
  // Search is not case sensitive.
  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
    // Note: Unicode will be converted to ANSI here, but for demonstration purposes we accept that for now.
    SetStatusbarText('Searching for: ' + Sender.SearchBuffer);
  if tsIncrementalSearching in Leave then
    SetStatusbarText('');

  if not (csDestroying in ComponentState) then
    UpdateStateDisplay(Sender.TreeStates, Enter, Leave);
end;

//----------------------------------------------------------------------------------------------------------------------

end.