runmain.pas

详细说明:毕业论文中关于小型宾馆管理系统的详细设计毕 业论文中关于小型宾馆...一个酒店管理系统VB+Access [学生学籍管理系统(VB+Acess).zip] - !这个是刚刚编的毕业设计,可能

unit runmain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls,utils,shellapi,clipbrd, Buttons,registry,list, ComCtrls,
  OleCtnrs, jpeg;

type
  TfrmRun = class(TForm)
    l11: TLabel;
    Panel1: TPanel;
    l6: TLabel;
    l7: TLabel;
    Panel2: TPanel;
    Bevel1: TBevel;
    Button1: TButton;
    Button2: TButton;
    Image1: TImage;
    Image6: TImage;
    l0: TLabel;
    Bevel2: TBevel;
    Bevel4: TBevel;
    Bevel10: TBevel;
    Panel4: TPanel;
    Image2: TImage;
    Image3: TImage;
    L12: TLabel;

    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure ClearColor;



    procedure l0MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure l0Click(Sender: TObject);



    procedure l5Click(Sender: TObject);
    procedure l6Click(Sender: TObject);
    procedure l6MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure l7MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure l7Click(Sender: TObject);


    procedure l11MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure l11Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure Install;



    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure L12MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure L12Click(Sender: TObject);
  private
      function WinExecAndWait32(FileName:String; Visibility : integer):Integer;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmRun: TfrmRun;

implementation

{$R *.DFM}



procedure TfrmRun.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 ClearColor;

end;

procedure TfrmRun.ClearColor;
begin




  l0.font.color:=clBlack;


  //l6.Font.color:= clGray;
  l7.Font.color:= clGray;


  l11.Font.color:=clBlack;
  L12.FONT.COLOR:=clBlack;
end;




procedure TfrmRun.l0MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  ClearColor;
  l0.Font.color:= clBlue ;
  l0.Cursor:=crHandPoint;

end;

procedure TfrmRun.l0Click(Sender: TObject);
begin

  Install;

end;

procedure TfrmRun.Install;
var str:string;
    r:integer;
begin

   Str:=ExtractFilePath(Application.ExeName)+'xwfd\Setup.exe';
   try

      r:=utils.WinExec32(PChar(str), SW_SHOWDEFAULT);
      if r<>0 then begin
         Application.MessageBox('安装程序没找到', PChar(str), mb_OK)
      end;
   except
      MessageDlg('安装失败!',mtWarning,[mbOK],0);
   end;



end;


procedure TfrmRun.l5Click(Sender: TObject);
begin

 ShellExecute(Application.Handle,nil,Pchar(ExtractFilePath(Application.ExeName)
 +'Install.TXT'), nil,nil,SW_NORMAL);
end;

procedure TfrmRun.l6Click(Sender: TObject);
begin
ShellExecute(Application.Handle,nil,Pchar('http://www.xuanwu.com'),
               nil,nil,SW_NORMAL);
end;


procedure TfrmRun.l6MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  //l6.Font.color:= clBlack;
  l6.Cursor:=crHandPoint;
end;

procedure TfrmRun.l7MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  l7.Font.color:= clBlack;
  l7.Cursor:=crHandPoint;
end;

procedure TfrmRun.l7Click(Sender: TObject);
begin
 Close;
end;



procedure TfrmRun.l11MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  ClearColor;
  l11.Font.color:= clBlue ;
  l11.Cursor:=crHandPoint;

end;

procedure TfrmRun.l11Click(Sender: TObject);
var str:string;
    r:integer;

begin

   Str:=ExtractFilePath(Application.ExeName)+'XWFD\Setupdb.exe';
   try
      r:=WinExecAndWait32(str, SW_SHOWDEFAULT); //utils.WinExec32(PChar(str), SW_SHOWDEFAULT);
      if r<>0 then begin
         Application.MessageBox('安装程序未找到', PChar(str), mb_OK)
      end;
   except
      MessageDlg('安装失败!',mtWarning,[mbOK],0);
   end;
end;
//
function TfrmRun.WinExecAndWait32(FileName:String; Visibility : integer):Integer;
var
  zAppName:array[0..512] of char;
  zCurDir:array[0..255] of char;
  WorkDir:String;
  StartupInfo:TStartupInfo;
  ProcessInfo:TProcessInformation;
  ExitCode: DWORD;
begin
  StrPCopy(zAppName,FileName);
  GetDir(0,WorkDir);
  StrPCopy(zCurDir,WorkDir);
  FillChar(StartupInfo,Sizeof(StartupInfo),#0);
  StartupInfo.cb := Sizeof(StartupInfo);

  StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow := Visibility;
  if not CreateProcess(nil,
    zAppName,                      { pointer to command line string }
    nil,                           { pointer to process security attributes }
    nil,                           { pointer to thread security attributes }
    false,                         { handle inheritance flag }
    CREATE_NEW_CONSOLE or          { creation flags }
    NORMAL_PRIORITY_CLASS,
    nil,                           { pointer to new environment block }
    nil,                           { pointer to current directory name }
    StartupInfo,                   { pointer to STARTUPINFO }
    ProcessInfo) then Result := -1 { pointer to PROCESS_INF }

  else begin
    WaitforSingleObject(ProcessInfo.hProcess,INFINITE);
    GetExitCodeProcess(ProcessInfo.hProcess, ExitCode);
    Result:=ExitCode;
  end;
end;


procedure TfrmRun.SpeedButton1Click(Sender: TObject);
begin
 Close;
end;

procedure TfrmRun.Button1Click(Sender: TObject);
begin
 Close;
end;

procedure TfrmRun.Button3Click(Sender: TObject);
begin
  ShellExecute(Application.Handle,nil,Pchar('readme.htm'),
               nil,nil,SW_NORMAL);
end;

procedure TfrmRun.L12MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
ClearColor;
  l12.Font.color:= clBlue ;
  l12.Cursor:=crHandPoint;

end;

procedure TfrmRun.L12Click(Sender: TObject);
var str:string;
    r:integer;

begin

   Str:=ExtractFilePath(Application.ExeName)+'XWFD\SetupADO.exe';
   try
      r:=WinExecAndWait32(str, SW_SHOWDEFAULT); //utils.WinExec32(PChar(str), SW_SHOWDEFAULT);
      if r<>0 then begin
         Application.MessageBox('安装程序未找到', PChar(str), mb_OK)
      end;
   except
      MessageDlg('安装失败!',mtWarning,[mbOK],0);
   end;

end;

end.