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

📄 bank.pas

📁 A data-based tool that can produce questionnaires dynamically which will be used to investigate clie
💻 PAS
字号:
unit bank;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, ADODB, StdCtrls, Mask, DBCtrls, Grids, DBGrids, ExtCtrls,
  Menus, XPMan;

type
  TForm1 = class(TForm)
    ADOConnection1: TADOConnection;
    ADOTable1: TADOTable;
    ADOQuery1: TADOQuery;
    DataSource1: TDataSource;
    DataSource2: TDataSource;
    DBNavigator1: TDBNavigator;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N4: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    XPManifest1: TXPManifest;
    Button1: TButton;
    N9: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    N10: TMenuItem;
    OpenDialog1: TOpenDialog;
    Edit1: TMenuItem;
    Refresh1: TMenuItem;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
    procedure Button1Click(Sender: TObject);
    procedure N15Click(Sender: TObject);
    procedure N13Click(Sender: TObject);
    procedure N14Click(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Refresh1Click(Sender: TObject);

  private
    N : integer;   //WheelDelta
    RencentPosition : integer;
    HasData: array[1..300] of Integer;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses question, login, display;

{$R *.dfm}


procedure TForm1.FormCreate(Sender: TObject);
var
   IDEdit,MyEdit : TDBEdit;
   IDText,MyText : TLabel;
   MyDBRadioGroup : TDBRadioGroup;
   ReturnButton : TButton;
   i,j,m : integer;
   StrPosition :integer;
   radiostr : string;

begin
  Form1.FormStyle:=fsStayOnTop;
  Form1.Top :=100;
  Form1.Left:=200;
  Form1.Height:=600;
  Form1.Width:=500;
  N := 5;
  RencentPosition := 0;

  with ADOQuery1 do
  begin
  close;
  sql.Clear;
  sql.Add('select * from Question');
  open;
  end;

  if DataSource1.DataSet.Eof then
    begin
    DataSource1.DataSet.Append;
    DataSource1.DataSet.Fields[0].AsInteger := 1;
    DataSource1.DataSet.Post;
    end;

  IDText := TLabel.Create(self);
  with IDText do try
  top:= RencentPosition + 50;
  RencentPosition := top + Height;
  Left:= 20;
  Caption:= 'CustomerID ';
  parent := self;
  finally
  end;

  IDEdit := TDBEdit.Create(self);
  with IDEdit do try
  top:= RencentPosition + 5;
  RencentPosition := top + Height;
  Left:= 30;
  datafield := 'CustomerID';
  datasource := datasource1;
  parent := self;
  finally
  end;

  for i := 1 to ADOQuery1.RecordCount do
  begin
  DataSource2.DataSet.Locate('QuestionNo',i,[]);
  
  {Normal Question }

  if ADOQuery1.Fields[2].AsInteger = 1 then
  begin
  HasData[i] := 1;

  MyText := TLabel.Create(self);
  with MyText do try
  top:= RencentPosition + 20;
  RencentPosition := top + Height;
  Left:= 20;
  Caption:= ADOQuery1.Fields[1].AsString + '    ';
  parent := self;
  finally
  end;

  MyEdit := TDBEdit.Create(self);
  with MyEdit do try
  top:= RencentPosition + 5;
  RencentPosition := top + Height;
  Left:= 30;
  datafield := IntToStr(i);
  datasource := datasource1;
  parent := self;
  finally
  end;
  end

 {Single-Optional Question }

  else if ADOQuery1.Fields[2].AsInteger = 2 then
  begin
  HasData[i] := 1;

  MyText := TLabel.Create(self);
  with MyText do try
  top:= RencentPosition + 20;
  RencentPosition := top + Height;
  Left:= 20;
  Caption:= ADOQuery1.Fields[1].AsString + '    ';
  parent := self;
  finally
  end;

  MyDBRadioGroup := TDBRadioGroup.Create(self);
  with MyDBRadioGroup do try
  top:= RencentPosition + 5;
  Left := 30 ;
  width := 300;
  m := ADOQuery1.Fields[3].AsInteger;
  if m > 4 then
    Height := 105 + (m-4) div 2 * 50
  else if m = 2 then
    Height := Height div 2;
  RencentPosition := top + Height;
  columns := ADOQuery1.Fields[4].AsInteger;
  datafield := IntToStr(i);
  datasource := datasource1;
  parent := self;
  finally
  end;

  with MyDBRadioGroup do try
   Values.Capacity := m;
   Items.Capacity := m;
   for j := 1 to Values.Capacity do
     values.Add(inttostr(j));
   finally
   end;

  radiostr := ADOQuery1.Fields[5].AsString + '^';

  while StrLen(pChar(radiostr)) <> 0  do
  begin
  StrPosition :=  Pos( '^',radiostr);
  MyDBRadioGroup.Items.Add(Copy(radiostr,1,StrPosition-1));
  Delete(radiostr, 1, StrPosition);
  end;
  end

  {Multi-optional Question }

  else if ADOQuery1.Fields[2].AsInteger = 3 then
  begin
  HasData[i] := 0;

  MyDBRadioGroup := TDBRadioGroup.Create(self);
  with MyDBRadioGroup do try
  top:= RencentPosition + 5;
  Height := Height div 2;
  RencentPosition := top + Height;
  Left := 30;
  width := 200;
  Caption := ADOQuery1.Fields[1].AsString;
  Columns := 2;
  Values.Capacity := 2;
  Items.Capacity := 2;
  values.Add('1');
  values.Add('0');

  datafield := IntToStr(i);
  datasource := datasource1;
  parent := self;
  finally
  end;

  MyDBRadioGroup.Items.Add('Yes');
  MyDBRadioGroup.Items.Add('No');

  end

  {Blank after Option}

  else if ADOQuery1.Fields[2].AsInteger = 4 then
  begin
  HasData[i] := 0;

  MyEdit := TDBEdit.Create(self);
  with MyEdit do try
  top:= RencentPosition + 5;
  RencentPosition := top + Height;
  Left:= 30;
  width := 300;
  datafield := IntToStr(i);
  datasource := datasource1;
  parent := self;
  finally
  end;
  end

  {Caption}

  else if ADOQuery1.Fields[2].AsInteger = 5 then
  begin
  HasData[i] := 0;

  MyText := TLabel.Create(self);
  with MyText do try
  top:= RencentPosition + 20;
  RencentPosition := top + Height;
  Left:= 20;
  Caption:= ADOQuery1.Fields[1].AsString + '       ';
  parent := self;
  finally
  end;
  end;

  end;

  {end loop }

  ReturnButton := TButton.Create(self);
  with ReturnButton do try
  top:= RencentPosition + Height;
  Left:= 360;
  Caption:= 'TOP';
  OnClick := Button1Click;
  parent := self;
  finally
  end;

end;

procedure TForm1.N7Click(Sender: TObject);
begin
    Form1.Visible := False;
    Form3.Visible:=True;
end;

procedure TForm1.N4Click(Sender: TObject);
begin
   Form1.close;
end;

procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
   Form1.VertScrollBar.Position:= Form1.VertScrollBar.Position- (WheelDelta*2 div N);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Form1.VertScrollBar.Position:= 0;
  Button2.Click;
end;

procedure TForm1.N15Click(Sender: TObject);
begin
   if N15.Checked = false then
   begin
     N15.Checked := true;
     N13.Checked := false;
     N14.Checked := false;
     N := 10;
   end;
end;

procedure TForm1.N13Click(Sender: TObject);
begin
   if N13.Checked = false then
   begin
     N15.Checked := false;
     N13.Checked := true;
     N14.Checked := false;
     N := 5;
   end;
end;

procedure TForm1.N14Click(Sender: TObject);
begin
   if N14.Checked = false then
   begin
     N15.Checked := false;
     N13.Checked := false;
     N14.Checked := true;
     N := 1;
   end;
end;

procedure TForm1.N11Click(Sender: TObject);
begin
   if N11.Checked = True then
   begin
      DBNavigator1.ConfirmDelete := False;
      Form2.DBNavigator1.ConfirmDelete := False;
      N11.Checked := False;
   end
   else
   begin
      DBNavigator1.ConfirmDelete :=True;
      Form2.DBNavigator1.ConfirmDelete := True;
      N11.Checked := True;
   end;
end;

procedure TForm1.N10Click(Sender: TObject);
begin
   Form1.FormStyle := fsNormal;
   Form4.Visible := true;
end;

procedure TForm1.N8Click(Sender: TObject);
begin
   ShowMessage('If you have any question or suggestion, tell me.'+ #10 + 'E-mail Adress: lc_talent@yahoo.com.cn');
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  j,m : integer;
  tempstr : string;

begin
  with ADOQuery1 do
  begin
  close;
  sql.Clear;
  sql.Add('select * from Question');
  open;
  end;

  tempstr := '';
  m := ADOQuery1.RecordCount;
  tempstr := tempstr + 'Lost NO.:';

  with ADOQuery1 do
  begin
  close;
  sql.Clear;
  sql.Add('select * from Answer');
  open;
  end;

  for j := 1 to m do
    if  HasData[j] = 1 then
      if ADOTable1.Fields[j].AsString = '' then
         tempstr := tempstr + inttostr(j) + ' ';
  if tempstr <> 'Lost NO.:' then
    ShowMessage(tempstr);

end;

procedure TForm1.Refresh1Click(Sender: TObject);
begin
   Button2.click;
end;

end.

⌨️ 快捷键说明

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