usedll.pas

初学DELPHI编写的“奖学金评定系统”

unit useDLL;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ActiveX,inifiles, ComCtrls, ExtCtrls, AppEvnts, DB,
  ADODB, Menus, ExcelXP, OleServer;

type
  TMainForm = class(TForm)
    StatusBar1: TStatusBar;
    Panel1: TPanel;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    ExcelWorksheet1: TExcelWorksheet;
    ExcelApplication1: TExcelApplication;
    ExcelWorkbook1: TExcelWorkbook;
    ExcelWorkbook2: TExcelWorkbook;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    Help1: TMenuItem;
    About1: TMenuItem;
    N18: TMenuItem;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    TabSheet4: TTabSheet;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Button1: TButton;
    Button9: TButton;
    Button2: TButton;
    Button3: TButton;
    ApplicationEvents1: TApplicationEvents;
    ADOQuery1: TADOQuery;
    Panel5: TPanel;
    Panel4: TPanel;
    ProgressBar1: TProgressBar;
    Panel3: TPanel;
    Label1: TLabel;
    Label3: TLabel;
    Label2: TLabel;
    RichEdit1: TRichEdit;
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure Button10Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure N10Click(Sender: TObject);
    procedure N15Click(Sender: TObject);
    procedure N16Click(Sender: TObject);
    procedure N18Click(Sender: TObject);
  //  procedure ApplicationEvents1Message(var Msg: tagMSG;
  //    var Handled: Boolean);
    procedure FormCreate(Sender: TObject);


  private
    { Private declarations }
  public
    { Public declarations }

  end;

  TThd = class(TThread)
  protected
    procedure Execute; override;
    function exec(): boolean;virtual;abstract;
  public
    constructor create();
  end;

  TTotal = class(TThd)
  protected
    function exec(): boolean;override;
  end;

  TXueJiCL = class(TThd)
  protected
    function exec(): boolean;override;
  end;

  TChengJiCL = class(TThd)
  protected
    function exec(): boolean;override;
  end;

  TdyzhCLAuto = class(TThd)
  protected
    function exec(): boolean;override;
  end;

  TAddData = class(TThd)
  protected
    function exec(): boolean;override;
  end;

  TOutput = class(TThd)
  protected
    function exec(): boolean;override;
  end;
var
  MainForm: TMainForm;
  cs: TRTLCriticalSection;

implementation
{$R *.dfm}
uses display, Unit9, zhUnit, configUnit, kcUnit, dbmodule;

procedure TMainForm.Button8Click(Sender: TObject);
var
  EChengJiCL:TChengJiCL;
begin
  try
    button6.Enabled:= false;
    update;
    EChengJiCL:= TChengJiCL.create;
  except
       messagedlg('线程未创建成功，程序将自动关闭',mterror,[mbok],0);
    application.Terminate;
  end;
end;

procedure TMainForm.Button9Click(Sender: TObject);
var
  EAddData: TAddData;
begin
  try
  button6.Enabled:= false;
  EAddData:= TAddData.create;
  except
      showmessage('线程未创建成功，程序将自动关闭');
    application.Terminate;
  end;
end;

procedure TMainForm.Button10Click(Sender: TObject);
begin
  free;
  exit;
end;

procedure TMainForm.Button7Click(Sender: TObject);
var
  EXueJiCL:TXueJiCL;
begin
  try
    button7.Enabled:= false;
    button6.Enabled:= false;
    EXueJiCL:= TXueJiCL.create;
  except
    showmessage('线程未创建成功，程序将自动关闭');
    application.Terminate;
  end;

end;

procedure TMainForm.Button6Click(Sender: TObject);
var
  ETotal: TTotal;
begin
  try
    button6.Enabled:= false;
    button1.Visible:= false;
    button7.Visible:= false;
    button8.Visible:= false;
    button9.Visible:= false;
    ETotal:= TTotal.create();
  except
    showmessage('线程未创建成功，程序将自动关闭');
    application.Terminate;
  end;
end;

procedure TMainForm.Button1Click(Sender: TObject);
var
  EdyzhCLAuto:TdyzhCLAuto;
begin
  try
    button6.Enabled:= false;
    EdyzhCLAuto:= TdyzhCLAuto.create;
  except
    showmessage('线程未创建成功，程序将自动关闭');
    application.Terminate;
  end;
end;

procedure TMainForm.Button2Click(Sender: TObject);
var
  form2: tdisplayForm2;
  EXueJiCL:TXueJiCL;
begin
  form2:= tdisplayForm2.Create(application);
  with form2 do begin
    caption:= '"学籍成绩"数据表';
    visible:= true;
    with adoquery1 do begin
      sql.Clear;
      sql.Add('select * from 学籍成绩');
      open;
    end;
  end;
end;

procedure TMainForm.Button3Click(Sender: TObject);
var
  EOutput: TOutput;
begin
  try
    EOutput:= TOutput.create;
  except
    showmessage('线程未创建成功，程序将自动关闭');
    application.Terminate;
    end;
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
var
  textfile1: textfile;
  filename: string;
