main.~pas

Delphi编程┃Delphi数据库编程

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, XPMenu, Menus, ImgList, ComCtrls, ExtCtrls, IniFiles, ComObj;

type
  TMainForm = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    XPMenu1: TXPMenu;
    ImageList1: TImageList;
    MainStatusBar: TStatusBar;
    Image1: TImage;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    DataLinkOpenDialog: TOpenDialog;
    N13: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    N17: TMenuItem;
    N18: TMenuItem;
    procedure N3Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure N8Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure N12Click(Sender: TObject);
    procedure N16Click(Sender: TObject);
    procedure N15Click(Sender: TObject);
    procedure N17Click(Sender: TObject);
  private
    FClientInstance,
    FPrevClientProc : TFarProc;
    procedure ClientWndProc(var Message: TMessage);
    Procedure ShowSystemTime(Sender:Tobject; var Done:boolean);
    function ChildFormTest(FormName :string):boolean;
    procedure MySystemMenu(var msg: twmmenuselect); message WM_SYSCOMMAND;
  public
    function PshowMessage(bt,Pmess :string; lx:integer):boolean;
    procedure SetDataLink(DataFileName :String);
  end;

var
  MainForm: TMainForm;
Const
  SConnectionString = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+
                      '%s; Persist Security Info=True';
implementation

uses login, Mess, about, input, find, DataManager, dataform;

{$R *.dfm}

procedure TMainForm.N3Click(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.N2Click(Sender: TObject);
begin
  LoginForm := TLoginForm.Create(Application);
  LoginForm.ShowModal;
end;

procedure TMainForm.FormCreate(Sender: TObject);
var hmenu : integer;
    DataLinkPath :string;
    Myini :TIniFile;
begin
   Application.OnIdle := ShowSystemtime;
   MainStatusBar.Panels.Items[2].Text :='系统已经正常启动，使用中……';
   //画背景
   FClientInstance := MakeObjectInstance(ClientWndProc);
   FPrevClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
   SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(FClientInstance));
   //写入自己的系统菜单
   hmenu := GetSystemMenu(handle,false);
   AppendMenu(hmenu,MF_SEPARATOR,0,nil);
   AppendMenu(hmenu,MF_STRING,100,'关于...');
   //禁用一些菜单
{   N6.Enabled := false;
   N7.Enabled := false;
   N10.Enabled := false;
   N11.Enabled := false;
   N12.Enabled := false;
}   //设置数据连接属性
   try
     Myini := TIniFile.Create('jeans.ini');
     DataLinkPath := MyIni.ReadString('DataLink','path','');
     SetDataLink(DataLinkPath);
   finally
     Myini.Free;
   end;
end;

function TMainForm.ChildFormTest(FormName: string): boolean;
var i:integer;
    find :boolean;
begin
  find:= false;  //确定是否找到
  if MainForm.MDIChildCount >=1 then
  begin
    for i:=0 to MainForm.MDIChildCount-1 do
    begin
      if MainForm.MDIChildren[i].Caption = FormName then
      begin
        find := true;
        break;
      end;
    end;
  end;

  Result := find;  //找到返回真，找不到回到假
end;

procedure TMainForm.ClientWndProc(var Message: TMessage);
VAR
  MyDC : hDC;
  Ro,Co : Word;
