systemmgr.pas

文具管理系统 采用VFP数据库编的

unit SystemMgr;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Buttons, StdCtrls, ComCtrls,jpeg, ExtDlgs,inifiles;

type
  TFrmSystemMgr = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    BitBtn1: TBitBtn;
    Label1: TLabel;
    EdtBackGroundPath: TEdit;
    Label2: TLabel;
    EdtBackupPath: TEdit;
    SpeedButton1: TSpeedButton;
    BitBtn3: TBitBtn;
    SpeedButton2: TSpeedButton;
    Bevel1: TBevel;
    BitBtn4: TBitBtn;
    GroupBox1: TGroupBox;
    Image1: TImage;
    OpenPictureDialog1: TOpenPictureDialog;
    BitBtn5: TBitBtn;
    BitBtn7: TBitBtn;
    Panel1: TPanel;
    BtnCompress: TBitBtn;
    Label3: TLabel;
    Panel2: TPanel;
    BitBtn6: TBitBtn;
    ChkDept: TCheckBox;
    ChbGoods: TCheckBox;
    ChkInOutHistory: TCheckBox;
    ChkStock: TCheckBox;
    ChkMonth: TCheckBox;
    Label4: TLabel;
    Label5: TLabel;
    OpenDialog1: TOpenDialog;
    procedure FormCreate(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn5Click(Sender: TObject);
    procedure EdtBackGroundPathChange(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure BtnCompressClick(Sender: TObject);
    procedure BitBtn6Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmSystemMgr: TFrmSystemMgr;
  MyIni:TInifile;

implementation

uses global,main,ShlObj,ShellAPI, ActiveX,dm,login;

{$R *.dfm}

procedure TFrmSystemMgr.FormCreate(Sender: TObject);
var
  Fn,sDefBackupPath:string;

begin
label5.Caption :=SAppname;
fn:=ExtractFilePath(paramstr(0))+'Setup.ini';
sDefBackupPath:=ExtractFilePath(paramstr(0))+'Backup';
self.caption:=SFormSystemMgr ;
MyIni:=TInifile.Create(fn);
EdtBackGroundPath.Text :=MyIni.ReadString('Setup','BackGround','');
EdtBackupPath.Text :=MyIni.ReadString('Setup','Backup',sDefBackupPath);
if fileexists(EdtBackGroundPath.Text) then
  Image1.Picture.LoadFromFile(EdtBackGroundPath.Text);
end;

procedure TFrmSystemMgr.SpeedButton2Click(Sender: TObject);
begin
OpenPictureDialog1.InitialDir :=ExtractFilePath(paramstr(0));
if OpenPictureDialog1.Execute then
  begin
    EdtBackGroundPath.Text :=OpenPictureDialog1.FileName;
    Image1.Picture.LoadFromFile(EdtBackGroundPath.Text);
  end;
end;

procedure TFrmSystemMgr.BitBtn1Click(Sender: TObject);
begin
with FrmMain.Image3 do
  begin
    Visible:=true;
    Picture.LoadFromFile(EdtBackGroundPath.Text);
  end;
MyIni.WriteString('Setup','BackGround',EdtBackGroundPath.Text);
end;

procedure TFrmSystemMgr.BitBtn5Click(Sender: TObject);
begin
FrmMain.Image3.Visible:=False;
MyIni.WriteString('Setup','BackGround','');
end;

procedure TFrmSystemMgr.EdtBackGroundPathChange(Sender: TObject);
begin
BitBtn1.Enabled :=trim(EdtBackGroundPath.Text)<>'';

end;

function BrowseFolder:string;
var
  Info:TBrowseInfo;
  Dir:array[0..256] of char;
  ItemId:PItemIDList;
begin
  with Info do
  begin
    hwndOwner:=Application.Handle; 
    pidlRoot:=nil;
    pszDisplayName:=nil;
    lpszTitle:=PChar(SFormSelectPath);
    ulFlags:=0;
    lpfn:=nil;
    lParam:=0;
    iImage:=1;
  end;
  ItemId:=SHBrowseForFolder(Info);
  SHGetPathFromIDList(ItemId,@Dir);
  Result:=string(Dir);
end;

procedure TFrmSystemMgr.SpeedButton1Click(Sender: TObject);
var
  lpbi: TBrowseInfo;
  pidlStart: PItemIDList;
  Malloc: IMalloc;
  sSelected: string;
  pidlSelected: PItemIDList;
begin
  SHGetSpecialFolderLocation(Handle, $00, pidlStart);
//  SHGetSpecialFolderLocation(Handle, $00, ExtractFilePath(paramstr(0)));
  SHGetMalloc(Malloc);
  with lpbi do
  begin
    hwndOwner := Handle;
    pidlRoot := pidlStart;
    GetMem(pszDisplayName, MAX_PATH);
    lpszTitle := PChar(SFormSelectPath);
    ulFlags := $00000041;
    lpfn := nil;
  end;
  pidlSelected := SHBrowseForFolder(lpbi);
  if pidlSelected <> nil then
  begin
    if SHGetPathFromIDList(pidlSelected, lpbi.pszDisplayName) then
    sSelected := StrPas(lpbi.pszDisplayName);

EdtBackupPath.text:=sSelected;
if trim(EdtBackupPath.text)<>'' then
  MyIni.WriteString('Setup','Backup',EdtBackupPath.text);
end;
end;

procedure TFrmSystemMgr.BtnCompressClick(Sender: TObject);
var
  fn:string;
begin
  fn:=ExtractFilePath(Paramstr(0))+'Data\'+SDefDataBaseName;
  DM_wjckgl.ADOConnt.Close;
  if  CompressDB(fn) then
   if  msgbox(sMsgOptimizeSucceed,STitleConfirm,4)=IDYes then
     Application.Terminate
     else
     DM_wjckgl.ADOConnt.Open
   else
   msgbox(sMsgOptimizeFail,STitleError,1);
  BtnCompress.Enabled :=False; 

end;

procedure TFrmSystemMgr.BitBtn6Click(Sender: TObject);
var
  bDel:boolean ;
begin
if Msgbox(sMsgDeleteConfirm,sTitleConfirm,4)=IDNo then exit;
bDel:=False;
with DM_Wjckgl.ADOQry do
  begin
    close;
    if ChkDept.Checked then
      begin
        sql.Text :=format(SSQLDeleteDataTable,[STDept]);
        execsql;
        bDel:=true;
      end;
    if ChkStock.Checked then
      begin
        sql.Text :=format(SSQLDeleteDataTable,[STDepotStock]);
        execsql;
        bDel:=true;
      end;
    if ChbGoods.Checked then
      begin
        sql.Text :=format(SSQLDeleteDataTable,[STGoodsName]);
        execsql;
        bDel:=true;
      end;
    if ChkMonth.Checked then
      begin
        sql.Text :=format(SSQLDeleteDataTable,[STMonthStock ]);
        execsql;
        bDel:=true;
      end;
    if ChkInOutHistory.Checked then
      begin
        sql.Text :=format(SSQLDeleteDataTable,[STInStockStat]);
        execsql;
        sql.Text :=format(SSQLDeleteDataTable,[STOutStockStat]);
        execsql;
        bDel:=true;
      end;
    close;
  end;
  if bDel then
    msgbox(sMsgDataDeleteOk,sTitleHint,0);
end;

procedure TFrmSystemMgr.BitBtn3Click(Sender: TObject);
var
  sFileName,sBackupFileName,sBackupDir:string;
  wH,wM,wS,wMM:word;
begin
  sFileName:=ExtractFilePath(Paramstr(0))+'Data\'+SDefDataBaseName;
  DecodeTime(now,wH,wM,wS,wMM);
  sBackUpDir:=DateToStr(now)+' '+IntToStr(wh)+IntToStr(wm)+intToStr(ws);
  if not DirectoryExists(EdtBackupPath.text+'\'+sBackUpDir) then
    mkdir(pchar(EdtBackupPath.text+'\'+sBackUpDir));
  sBackupFileName:=EdtBackupPath.text+'\'+sBackUpDir+'\'+SDefDataBaseName;
  copyFile(PChar(sFileName),PChar(sBackupFileName),false);
  if FileExists(sBackupFileName) then
    msgbox(format(sMsgDataBaseBackupOk,[sBackupFileName]),sTitleHint,0);
end;

procedure TFrmSystemMgr.BitBtn4Click(Sender: TObject);
var
  Fn,sDataFile:string;
begin
OpenDialog1.InitialDir :=EdtBackupPath.Text;
OpenDialog1.FileName:=SDefDataBaseName;
OpenDialog1.Filter :='数据库文件|*.mdb';
OpenDialog1.Title :=sFormSelectBackupFile;
if OpenDialog1.Execute then
  Fn:=OpenDialog1.FileName;
if not fileExists(fn) then exit;
DM_wjckgl.ADOConnt.Close;  //关闭连接
sDataFile:=ExtractFilePath(Paramstr(0))+'Data\'+SDefDataBaseName;
showmessage(sDataFile);
showmessage(fn);
try
  DeleteFile(sDataFile);    //删除现有的数据文件
  CopyFile(PChar(Fn),PChar(sDataFile),False);   //将备份的数据文件COPY到数据库目录中
  Msgbox(sMsgRevertOk,sTitleHint,0);
except
  Msgbox(sMsgRevertFail,sTitleError,1);
end;
Application.Terminate;   //终止程序运行
end;

end.