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.