448 lines
11 KiB
Plaintext
448 lines
11 KiB
Plaintext
unit DPatternInfo;
|
||
|
||
interface
|
||
|
||
uses
|
||
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
|
||
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, VirtualTrees, Vcl.Buttons,
|
||
Vcl.Menus, ManagerPattern;
|
||
|
||
type
|
||
PNameEnt = ^TNameEnt;
|
||
TNameEnt = record
|
||
wLangId: WORD;
|
||
sName: String;
|
||
end;
|
||
|
||
PPtnEnt = ^TPtnEnt;
|
||
TPtnEnt = record
|
||
sInfo: String;
|
||
end;
|
||
|
||
TDlgNameInfo = class(TForm)
|
||
cbLang: TComboBox;
|
||
edName: TEdit;
|
||
btnAdd: TSpeedButton;
|
||
vtName: TVirtualStringTree;
|
||
btnOk: TButton;
|
||
btnCancel: TButton;
|
||
popFun: TPopupMenu;
|
||
btnDel: TMenuItem;
|
||
Label1: TLabel;
|
||
Label2: TLabel;
|
||
vtList: TVirtualStringTree;
|
||
edPtnKwd: TEdit;
|
||
btnAddPtn: TSpeedButton;
|
||
popFun2: TPopupMenu;
|
||
miDel: TMenuItem;
|
||
N1: TMenuItem;
|
||
miImportCsv: TMenuItem;
|
||
OpenDialog: TOpenDialog;
|
||
miCopyToCB: TMenuItem;
|
||
procedure edNameKeyPress(Sender: TObject; var Key: Char);
|
||
procedure vtNameGetNodeDataSize(Sender: TBaseVirtualTree;
|
||
var NodeDataSize: Integer);
|
||
procedure vtNameFreeNode(Sender: TBaseVirtualTree;
|
||
Node: PVirtualNode);
|
||
procedure vtNameGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
|
||
Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
|
||
procedure vtNameGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode;
|
||
Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle;
|
||
var HintText: string);
|
||
procedure btnAddClick(Sender: TObject);
|
||
procedure btnDelClick(Sender: TObject);
|
||
procedure btnOkClick(Sender: TObject);
|
||
procedure vtNameContextPopup(Sender: TObject; MousePos: TPoint;
|
||
var Handled: Boolean);
|
||
procedure vtNameFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode;
|
||
Column: TColumnIndex);
|
||
procedure btnAddPtnClick(Sender: TObject);
|
||
procedure vtListGetNodeDataSize(Sender: TBaseVirtualTree;
|
||
var NodeDataSize: Integer);
|
||
procedure vtListFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
|
||
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 miDelClick(Sender: TObject);
|
||
procedure miImportCsvClick(Sender: TObject);
|
||
procedure miCopyToCBClick(Sender: TObject);
|
||
private
|
||
{ Private declarations }
|
||
function GetNameEntByLangId(wLangId: WORD): PNameEnt;
|
||
public
|
||
{ Public declarations }
|
||
Constructor Create(aOwner: TComponent; aEnt: TPatternEnt = nil);
|
||
|
||
procedure SavePatternInfo(aEnt: TPatternEnt);
|
||
end;
|
||
|
||
var
|
||
DlgNameInfo: TDlgNameInfo;
|
||
|
||
implementation
|
||
|
||
uses
|
||
Tocsg.VTUtil, Tocsg.Safe, Tocsg.Strings, Tocsg.Clipboard;
|
||
|
||
{$R *.dfm}
|
||
|
||
Constructor TDlgNameInfo.Create(aOwner: TComponent; aEnt: TPatternEnt = nil);
|
||
var
|
||
pData: PNameEnt;
|
||
pDataP: PPtnEnt;
|
||
w: WORD;
|
||
i: Integer;
|
||
begin
|
||
Inherited Create(aOwner);
|
||
|
||
vtName.BeginUpdate;
|
||
vtList.BeginUpdate;
|
||
try
|
||
if aEnt <> nil then
|
||
begin
|
||
for i := 0 to aEnt.NameList.Count - 1 do
|
||
begin
|
||
w := WORD(aEnt.NameList.Objects[i]);
|
||
if (w <> 0) and (GetNameEntByLangId(w) = nil) then
|
||
begin
|
||
pData := VT_AddChildData(vtName);
|
||
pData.wLangId := w;
|
||
pData.sName := aEnt.NameList[i];
|
||
end;
|
||
end;
|
||
|
||
for i := 0 to aEnt.PatternList.Count - 1 do
|
||
begin
|
||
pDataP := VT_AddChildData(vtList);
|
||
pDataP.sInfo := aEnt.PatternList[i];
|
||
end;
|
||
end;
|
||
finally
|
||
vtList.EndUpdate;
|
||
vtName.EndUpdate;
|
||
end;
|
||
end;
|
||
|
||
procedure TDlgNameInfo.SavePatternInfo(aEnt: TPatternEnt);
|
||
var
|
||
pNode: PVirtualNode;
|
||
pData: PNameEnt;
|
||
pDataP: PPtnEnt;
|
||
begin
|
||
vtName.BeginUpdate;
|
||
vtList.BeginUpdate;
|
||
try
|
||
aEnt.NameList.Clear;
|
||
pNode := vtName.GetFirst;
|
||
while pNode <> nil do
|
||
begin
|
||
pData := vtName.GetNodeData(pNode);
|
||
aEnt.AddName(pData.wLangId, pData.sName);
|
||
pNode := vtName.GetNext(pNode);
|
||
end;
|
||
|
||
aEnt.PatternList.Clear;
|
||
pNode := vtList.GetFirst;
|
||
while pNode <> nil do
|
||
begin
|
||
pDataP := vtList.GetNodeData(pNode);
|
||
aEnt.PatternList.Add(pDataP.sInfo);
|
||
pNode := vtList.GetNext(pNode);
|
||
end;
|
||
finally
|
||
vtList.EndUpdate;
|
||
vtName.EndUpdate;
|
||
end;
|
||
end;
|
||
|
||
function TDlgNameInfo.GetNameEntByLangId(wLangId: WORD): PNameEnt;
|
||
var
|
||
pNode: PVirtualNode;
|
||
pData: PNameEnt;
|
||
begin
|
||
Result := nil;
|
||
pNode := vtName.GetFirst;
|
||
while pNode <> nil do
|
||
begin
|
||
pData := vtName.GetNodeData(pNode);
|
||
if pData.wLangId = wLangId then
|
||
begin
|
||
Result := pData;
|
||
exit;
|
||
end;
|
||
pNode := vtName.GetNext(pNode);
|
||
end;
|
||
end;
|
||
|
||
procedure TDlgNameInfo.miCopyToCBClick(Sender: TObject);
|
||
begin
|
||
if VT_CopyToClipboardSelectedInfo(vtList) = 0 then
|
||
MessageBox(Handle, PChar('Ŭ<><C5AC><EFBFBD><EFBFBD><EFBFBD>忡 <20><><EFBFBD><EFBFBD> <20>Ǿ<EFBFBD><C7BE><EFBFBD><EFBFBD>ϴ<EFBFBD>.'), PChar(Caption), MB_ICONINFORMATION or MB_OK);
|
||
end;
|
||
|
||
procedure TDlgNameInfo.miDelClick(Sender: TObject);
|
||
begin
|
||
if vtList.SelectedCount = 0 then
|
||
begin
|
||
MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><EFBFBD><D7B8><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>ֽʽÿ<CABD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
|
||
exit;
|
||
end;
|
||
|
||
if MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD><EFBFBD>Ͻðڽ<C3B0><DABD>ϱ<EFBFBD>?'),
|
||
PChar(Caption), MB_ICONQUESTION or MB_YESNO) = IDNO then exit;
|
||
|
||
vtList.DeleteSelectedNodes;
|
||
end;
|
||
|
||
procedure TDlgNameInfo.miImportCsvClick(Sender: TObject);
|
||
var
|
||
StrList: TStringList;
|
||
i: Integer;
|
||
pData: PPtnEnt;
|
||
begin
|
||
OpenDialog.FileName := '';
|
||
if OpenDialog.Execute(Handle) then
|
||
begin
|
||
try
|
||
Guard(StrList, TStringList.Create);
|
||
StrList.LoadFromFile(OpenDialog.FileName, TEncoding.UTF8);
|
||
SplitString(StrList.Text, #13#10, StrList);
|
||
|
||
vtList.BeginUpdate;
|
||
try
|
||
for i := 0 to StrList.Count - 1 do
|
||
begin
|
||
pData := VT_AddChildData(vtList);
|
||
pData.sInfo := StrList[i];
|
||
end;
|
||
finally
|
||
vtList.EndUpdate;
|
||
end;
|
||
except
|
||
MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><EFBFBD><DFBB>߽<EFBFBD><DFBD>ϴ<EFBFBD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TDlgNameInfo.btnAddClick(Sender: TObject);
|
||
|
||
function GetLangIdByCbIndex: WORD;
|
||
begin
|
||
case cbLang.ItemIndex of
|
||
1 : Result := $0409;
|
||
2 : Result := $0411;
|
||
3 : Result := $0804;
|
||
4 : Result := $0404;
|
||
5 : Result := 1;
|
||
else Result := $0412;
|
||
end;
|
||
end;
|
||
|
||
var
|
||
pData: PNameEnt;
|
||
wLangId: WORD;
|
||
begin
|
||
edName.Text := Trim(edName.Text);
|
||
if edName.Text = '' then
|
||
begin
|
||
MessageBox(Handle, PChar('<27≯<EFBFBD><CCB8><EFBFBD> <20>Է<EFBFBD><D4B7><EFBFBD> <20>ֽʽÿ<CABD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
|
||
exit;
|
||
end;
|
||
|
||
vtName.BeginUpdate;
|
||
try
|
||
wLangId := GetLangIdByCbIndex;
|
||
pData := GetNameEntByLangId(wLangId);
|
||
if pData = nil then
|
||
begin
|
||
pData := VT_AddChildData(vtName);
|
||
pData.wLangId := wLangId;
|
||
end;
|
||
pData.sName := edName.Text;
|
||
finally
|
||
vtName.EndUpdate;
|
||
end;
|
||
end;
|
||
|
||
procedure TDlgNameInfo.btnAddPtnClick(Sender: TObject);
|
||
var
|
||
pNode: PVirtualNode;
|
||
pData: PPtnEnt;
|
||
begin
|
||
edPtnKwd.Text := Trim(edPtnKwd.Text);
|
||
|
||
vtList.BeginUpdate;
|
||
try
|
||
pNode := vtList.GetFirst;
|
||
while pNode <> nil do
|
||
begin
|
||
pData := vtList.GetNodeData(pNode);
|
||
if CompareText(pData.sInfo, edPtnKwd.Text) = 0 then
|
||
begin
|
||
MessageBox(Handle, PChar('<27>̹<EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>ϴ<EFBFBD> <20><><EFBFBD><EFBFBD>/Ű<><C5B0><EFBFBD><EFBFBD> <20>Դϴ<D4B4>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
|
||
exit;
|
||
end;
|
||
pNode := vtList.GetNext(pNode);
|
||
end;
|
||
|
||
pData := VT_AddChildData(vtList);
|
||
pData.sInfo := edPtnKwd.Text;
|
||
|
||
edPtnKwd.Clear;
|
||
finally
|
||
vtList.EndUpdate;
|
||
end;
|
||
end;
|
||
|
||
procedure TDlgNameInfo.btnDelClick(Sender: TObject);
|
||
var
|
||
pNode: PVirtualNode;
|
||
begin
|
||
if vtName.Focused then
|
||
begin
|
||
pNode := vtName.GetFirstSelected;
|
||
if pNode = nil then
|
||
exit;
|
||
|
||
if MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD><EFBFBD>Ͻðڽ<C3B0><DABD>ϱ<EFBFBD>?'),
|
||
PChar(Caption), MB_ICONQUESTION or MB_YESNO) = IDNO then exit;
|
||
|
||
vtName.DeleteSelectedNodes;
|
||
end;
|
||
// else
|
||
// if vtList.Focused then
|
||
// begin
|
||
// pNode := vtList.GetFirstSelected;
|
||
// if pNode = nil then
|
||
// exit;
|
||
//
|
||
// if MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD><EFBFBD>Ͻðڽ<C3B0><DABD>ϱ<EFBFBD>?'),
|
||
// PChar(Caption), MB_ICONQUESTION or MB_YESNO) = IDNO then exit;
|
||
//
|
||
// vtList.DeleteSelectedNodes;
|
||
// end;
|
||
end;
|
||
|
||
procedure TDlgNameInfo.btnOkClick(Sender: TObject);
|
||
begin
|
||
if vtName.RootNodeCount = 0 then
|
||
begin
|
||
MessageBox(Handle, PChar('<27≯<EFBFBD><CCB8><EFBFBD> <20>ϳ<EFBFBD> <20>̻<EFBFBD> <20>߰<EFBFBD><DFB0><EFBFBD><EFBFBD>ֽʽÿ<CABD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
|
||
exit;
|
||
end;
|
||
ModalResult := mrOk;
|
||
end;
|
||
|
||
procedure TDlgNameInfo.edNameKeyPress(Sender: TObject; var Key: Char);
|
||
begin
|
||
if Key = #13 then
|
||
begin
|
||
Key := #0;
|
||
btnAdd.Click;
|
||
exit;
|
||
end;
|
||
end;
|
||
|
||
procedure TDlgNameInfo.vtListFreeNode(Sender: TBaseVirtualTree;
|
||
Node: PVirtualNode);
|
||
var
|
||
pData: PPtnEnt;
|
||
begin
|
||
pData := Sender.GetNodeData(Node);
|
||
Finalize(pData^);
|
||
end;
|
||
|
||
procedure TDlgNameInfo.vtListGetHint(Sender: TBaseVirtualTree;
|
||
Node: PVirtualNode; Column: TColumnIndex;
|
||
var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: string);
|
||
begin
|
||
HintText := vtList.Text[Node, Column];
|
||
end;
|
||
|
||
procedure TDlgNameInfo.vtListGetNodeDataSize(Sender: TBaseVirtualTree;
|
||
var NodeDataSize: Integer);
|
||
begin
|
||
NodeDataSize := SizeOf(TPtnEnt);
|
||
end;
|
||
|
||
procedure TDlgNameInfo.vtListGetText(Sender: TBaseVirtualTree;
|
||
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
|
||
var CellText: string);
|
||
var
|
||
pData: PPtnEnt;
|
||
begin
|
||
pData := Sender.GetNodeData(Node);
|
||
|
||
case Column of
|
||
0 : CellText := IntToStr(Node.Index + 1);
|
||
1 : CellText := pData.sInfo;
|
||
end;
|
||
end;
|
||
|
||
procedure TDlgNameInfo.vtNameContextPopup(Sender: TObject; MousePos: TPoint;
|
||
var Handled: Boolean);
|
||
begin
|
||
Handled := vtName.GetFirstSelected = nil;
|
||
end;
|
||
|
||
procedure TDlgNameInfo.vtNameFocusChanged(Sender: TBaseVirtualTree;
|
||
Node: PVirtualNode; Column: TColumnIndex);
|
||
var
|
||
pData: PNameEnt;
|
||
begin
|
||
if Node = nil then
|
||
exit;
|
||
|
||
pData := Sender.GetNodeData(Node);
|
||
case pData.wLangId of
|
||
$0409 : cbLang.ItemIndex := 1;
|
||
$0411 : cbLang.ItemIndex := 2;
|
||
$0804 : cbLang.ItemIndex := 3;
|
||
$0404 : cbLang.ItemIndex := 4;
|
||
1 : cbLang.ItemIndex := 5;
|
||
else cbLang.ItemIndex := 0;
|
||
end;
|
||
edName.Text := pData.sName;
|
||
end;
|
||
|
||
procedure TDlgNameInfo.vtNameFreeNode(Sender: TBaseVirtualTree;
|
||
Node: PVirtualNode);
|
||
var
|
||
pData: PNameEnt;
|
||
begin
|
||
pData := Sender.GetNodeData(Node);
|
||
Finalize(pData^);
|
||
end;
|
||
|
||
procedure TDlgNameInfo.vtNameGetHint(Sender: TBaseVirtualTree;
|
||
Node: PVirtualNode; Column: TColumnIndex;
|
||
var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: string);
|
||
begin
|
||
HintText := vtName.Text[Node, Column];
|
||
end;
|
||
|
||
procedure TDlgNameInfo.vtNameGetNodeDataSize(
|
||
Sender: TBaseVirtualTree; var NodeDataSize: Integer);
|
||
begin
|
||
NodeDataSize := SizeOf(TNameEnt);
|
||
end;
|
||
|
||
procedure TDlgNameInfo.vtNameGetText(Sender: TBaseVirtualTree;
|
||
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
|
||
var CellText: string);
|
||
var
|
||
pData: PNameEnt;
|
||
begin
|
||
pData := Sender.GetNodeData(Node);
|
||
|
||
case Column of
|
||
0 : CellText := IntToStr(Node.Index + 1);
|
||
1 : CellText := LangIdToStr(pData.wLangId);
|
||
2 : CellText := pData.sName;
|
||
end;
|
||
end;
|
||
|
||
end.
|