📄 frame_ulayoutsetup.pas
字号:
unit frame_uLayoutSetup;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, frame_uBase, ExtCtrls, ComCtrls, StdCtrls, Buttons,db, ImgList,
dcfdes, dcddes;
type
Tframe_frmLayoutSetup = class(Tframe_frmBase)
pgc: TPageControl;
pnl: TPanel;
btnOk: TBitBtn;
btnCancel: TBitBtn;
tsBtn: TTabSheet;
tsSkin: TTabSheet;
tsTrade: TTabSheet;
btnApply: TBitBtn;
lstbtn: TListBox;
Panel1: TPanel;
imgbtn: TImage;
Label1: TLabel;
Label2: TLabel;
lstbtnImg: TListBox;
Label3: TLabel;
Panel2: TPanel;
Imgfather: TImage;
Label4: TLabel;
lstTradeimg: TListBox;
Label5: TLabel;
lstFatherTrade: TListBox;
Label6: TLabel;
tsChildTrade: TTabSheet;
tsTool: TTabSheet;
lbl1: TLabel;
lbl2: TLabel;
lbl3: TLabel;
pnl1: TPanel;
imgchild: TImage;
lstChildimg: TListBox;
lstChildTrade: TListBox;
lbl4: TLabel;
lbl5: TLabel;
lbl6: TLabel;
pnl2: TPanel;
imgtool: TImage;
lsttoolimg: TListBox;
lsttool: TListBox;
tsbtntool: TTabSheet;
lbl7: TLabel;
lbl8: TLabel;
lbl9: TLabel;
lstToolbtn: TListBox;
pnl3: TPanel;
imgtoolBtn: TImage;
lstToolbtnimg: TListBox;
procedure FormShow(Sender: TObject);
procedure btnOkClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure btnApplyClick(Sender: TObject);
procedure btnCancelClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure lstbtnImgClick(Sender: TObject);
procedure lstTradeimgClick(Sender: TObject);
procedure lstChildimgClick(Sender: TObject);
procedure lsttoolimgClick(Sender: TObject);
procedure lstFatherTradeClick(Sender: TObject);
procedure lstChildTradeClick(Sender: TObject);
procedure lsttoolClick(Sender: TObject);
procedure lstItemClick(Sender: TObject);
procedure lstImgClick(Sender: TObject);
private
{ Private declarations }
updateList: TStringList;
procedure GenSkinChoice;
procedure GenimgChoice;
procedure GenTradeChoice;
procedure selSkinClick(Sender: TObject);
public
{ Public declarations }
end;
var
frame_frmLayoutSetup: Tframe_frmLayoutSetup;
implementation
uses frame_uMain, frame_UtilFunc, frame_uDM;
{$R *.dfm}
procedure Tframe_frmLayoutSetup.FormShow(Sender: TObject);
begin
inherited;
updateList := TStringList.Create;
caption := '外观设置';
pgc.ActivePage := tsSKin;
genSkinChoice;
genimgchoice;
GenTradeChoice;
end;
procedure Tframe_frmLayoutSetup.GenSkinChoice;
var
skinList: TStringList;
sr: TSearchRec;
c, i: integer;
begin
SkinList := TStringList.create;
if FindFirst(getAppPath + 'Skins\*.skn', faAnyFile, sr) = 0 then
begin
repeat
SkinList.Add(ExtractFileName(sr.Name));
until FindNext(sr) <> 0;
FindClose(sr);
end;
SkinList.Add('无风格');
c := trunc(tsSKin.ClientWidth div 130);
for i := 0 to SkinList.Count - 1 do
begin
with TRadioButton.Create(self) do
begin
parent := tsSkin;
height := 20;
width := 120;
Left := 20 + 130 * (i mod c);
Top := 20 + 30 * (i div c);
Caption := SkinList[i];
if caption = readCfg('Layout', 'SkinFile', '') then
checked := true;
OnClick := selSkinClick;
end;
end;
freeAndNil(skinList);
end;
procedure Tframe_frmLayoutSetup.selSkinClick(Sender: TObject);
var
skinFile: string;
di: integer;
begin
SkinFile := GetAppPath + 'Skins\' + (Sender as TRadioButton).Caption;
if fileexists(skinfile) then
begin
SD.SkinFile := SkinFile;
SD.Active := true;
end
else
begin
sd.active := false;
end;
di := UpdateList.IndexOfName('SkinFile');
if di > -1 then
begin
updateList[di] := 'SkinFile=' + (Sender as TRadioButton).Caption;
end
else
begin
updateList.Add('SkinFile=' + (Sender as TRadioButton).Caption);
end;
// WriteCfg('Layout', 'SkinFile', (Sender as TRadioButton).Caption);
end;
procedure Tframe_frmLayoutSetup.btnOkClick(Sender: TObject);
begin
inherited;
btnApplyClick(nil);
self.Close;
end;
procedure Tframe_frmLayoutSetup.FormDestroy(Sender: TObject);
begin
inherited;
freeAndNil(updateList);
end;
procedure Tframe_frmLayoutSetup.btnApplyClick(Sender: TObject);
var
i: integer;
begin
inherited;
for i := 0 to updateList.Count - 1 do
begin
WriteCfg('Layout', updateList.Names[i], updateList.Values[updateList.Names[i]]);
end;
end;
procedure Tframe_frmLayoutSetup.btnCancelClick(Sender: TObject);
begin
inherited;
self.Close;
end;
procedure Tframe_frmLayoutSetup.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
inherited;
readskin;
end;
procedure Tframe_frmLayoutSetup.GenimgChoice;
var
imgList: TStringList;
sr: TSearchRec;
c, i: integer;
begin
imgList := TStringList.create;
// 按钮图片
imglist.Clear;
if FindFirst(getAppPath + 'img\*.*', faAnyFile, sr) = 0 then
begin
repeat
if (sr.Name <> '.') and (sr.Name <> '..') then
imgList.Add(ExtractFileName(sr.Name));
until FindNext(sr) <> 0;
FindClose(sr);
end;
imgList.Add('无图片');
lstbtnImg.Items.Assign(imgList);
// 按钮工具图片
imglist.Clear;
if FindFirst(getAppPath + 'img\*.*', faAnyFile, sr) = 0 then
begin
repeat
if (sr.Name <> '.') and (sr.Name <> '..') then
imgList.Add(ExtractFileName(sr.Name));
until FindNext(sr) <> 0;
FindClose(sr);
end;
imgList.Add('无图片');
lsttoolbtnImg.Items.Assign(imgList);
// 父交易图片
imgList.Clear;
if FindFirst(getAppPath + 'img\*.*', faAnyFile, sr) = 0 then
begin
repeat
if (sr.Name <> '.') and (sr.Name <> '..') then
imgList.Add(ExtractFileName(sr.Name));
until FindNext(sr) <> 0;
FindClose(sr);
end;
imgList.Add('无图片');
lstTradeImg.items.Assign(imgList);
// 子交易图片
imgList.Clear;
if FindFirst(getAppPath + 'img\*.*', faAnyFile, sr) = 0 then
begin
repeat
if (sr.Name <> '.') and (sr.Name <> '..') then
imgList.Add(ExtractFileName(sr.Name));
until FindNext(sr) <> 0;
FindClose(sr);
end;
imgList.Add('无图片');
lstChildImg.items.Assign(imgList);
// 工具栏图片
imgList.Clear;
if FindFirst(getAppPath + 'img\*.*', faAnyFile, sr) = 0 then
begin
repeat
if (sr.Name <> '.') and (sr.Name <> '..') then
imgList.Add(ExtractFileName(sr.Name));
until FindNext(sr) <> 0;
FindClose(sr);
end;
imgList.Add('无图片');
lsttoolImg.items.Assign(imgList);
freeAndNil(imgList);
end;
procedure Tframe_frmLayoutSetup.lstImgClick(Sender: TObject);
var
itemName, imgFile: string;
di: integer;
lstImg:TListBox;
lstItem:TListBox;
img:Timage;
pre:String;
istart,iLength:Integer;
begin
if UpperCase((Sender as TListBox).Name)=UpperCase('lstbtnImg') then
begin
lstImg:=lstbtnImg; // 项目列表
lstItem:=lstBtn; // 图片列表
img:=imgbtn; // 图片
istart:=5; //项目名字的开始
ilength:=20; //项目名字的长度
pre:=''; //项目名字的前缀
end;
if UpperCase((Sender as TListBox).Name)=UpperCase('lstToolbtnimg') then
begin
lstImg:=lstToolbtnImg; // 项目列表
lstItem:=lsttoolbtn; // 图片列表
img:=imgtoolbtn; // 图片
istart:=5; //项目名字的开始
ilength:=20; //项目名字的长度
pre:='ico'; //项目名字的前缀
end;
if UpperCase((Sender as TListBox).Name)=UpperCase('lsttradeImg') then
begin
lstImg:=lstTradeimg; // 项目列表
lstItem:=lstFatherTrade; // 图片列表
img:=Imgfather; // 图片
istart:=1; //项目名字的开始
ilength:=10; //项目名字的长度
pre:='Father'; //项目名字的前缀
end;
if UpperCase((Sender as TListBox).Name)=UpperCase('lstChildImg') then
begin
lstImg:=lstChildimg; // 项目列表
lstItem:=lstChildTrade; // 图片列表
img:=ImgChild; // 图片
istart:=1; //项目名字的开始
ilength:=10; //项目名字的长度
pre:='Child'; //项目名字的前缀
end;
if UpperCase((Sender as TListBox).Name)=UpperCase('lsttoolImg') then
begin
lstImg:=lstToolimg; // 项目列表
lstItem:=lsttool; // 图片列表
img:=imgtool; // 图片
istart:=1; //项目名字的开始
ilength:=10; //项目名字的长度
pre:='Tool'; //项目名字的前缀
end;
if lstImg.ItemIndex < 0 then exit;
if lstItem.ItemIndex < 0 then exit;
imgFile := GetAppPath + 'img\' + lstimg.Items[lstImg.ItemIndex];
if fileexists(imgFile) then
begin
img.Picture.LoadFromFile(imgFile);
end
else
begin
img.Picture.Bitmap.FreeImage;
img.Canvas.Rectangle(img.Canvas.ClipRect);
end;
itemname := lstItem.Items[lstItem.itemindex];
itemname := copy(itemName, istart, ilength);
itemName :=pre+itemName;
di := UpdateList.IndexOfName(itemName);
if di > -1 then
begin
updateList[di] := itemName + '=' + lstimg.Items[lstImg.ItemIndex];
end
else
begin
updateList.Add(itemName + '=' + lstimg.Items[lstImg.ItemIndex]);
end;
// WriteCfg('Layout', 'SkinFile', (Sender as TRadioButton).Caption);
end;
procedure Tframe_frmLayoutSetup.lstItemClick(Sender: TObject);
var
itemName, imgFile: string;
di: integer;
lstImg:TListBox;
lstItem:TListBox;
img:Timage;
imgname:String;
pre:String;
istart,iLength:Integer;
begin
inherited;
if UpperCase((Sender as TListBox).Name)=UpperCase('lstbtn') then
begin
lstImg:=lstbtnImg; // 项目列表
lstItem:=lstBtn; // 图片列表
img:=imgbtn; // 图片
istart:=5; //项目名字的开始
ilength:=20; //项目名字的长度
pre:=''; //项目名字的前缀
end;
if UpperCase((Sender as TListBox).Name)=UpperCase('lstToolbtn') then
begin
lstImg:=lstToolbtnImg; // 项目列表
lstItem:=lsttoolbtn; // 图片列表
img:=imgtoolbtn; // 图片
istart:=5; //项目名字的开始
ilength:=20; //项目名字的长度
pre:='ico'; //项目名字的前缀
end;
if UpperCase((Sender as TListBox).Name)=UpperCase('lstFathertrade') then
begin
lstImg:=lstTradeimg; // 项目列表
lstItem:=lstFatherTrade; // 图片列表
img:=Imgfather; // 图片
istart:=1; //项目名字的开始
ilength:=10; //项目名字的长度
pre:='Father'; //项目名字的前缀
end;
if UpperCase((Sender as TListBox).Name)=UpperCase('lstChildTrade') then
begin
lstImg:=lstChildimg; // 项目列表
lstItem:=lstChildTrade; // 图片列表
img:=ImgChild; // 图片
istart:=1; //项目名字的开始
ilength:=10; //项目名字的长度
pre:='Child'; //项目名字的前缀
end;
if UpperCase((Sender as TListBox).Name)=UpperCase('lsttool') then
begin
lstImg:=lstToolimg; // 项目列表
lstItem:=lsttool; // 图片列表
img:=imgtool; // 图片
istart:=1; //项目名字的开始
ilength:=10; //项目名字的长度
pre:='Tool'; //项目名字的前缀
end;
if lstItem.ItemIndex < 0 then exit;
itemname := lstItem.Items[lstItem.itemindex];
itemname := copy(itemName, istart, ilength);
itemName :=pre+itemName;
imgname := Readcfg('Layout', itemname, '无图片');
imgFile := GetAppPath + 'img\' + imgname;
if not fileexists(imgFile) then
begin
imgname := '无图片'
end;
lstimg.ItemIndex := lstimg.Items.IndexOf(imgname);
lstimgClick(lstimg);
end;
procedure Tframe_frmLayoutSetup.GenTradeChoice;
var
fatherTradeList: TStringList;
ChildTradeList: TStringList;
sql:String;
procedure genChildTrade(upperseqn: string);
var
mysql: string;
Qry: TDataset;
begin
mysql := ' select a.* from t_tradecode a,t_right b,t_job c,t_employee d '
+ ' where a.upperTradeseqn=:P1 '
+ ' and d.employeeseqn=:P2 '
+ ' and a.tradeseqn=b.tradeseqn '
+ ' and c.jobseqn=b.jobseqn '
+ ' and d.jobseqn=c.jobseqn order by a.tradeid ';
Qry := frame_DM.GenQry;
frame_DM.OPENSQL(Qry, mysql, [upperseqn, SysParam.userseqn]);
if (Qry.RecordCount > 0) then
begin
repeat
if (Qry.fieldByName('ChildFlag').AsString = '2') then
begin
ChildTradeList.Add(Qry.fieldByName('TradeID').AsString
+ ' ' + Qry.fieldByName('TradeName').AsString);
end;
if (Qry.fieldByName('ChildFlag').AsString = '1') then
begin
genChildTrade(Qry.fieldByName('tradeSeqn').AsString);
end;
Qry.Next;
until Qry.Eof;
end;
FreeAndNil(Qry);
end;
begin
fatherTradeList := TStringList.Create;
ChildTradeList := TStringList.Create;
sql := ' select a.* from t_tradecode a,t_TradeCode b,t_right c,t_job d,t_employee e '
+ ' where b.Tradeid=:P1 '
+ ' and e.employeeseqn=:P2 '
+ ' and a.uppertradeseqn=b.tradeseqn '
+ ' and a.tradeseqn=c.tradeseqn '
+ ' and d.jobseqn=c.jobseqn '
+ ' and e.jobseqn=d.jobseqn order by a.tradeid ';
frame_DM.openSQL(GV_Qry, SQL, ['0000000000', SysParam.userseqn]);
if (GV_Qry.RecordCount > 0) then
begin
repeat
fatherTradeList.Add(GV_Qry.fieldByName('TradeID').AsString
+ ' ' + GV_Qry.fieldByName('TradeName').AsString);
genChildTrade(GV_Qry.fieldByName('TradeSeqn').AsString);
GV_Qry.Next;
until GV_Qry.Eof;
end;
lstFatherTrade.items.Assign(fatherTradeList);
lstChildTrade.items.Assign(ChildTradeList);
lsttool.items.Assign(ChildTradeList);
fatherTradeList.Free;
ChildTradeList.Free;
end;
procedure Tframe_frmLayoutSetup.lstbtnImgClick(Sender: TObject);
begin
inherited;
lstImgClick(lstbtnImg);
end;
procedure Tframe_frmLayoutSetup.lstTradeimgClick(Sender: TObject);
begin
inherited;
lstImgClick(lstTradeimg);
end;
procedure Tframe_frmLayoutSetup.lstChildimgClick(Sender: TObject);
begin
inherited;
lstImgClick(lstChildimg);
end;
procedure Tframe_frmLayoutSetup.lsttoolimgClick(Sender: TObject);
begin
inherited;
lstImgClick(lsttoolimg);
end;
procedure Tframe_frmLayoutSetup.lstFatherTradeClick(Sender: TObject);
begin
inherited;
lstItemClick(lstFatherTrade);
end;
procedure Tframe_frmLayoutSetup.lstChildTradeClick(Sender: TObject);
begin
inherited;
lstItemClick(lstChildTrade);
end;
procedure Tframe_frmLayoutSetup.lsttoolClick(Sender: TObject);
begin
inherited;
lstItemClick(lsttool);
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -