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

📄 frame_umain.~pas

📁 企业信息管理系统程序框架
💻 ~PAS
字号:
unit frame_uMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, frame_uBase, WinSkinData, Menus, StdCtrls, DosMove, db,
  ToolWin, ExtCtrls, ComCtrls, Buttons, jpeg, ImgList, dcfdes, dcddes;

type
  Tframe_frmMain = class(Tframe_frmBase)
    mm: TMainMenu;
    mifile: TMenuItem;
    miExit: TMenuItem;
    misepa: TMenuItem;
    miReLogin: TMenuItem;
    pnlLeft: TPanel;
    btnNavigator: TBitBtn;
    pgc: TPageControl;
    tlb: TToolBar;
    ts: TTabSheet;
    img: TImage;
    miLayOutSetup: TMenuItem;
    btnExit: TToolButton;
    procedure miExitClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure miReLoginClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure pgcResize(Sender: TObject);
    procedure miLayOutSetupClick(Sender: TObject);
    procedure btnNavigatorClick(Sender: TObject);
  protected
    tradeClass: TFormClass; // 当前要调用的窗体,在tradeclick内使用.
    function getTradeID(Sender: TObject): string;
    procedure tradeClick(Sender: TObject); virtual;
  private
    { Private declarations }
    procedure Login(aLoginFlag: Integer);
    procedure showall;
    procedure imgall;
    procedure DestroyTrades;
    procedure resizeTab;
    procedure ChangeTab(Sender: TObject);

  public
    { Public declarations }
  end;
procedure readSkin;
var
  frame_frmMain: Tframe_frmMain;
  frmMainClass:TFormClass;
  SD: TSKinData;
  myDosMove: TDOSMove;
implementation

uses frame_UtilFunc, frame_uLogin, frame_uDM, frame_uLayoutSetup,
  frame_uTradeBase,frame_uBusinessCenter;

{$R *.dfm}



// readSkin
// 功能: 从配置文件读取皮肤

procedure readSkin;
var
  skinName: string;
begin
  skinName := GetAppPath + 'Skins\' + ReadCfg('Layout', 'SkinFile', '');
  if (skinName <> '') then
  begin
    if FileExists(skinName) then
    begin
      sd.SkinFile := skinName;
      sd.Active := true;
    end
    else
    begin
      sd.Active := false;
    end;
  end;
end;

procedure Tframe_frmMain.miExitClick(Sender: TObject);
// 退出程序
begin
  inherited;
  Close;
end;



procedure Tframe_frmMain.FormShow(Sender: TObject);
// 程序显示
begin
  inherited;
  Width := Screen.Width;
  Height := Screen.Height;
  login(normalLogin);
  btnExit.OnClick := tradeClick;
end;





procedure Tframe_frmMain.Login(aLoginFlag: Integer);
// 登陆处理
// aLoginFlag   normallogin正常登陆,relogin重新登陆
var
  myform: Tframe_frmLogin;

begin
  myForm := (frmlogin_Class.create(nil) as Tframe_frmLogin);
  try
    myform.loginFlag := aLoginFlag;
    myform.showmodal;
  finally
    if myform.loginOk then
    begin
      ShowAll;
      imgAll;
      SD.UpdateSkinControl(self);

    end;
    FreeAndNil(myform);
  end;

end;



procedure Tframe_frmMain.miReLoginClick(Sender: TObject);
// 重新登陆
begin
  inherited;
  Login(reLogin);
end;

procedure Tframe_frmMain.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
// 程序退出
begin
  inherited;
  CanClose := QueryDlg('真的要退出' + SysParam.SysName + '吗?', true);
end;




procedure Tframe_frmMain.showall;
// 生成并显示所有业务控件
var
  sql: string;
  mi: tMenuitem;
  leftbtn: TBitBtn;
  ts: TTabSheet;
  btnCount: Integer;
  sb: TSpeedButton;
  procedure genChildMenu(mainmenu: TMenuItem; ts: TTabSheet; upperseqn: string);
  var
    mysql: string;
    Qry: TDataset;
    ami: TMenuItem;
  begin
    sql := ' select a.*,b.rightFlag from t_tradecode a,t_right b '
      + ' where a.upperTradeseqn=:P1 '
      + ' and a.tradeseqn=b.tradeseqn '
      + ' and b.jobseqn=:p2 '
      + ' order by a.tradeseqn ';
    Qry := frame_DM.GenQry;
    frame_DM.openSQL(Qry, SQL, [upperseqn, SysParam.jobseqn]);
    if (Qry.RecordCount > 0) then
    begin
      repeat
        ami := mainmenu;
        if (Qry.fieldByName('ChildFlag').AsString = '1') then
        begin
          genChildMenu(ami, ts, Qry.fieldByName('TradeSeqn').AsString);
        end
        else
        begin
          ami := TMenuItem.Create(mainmenu);
          ami.Caption := Qry.fieldByName('TradeName').AsString;
          ami.OnClick := tradeclick;
          ami.Name := 'Dyna' + qry.fieldByName('TradeID').AsString
            + qry.fieldByName('RightFlag').AsString
            + IntToStr(Integer(ami));
          mainmenu.Add(ami);

          sb := TSpeedButton.Create(self);
          sb.Name := 'Dyna' + qry.fieldByName('TradeID').AsString
            + qry.fieldByName('RightFlag').AsString
            + IntToStr(Integer(sb));
          sb.Parent := ts;
          sb.Left := 20;
          sb.Top := 20;
          sb.Width := 120;
          sb.Height := 120;
          sb.Layout := blGlyphTop;
          sb.Caption := Qry.fieldByName('TradeName').AsString;
          sb.OnClick := tradeclick;

        end;
        Qry.Next;
      until Qry.Eof;
    end;
    FreeAndNil(Qry);
  end;