begin
  with Message do
    case Msg of WM_ERASEBKGND:
      begin
        MyDC := TWMEraseBkGnd(Message).DC;
        For Ro := 0 to ClientHeight div Image1.Picture.Height do
          For Co := 0 to ClientWIDTH div Image1.Picture.Width do
            BitBlt(MyDC, Co*Image1.Picture.Width, Ro*Image1.Picture.Height,
              Image1.Picture.Width, Image1.Picture.Height,
              Image1.Picture.Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
        Result := 1;
      end;
    else
      Result := CallWindowProc(FPrevClientProc, ClientHandle, Msg, wParam, lParam);
    end;end;

procedure TMainForm.MySystemMenu(var msg: twmmenuselect);
begin
  if msg.IDItem = 100 then N8Click(nil)
                      else inherited;
end;

procedure TMainForm.ShowSystemTime(Sender: Tobject; var Done: boolean);
begin
  MainStatusBar.Panels.Items[1].Text := DateToStr(Date)+'  '+TimeToStr(Time);
end;

function TMainForm.PshowMessage(bt, Pmess: string; lx: integer): boolean;
begin
  with MessForm do
  begin
    Caption := bt;
    Label1.Caption := Pmess;
    if lx =1 then  SpeedButton2.Visible := true
             else  SpeedButton2.Visible := false;
    ShowModal;
    if Label1.Caption = '确定' then Result := true
                               else Result := false;
  end;

end;

procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if PShowMessage('退出系统','确定要退出系统吗？',1) then
    CanClose := true
  else
    CanClose := false;
end;

procedure TMainForm.N8Click(Sender: TObject);
begin
  AboutForm := TAboutForm.Create(Application);
  AboutForm.ShowModal;
end;

procedure TMainForm.N6Click(Sender: TObject);
begin
  //显示录入界面
  if not ChildFormTest('数据录入') then
    InputForm := TInputForm.Create(Application);
  InputForm.mcEdit.ReadOnly := true;
  InputForm.Show;
end;

procedure TMainForm.N7Click(Sender: TObject);
begin
  //显示输入界面
  if not ChildFormTest('数据查询') then
    FindForm := TFindForm.Create(Application);
  FindForm.Show;
end;

procedure TMainForm.N10Click(Sender: TObject);
begin
  DataManagerForm := TDataManagerForm.Create(application);
  DataManagerForm.Show;
end;

procedure TMainForm.N12Click(Sender: TObject);
var MySaveIni :TInifile;
    DataFileName :string;
begin
  //设置数据连接
  try
    if DataLinkOpenDialog.Execute then
    begin
      if DataLinkOpenDialog.FileName <>'' then
      begin
        DataFileName := DataLinkOpenDialog.FileName;
        SetDataLink(DataFileName);

        MySaveIni := TIniFile.Create('jeans.ini');
        MySaveIni.WriteString('DataLink','path',DataFileName);
        MySaveIni.Free;
        PshowMessage('提示','指定数据库文件成功，已经保存并设置！',0);
      end else
        PshowMessage('提示','没有指定数据库文件，设置过程取消！',0);
    end;
  except
    MySaveIni.Free;
    PshowMessage('系统错误','指定数据库文件失败！',0);
  end;
end;

procedure TMainForm.SetDataLink(DataFileName: String);
var ConString :string;
begin
  //设定ADOConnection的属性
  ConString :=Format(SConnectionString,[DataFileName]);

  MDataForm.DataADOConnection.Connected := false;
  MDataForm.DataADOConnection.ConnectionString :=ConString;
end;

procedure TMainForm.N16Click(Sender: TObject);
var AppPath :string;
    Myini :TiniFile;
begin
  try       //备份数据
    MyIni := TIniFile.Create('jeans.ini');
    MyIni.WriteString('DataBack','BackTime',FormatDateTime('yyyy-mm-dd',Date));
    AppPath := ExtractFilePath(Application.ExeName);
    CopyFile(PChar(AppPath+'jeans.mdb'),PChar(AppPath+'backup.mdb'),true);
    MainForm.PshowMessage('提示','数据已经成功备份！',0);
    MyIni.Free;
  except
    MyIni.Free;
    MainForm.PshowMessage('系统错误','数据备份失败！',0);
  end;
end;

procedure TMainForm.N15Click(Sender: TObject);
var DataLinkPath, STempFileName:string;
    vJE:OleVariant;
    Myini :TiniFile;
begin
 try   //压缩数据
   Myini := TIniFile.Create('jeans.ini');
   DataLinkPath := MyIni.ReadString('DataLink','path','');
 finally
   Myini.Free;
 end;

 STempFileName:=ExtractFilePath(Application.ExeName)+'temp.mdb';
 try
   vJE:=CreateOleObject('DAO.DBEngine.36');
   vJE.CompactDatabase(DataLinkPath,STempFileName);
//   vJE.CompactDatabase(Format(SConnectionString,[DataLinkPath]),
//                       Format(SConnectionString,[STempFileName]));
   CopyFile(PChar(STempFileName),PChar(DataLinkPath),false);
   DeleteFile(STempFileName);
   MainForm.PshowMessage('提示','压缩数据库成功！你可以检查一下数据库的大小。',0);
 except
   MainForm.PshowMessage('系统错误','压缩数据库时发生错误！',0);
 end;
end;

procedure TMainForm.N17Click(Sender: TObject);
var BackDate, AppPath:string;
    MyIni :TIniFile;
begin
    try//恢复数据
      MyIni := TIniFile.Create('jeans.ini');
      BackDate := MyIni.ReadString('DataBack','BackTime','');
    Finally
      MyIni.Free;
    end;

    if BackDate <>'' then
    begin
      if MainForm.PshowMessage('提示','最近一次备份数据的日期是“'+BackDate+
                               '”。'+#13+#13+'如果恢复数据则这日之后的数据都会丢失，是否继续？',1) then
      begin
        try
          MDataForm.DataADOConnection.Connected := false;
          AppPath := ExtractFilePath(Application.ExeName);
          CopyFile(PChar(AppPath+'backup.mdb'),PChar(AppPath+'jeans.mdb'),false);
          MainForm.PshowMessage('提示','数据已经成功恢复！请查对数据！',0);
        except
          MainForm.PshowMessage('系统错误','恢复数据时失败！',0);
        end;
      end;
    end else
      MainForm.PshowMessage('提示','没有备份数据可以使用！',0);
end;

end.