unit DBS1MgPoMain; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, VirtualTrees, Vcl.ExtCtrls, Vcl.StdCtrls, ManagerPolicy; type TDlgBS1MgPo = class(TForm) pnBottom: TPanel; vtList: TVirtualStringTree; btnLoad: TButton; procedure btnLoadClick(Sender: TObject); procedure vtListGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer); procedure vtListGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: string); procedure vtListGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); procedure vtListCompareNodes(Sender: TBaseVirtualTree; Node1, Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer); procedure vtListHeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo); procedure vtListFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); private { Private declarations } MgPo_: TManagerPolicy; procedure UpdatePolicy; public { Public declarations } Constructor Create(aOwner: TComponent); override; Destructor Destroy; override; end; var DlgBS1MgPo: TDlgBS1MgPo; implementation uses superobject, Tocsg.Safe, System.Math, Tocsg.VTUtil, VirtualTrees.Types; {$R *.dfm} Constructor TDlgBS1MgPo.Create(aOwner: TComponent); begin Inherited Create(aOwner); MgPo_ := TManagerPolicy.Create; end; Destructor TDlgBS1MgPo.Destroy; begin FreeAndNil(MgPo_); Inherited; end; procedure TDlgBS1MgPo.UpdatePolicy; var enum: TPoEntEnumerator; pData: PPoEnt; begin vtList.BeginUpdate; try Guard(enum, MgPo_.GetPoEntEnumerator); while enum.MoveNext do begin pData := VT_AddChildData(vtList); pData^ := enum.Current^; end; vtList.Sort(nil, 1, sdAscending); finally vtList.EndUpdate; end; end; procedure TDlgBS1MgPo.vtListCompareNodes(Sender: TBaseVirtualTree; Node1, Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer); var pData1, pData2: PPoEnt; begin case Column of 0 : ; 1 : begin pData1 := Sender.GetNodeData(Node1); pData2 := Sender.GetNodeData(Node2); Result := CompareValue(pData1.nCode, pData2.nCode); end; else Result := CompareText(vtList.Text[Node1, Column], vtList.Text[Node2, Column]); end; end; procedure TDlgBS1MgPo.vtListFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); var pData: PPoEnt; begin pData := Sender.GetNodeData(Node); Finalize(pData^); end; procedure TDlgBS1MgPo.vtListGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: string); begin HintText := vtList.Text[Node, Column]; end; procedure TDlgBS1MgPo.vtListGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer); begin NodeDataSize := SizeOf(TPoEnt); end; procedure TDlgBS1MgPo.vtListGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); var pData: PPoEnt; begin pData := Sender.GetNodeData(Node); case Column of 0 : CellText := IntToStr(Node.Index + 1); 1 : CellText := IntToStr(pData.nCode); 2 : CellText := pData.sKey; 3 : CellText := pData.sCate; 4 : CellText := pData.sDesc; 5 : CellText := pData.sUpDate; 6 : CellText := pData.sComment; end; end; procedure TDlgBS1MgPo.vtListHeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo); begin if HitInfo.Button = mbLeft then begin if HitInfo.Column < 0 then exit; with Sender, Treeview do begin if SortColumn > NoColumn then Columns[SortColumn].Options := Columns[SortColumn].Options + [coParentColor]; if HitInfo.Column = 0 then SortColumn := NoColumn else begin if (SortColumn = NoColumn) or (SortColumn <> HitInfo.Column) then begin SortColumn := HitInfo.Column; SortDirection := sdAscending; end else if SortDirection = sdAscending then SortDirection := sdDescending else SortDirection := sdAscending; Columns[SortColumn].Color := $00EFEFEF; vtList.BeginUpdate; try vtList.SortTree(SortColumn, SortDirection, False); finally vtList.EndUpdate; end; end; end; end; end; procedure TDlgBS1MgPo.btnLoadClick(Sender: TObject); var sPath: String; O: ISuperObject; begin // sPath := 'C:\Users\tocsg\Nextcloud\BSOneRel\Manager\yml file\policy-doc.json'; sPath := 'C:\Users\kku\Nextcloud\BSOneRel\Manager\yml file\policy-doc.json'; if not FileExists(sPath) then begin MessageBox(Handle, PChar('정책 파일이 존재하지 않습니다.'), PChar(Caption), MB_ICONWARNING or MB_OK); exit; end; MgPo_.ExtractPolicyDoc(sPath); UpdatePolicy; end; end.