begin
// 生成并显示所有业务控件
  DestroyTrades;
  sql := ' select a.* ,c.rightFlag from t_tradecode a,t_TradeCode b,t_right c '
    + ' where b.Tradeid=:P1 '
    + ' and a.uppertradeseqn=b.tradeseqn '
    + ' and a.tradeseqn=c.tradeseqn '
    + ' and c.jobseqn=:p2 '
    + '  order by a.tradeseqn ';
  frame_DM.openSQL(GV_Qry, SQL, ['0000000000', SysParam.jobseqn]);
  btnCount := 0;
  if (GV_Qry.RecordCount > 0) then
  begin
    repeat
      mi := TMenuItem.Create(self);
      mi.Name := 'Dyna' + IntToStr(Integer(mi));
      mi.Caption := GV_Qry.fieldByName('TradeName').AsString;
      mm.Items.Add(mi);

      leftbtn := TBitBtn.Create(self);
      leftBtn.Name := 'Dyna' + GV_qry.fieldByName('TradeID').AsString + IntToStr(Integer(leftbtn));
      LeftBtn.Caption := GV_Qry.fieldByName('TradeName').AsString;
      Leftbtn.top := 104 + 42 * btnCount;
      leftbtn.Left := btnNavigator.Left;
      leftbtn.Width := btnNavigator.width;
      leftbtn.Height := btnNavigator.Height;
      leftbtn.Parent := pnlLeft;
      LeftBtn.OnClick := ChangeTab;

      ts := TTabSheet.Create(self);
      ts.Name := 'Dyna' + GV_qry.fieldByName('TradeID').AsString + IntToStr(Integer(ts));
      ts.PageControl := pgc;
      ts.TabVisible := false;

      genChildMenu(mi, ts, GV_Qry.fieldByName('TradeSeqn').AsString);
      GV_Qry.Next;
      btncount := btnCount + 1;
    until GV_Qry.Eof;
  end;
  btnNavigator.Click;
end;

procedure Tframe_frmMain.tradeClick(Sender: TObject);
// 点击交易的公共事件
var
  aForm: Tframe_frmtradeBase;
  clickcomp: Tcomponent;
  seltradeid:String;
begin
  ClickComp := Sender as Tcomponent;
  if clickcomp.Name = 'btnExit' then
  begin
    Self.Close;
    exit;
  end;
  seltradeID := Copy(clickcomp.Name, 5, 10);
  tradeClass:=BusinessCenter.getTradeClass(seltradeid);
  if (tradeClass = nil) then
  begin
    ShowMessage(GetPropValueIncludeSub(clickcomp, 'caption', False) + '---此交易尚未实现!');
    exit;
  end;
  try
    AForm := Tframe_frmTradeBase(TradeClass.create(Application));
    aForm.RequestForm := Self;
    aForm.tradeID := Copy(clickcomp.Name, 5, 10);
    aForm.tradeName := GetPropValueIncludeSub(clickcomp, 'caption', False);
    aForm.tradeRight := Copy(clickcomp.Name, 15, 20);
    aForm.showmodal;
  finally
    FreeAndNil(aForm);
  end;
end;





procedure Tframe_frmMain.DestroyTrades;
// 销毁业务控件
var
  i, j: Integer;
  atab: TTabSheet;
  mycon: TComponent;
begin

  for i := ComponentCount - 1 downto 0 do
  begin
    mycon := Components[i];
    if (Copy(mycon.Name, 1, 4) = 'Dyna') then
    begin
      freeandnil(mycon);
    end;
  end;
  for i := il.Count - 1 downto 2 do
    il.Delete(i);

  if tlb.ButtonCount < 1 then
    tlb.Visible := false;
end;




procedure Tframe_frmMain.ChangeTab(Sender: TObject);
// 更改tab事件
var
  aname: string;
  i: Integer;
begin
  aname := (Sender as TComponent).name;
  for i := 0 to pgc.PageCount - 1 do
  begin
    if copy(pgc.Pages[i].Name, 5, 10) = copy(aname, 5, 10) then
    begin
      pgc.ActivePage := pgc.Pages[i];
    end;
  end;
end;





procedure Tframe_frmMain.btnNavigatorClick(Sender: TObject);
// 导航按钮
begin
  inherited;
  pgc.ActivePage := ts;
end;





