⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit5.pas

📁 本人帮别人写的一个卡特尔16F性格检测程序
💻 PAS
字号:
unit Unit5;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ExtCtrls, ToolWin, Grids, DBGrids, ImgList, DB,ADODB,
  StdCtrls, DBCtrls;

type
  TForm5 = class(TForm)
    TreeView1: TTreeView;
    StatusBar1: TStatusBar;
    Splitter1: TSplitter;
    ToolBar1: TToolBar;
    ImageList1: TImageList;
    Label1: TLabel;
    DataSource1: TDataSource;
    Label2: TLabel;
    DBGrid1: TDBGrid;
    ImageList2: TImageList;
    ToolButton2: TToolButton;
    DBNavigator1: TDBNavigator;
    ToolButton3: TToolButton;
    ToolButton1: TToolButton;
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure TreeView1Change(Sender: TObject; Node: TTreeNode);
    procedure ToolButton2Click(Sender: TObject);
    procedure ToolButton1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form5: TForm5;

implementation


uses dataModel, pmt, main;

{$R *.dfm}
 var  i:array of integer;
procedure TForm5.FormShow(Sender: TObject);
var
  MyTreeNode1, MyTreeNode2: TTreeNode;
  pName:string;
  
  j,m:integer; //记录长度
begin
  DataModule1.ADOQuery4.Open;
  j := DataModule1.ADOQuery4.RecordCount;
   if j =0 then
    begin
       exit;
    end;
  setlength(i,j);
  with TreeView1.Items do
  begin
    Clear; { remove any existing nodes }
    MyTreeNode1 := Add(nil, '测试人'); { Add a root node }

    { Add a child node to the node just added }
    DataModule1.ADOQuery4.First;
    m :=0;
    while  not  DataModule1.ADOQuery4.Eof do
    begin
       pName := DataModule1.ADOQuery4.Recordset.Fields['xm'].Value;
      MyTreeNode2 := AddChild(MyTreeNode1,pName);
      i[m]:= DataModule1.ADOQuery4.Recordset.Fields['bh'].value ;
      MyTreeNode2.Data := @i[m];
      MyTreeNode2.ImageIndex :=1;
      //MyTreeNode2. :=1;
        m :=m +1;
        DataModule1.ADOQuery4.Next;
    end;

    MyTreeNode1.Expanded := true;
  end;
end;

procedure TForm5.FormClose(Sender: TObject; var Action: TCloseAction);
begin
DataModule1.ADOQuery4.Close;
i := nil;
end;

procedure TForm5.TreeView1Change(Sender: TObject; Node: TTreeNode);
var intC : integer;
begin
        if Node.Text <> '测试人' then
        begin
        intC := integer(Node.data^);
        //application.MessageBox(pansichar(inttostr(intc)),'ok') ;
        DataModule1.ADOQuery4.Filter := '';
        DataModule1.ADOQuery4.Filter :='bh=' + inttostr(intc);
        DataModule1.ADOQuery4.Filtered := true;

        end
        else
         begin
         DataModule1.ADOQuery4.Filter := '';
         DataModule1.ADOQuery4.Filtered := true;

         end;

end;

procedure TForm5.ToolButton2Click(Sender: TObject);
var
strrybh :string; //人员编号
strCmbh :string; //长摸编号
strXB,strZy :string;
begin

try
 Form4 := Tform4.Create(self);
strrybh :=  dbgrid1.columns[0].field.value;
strXB :=    dbgrid1.columns[2].field.value;
strZy :=    dbgrid1.columns[4].field.value;
strCmbh :=  form1.getCmbh(strXB,strZy) ;
//application.MessageBox(Pansichar(strrybh),'ok') ;

form4.strRybh := strrybh;
form4.strcmbh :=strCmbh;
form4.Show;


except
   application.MessageBox('应用程序发生错误!','错误')  ;



end;

end;

procedure TForm5.ToolButton1Click(Sender: TObject);
begin
if application.MessageBox('你确认要全部删除么?','提示', MB_YESNO or MB_ICONQUESTION or MB_DEFBUTTON2) = IDYES		then
begin
  DataModule1.ADOCommand1.CommandText := 'delete from csz';
  DataModule1.ADOCommand1.Execute;
  self.DataSource1.DataSet.Close;
  self.TreeView1.Items.Clear;
end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -