BSOne.SFC/Tocsg.Module/PatternManager/FManagerPattern.pas

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('<27><><EFBFBD><EFBFBD><EFBFBD>Ͻðڽ<C3B0><DABD>ϱ<EFBFBD>?'),
        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.