procedure Tframe_frmMain.resizeTab;
// tab内按钮位置重排
var
  i, j: integer;
  tab: TwinControl;
  btn: TControl;
  colcount, cleft: Integer;
begin
  // 一个按钮120宽高。
  for i := 0 to pgc.PageCount - 1 do
  begin
    tab := pgc.Pages[i];
    colcount := (tab.ClientWidth - 20 * 2) div 140;
    if colcount = 0 then colcount := 1;
//       cLeft:=(tab.ClientWidth-((colcount-1)*140+120)) div 2;
    cleft := 20;
    for j := 0 to tab.ControlCount - 1 do
    begin
      btn := tab.Controls[j];
      if (btn is TSpeedButton) then
      begin
        btn.Top := 20 + (j div colcount) * 130;
        btn.Left := cleft + (j mod colcount) * 130;
      end;
    end;
  end;
end;

procedure Tframe_frmMain.pgcResize(Sender: TObject);
// pgc 的resize事件
begin
  inherited;
  resizeTab;
end;

procedure Tframe_frmMain.miLayOutSetupClick(Sender: TObject);
// 设置外观属性
var
  myform: TFrame_frmLayoutSetup;
begin
  inherited;
  try
    myForm := TFrame_frmLayoutSetup.Create(Application);
    myForm.ShowModal
  finally
    freeAndNil(myForm);
  end;
end;

procedure Tframe_frmMain.imgall;
// 显示业务按钮图像
var
  i, j: integer;
  btn: TBitBtn;
  sbtn: TSpeedButton;
  tab: TTabSheet;
  imgfile: string;
  aToolButton: TToolButton;
  ii: integer;
  aimg,BIMG: TBITMAP;
  aList: TList;
  bl:double;
  x1,y1:integer;
begin
  ii := 0;

  aList := TList.Create;
  for i := 0 to pnlleft.ControlCount - 1 do
  begin
    if (pnlLeft.Controls[i] is TBitBtn) then
    begin
      Btn := TbitBtn(pnlLeft.Controls[i]);
      if uppercase(copy(btn.Name, 1, 4)) = UpperCase('Dyna') then
      begin
        imgfile := GetAppPath + 'img\' + ReadCfg('Layout', 'Father' + Copy(btn.name, 5, 10), '');
        if fileexists(imgfile) then
        begin
          btn.Glyph.LoadFromFile(imgfile);
        end;
      end;
    end;
  end;
  for i := 0 to pgc.ControlCount - 1 do
  begin
    if (pgc.Controls[i] is TTabSheet) and (UpperCase(pgc.Controls[i].Name) <> UpperCase('ts')) then
    begin
      tab := TTabsheet(pgc.Controls[i]);
      for j := 0 to tab.ControlCount - 1 do
      begin
        if (tab.Controls[j] is TSpeedButton) then
        begin
          sbtn := TSpeedbutton(tab.controls[j]);
          if uppercase(copy(sbtn.Name, 1, 4)) = UpperCase('Dyna') then
          begin
            imgfile := GetAppPath + 'img\' + ReadCfg('Layout', 'Child' + Copy(sbtn.name, 5, 10), '');
            if fileexists(imgfile) then
            begin
              sbtn.Glyph.LoadFromFile(imgfile);
            end;
            imgfile := GetAppPath + 'img\' + ReadCfg('Layout', 'Tool' + Copy(sbtn.name, 5, 10), '');
            if fileexists(imgfile) then
            begin
              aToolButton := TToolButton.Create(Self);
              aToolButton.Caption := sbtn.Caption;
              aToolButton.OnClick := tradeclick;
              aToolButton.Style := tbsbutton;
              aToolButton.Height := 50;
              aToolbutton.Width := 50;
              aToolButton.Name := 'Dyna' + Copy(sbtn.name, 5, 30) + IntToStr(Integer(aToolButton));
              DisToolBtnImg(aToolButton,imgfile);
              aList.Add(aToolButton);
//              Glyph.LoadFromFile(imgfile);
            end;

          end;
        end;
      end;
    end;
  end;

{  // 显示工具按钮:退出图像。
  aToolButton := TToolButton.Create(self);
  aToolButton.Caption := '退出';
  aToolButton.Name := 'btnExit';
  aToolButton.OnClick := tradeclick;
  aToolButton.Style := tbsbutton;
  aToolButton.Height := 50;
  aToolbutton.Width := 50;
  aList.Add(aToolButton);
}
  for i := aList.Count - 1 downto 0 do
  begin
    tlb.InsertControl(alist[i]);
  end;
  if tlb.ButtonCount > 0 then
  begin
    tlb.Visible := True;
    tlb.ShowCaptions := true;
//    tlb.ButtonHeight := 50;
//    tlb.Buttonwidth := 50;
//    tlb.AutoSize := false;
  end;
  aList.Free;
end;

function Tframe_frmMain.getTradeID(Sender: TObject): string;
// 获取交易ID
begin
  Result := Copy(TComponent(Sender).Name, 5, 10);
end;
initialization
  frmMainClass:=Tframe_frmMain;
end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -