unit Main_F;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, VirtualTrees;
type
TMainForm =
class;
TTreeData =
record
Id : integer;
Name :
string;
Quantity : integer;
end;
PTreeData = ^TTreeData;
TMainForm =
class(TForm)
VST: TVirtualStringTree;
procedure VSTFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure VSTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType;
var CellText: WideString);
procedure VSTEditing(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex;
var Allowed: Boolean);
procedure VSTNewText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; NewText: WideString);
procedure VSTCreateEditor(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex;
out EditLink: IVTEditLink);
procedure FormShow(Sender: TObject);
protected
function AddNodeToTree(Tree: TCustomVirtualStringTree; Parent: PVirtualNode; Node: TTreeData): PVirtualNode;
procedure LoadData;
public
end;
// Our own edit link to implement several different node editors.
TPropertyEditLink =
class(TInterfacedObject, IVTEditLink)
private
FColumn : integer;
// The column of the node being edited.
FEdit : TWinControl;
// One of the property editor classes.
FNode : PVirtualNode;
// The node being edited.
FOldEditProc : TWndMethod;
// Used to capture some important messages
// regardless of the type of edit control we use.
FTree : TVirtualStringTree;
// A back reference to the tree calling.
protected
procedure EditKeyDown(Sender: TObject;
var Key: Word; Shift: TShiftState);
procedure EditWindowProc(
var Message: TMessage);
public
destructor Destroy;
override;
procedure ProcessMessage(
var Message: TMessage);
stdcall;
procedure SetBounds(R: TRect);
stdcall;
function BeginEdit: boolean;
stdcall;
function CancelEdit: boolean;
stdcall;
function EndEdit: boolean;
stdcall;
function GetBounds: TRect;
stdcall;
function PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): boolean;
stdcall;
end;
var
MainForm: TMainForm;
implementation
uses
StdCtrls;
{$R *.dfm}
{ TMainForm }
function TMainForm.AddNodeToTree(Tree: TCustomVirtualStringTree;
Parent: PVirtualNode; Node: TTreeData): PVirtualNode;
var
pData : PTreeData;
begin
Result := Tree.AddChild(Parent);
pData := Tree.GetNodeData(Result);
Tree.ValidateNode(Result, false);
pData^.Id := Node.Id;
pData^.
Name := Node.
Name;
pData^.Quantity := Node.Quantity;
end;
procedure TMainForm.FormShow(Sender: TObject);
begin
//VST.Header.Columns[0].Options := VST.Header.Columns[0].Options + [coVisible];
//VST.Header.Columns[1].Options := VST.Header.Columns[1].Options + [coVisible];
LoadData;
end;
procedure TMainForm.LoadData;
var
pNode : PVirtualNode;
rData : TTreeData;
begin
VST.NodeDataSize := SizeOf(TTreeData);
VST.BeginUpdate;
rData.Id := 1;
rData.
Name := '
Test 1';
rData.Quantity := 1;
pNode := AddNodeToTree(VST,
nil, rData);
rData.Id := 2;
rData.
Name := '
Test 2';
rData.Quantity := 7;
AddNodeToTree(VST, pNode, rData);
VST.EndUpdate;
end;
procedure TMainForm.VSTFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
var
pData: PTreeData;
begin
inherited;
pData := Sender.GetNodeData(Node);
if Assigned(pData)
then
pData^.
Name := '
';
end;
procedure TMainForm.VSTGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: WideString);
var
iUnitIdx : integer;
pData : PTreeData;
begin
pData := Sender.GetNodeData(Node);
if Assigned(pData)
then
case Column
of
0: CellText := IntToStr(pData^.Id) + '
- ' + pData^.
Name;
1: CellText := FormatFloat('
0.##', pData^.Quantity);
end;
inherited;
end;
procedure TMainForm.VSTEditing(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex;
var Allowed: Boolean);
begin
Allowed := true;
end;
procedure TMainForm.VSTNewText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; NewText: WideString);
var
iUnitIdx : integer;
pData : PTreeData;
begin
inherited;
pData := Sender.GetNodeData(Node);
if not Assigned(pData)
then
Exit;
case Column
of
0 : pData^.
Name := NewText;
1 :
if StrToIntDef(NewText, -1) < 0
then
MessageDlg('
Bitte geben Sie eine gültige Menge ein.', mtInformation, [mbOK], 0)
else
pData^.Quantity := StrToInt(NewText);
end;
end;
procedure TMainForm.VSTCreateEditor(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex;
out EditLink: IVTEditLink);
begin
EditLink := TPropertyEditLink.Create;
end;
{ TPropertyEditLink }
function TPropertyEditLink.BeginEdit: boolean;
begin
Result := true;
FEdit.Show;
FEdit.SetFocus;
// Set a window procedure hook (aka subclassing) to get notified about important messages.
FOldEditProc := FEdit.WindowProc;
FEdit.WindowProc := EditWindowProc;
end;
function TPropertyEditLink.CancelEdit: boolean;
begin
Result := true;
// Restore the edit's window proc.
FEdit.WindowProc := FOldEditProc;
FEdit.Hide;
end;
destructor TPropertyEditLink.Destroy;
begin
FreeAndNil(FEdit);
inherited;
end;
procedure TPropertyEditLink.EditKeyDown(Sender: TObject;
var Key: Word;
Shift: TShiftState);
var
bCanAdvance: Boolean;
begin
case Key
of
VK_RETURN,
VK_UP,
VK_DOWN:
begin
// Consider special cases before finishing edit mode.
bCanAdvance := Shift = [];
if FEdit
is TComboBox
then
bCanAdvance := bCanAdvance
and not TComboBox(FEdit).DroppedDown;
if bCanAdvance
then
begin
FTree.EndEditNode;
if Key = VK_UP
then
FTree.FocusedNode := FTree.GetPreviousVisible(FTree.FocusedNode)
else
FTree.FocusedNode := FTree.GetNextVisible(FTree.FocusedNode);
FTree.Selected[FTree.FocusedNode] := true;
Key := 0;
end;
end;
end;
end;
procedure TPropertyEditLink.EditWindowProc(
var Message: TMessage);
begin
case Message.Msg
of
WM_KILLFOCUS: FTree.EndEditNode;
else
FOldEditProc(
Message);
end;
end;
function TPropertyEditLink.EndEdit: boolean;
var
aBuffer :
array[0..1024]
of Char;
iDummy : integer;
pData : PTreeData;
rPoint : TPoint;
sString : WideString;
begin
// Check if the place the user click on yields another node as the one we
// are currently editing. If not then do not stop editing.
GetCursorPos(rPoint);
rPoint := FTree.ScreenToClient(rPoint);
Result := FTree.GetNodeAt(rPoint.X, rPoint.Y, True, iDummy) <> FNode;
if Result
then
begin
// restore the edit's window proc
FEdit.WindowProc := FOldEditProc;
pData := FTree.GetNodeData(FNode);
if FEdit
is TComboBox
then
sString := TComboBox(FEdit).Text
else
begin
GetWindowText(FEdit.Handle, aBuffer, 1024);
sString := aBuffer;
end;
if Assigned(pData)
then
case FColumn
of
0 :
begin
pData^.
Name := sString;
FTree.InvalidateNode(FNode);
end;
1 :
if StrToIntDef(sString, -1) >= 0
then
begin
pData^.Quantity := StrToInt(sString);
FTree.InvalidateNode(FNode);
end else
MessageDlg('
Geben Sie eine gültige Mengenangabe ein.', mtWarning, [mbOK], 0);
end;
FEdit.Hide;
end;
end;
function TPropertyEditLink.GetBounds: TRect;
begin
Result := FEdit.BoundsRect;
end;
function TPropertyEditLink.PrepareEdit(Tree: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex): boolean;
var
i : integer;
pData : PTreeData;
oComboBox : TComboBox;
oEdit : TEdit;
sItem :
string;
begin
Result := true;
FTree := Tree
as TVirtualStringTree;
FNode := Node;
FColumn := Column;
// determine what edit type actually is needed
FreeAndNil(FEdit);
pData := FTree.GetNodeData(Node);
case Column
of
0 :
begin
oEdit := TEdit.Create(Tree);
oEdit.Visible := false;
oEdit.Parent := Tree;
oEdit.OnKeyDown := EditKeyDown;
if Assigned(pData)
then
oEdit.Text := pData^.
Name
else
oEdit.Text := '
';
FEdit := oEdit;
oEdit :=
nil;
end;
1 :
if Assigned(pData)
then
begin
oComboBox := TComboBox.Create(Tree);
oComboBox.Visible := false;
oComboBox.Parent := Tree;
oComboBox.Style := csDropDownList;
oComboBox.Items.Clear;
for i := 1
to 5
do
begin
oComboBox.Items.Add(IntToStr(i));
if pData^.Quantity = i
then
oComboBox.ItemIndex := Pred(oComboBox.Items.Count);
end;
oComboBox.OnKeyDown := EditKeyDown;
FEdit := oComboBox;
oComboBox :=
nil;
//Referenz wurde in FEdit gespeichert!
end else
Result := false;
else
Result := false;
end;
end;
procedure TPropertyEditLink.ProcessMessage(
var Message: TMessage);
begin
if FEdit <>
nil then
FEdit.WindowProc(
Message);
end;
procedure TPropertyEditLink.SetBounds(R: TRect);
var
iDummy: integer;
begin
// Since we don't want to activate grid extensions in the tree (this would influence how the selection is drawn)
// we have to set the edit's width explicitly to the width of the column.
FTree.Header.Columns.GetColumnBounds(FColumn, iDummy, R.Right);
FEdit.BoundsRect := R;
end;
end.