main.~pas

本人帮别人写的一个卡特尔16F性格检测程序

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ToolWin, ComCtrls, StdCtrls, Buttons, AxCtrls, OleCtrls, VCF1,
  OleServer,  ExtCtrls, Mask, jpeg, Grids, DBGrids, ImgList, Menus,
  ActnList;


type
  TForm1 = class(TForm)
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    mainSateBar: TStatusBar;
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Edit1: TEdit;
    ComboBox1: TComboBox;
    MaskEdit1: TMaskEdit;
    Edit2: TEdit;
    BitBtn1: TBitBtn;
    Timer1: TTimer;
    Panel2: TPanel;
    Memo1: TMemo;
    Label8: TLabel;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    Image1: TImage;
    Panel3: TPanel;
    BitBtn4: TBitBtn;
    BitBtn5: TBitBtn;
    Image3: TImage;
    ImageList1: TImageList;
    ToolButton8: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ActionList1: TActionList;
    newCs: TAction;
    about: TAction;
    exitSystem: TAction;
    Image2: TImage;
    stEdit: TAction;
    ToolButton6: TToolButton;
    findRecord: TAction;
    ComboBox2: TComboBox;
    Label9: TLabel;
    Image4: TImage;
    Bevel1: TBevel;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N3: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N2: TMenuItem;
    N9: TMenuItem;
    changUser: TAction;
    ToolButton7: TToolButton;
    jcTreeManeger: TAction;
    ToolButton9: TToolButton;
    totalRpt: TAction;
    ToolButton10: TToolButton;
    procedure BitBtn1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure createControles(i:integer;c:string;tH:integer;ttype:integer;q1:string;q2:string;q3:string;qaf:integer;qbf:integer;qcf:integer);
    procedure createNewSt(tsY:integer);
    procedure BitBtn5Click(Sender: TObject);
    procedure aboutExecute(Sender: TObject);
    procedure exitSystemExecute(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure newCsExecute(Sender: TObject);
    procedure stEditExecute(Sender: TObject);
    procedure ToolButton7Click(Sender: TObject);
    procedure ComboBox2Change(Sender: TObject);
    procedure findRecordExecute(Sender: TObject);
    procedure changUserExecute(Sender: TObject);
    procedure jcTreeManegerExecute(Sender: TObject);
    procedure totalRptExecute(Sender: TObject);
  private
    procedure clearPanl3Controls;
    procedure chkclick(Sender: Tobject);
    procedure SaveTs;
   
    { Private declarations }
  public
    { Public declarations }
       function getCmbh(xb, zy: string): string;
  end;

var
  Form1: TForm1;
  rybh :integer; //人员编号
  cmbh : string; //长摸编号
  isAdminLogin :bool;
implementation

uses dataModel, yinsuAdd, about, editst, pmt, Unit5, Login, jcTreeManager,
  report;

{$R *.dfm}
var
StartTime{开始记录时间的时间点}, StopTime{结束记录时间的时间点}, Difference : TDateTime;
js:bool;   //是否开始记时开始
isNewcsz:bool;//是否新的测试

{*****************************************
  功能描述：根据测试者性别与职业，或得长摸编号
  参数：xb 性别,zy 职业
  创建时间：2008-03-24
 *****************************************}
function  Tform1.getCmbh(xb,zy:string):string;
begin
    if (xb = '男') and (zy = '高中生') then
    result := '01'
    else if (xb = '女') and (zy = '高中生') then
    result := '02'
    else if (xb = '男') and (zy = '大学生') then
    result := '03'
    else if (xb = '女') and (zy = '大学生') then
    result := '04'
    else if (xb = '男') and (zy = '成人') then
    result := '05'
    else if (xb = '女') and (zy = '成人') then
    result := '06'
end;
{
  ***********************************************
     功能描述：开始进入测试的功能按钮事件，
               在次功能模块中判断测试者输入的信息是否合法
     创建时间：2008-03-24

  ***********************************************
}
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
if trim( Edit1.Text) = '' then
    begin
    application.MessageBox('你输入的名字为空，请重新输入！','提示');// ,MB_YesNoCancel+MB_IconQuestion
    exit;
    end;
if trim( ComboBox1.Text) = '' then
begin
    application.MessageBox('你输入的性别为空，请重新输入！','提示');// ,MB_YesNoCancel+MB_IconQuestion
    exit;
end;
if trim( MaskEdit1.Text) = '' then
    begin
    application.MessageBox('你输入的年龄为空，请重新输入！','提示');// ,MB_YesNoCancel+MB_IconQuestion
    exit;
    end;
//得到长摸编号
cmbh :=  getCmbh( ComboBox1.Text, ComboBox2.Text);
//设置当前输入信息的步骤不可见
Panel1.Visible := false;
//设置下一步信息提示可见
Panel2.Visible := true;
//记录开始测试时的时间点
StartTime := Now;
//大开开始测试的标志
js := true;
//判断是否新的测试，是的话将测试者信息插入到数据库
if isNewcsz then
  DataModule1.ADOTable1.Append
  else   DataModule1.ADOTable1.Edit;//否则，修改测试者信息
//测试者姓名
DataModule1.ADOTable1.FieldByName('xm').Value :=  Edit1.Text;
//测试者性别
DataModule1.ADOTable1.FieldByName('xb').Value :=  ComboBox1.Text;
//测试者年龄
DataModule1.ADOTable1.FieldByName('nl').Value := strtoint( MaskEdit1.Text);
//测试者职业
DataModule1.ADOTable1.FieldByName('zy').Value :=  Edit2.Text;
//测试时间
DataModule1.ADOTable1.FieldByName('cssj').Value := now;
//提交数据
DataModule1.ADOTable1.Post;
//将测试者编号保存到全局变量中，以备计算测试者得分时用
rybh :=   DataModule1.ADOTable1.FieldByName('bh').Value  ;
isNewcsz := false;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
if js  then
 mainSateBar.Panels[1].Text := '用时：' + TimeToStr(StartTime - Now);

 mainSateBar.Panels[2].Text := '当前时间：' + formatdatetime('yyyy-mm-dd hh:MM:ss',now);

end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
 mainSateBar.Panels[0].Text := '姓名：' +  Edit1.Text;
end;

procedure TForm1.FormShow(Sender: TObject);
var
currDataBasePt :string;
begin
   with  self.Image4 do
   begin
   //  Canvas.Pen.Color := clRed;
   Canvas.MoveTo( 200, 300 );
   //Canvas.LineTo( 500, 500 );
   Canvas.Brush.Color := clGrayText;
   Canvas.Font.Name := 'Arial';
   canvas.Font.Color := clRed;
   canvas.Font.Size :=24;
  // Canvas.TextOut( Canvas.PenPos.x, Canvas.PenPos.y,'北京首电创新应用技术有限公司 张磊设计' );

   end;
     isNewcsz := true;
      mainSateBar.Panels[1].Text := '用时：';
      mainSateBar.Panels[0].Text := '姓名：';
     currDataBasePt :=ExtractFilePath(application.ExeName);
    DataModule1.  ADOConnection1.ConnectionString :=
    'Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+ currDataBasePt +'\DataBase\16pf.mdb;Jet OLEDB:Database Password=nocrake;Persist Security Info=false';
    //DataModule1.ADOTable1.Active := true;
    DataModule1.ADOTable1.Open;
     Image1.Left:=0;
     Image3.Left:=0;
     Image2.Left:=0;
     Image4.Left:=0;
     Image1.Height:=  Panel1.Height;
     Image3.Height:=  Panel1.Height;
     Image2.Height:= Panel1.Height;
     Image4.Height := Panel1.Height;
     Image1.Width:=  Panel1.Width;
     Image3.Width:=  Panel1.Width;
     Image2.Width:= Panel1.Width;
     Image4.Width := Panel1.Width;
    // Hide;
    OKBottomDlg := TOKBottomDlg.Create(self);
    OKBottomDlg.ShowModal;
   {  stEdit.Enabled :=isAdminLogin;
     findRecord.Enabled :=isAdminLogin;
    }
   // memo1.Brush.Style:=bsClear;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
 Panel2.Visible := false;
 Panel1.Visible := true;
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
var j,i:integer;
var c:string;
begin
 createNewSt(0);
end;
procedure Tform1.createNewSt(tsY:integer);
var j,i:integer;
var c:string;
var ttype:integer;
var q1,q2,q3 :string;
var qaf,qbf,qcf:integer;
begin
j:=0;
 Panel2.Visible := false;
 Panel3.Visible := true;
//Application.ExeName;
DataModule1.ADOQuery1.Close;
//DataModule1.ADOQuery1.Active :=true;
DataModule1.ADOQuery1.Parameters[0].Value := tsY +1;
DataModule1.ADOQuery1.Parameters[1].Value := tsY + 11;
DataModule1.ADOQuery1.Open;
if DataModule1.ADOQuery1.RecordCount =0 then
begin
   DataModule1.ADOQuery1.Close;
    Label9.Visible := true;
   Form4 := Tform4.Create(self);
   form4.strRybh := inttostr(rybh);
   form4.strcmbh := cmbh;
   Form4.Show;
   exit;
end;
DataModule1.ADOQuery1.First;
 mainSateBar.Panels[4].Text := '共187题，当前页题数：' + inttostr(DataModule1.ADOQuery1.Recordset.RecordCount);
while not DataModule1.ADOQuery1.Eof do
begin
     j :=j + 1;
     i :=DataModule1.ADOQuery1.Recordset.Fields[0].Value;
     c :=DataModule1.ADOQuery1.Recordset.Fields[1].Value;
     ttype := DataModule1.ADOQuery1.Recordset.Fields[3].Value;
     q1 :=    DataModule1.ADOQuery1.Recordset.Fields['QA'].Value;
     q2 :=    DataModule1.ADOQuery1.Recordset.Fields['QB'].Value;
     q3 :=    DataModule1.ADOQuery1.Recordset.Fields['QC'].Value;
     qaf :=   DataModule1.ADOQuery1.Recordset.Fields['QAf'].Value;
     qbf :=   DataModule1.ADOQuery1.Recordset.Fields['QBf'].Value;
     qcf :=   DataModule1.ADOQuery1.Recordset.Fields['QCf'].Value;
     createControles(j,c,i,ttype,q1,q2,q3,qaf,qbf,qcf );