unit2.pas

本系统在一些大中型企业(跨多达24个区域)一直都在很好的服务过

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db, DBClient,filectrl, ExtCtrls, ComCtrls, Grids, DBGrids, StdCtrls, Buttons,
  Menus,
 TB97, ArchiverRoot, CustExtractor, CustArchiver, Archiver,
 MPlayer, MPEGPlayer, AMixer,  lmdclass, lmdnonvS, lmdctrl, lmdstdcS,
  cmpGFXComboBox;

type
  TForm2 = class(TForm)
    DataSource1: TDataSource;
    StatusBar1: TStatusBar;
    Timer1: TTimer;
    SaveDialog1: TSaveDialog;
    MainMenu1: TMainMenu;
    O1: TMenuItem;
    E1: TMenuItem;
    H1: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N10: TMenuItem;
    PopupMenu2: TPopupMenu;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    N17: TMenuItem;
    N20: TMenuItem;
    N21: TMenuItem;
    N22: TMenuItem;
    N23: TMenuItem;
    N24: TMenuItem;
    N25: TMenuItem;
    Panel2: TPanel;
    DBGrid1: TDBGrid;
    Panel7: TPanel;
    Memo1: TMemo;
    Dock971: TDock97;
    Toolbar971: TToolbar97;
    Panel8: TPanel;
    Image2: TImage;
    SpeedButton16: TSpeedButton;
    SpeedButton17: TSpeedButton;
    SpeedButton18: TSpeedButton;
    Label7: TLabel;
    Label8: TLabel;
    Toolbar972: TToolbar97;
    Toolbar973: TToolbar97;
    Panel6: TPanel;
    Image1: TImage;
    SpeedButton23: TSpeedButton;
    Panel9: TPanel;
    Image3: TImage;
    SpeedButton19: TSpeedButton;
    SpeedButton20: TSpeedButton;
    SpeedButton21: TSpeedButton;
    Dock972: TDock97;
    Toolbar974: TToolbar97;
    Panel1: TPanel;
    Label4: TLabel;
    SpeedButton9: TSpeedButton;
    SpeedButton10: TSpeedButton;
    SpeedButton11: TSpeedButton;
    SpeedButton12: TSpeedButton;
    G1: TMenuItem;
    N3: TMenuItem;
    N11: TMenuItem;
    N26: TMenuItem;
    N27: TMenuItem;
    N28: TMenuItem;
    N29: TMenuItem;
    N30: TMenuItem;
    N31: TMenuItem;
    OpenDialog1: TOpenDialog;
    Archiver1: TArchiver;
    width1: TMemo;
    Panel10: TPanel;
    Image5: TImage;
    N32: TMenuItem;
    S1: TMenuItem;
    N33: TMenuItem;
    Mixer: TAudioMixer;
    MPlayer: TMPEGPlayer;
    CD011: TMenuItem;
    CD021: TMenuItem;
    CD031: TMenuItem;
    CD041: TMenuItem;
    C1: TMenuItem;
    ColorDialog1: TColorDialog;
    LMDSysInfo1: TLMDSysInfo;
    N34: TMenuItem;
    N35: TMenuItem;
    Image4: TImage;
    Sendbt: TSpeedButton;
    N38: TMenuItem;
    GFXComboBox1: TGFXComboBox;
    LMDSimpleLabel1: TLMDSimpleLabel;
    ImageList1: TImageList;
    N9: TMenuItem;
    N36: TMenuItem;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure DataSource1DataChange(Sender: TObject; Field: TField);
    procedure Timer1Timer(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton9Click(Sender: TObject);
    procedure SpeedButton10Click(Sender: TObject);
    procedure SpeedButton11Click(Sender: TObject);
    procedure SpeedButton12Click(Sender: TObject);
    procedure DBGrid1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure SpeedButton5Click(Sender: TObject);
    procedure SpeedButton6Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure N24Click(Sender: TObject);
    procedure N25Click(Sender: TObject);
    procedure SpeedButton8Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure SpeedButton14Click(Sender: TObject);

    procedure N5Click(Sender: TObject);
     procedure SpeedButton16Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure N26Click(Sender: TObject);
    procedure N28Click(Sender: TObject);
    procedure N30Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Archiver1DeleteFile(Sender: TObject;
      const FileEntry: TFileEntry; var Accept: Boolean);
    procedure N32Click(Sender: TObject);
    procedure N33Click(Sender: TObject);
    procedure CD011Click(Sender: TObject);
    procedure CD021Click(Sender: TObject);
    procedure CD031Click(Sender: TObject);
    procedure CD041Click(Sender: TObject);
    procedure N34Click(Sender: TObject);
    procedure N35Click(Sender: TObject);
    procedure SendbtClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure GFXComboBox1Change(Sender: TObject);
    procedure N36Click(Sender: TObject);
  private
     MsExcel:Variant;
     MsExcelWorkBook:Variant;
     MsExcelWorkSheet:Variant;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

uses Unit1,comobj, Unit5, Unit4, REMain1,Reabout, sendUnit, handUnit;

{$R *.DFM}

var
copy:array[0..20] of Variant;
dir:string;

  y:word;
m:word;
d:word;
Fdate:Tdatetime;
procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
var
ret:integer;
begin


      if  not form4.ClientDataSet1.IsEmpty then
     begin
      ret:=application.MessageBox('当前录入数据是否要暂存?如果你需要并已经暂存则可以选择取消,否则当前这些数据可能丢失!!','备份选项',MB_OKCANCEL+MB_DEFBUTTON2+MB_ICONQUESTION);
        if ret=1 then
          begin
                 form4.ClientDataSet1.SaveToFile(trim('c:\NewStar\Save\'+form4.name.Lines.Text+label4.Caption)+'.sav');

          end;
     end;
     form4.ClientDataSet1.Close;
     form4.ClientDataSet1.FieldDefs.Clear;
     form4.Label2.Caption:='true';
     mainform.Close;
     form1.Enabled:=true;


try
  If form2.Mixer.MixerCount>0 then
  begin
{======================}
      try
       if form2.MPlayer.Mode>2 then
        begin
            form2.MPlayer.Close;
        end;
      except
      end;
  end;
except
end;

end;

procedure TForm2.DataSource1DataChange(Sender: TObject; Field: TField);
begin
StatusBar1.Panels[1].text:=inttostr(form4.ClientDataSet1.RecNo);;

end;





procedure TForm2.Timer1Timer(Sender: TObject);
begin
label7.Caption:=datetostr(date);
label8.Caption:=timetostr(time);

end;

procedure TForm2.SpeedButton16Click(Sender: TObject);
begin

memo1.Visible:=not memo1.Visible;
panel7.Visible:=not panel7.Visible;
if memo1.Visible then
begin
    n10.Checked:=true;
    SpeedButton16.Caption:='返回';

end else
begin
     n10.Checked:=false;
    SpeedButton16.Caption:='帮助';
end;
end;


procedure TForm2.SpeedButton3Click(Sender: TObject);
VAR
RET: INTEGER;
begin

if  not form4.ClientDataSet1.IsEmpty then
begin
ret:=application.MessageBox('确定要暂存数据？ 注：暂存数据只是暂时保存，要想真正保存请按结束按钮并输入合法密码才能真正保存?','暂存选项',MB_OKCANCEL+MB_DEFBUTTON2+MB_ICONQUESTION);
if ret=1 then
begin
 //showmessage(trim('c:\NewStar\Save\'+form4.name.Lines.Text+label4.Caption+'.sav'));
 form4.ClientDataSet1.SaveToFile(trim('c:\NewStar\Save\'+form4.name.Lines.Text+label4.Caption)+'.sav');

end;
end else
begin
 showmessage('系统已经检测到你所暂存的数据库是空库，此项操作不将执行!!');
end;

end;

procedure TForm2.SpeedButton2Click(Sender: TObject);
VAR
RET: INTEGER;
begin
if not form4.ClientDataSet1.IsEmpty then
begin
ret:=application.MessageBox('确定要读取暂存数据，此项操作将使当前数据丢失?','读取选项',MB_OKCANCEL+MB_DEFBUTTON2+MB_ICONQUESTION);
if ret=1 then
begin
 if fileexists(trim('c:\NewStar\Save\'+form4.name.Lines.Text+label4.Caption)+'.sav') then
 begin
 form4.ClientDataSet1.LoadFromFile(trim('c:\NewStar\Save\'+form4.name.Lines.Text+label4.Caption)+'.sav');
 // showmessage('读取暂存数据完毕！！！');
 end else
 begin
  showmessage('不能读取暂存数据，可能它还未保存！！！');
 end;
end;
end
else
begin
 if fileexists(trim('c:\NewStar\Save\'+form4.name.Lines.Text+label4.Caption)+'.sav') then
 begin
 form4.ClientDataSet1.LoadFromFile(trim('c:\NewStar\Save\'+form4.name.Lines.Text+label4.Caption)+'.sav');
 // showmessage('读取暂存数据完毕！！！');
 end else
 begin
  showmessage('不能读取暂存数据，可能它还未保存！！！');
 end;
end;

end;

procedure TForm2.SpeedButton9Click(Sender: TObject);
begin

form4.ClientDataSet1.Prior;
end;

procedure TForm2.SpeedButton10Click(Sender: TObject);
begin
form4.ClientDataSet1.Next;
end;

procedure TForm2.SpeedButton11Click(Sender: TObject);
VAR
RET: INTEGER;
begin
ret:=application.MessageBox('确定要删除此项数据?','删除选项',MB_OKCANCEL+MB_DEFBUTTON2+MB_ICONQUESTION);
if ret=1 then
begin

    IF  NOT form4.ClientDataSet1.IsEmpty THEN
          BEGIN
            form4.ClientDataSet1.Delete;
          END;
END;
end;

procedure TForm2.SpeedButton12Click(Sender: TObject);
var
i:integer;
t:variant;
begin
  form2.label4.Caption:=trim(form2.label4.Caption);
  form4.name.Lines.Text:=trim(form4.name.Lines.Text);

if not form4.ClientDataSet1.IsEmpty then
begin
showmessage('系统将自动检测你所录入的数据库字母部分是否有小写，并自动更该为大写!');
form4.ClientDataSet1.First;
WHILE NOT form4.ClientDataSet1.EOF do
  begin
     for i:=0 to form4.ClientDataSet1.FieldCount-1 do
        begin
          if form4.ClientDataSet1.FieldDefs[i].datatype=ftstring then
            begin
               T:=form4.ClientDataSet1.Fields[i].AsString;
               form4.ClientDataSet1.Edit;
                form4.ClientDataSet1.Fields[i].Value:=uppercase(T);

            end;
        end;
 form4.ClientDataSet1.Next;
  end;
 {=======================================}
 handform := Thandform.Create( Application );
      try
       handform.Show;
       handform.Update;
      except
       end;

{=======================================}


end else
begin
 showmessage('系统已经检测到你想要提交的数据库是空数据库，提交将不能进行!!!');
end;
end;



procedure TForm2.DBGrid1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 {============}
  if dbgrid1.EditorMode then
   begin
    if key=39 then
      if (activeControl is TDBGRID) then
      with  TDBGRID(ACTIVECoNTROL) do
      if selectedindex <(fieldcount-1) then
      selectedindex :=selectedindex+1
      else
      selectedindex:=0;
    end;
   {===============}
   if dbgrid1.EditorMode then
   begin
    if key=37 then
      if (activeControl is TDBGRID) then
      with  TDBGRID(ACTIVECoNTROL) do
      if selectedindex >(0) then
      selectedindex :=selectedindex-1
      else
      selectedindex:=fieldcount-1;
    end;
   {===============}

end;

procedure TForm2.SpeedButton5Click(Sender: TObject);
var
i:integer;
begin
for i:=0 to form4.ClientDataSet1.FieldCount-1 do
begin
copy[i]:=form4.ClientDataSet1.Fields[i].Value;
end;

end;

procedure TForm2.SpeedButton6Click(Sender: TObject);
var
i:integer;
begin
form4.ClientDataSet1.Insert;
for i:=0 to form4.ClientDataSet1.FieldCount-1 do
begin
form4.ClientDataSet1.Edit;
form4.ClientDataSet1.Fields[i].Value:=copy[i];
end;


end;

procedure TForm2.SpeedButton4Click(Sender: TObject);
var
i:integer;
begin
if  not form4.ClientDataSet1.IsEmpty then
begin
for i:=0 to form4.ClientDataSet1.FieldCount-1 do
begin
copy[i]:=form4.ClientDataSet1.Fields[i].Value;
end;
form4.ClientDataSet1.Delete;
end;
end;

procedure TForm2.N24Click(Sender: TObject);
var
C:variant;
begin
c:=form4.ClientDataSet1.Fields[DBGriD1.SelectedIndex].Value;
while not form4.ClientDataSet1.EOF do
begin
form4.ClientDataSet1.Edit;
form4.ClientDataSet1.Fields[DBGriD1.SelectedIndex].Value:=c;
form4.ClientDataSet1.Next;
end;

end;

procedure TForm2.N25Click(Sender: TObject);
var

C:variant;
begin
while not form4.ClientDataSet1.EOF do
begin
form4.ClientDataSet1.Edit;
form4.ClientDataSet1.Fields[DBGriD1.SelectedIndex].Value:=c;
form4.ClientDataSet1.Next;
end;
end;

procedure TForm2.SpeedButton8Click(Sender: TObject);
var
i:integer;
j:integer;
C:string;

begin
if not form4.ClientDataSet1.IsEmpty then
begin

 try
        MsExcel:=CreateOleObject('Excel.Application');
        MsExcelWorkBook:=MsExcel.WorkBooks.Add;
        MsExcelWorkSheet:=MsExcel.WorkSheets.Add;
    except
        MessageDlg('启动Excel 97出现异常！！请检查你的机器内是否安装OFFICE97？',mtWarning,[mbOK],0);
        exit;
   end;

   MsExcel.Visible:=True;
  {+========================================+}

      form4.ClientDataSet1.First;
      for I:=0 to   form4.ClientDataSet1.FieldCount-1 do
      begin
        if i=0 then C:='A';
           if i=1 then C:='B';
           if i=2 then C:='C';
           if i=3 then C:='D';
           if i=4 then C:='E';
           if i=5 then C:='F';
           if i=6 then C:='G';
           if i=7 then C:='H';
           if i=8 then C:='I';
           if i=9 then C:='J';
           if i=10 then C:='K';
           if i=11 then C:='L';
           if i=12 then C:='M';
           if i=13 then C:='N';
           if i=14 then C:='O';
           if i=15 then C:='P';
           if i=16 then C:='K';
           if i=17 then C:='R';
           if i=18 then C:='S';
           if i=19 then C:='T';
           if i=20 then C:='U';
           if i=21 then C:='V';
           if i=22 then C:='W';
           if i=23 then C:='X';
           if i=24 then C:='Y';