begin
try
  CreateDirectory(PChar(ExtractFilePath(ParamStr(0))+'log'),nil);
  filename:= ExtractFilePath(paramstr(0))+'log\'+datetostr(date)+'.txt';
  assignfile(textfile1,filename);
  if fileexists(filename) then
    append(textfile1)
  else
    rewrite(textfile1);

  write(textfile1,#13+richedit1.text);
  closefile(textfile1);
finally

  free;
  application.Terminate;
end;
end;

procedure TMainForm.N10Click(Sender: TObject);
begin
  dyzhCL();
end;

procedure TMainForm.N15Click(Sender: TObject);
var
  dlg: TPagesDlg;
begin
  application.CreateForm(TPagesDlg,dlg);
end;

procedure TMainForm.N16Click(Sender: TObject);
begin
close;
end;

procedure TMainForm.N18Click(Sender: TObject);
var
  kcform1: tkcform1;
begin
  application.CreateForm(tkcform1,kcform1);
end;
{
procedure TMainForm.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
var hWnd: THandle; aName: array [0..255] of char;

begin
    //给DBGrid加上鼠标滚轮
    if Msg.message <> WM_MOUSEWHEEL then exit;
    hWnd := WindowFromPoint(msg.pt);
    if boolean(GetClassName(hWnd, aName, 256))and(aName='Trichedit') then//如果第三方控件需要修改，比如用aName='TbsSkinDBGrid'
    begin
        if Short(HIWORD(Msg.wParam)) < 0 then

        begin
            PostMessage(hWnd, WM_KEYDOWN, VK_DOWN, 0);
            PostMessage(hWnd, WM_KEYUP, VK_DOWN, 0)
        end
        else

        begin
            PostMessage(hWnd, WM_KEYDOWN, VK_UP, 0);
            PostMessage(hWnd, WM_KEYUP, VK_UP, 0);

        end;

        Handled := true;
    end;
end;
}

procedure TThd.Execute;
begin
  exec();
end;

constructor TThd.create();
begin
  freeonterminate:= true;
  inherited create(false);
end;

function TChengJiCL.exec(): boolean;
begin
  with mainform do begin
      label2.caption:= '成绩信息录入中';
      update;
    if ChengJiCL() then begin
      if terminated then
        exit;
      label2.caption:= '成绩信息录入完毕';
      update;
    end;
    button6.Enabled:= true;
  end;
end;

function TTotal.exec(): boolean;
var
  EChengJiCL: TChengJiCL ;
  EdyzhCLAuto: TdyzhCLAuto;
begin
  with mainform do begin

    label2.caption:= '学籍信息录入中';
    update;
    if XueJiCL() then begin
      label2.caption:= '学籍信息录入完毕';
      update;
    end;

    label2.caption:= '成绩信息录入中';
      update;
    if ChengJiCL() then begin
      label2.caption:= '成绩信息录入完毕';
      update;
    end;
      label2.caption:= '得分信息录入中';
      update;
    if dyzhCLAuto() then begin

      label2.caption:= '得分信息录入完毕';
      update;
    end;

      label2.caption:= '正在综合处理成绩';
      update;
    if AddData() then begin

      label2.caption:= '所有成绩信息输入完成';
      update;
    end;
      label2.caption:= '正在输出成绩';
      update;
    if Output() then begin
      label2.caption:= '成绩信息输出完成';
      update;
    end; 
    button6.Enabled:= true;
    button1.Visible:= true;
    button7.Visible:= true;
    button8.Visible:= true;
    button9.Visible:= true;
  end;
end;

function TXueJiCL.exec(): boolean;
begin
  with mainform do begin
    label2.caption:= '学籍信息录入中';
    update;

    if XueJiCL() then begin
      if terminated then
        exit;
      label2.caption:= '学籍信息录入完毕';
      update;
    end;
    button8.Enabled:= true;
    button1.Enabled:= true;
    button7.Enabled:= true;
    button6.Enabled:= true;
  end;
end;

function TdyzhCLAuto.exec(): boolean;
begin
  with mainform do begin
      label2.caption:= '得分信息录入中';
      update;
    if dyzhCLAuto() then begin
      if terminated then
        exit;
      label2.caption:= '得分信息录入完毕';
      update;
    end;
    button9.Enabled:= true;
    button6.Enabled:= true;
  end;
end;

function TAddData.exec: boolean;
begin
  with mainform do begin
      label2.caption:= '正在综合处理成绩';
      update;
    if AddData then begin
      if terminated then
        exit;
      label2.caption:= '所有成绩信息输入完成';
      update;
    end;
    button6.Enabled:= true;
    button2.Enabled:= true;
    button3.Enabled:= true;
  end;
end;

function TOutput.exec(): boolean;
begin
  with mainform do begin
      label2.caption:= '正在输出成绩';
      update;
    if Output() then begin
      label2.caption:= '成绩信息输出完成';
      update;
    end;
  end;
end;


procedure TMainForm.FormCreate(Sender: TObject);
var
  hMutex:hwnd;
begin
  label2.Caption:= '';
    hMutex:= CreateMutex(nil,False,Pchar('SchoolHome.exe'));
      if   GetLastError=ERROR_ALREADY_EXISTS   Then
      begin
          ReleaseMutex(hMutex);
          ShowMessage('程序已经打开');
          application.Terminate;
          //free;
      end;
end;

initialization
      ActiveX.CoInitialize(nil);

finalization
      ActiveX.CoUninitialize;
end.