unit DRuleList; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, VirtualTrees, Vcl.StdCtrls, Vcl.ExtCtrls, ManagerRule; type TDlgRuleList = class(TForm) pnClient: TPanel; pnBottom: TPanel; btnOk: TButton; btnCancel: TButton; vtList: TVirtualStringTree; procedure vtListGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer); procedure vtListGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: string); procedure vtListFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); 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 btnOkClick(Sender: TObject); private { Private declarations } sChkRList_: String; procedure UpdateList; public { Public declarations } Constructor Create(aOwner: TComponent; sChkRList: String); property ChkRList: String read sChkRList_; end; var DlgRuleList: TDlgRuleList; implementation uses Tocsg.VTUtil, ManagerService, VirtualTrees.Types, Tocsg.Safe, Tocsg.Strings; resourcestring RS_CheckRule = '하나 이상의 컨텐츠 룰을 체크해 주십시오.'; {$R *.dfm} Constructor TDlgRuleList.Create(aOwner: TComponent; sChkRList: String); begin Inherited Create(aOwner); sChkRList_ := sChkRList; UpdateList; end; procedure TDlgRuleList.UpdateList; var pNode: PVirtualNode; pData: PRuleEnt; i: Integer; ChkRList: TStringList; begin if gMgSvc = nil then exit; Guard(ChkRList, TStringList.Create); SplitString(sChkRList_, ';', ChkRList); vtList.BeginUpdate; try VT_Clear(vtList); for i := 0 to gMgSvc.MgRule.CountRule - 1 do begin pData := VT_AddChildDataN(vtList, pNode); pData^ := gMgSvc.MgRule.RList[i]^; pNode.CheckType := ctCheckBox; if ChkRList.IndexOf(pData.sId) <> -1 then pNode.CheckState := csCheckedNormal; end; finally vtList.EndUpdate; end; end; procedure TDlgRuleList.vtListCompareNodes(Sender: TBaseVirtualTree; Node1, Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer); begin case Column of 1, 2 : Result := CompareText(vtList.Text[Node1, Column], vtList.Text[Node2, Column]); 3 : begin var pData1: PRuleEnt := Sender.GetNodeData(Node1); var pData2: PRuleEnt := Sender.GetNodeData(Node2); Result := pData1.nCnt - pData2.nCnt; end; end; end; procedure TDlgRuleList.vtListFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); var pData: PRuleEnt; begin pData := Sender.GetNodeData(Node); Finalize(pData^); end; procedure TDlgRuleList.vtListGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: string); begin HintText := vtList.Text[Node, Column]; end; procedure TDlgRuleList.vtListGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer); begin NodeDataSize := SizeOf(TRuleEnt); end; procedure TDlgRuleList.vtListGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); var pData: PRuleEnt; begin pData := Sender.GetNodeData(Node); case Column of 0 : CellText := IntToStr(Node.Index + 1); 1 : CellText := pData.sRName; 2 : begin case pData.RSeverity of rsLow : CellText := 'LOW'; rsNormal : CellText := 'NORMAL'; rsHigh : CellText := 'HIGH'; else CellText := 'Unknown'; end; end; 3 : begin if pData.nCnt > 0 then CellText := IntToStr(pData.nCnt) else CellText := '1'; end; end; end; procedure TDlgRuleList.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 TDlgRuleList.btnOkClick(Sender: TObject); var pNode: PVirtualNode; pData: PRuleEnt; begin sChkRList_ := ''; vtList.BeginUpdate; try pNode := vtList.GetFirst; while pNode <> nil do begin if pNode.CheckState = csCheckedNormal then begin pData := vtList.GetNodeData(pNode); SumString(sChkRList_, pData.sId, ';'); end; pNode := vtList.GetNext(pNode); end; finally vtList.EndUpdate; end; if sChkRList_ = '' then begin MessageBox(Handle, PChar(RS_CheckRule), PChar(Caption), MB_ICONWARNING or MB_OK); exit; end; ModalResult := mrOk; end; end.