213 lines
5.9 KiB
ObjectPascal
213 lines
5.9 KiB
ObjectPascal
unit uSetMain;
|
|
|
|
interface
|
|
|
|
uses
|
|
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
|
|
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects,
|
|
System.ImageList, FMX.ImgList, FMX.Controls.Presentation, FMX.Edit,iniFiles,
|
|
FMX.TabControl, FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Param,
|
|
FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf, FireDAC.DApt.Intf,
|
|
Data.DB, FireDAC.Comp.DataSet, FireDAC.Comp.Client, System.Rtti,uShowInfo,
|
|
FMX.Grid.Style, FMX.Grid, FMX.ScrollBox,uPucFun, uFrameSet,Data.Bind.Grid,
|
|
FireDAC.Stan.StorageJSON, Data.Bind.Components, Data.Bind.DBScope,
|
|
FireDAC.Stan.StorageBin,FMX.DialogService,uAddKey, FMX.StdCtrls,Generics.Collections;
|
|
|
|
type
|
|
TfrmSetMain = class(TForm)
|
|
Rectangle1: TRectangle;
|
|
Rectangle7: TRectangle;
|
|
Rectangle8: TRectangle;
|
|
ImageList1: TImageList;
|
|
Rectangle13: TRectangle;
|
|
Rectangle12: TRectangle;
|
|
Rectangle14: TRectangle;
|
|
Text7: TText;
|
|
Rectangle10: TRectangle;
|
|
Rectangle5: TRectangle;
|
|
Rectangle2: TRectangle;
|
|
Rectangle3: TRectangle;
|
|
Rectangle6: TRectangle;
|
|
Rectangle4: TRectangle;
|
|
TxtFactoryCode: TText;
|
|
Text6: TText;
|
|
Rectangle33: TRectangle;
|
|
Text20: TText;
|
|
Rectangle11: TRectangle;
|
|
TabControl1: TTabControl;
|
|
Rectangle26: TRectangle;
|
|
Rectangle27: TRectangle;
|
|
Text17: TText;
|
|
Text21: TText;
|
|
Text4: TText;
|
|
Glyph23: TGlyph;
|
|
CheckBox1: TCheckBox;
|
|
procedure Text7Click(Sender: TObject);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure Rectangle2MouseDown(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Single);
|
|
procedure Text20Click(Sender: TObject);
|
|
procedure FormDestroy(Sender: TObject);
|
|
procedure Text17Click(Sender: TObject);
|
|
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
|
procedure Text4Click(Sender: TObject);
|
|
private
|
|
public
|
|
GridList:TList<TFrameSet>;
|
|
IsSave:boolean;
|
|
end;
|
|
|
|
var
|
|
frmSetMain: TfrmSetMain;
|
|
|
|
implementation
|
|
|
|
{$R *.fmx}
|
|
|
|
uses uListConent, uDM, uMain, uSafeLog;
|
|
|
|
procedure TfrmSetMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
|
var
|
|
i:integer;
|
|
begin
|
|
if IsSave then begin CanClose:=true; Exit; end;
|
|
|
|
CanClose:=true;
|
|
for I := 0 to GridList.Count-1 do
|
|
begin
|
|
if GridList.items[i].IsChange then
|
|
begin
|
|
if ShowInfoOKCancel('有編輯的數據還未保存,確定要退出嗎?') then
|
|
begin
|
|
Exit;
|
|
end
|
|
else
|
|
begin
|
|
CanClose:=false;
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmSetMain.FormCreate(Sender: TObject);
|
|
var
|
|
I: Integer;
|
|
tbitem: TTabItem;
|
|
Recitem:TFrameSet;
|
|
begin
|
|
GridList := TList<TFrameSet>.Create;
|
|
IsSave:=false;
|
|
TxtFactoryCode.Text:= FactoryCode;
|
|
|
|
for I := 0 to iniListName.Count-1 do
|
|
begin
|
|
tbitem:= TabControl1.Add(TTabItem) as TTabItem;
|
|
Recitem:= TFrameSet.Create(nil);
|
|
GridList.Add(Recitem);
|
|
Recitem.Parent:=tbitem;
|
|
recitem.Align:=TAlignLayout.Client;
|
|
tbitem.Text:= iniListName.Strings[i];
|
|
Recitem.id.Width:=0; //隐藏ID列
|
|
Recitem.Key.Width :=150;
|
|
Recitem.Name.Width :=150;
|
|
Recitem.Value.Width :=Recitem.GridSet.Width-Recitem.Name.Width-Recitem.Key.Width-Recitem.id.Width-10;
|
|
dm.MemTableLoadTab(tbitem.Text,Recitem.gridset);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmSetMain.Rectangle2MouseDown(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Single);
|
|
begin
|
|
self.StartWindowDrag;
|
|
end;
|
|
|
|
procedure TfrmSetMain.Text17Click(Sender: TObject);
|
|
var
|
|
tbitem: TTabItem;
|
|
Recitem:TFrameSet;
|
|
i:integer;
|
|
begin
|
|
// 输出完整响应信息
|
|
// WorkLog.MessageInfo('TfrmSetMain状态码: %d,', [1]);
|
|
frmAddKey:= TfrmAddKey.Create(nil);
|
|
// WorkLog.MessageInfo('TfrmSetMain状态码: %d,', [2]);
|
|
frmAddKey.Position:=TFormPosition.MainFormCenter;
|
|
// WorkLog.MessageInfo('TfrmSetMain状态码: %d,', [3]);
|
|
try
|
|
frmAddKey.TxtFactoryCode:=TxtFactoryCode; //厂区
|
|
// WorkLog.MessageInfo('TfrmSetMain状态码: %d,', [4]);
|
|
if frmAddKey.ShowModal=mrOk then
|
|
begin
|
|
// WorkLog.MessageInfo('TfrmSetMain状态码: %d,', [5]);
|
|
//增加到数据库
|
|
for I := 1 to High(frmAddKey.KeyName) do
|
|
begin
|
|
dm.MemTableWriteKey(Trim(frmAddKey.TabName),Trim(frmAddKey.KeyName[i]));
|
|
end;
|
|
// WorkLog.MessageInfo('TfrmSetMain状态码: %d,', [6]);
|
|
tbitem:= TabControl1.Add(TTabItem) as TTabItem;
|
|
Recitem:= TFrameSet.Create(nil);
|
|
// WorkLog.MessageInfo('TfrmSetMain状态码: %d,', [7]);
|
|
GridList.Add(Recitem);
|
|
Recitem.Parent:=tbitem;
|
|
recitem.Align:=TAlignLayout.Client;
|
|
// WorkLog.MessageInfo('TfrmSetMain状态码: %d,', [8]);
|
|
tbitem.Text:=frmAddKey.TabName;
|
|
Recitem.id.Width:=0; //隐藏ID列
|
|
Recitem.Key.Width :=150;
|
|
Recitem.Name.Width :=150;
|
|
Recitem.Value.Width := Recitem.GridSet.Width
|
|
- Recitem.Name.Width
|
|
- Recitem.Key.Width
|
|
- Recitem.id.Width - 10;
|
|
|
|
dm.MemTableLoadTab(tbitem.Text,Recitem.GridSet);
|
|
// WorkLog.MessageInfo('TfrmSetMain状态码: %d,', [9]);
|
|
end;
|
|
finally
|
|
frmAddKey.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmSetMain.Text20Click(Sender: TObject);
|
|
begin
|
|
Close;
|
|
end;
|
|
|
|
procedure TfrmSetMain.Text4Click(Sender: TObject);
|
|
begin
|
|
ShowTouchKeyBoard();
|
|
end;
|
|
|
|
procedure TfrmSetMain.Text7Click(Sender: TObject);
|
|
var
|
|
i:integer;
|
|
begin
|
|
try
|
|
for I := 0 to GridList.Count-1 do
|
|
begin
|
|
GridList.items[i].GridSet.Row:=1;
|
|
GridList.items[i].GridSet.Col:=1;
|
|
dm.MemTableSaveTab(GridList.items[i].GridSet);
|
|
end;
|
|
dm.fdmemtable1.SaveToFile(ExtractFilePath(Paramstr(0))+'system.json');
|
|
IsSave:=true;
|
|
except
|
|
|
|
end;
|
|
|
|
Close;
|
|
Application.Terminate;
|
|
end;
|
|
|
|
procedure TfrmSetMain.FormDestroy(Sender: TObject);
|
|
begin
|
|
GridList.Clear;
|
|
GridList.Free;
|
|
end;
|
|
|
|
|
|
|
|
end.
|