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

📄 frmmain.pas

📁 关于利用DELPHI来进行企业级方案解决的著作的附书源码
💻 PAS
字号:
unit frmMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   ComCtrls, ToolWin, StdCtrls, ImgList, ExtCtrls, DBCtrls, fraTree,
  DBActns, ActnList,db,PubVar, Menus,Quickrpt, ExtActns, ActnMan, ActnCtrls,
  ActnMenus;

type
  TForm1 = class(TForm)
    ImageList1: TImageList;
    FrameTree1: TFrameTree;
    ImageList2: TImageList;
    ActionManager2: TActionManager;
    DataSetInsert2: TDataSetInsert;
    DataSetDelete2: TDataSetDelete;
    DataSetEdit2: TDataSetEdit;
    DataSetCancel2: TDataSetCancel;
    DataSetPost2: TDataSetPost;
    aImp: TAction;
    ActionToolBar1: TActionToolBar;
    aExp: TAction;
    aPrint: TAction;
    aQuit: TAction;
    SendMail1: TSendMail;
    Action1: TAction;
    ActionMainMenuBar1: TActionMainMenuBar;
    procedure FrameTree1Splitter1CanResize(Sender: TObject;
      var NewSize: Integer; var Accept: Boolean);
    procedure FormResize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FrameTree1TreeClick(Sender: TObject);
    procedure aQuitExecute(Sender: TObject);
    procedure aExpExecute(Sender: TObject);
    procedure aImpExecute(Sender: TObject);
    procedure aPrintExecute(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private

  public
  procedure AppException(Sender: TObject; E: Exception);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}
uses
 frmWait, dataModel;

procedure  TForm1.AppException(Sender: TObject;E: Exception);
var tmp,tmp1:String;
	tmpstr:PChar;
	i:Integer;
begin
    tmp:=E.Message;
    HandelException( E);
  // Application.ShowException(E);
end;

procedure TForm1.FrameTree1Splitter1CanResize(Sender: TObject;
  var NewSize: Integer; var Accept: Boolean);
begin
  self.Width:=newsize+445;
  Form1.Refresh;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
FrameTree1.panel1.Width:=self.ClientWidth-455;
end;

procedure TForm1.FormCreate(Sender: TObject);
var errNo:integer;
begin
     mustIMP:=false;
     Application.OnException :=AppException;
     //取注册表系统全程量
     //登录用户窗体
     update;
     StartLoad('正在载入系统,请稍侯...');
     Try
          // 连接数据库
          DM:=TDM.Create(Self);
          DM.MDB.Connected:=False;
          DM.MDB.Connected:=True;
        Except On E: EDatabaseError Do
        Begin
            //处理连接数据库连接出错
          errNo:=HandelException(E) ;
          If errNo=1 Then
            begin
             application.MessageBox('与服务器连接出错','警告',mb_iconinformation);
             Application.Terminate;
             exit;
             end
         end;
     End;
     try
         with dm.Table1 do
         begin
           Open;
           if recordcount=0 then mustIMP:=true;
         end;
      Except On E: EDatabaseError Do
          Begin
            //处理连接数据库连接出错
          errNo:=HandelException(E) ;
          if errNo<>942 then
            begin
              If errNo=1 Then
                begin
                  application.MessageBox('与服务器连接出错','警告',mb_iconinformation);
                  Application.Terminate;
                  exit;
                end
            Else
             Raise;
            end;
          end;
     end;

     if (errNo=942) or (mustIMP) then
     begin
        application.MessageBox('需要导入或恢复单位表!','警告',mb_iconinformation);
        form1.aImpExecute(self);
        Application.Terminate;
     end
     else
     begin
        with dm.Table1 do
         begin
            indexFieldNames:='DWBM';
            active:=true;
         end;
         frameTree1.LoadTree(dm.table1);
     end;
     EndLoad;
     GLogInTime:=now;
end;

procedure TForm1.FrameTree1TreeClick(Sender: TObject);
var

temp,recID:string;
n,m:integer;
curLevel:integer;
begin
  gNode:=FrameTree1.tree.selected;
  n:=Pos('-', gNode.text)-1 ;
  recID:=Copy(gNode.text,1,n);
  gNodeID:=recID;

  if   gNode.text<>'单位字典' then
  begin
   if   recID<>'' then
   begin
    //Locate table record
    with dm.Table1 do
    begin
      Open;
      active:=true;
      FindNearest([recID]);
    end;
    //set TField.EditMask
    curLevel:= FrameTree1.GetNodeLevel(cTreeCodeFormat,recID)+1;
   end
  else
  curLevel:= 1;
  end;
  gNodelevel:=curLevel;
  FrameTree1.FrameDetail1.StaticText1.Caption:=
                '单位字典详细信息(注意:当前节点位置是第'
                +InttoStr(gNodelevel)+'层)';
  {注意:代码为6层,必须限制新增记录的层,以免数据超出范围。}
  {if gNodelevel>5 then  form1.tbNew.Enabled:=False
  else    form1.tbNew.Enabled:=True;
  注意:含有子层的节点(记录)无法删除,
    如果要删除必须先删除子节点(下层记录),以免出现孤记录数据。
  if  gNode.HasChildren then   form1.tbDelete.Enabled:=False
  else   form1.tbDelete.Enabled:=True;   }
end;


procedure TForm1.aQuitExecute(Sender: TObject);
begin
dm.Table1.Close;
close;
end;

procedure TForm1.aExpExecute(Sender: TObject);
begin
 {填写编码}
end;

procedure TForm1.aImpExecute(Sender: TObject);
begin
 {填写编码}
end;

procedure TForm1.aPrintExecute(Sender: TObject);
begin
 {填写编码}
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 {填写编码}
end;

end.

⌨️ 快捷键说明

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