⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frame_ulayoutsetup.pas

📁 企业信息管理系统程序框架
💻 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 + -