mainfrmex.pas

来自「群星医药系统源码」· PAS 代码 · 共 830 行 · 第 1/2 页

unit MainFrmEx;

interface

uses Windows, Classes, SysUtils, Controls, Forms, IMainFrm, IMainFrmEx, ActnList,
  Menus, Graphics, IniFiles, MConnect, DBClient, ModuleAction,DB, Dialogs,
  DataModules, uGlobal, uDataTypes,ckDBClient, ExtCtrls,StdCtrls,
  RzTabs, RzListVw, ComCtrls,ceGlobal;

type
  TMainFormEx = Class(TComponent, IMainFormEx)
  private
    IFmMain: IMainForm;
    AppPath: String;
    Actions: TActionList;
    ImgList: TImageList;
    MainMenu: TMainMenu;
    NavigationBox: TPanel;
    FNavList: TRzPageControl;
    IniFile: TIniFile;
    FLogonInfo:  TLogonInfo;
    FSvrSetting: TSvrSetting;
    FLocSetting: TLocSetting;
    CdsBillSetting : TCkClientDataSet;
    FFavoritesListView: TRzListView;
    FMousePressed: boolean;
    FCurListView: TRzListView;
    procedure OnAction(Sender: TObject);
    procedure BuildMainMenu;
    Function ReadConnType: Boolean;
    Function ReadUserSetting: Boolean;
    function CreateNavList: TRzPageControl;
    procedure DisplayNavigationData;
    procedure CallModuleFunc(Sender: TObject);
    procedure PressReturnKeyOnListView(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure OnListViewMouseDown(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure OnListViewMouseMove(Sender: TObject;
      Shift: TShiftState; X, Y: Integer);
    procedure OnListViewMouseUp(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure AcceptDragListItems(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure ParentAcceptDragListItems(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure ApplyDragListItems(Sender, Source: TObject; X, Y: Integer);
    procedure OnFavoritesKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure OnNavigationMouseDown(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure OnListViewResize(Sender: TObject);
    procedure OnNavigationChanged(Sender: TObject);
  protected
    dmModules: TdmModules;
    SvrSysManage:TDispatchConnection;
    Function  InitApp: Boolean;
    Function  UserLogon: Boolean;
    Function  ChangePassword: Boolean;
    procedure SynchNativeData;
    Function  GetPrivOfCurrUser(sMFileCName: String): String;
    Function  GetModlsOfUser: TClientDataSet;
    Procedure ReadSetting;
    Procedure SaveSetting;
    procedure ChangeNavigationColor;
    Function GetLogonInfo: PLogonInfo;
    Function GetSvrSetting: PSvrSetting;
    Function GetLocSetting: PLocSetting;
    Function GetClientID: Integer;
  public
    constructor Create(Owner: TComponent); override;
    destructor Destroy; override;
  end;


implementation

uses UserLogonFrm, SetConnTypeFrm,UserSettingFrm;

{ TMainFormEx }

procedure TMainFormEx.BuildMainMenu;
const
  sqStr = 'SELECT ModuleID, ParentID, MenuIndex, MenuName, ModuleFile, FormClassName, DispType, Popedoms, HidePopedom, Remark FROM ModuleSetting WHERE 1=1 ';
  soStr = ' Order By MenuIndex, ModuleID ';

  procedure CreateMenuItem(pMenuItem: TMenuItem);
  var iID, iParentID, iShortCut: Integer;
      sMenuName, sMFileCName, sFilter: String;
      NewAction: TModlAction;
      NewMenuItem: TMenuItem;
      Icon: TBitmap;
      mark1: TBookmark;
      b1: Boolean;
  begin
    if pMenuItem=nil then begin
      iParentID := 0;
      MainMenu.Items.Clear;
      ImgList.Clear;
      while Actions.ActionCount>0 do
        Actions.Actions[0].Free;
    end else begin
      iParentID := pMenuItem.Tag;
      pMenuItem.Clear;
    end;
    with dmModules.cdsModlsOfUser do begin
      Filter := 'ParentID='+IntToStr(iParentID);
      First;
      while not Eof do begin
        iID := FieldByName('ModuleID').AsInteger;
        iShortCut := FieldByName('ShortCut').AsInteger;
        sMenuName := FieldByName('MenuName').AsString;
        sMFileCName := FieldByName('MFileCName').AsString;
        NewMenuItem := TMenuItem.Create(self);
        NewMenuItem.Tag := iID;
        NewMenuItem.Caption := sMenuName;
        if not FieldByName('Icon').IsNull then begin
          Icon := TBitmap.Create;
          Icon.Assign(TBlobField(FieldByName('Icon')));
          IFmMain.ImgList.AddMasked(ICon, Icon.TransparentColor);
          NewMenuItem.ImageIndex := IFmMain.ImgList.Count-1;
        end;
        if pMenuItem=nil then
          MainMenu.Items.Add(NewMenuItem)
        else
          pMenuItem.Add(NewMenuItem);
        b1 := (sMenuName<>'-')and(Length(sMFileCName)>1);
        if b1 then begin
          NewAction := TModlAction.Create(self);
          NewAction.ActionID := iID;
          NewAction.Caption  := sMenuName;
          NewAction.ModuleFile := sMFileCName;
          NewAction.OnExecute  := OnAction;
          NewAction.ActionList := Actions;
          NewAction.ShortCut   := iShortCut;
          NewAction.ImageIndex := NewMenuItem.ImageIndex;
          NewMenuItem.Action   := NewAction;
        end else begin
          if sMenuName<>'-' then begin
            sFilter := Filter;
            Mark1 := GetBookmark;
            CreateMenuItem(NewMenuItem);
            Filter := sFilter;
            GotoBookmark(Mark1);
            FreeBookmark(Mark1);
          end;
        end;
        Next;
      end;
    end;
  end;
begin
  with dmModules.cdsModlsOfUser do begin
    Filter := '';
    Params.Items[0].Value := FLogonInfo.UserID;
    if Active then
      Refresh
    else
      Open;
    Filtered := true;
    CreateMenuItem(nil);
    Filtered := false;
  end;
end;

constructor TMainFormEx.Create(Owner: TComponent);
begin
  FLogonInfo.ClientID := -1;
  IFmMain := Application.MainForm as IMainForm;
  AppPath := ExtractFilePath(Application.ExeName);
  IniFile := TIniFile.Create(IFmMain.IniFileName);
  Actions := IFmMain.ActionList;
  ImgList := IFmMain.ImgList;
  MainMenu:= IFmMain.MainMenu;
  NavigationBox := IFmMain.NavPanel;
  ReadSetting;
end;

destructor TMainFormEx.Destroy;
begin
  Application.MessageBox('MainFormEx.Destroy', '', 0);
  IFmMain.ClosePropConns(Application.MainForm.Handle);
  IniFile.Free;
end;

procedure TMainFormEx.OnAction(Sender: TObject);
begin
  IFmMain.OnAction(Sender);
end;

function TMainFormEx.UserLogon: Boolean;
var b1: Boolean;
    FilePath, sSvrIP: String;
    Ini: TIniFile;
begin
  with TFmUserLogon.Create(Application) do begin
    SvrConn := SvrSysManage;
    if FLogonInfo.AcctName<>'' then
      edAcctName.Text := FLogonInfo.AcctName;
    b1 := ShowModal=mrOK;
    if b1 then begin
      FLogonInfo.ClientID := ClientID;
      FLogonInfo.AcctName := AcctName;
      FLogonInfo.DBConnStr:= DBConnStr;
      FLogonInfo.UserID   := UserID;
      FLogonInfo.Password := UserPasswd;
      FLogonInfo.UserGrupID:=DepartID;
      FLogonInfo.DBScanRange := DBScanRange;
      FLogonInfo.DBModiRange := DBModiRange;
      BuildMainMenu;
      IFmMain.OnUserLogon;
    end;
    Free;
  end;
  Result := b1;
  if Result then  begin
    //判断并显示系统导航
    if Assigned(FNavList) then
      FreeAndNil(FNavList);
    IFmMain.SetNavVisible(FLocSetting.NavVisible);
//    DisplayNavigationData;
    ChangeNavigationColor;
    //完成显示系统导航
    SynchNativeData;
//不再使用旧版的消息浏览器    LogOutMsg;//退出消息服务器
    with dmModules.cdsPublic do
    begin
      Close;
      CommandText := 'select MsgServerIP from SysSetting';
      Open;
      sSvrIP := Fields[0].AsString;
    end;
    if sSvrIP='' then
      Application.MessageBox('请在"系统设置"模块中设置您的消息服务器地址！', '提示', 64);
//不再登录旧版的消息浏览器    LoginMsg(FLogonInfo.UserID, FLogonInfo.AcctName, sSvrIP);//登入消息处理服务器

    FilePath := ExtractFilePath(Application.ExeName); //ego add 把服务器数据和客户端数据写入公共文件
    Ini := TIniFile.Create(FilePath + 'Msg.Dat');
    Ini.WriteString('Logon', 'UserID', FLogonInfo.UserId);
    Ini.WriteString('Logon', 'AccountName', FLogonInfo.AcctName);
    Ini.WriteString('Logon', 'ServerIP', sSvrIP);
    Ini.Free;
  End;
end;

Function TMainFormEx.ReadConnType: Boolean;
var b1: Boolean;
    iConnType: Integer;
    sServers, sIntcptName: String;
begin
  Result := false;
  iConnType := IniFile.ReadInteger('ConnSetting', 'ConnType', -1);
  if iConnType=-1 then begin
    with TFmSetConnType.Create(self) do begin
      b1 := ShowModal=mrOk;
      Free;
      if not b1 then
        Exit;
      iConnType := IniFile.ReadInteger('ConnSetting', 'ConnType', -1);
    end;
  end;
  sServers := IniFile.ReadString('ConnSetting', 'AppServers', '');
  sIntcptName := IniFile.ReadString('ConnSetting', 'InterceptName', '');
  b1 := IniFile.ReadBool('ConnSetting', 'LoadBalanced', false);
  IFmMain.SetAppServer(iConnType, sServers, sIntcptName, b1);
  Result := true;
end;

function TMainFormEx.InitApp: Boolean;
var b1: Boolean;
    str: String;
begin
  Result := false;
  b1 := ReadConnType;
  if b1 and (SvrSysManage=nil) then begin
    try
      SvrSysManage := IFmMain.GetConnection(Application.MainForm.Handle, '','ckSysManager.ModuleSetting');
    except
      on E: Exception do begin
        if E.Message='No server available' then E.Message:='找不到可用的服务器！';
        str := '连接服务器失败，下面是错误信息：'#13+E.Message;
        Application.MessageBox(PChar(str), '错误', 16);
        Exit;
      end;
    end;
    dmModules := TdmModules.Create(self);
    dmModules.cdsModules.RemoteServer := SvrSysManage;
    dmModules.cdsPublic.RemoteServer := SvrSysManage;
    dmModules.cdsModlsOfUser.RemoteServer := SvrSysManage;
  end;
  Result := b1;
end;

function TMainFormEx.GetModlsOfUser: TClientDataSet;
begin
  if dmModules=nil then
    Result := nil
  else
    Result := dmModules.cdsModlsOfUser;
end;

function TMainFormEx.GetPrivOfCurrUser(sMFileCName: String): String;
begin
  Result := '';
  if dmModules=nil then
    raise Exception.Create('Please logon first!');
  if dmModules.cdsModlsOfUser.Locate('MFileCName', sMFileCName, [loCaseInsensitive]) then
    Result := dmModules.cdsModlsOfUser.FieldByName('PrivChar').AsString;
end;

procedure TMainFormEx.ReadSetting;
var str: string;
begin
  FSvrSetting.ConnType:= IniFile.ReadInteger('ConnSetting', 'ConnType', 1);
  FSvrSetting.SvrList := IniFile.ReadString('ConnSetting', 'AppServers', '');
  FSvrSetting.LoadBalanced := IniFile.ReadBool('ConnSetting', 'LoadBalanced', false);
  FSvrSetting.InterceptName:= IniFile.ReadString('ConnSetting', 'InterceptName', '');
  FLocSetting.PacketRecs:=IniFile.ReadInteger('LocaSetting','PacketRecs', 300);
  str := AppPath+'FldLyout.cfg';
  FLocSetting.FieldLayoutCfgFile := IniFile.ReadString('LocaSetting', 'FieldLayoutCfgFile', str);
  FLocSetting.MachineNo := IniFile.ReadInteger('LocaSetting','MachineNo',-1);
  FLocSetting.BranchNo  := IniFile.ReadInteger('LocaSetting','BranchNo',-1);
  FLocSetting.NavVisible:= IniFile.ReadBool('LocaSetting', 'NavVisible', true);
end;

procedure TMainFormEx.SaveSetting;
begin
  IniFile.WriteInteger('ConnSetting', 'ConnType', FSvrSetting.ConnType);
  IniFile.WriteString('ConnSetting', 'AppServers', FSvrSetting.SvrList);
  IniFile.WriteBool('ConnSetting', 'LoadBalanced', FSvrSetting.LoadBalanced);
  IniFile.WriteString('ConnSetting', 'InterceptName', FSvrSetting.InterceptName);
  IniFile.WriteInteger('LocaSetting','PacketRecs',FLocSetting.PacketRecs);
  IniFile.WriteString('LocaSetting', 'FieldLayoutCfgFile', FLocSetting.FieldLayoutCfgFile);
  IniFile.WriteInteger('LocaSetting','MachineNo',FLocSetting.MachineNo);
  IniFile.WriteInteger('LocaSetting','BranchNo',FLocSetting.BranchNo);
  IniFile.WriteBool('LocaSetting', 'NavVisible', FLocSetting.NavVisible);
end;

function TMainFormEx.GetLocSetting: PLocSetting;
begin
  Result := @FLocSetting;
end;

function TMainFormEx.GetSvrSetting: PSvrSetting;
begin
  Result := @FSvrSetting;
end;

function TMainFormEx.GetLogonInfo: PLogonInfo;
begin
  Result := @FLogonInfo;
end;

function TMainFormEx.GetClientID: Integer;
begin
  Result := FLogonInfo.ClientID;
end;

procedure TMainFormEx.SynchNativeData;
var XMLPath: String;
begin
//用服务器下载必须的设置数据保存到本地为xml文档
  CdsBillSetting := TCKClientDataSet.Create(Self);
  CdsBillSetting.ProviderName := 'dspBillSetting';
  CdsBillSetting.RemoteServer := SvrSysManage;
  XMLPath := ExtractFilePath(ParamStr(0))+'XML\';
  if not DirectoryExists(XMLPath) then
    CreateDir(XMLPath);
  CdsBillSetting.Open;
  CdsBillSetting.SaveToFile(XMLPath+'BillSetting.Xml',dfXMLUTF8);
  ReadUserSetting;
end;

function TMainFormEx.ReadUserSetting: Boolean;
var iBranchNo: Integer;
begin
//  Result := false;
  iBranchNo := IniFile.ReadInteger('LocaSetting','BranchNo',-1);
  While iBranchNo=-1 Do Begin
    With TFmUserSetting.Create(self) do begin
      Hide;
      ShowModal;
      Free;
      iBranchNo := IniFile.ReadInteger('LocaSetting','BranchNo',-1);
    End;
  End;
  Result := true;
End;

function TMainFormEx.ChangePassword: Boolean;
var str, str1: String;
begin
  Result := false;
  if not xInputQuery('更改口令', '请输入新口令：', str, '*') then Exit;
  if not xInputQuery('更改口令', '请再次确认新口令：', str1, '*') then Exit;
  if str<>str1 then
  begin
    Application.MessageBox('两次输入的口令不符！', '消息', 64);
    Exit;
  end;
  if SvrSysManage.AppServer.ChangePassword(FLogonInfo.ClientID, FLogonInfo.UserID, FLogonInfo.Password, str1) then
  begin
    FLogonInfo.Password := str;//由于上面传入的str1的值会作为错误信息返回所以这里一定要用str
    Application.MessageBox('您的口令已经修改，请记住新口令！', '消息', 64);
    Result := true;
  end
  else
    Application.MessageBox(PChar('口令修改失败，你只能继续使用原口令！'#13+str), '消息', 16);
end;

//建立导航图
function TMainFormEx.CreateNavList: TRzPageControl;
begin
  Result := TRzPageControl.Create(NavigationBox);
  with Result do begin