unit FManagerPattern; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, VirtualTrees, Vcl.ExtCtrls, Vcl.Buttons, ManagerPattern, Vcl.Menus, Vcl.Imaging.pngimage, System.ImageList, Vcl.ImgList, PngImageList, Vcl.StdCtrls; type PPtnEnt = ^TPtnEnt; TPtnEnt = record Info: TPatternEnt; end; TFrmManagerPattern = class(TFrame) pnClient: TPanel; pnTop: TPanel; vtList: TVirtualStringTree; btnAdd: TSpeedButton; btnMod: TSpeedButton; btnDel: TSpeedButton; popFun: TPopupMenu; miAdd: TMenuItem; miMod: TMenuItem; miDel: TMenuItem; imgList: TPngImageList; procedure vtListGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer); procedure vtListGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); procedure vtListGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: string); procedure btnAddClick(Sender: TObject); procedure btnModClick(Sender: TObject); procedure btnDelClick(Sender: TObject); procedure vtListContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean); private { Private declarations } MgPtn_: TManagerPattern; bSelectMode_: Boolean; public { Public declarations } Constructor Create(aOwner: TComponent); override; Destructor Destroy; override; procedure SetSelectMode; procedure SaveUseInfo; procedure RefreshList; end; implementation uses Tocsg.VTUtil, DPatternInfo, Tocsg.Safe, Define; {$R *.dfm} Constructor TFrmManagerPattern.Create(aOwner: TComponent); begin Inherited Create(aOwner); bSelectMode_ := false; MgPtn_ := TManagerPattern.Create; RefreshList; end; Destructor TFrmManagerPattern.Destroy; begin FreeAndNil(MgPtn_); Inherited; end; procedure TFrmManagerPattern.SetSelectMode; begin bSelectMode_ := true; // pnTop.Visible := false; // vtList.PopupMenu := nil; // miMod.Enabled := false; end; procedure TFrmManagerPattern.SaveUseInfo; var pNode: PVirtualNode; pData: PPtnEnt; begin if not bSelectMode_ then exit; vtList.BeginUpdate; try pNode := vtList.GetFirst; while pNode <> nil do begin pData := vtList.GetNodeData(pNode); pData.Info.SetUse(pNode.CheckState = csCheckedNormal); pNode := vtList.GetNext(pNode); end; finally vtList.EndUpdate; end; MgPtn_.Save; end; procedure TFrmManagerPattern.RefreshList; procedure AddPatternEnt(pParentNode: PVirtualNode; aEnt: TPatternEnt); var pNode: PVirtualNode; pData: PPtnEnt; i: Integer; begin pData := VT_AddChildDataN(vtList, pNode, pParentNode); if bSelectMode_ then begin pNode.CheckType := ctCheckBox; if aEnt.Use then pNode.CheckState := csCheckedNormal; end; pData.Info := aEnt; for i := 0 to aEnt.ChildList.Count - 1 do AddPatternEnt(pNode, aEnt.ChildList[i]); end; var i: Integer; begin vtList.BeginUpdate; try VT_Clear(vtList); // MgPtn_.LangId := 1; for i := 0 to MgPtn_.EntList.Count - 1 do AddPatternEnt(nil, MgPtn_.EntList[i]); VT_ExpandAll(vtList, true); finally vtList.EndUpdate; end; end; procedure TFrmManagerPattern.btnAddClick(Sender: TObject); var pNode, pCNode: PVirtualNode; pData: PPtnEnt; Ent, ParentEnt: TPatternEnt; dlg: TDlgNameInfo; begin vtList.BeginUpdate; try pNode := vtList.GetFirstSelected; if pNode <> nil then begin pData := vtList.GetNodeData(pNode); ParentEnt := pData.Info; end else ParentEnt := nil; Guard(dlg, TDlgNameInfo.Create(Self)); if dlg.ShowModal = mrOk then begin Ent := TPatternEnt.Create(MgPtn_, ParentEnt); dlg.SavePatternInfo(Ent); if ParentEnt <> nil then ParentEnt.ChildList.Add(Ent) else MgPtn_.EntList.Add(Ent); MgPtn_.Save; pData := VT_AddChildDataN(vtList, pCNode, pNode); pData.Info := Ent; if bSelectMode_ then pCNode.CheckType := ctCheckBox; end; finally vtList.EndUpdate; end; end; procedure TFrmManagerPattern.btnDelClick(Sender: TObject); var pNode: PVirtualNode; pData, pPData: PPtnEnt; i: Integer; begin vtList.BeginUpdate; try pNode := vtList.GetFirstSelected; if pNode = nil then exit; if MessageBox(Handle, PChar('»èÁ¦ÇϽðڽÀ´Ï±î?'), PChar(APP_TITLE), MB_ICONQUESTION or MB_YESNO) = IDNO then exit; pData := vtList.GetNodeData(pNode); if pNode.Parent <> vtList.RootNode then begin pPData := vtList.GetNodeData(pNode.Parent); i := pPData.Info.ChildList.IndexOf(pData.Info); if i <> -1 then begin pPData.Info.ChildList.Delete(i); vtList.DeleteNode(pNode); end; end else begin i := MgPtn_.EntList.IndexOf(pData.Info); if i <> -1 then begin MgPtn_.EntList.Delete(i); vtList.DeleteNode(pNode); end; end; MgPtn_.Save; finally vtList.EndUpdate; end; end; procedure TFrmManagerPattern.btnModClick(Sender: TObject); var pNode: PVirtualNode; dlg: TDlgNameInfo; pData: PPtnEnt; begin vtList.BeginUpdate; try pNode := vtList.GetFirstSelected; if pNode = nil then exit; pData := vtList.GetNodeData(pNode); Guard(dlg, TDlgNameInfo.Create(Self, pData.Info)); if dlg.ShowModal = mrOk then begin dlg.SavePatternInfo(pData.Info); MgPtn_.Save; end; finally vtList.EndUpdate; end; end; procedure TFrmManagerPattern.vtListContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean); begin miMod.Visible := vtList.GetNodeAt(MousePos) <> nil; miDel.Visible := miMod.Visible; end; procedure TFrmManagerPattern.vtListGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: string); begin HintText := vtList.Text[Node, Column]; end; procedure TFrmManagerPattern.vtListGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer); begin NodeDataSize := SizeOf(TPtnEnt); end; procedure TFrmManagerPattern.vtListGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); var pData: PPtnEnt; nCnt: Integer; begin if Column = 0 then begin pData := Sender.GetNodeData(Node); nCnt := pData.Info.PatternCount; if nCnt > 0 then CellText := Format('%s (%d)', [pData.Info.Name, pData.Info.PatternCount]) else CellText := pData.Info.Name; end; end; end.