unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Buttons,
VirtualTrees;
type
{ TStudyRec }
TStudyRecType = (srUser, srStudy);
TStudyRec = record
case RecType: TStudyRecType of
srUser: (
UserID: integer;
UserPaCoCode: string[10];
UserStudyCode: string[20];
UserName: string[255];
);
srStudy: (
StudyID: integer;
StudyCode: string[20];
StudyName: string[255];
);
end;
PStudyRec = ^TStudyRec;
type
{ TForm1 }
TForm1 = class(TForm)
Panel1: TPanel;
SpeedButtonAddStudy: TSpeedButton;
SpeedButtonAddUser: TSpeedButton;
SpeedButtonDelNode: TSpeedButton;
SpeedButtonDelTree: TSpeedButton;
StudyStringTree: TVirtualStringTree;
procedure SpeedButtonAddStudyClick(Sender: TObject);
procedure SpeedButtonAddUserClick(Sender: TObject);
procedure SpeedButtonDelNodeClick(Sender: TObject);
procedure SpeedButtonDelTreeClick(Sender: TObject);
procedure StudyStringTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType; var CellText: string);
procedure StudyStringTreeInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
var InitialStates: TVirtualNodeInitStates);
private
FNextStudyID: Integer;
FNextUserID: Integer;
function GetNextStudyID: Integer;
function GetNextUserID: Integer;
public
property NextStudyID:Integer read GetNextStudyID default 1;
property NextUserID: Integer read GetNextUserID default 1;
procedure FormCreate(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
function SelectText(Condition: boolean; TrueValue, FalseValue: string): string; Overload;
begin
if Condition then
Result := TrueValue
else
Result := FalseValue;
end;
function SelectText(Condition: boolean; TrueValue, FalseValue: integer): string; Overload;
begin
if Condition then
Result := IntToStr(TrueValue)
else
Result := IntToStr(FalseValue);
end;
function RandomString(StringLength:Integer):ShortString;
var
i:integer;
begin
Result := '';
for i := 1 to StringLength do
Result := Result + chr(ord(' ')+random(ord('z')-ord(' ')+1));
end;
{ TForm1 }
function TForm1.GetNextStudyID: Integer;
begin
Result := FNextStudyID;
Inc(FNextStudyID);
end;
function TForm1.GetNextUserID: Integer;
begin
Result := FNextUserID;
Inc(FNextUserID);
end;
procedure TForm1.StudyStringTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType; var CellText: string);
var
n: PStudyRec;
rec:TStudyRec;
begin
n := StudyStringTree.GetNodeData(Node);
rec := n^;
case Column of
0: CellText := SelectText(rec.RecType = srStudy, rec.StudyID, rec.UserID);
1: Celltext := SelectText(rec.RecType = srStudy, rec.StudyCode, rec.UserPaCoCode);
2: Celltext := SelectText(rec.RecType = srStudy, rec.StudyName, rec.UserName);
else Celltext := SelectText(rec.RecType = srStudy, '', rec.UserStudyCode);
end;
end;
procedure TForm1.SpeedButtonAddStudyClick(Sender: TObject);
begin
StudyStringTree.RootNodeCount := StudyStringTree.RootNodeCount + 1;
end;
procedure TForm1.SpeedButtonAddUserClick(Sender: TObject);
var
node : PVirtualNode;
begin
node := StudyStringTree.FocusedNode;
if assigned(node) and (StudyStringTree.GetNodeLevel(node) = 0) then
StudyStringTree.ChildCount[node] := StudyStringTree.ChildCount[node] + 1;
end;
procedure TForm1.SpeedButtonDelNodeClick(Sender: TObject);
var
n : PVirtualNode;
begin
for n in StudyStringTree.SelectedNodes do
StudyStringTree.DeleteNode(n);
end;
procedure TForm1.SpeedButtonDelTreeClick(Sender: TObject);
begin
StudyStringTree.RootNodeCount:=0;
end;
procedure TForm1.StudyStringTreeInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
var InitialStates: TVirtualNodeInitStates);
var
n: PStudyRec;
rec:TStudyRec;
begin
n := StudyStringTree.GetNodeData(Node);
rec := n^;
if StudyStringTree.GetNodeLevel(Node) = 0 then //root
begin
rec.RecType := srStudy;
rec.StudyID := NextStudyID;
rec.StudyCode := 'TS-' + RandomString(3);
rec.StudyName := 'A very interesting topic: ' + rec.StudyCode;
end
else
begin
rec.RecType := srUser;
rec.UserID := NextUserID;
rec.UserPaCoCode := 'PC' + RandomString(4);
rec.UserStudyCode := RandomString(10);
rec.UserName := Format('My valued user #%d',[rec.UserID]);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
StudyStringTree.NodeDataSize := SizeOf(TStudyRec);
end;
end.