?? ufrmadd.pas
字號:
unit UfrmAdd;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, DBGrids, DB, DBTables, ComCtrls, StdCtrls, ExtCtrls,IniFiles,
Spin, Buttons, ADODB;
type
TfrmAdd = class(TForm)
Panel3: TPanel;
Label11: TLabel;
Label12: TLabel;
Label13: TLabel;
cbxType: TComboBox;
cbx1: TComboBox;
lv: TListView;
btnadd: TButton;
btndel: TButton;
btngo: TButton;
btnclear: TButton;
btnout: TButton;
StatusBar1: TStatusBar;
Database3: TDatabase;
Query1: TQuery;
DataSource1: TDataSource;
Panel2: TPanel;
DBGrid1: TDBGrid;
Panel1: TPanel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
edita1: TEdit;
edita2: TEdit;
edita3: TEdit;
edita4: TEdit;
edita5: TEdit;
btnlink1: TButton;
btnunlink1: TButton;
CheckBox1: TCheckBox;
Edit1: TEdit;
dtpDate: TDateTimePicker;
lv1: TListView;
SpinEdit1: TSpinEdit;
Label6: TLabel;
Query3: TQuery;
pbr: TProgressBar;
BitBtn1: TBitBtn;
mo: TMemo;
adoQry: TADOQuery;
Database1: TDatabase;
BitBtn3: TBitBtn;
procedure btnlink1Click(Sender: TObject);
procedure btnunlink1Click(Sender: TObject);
procedure Database3AfterConnect(Sender: TObject);
procedure Database3AfterDisconnect(Sender: TObject);
procedure btnoutClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure btngoClick(Sender: TObject);
procedure btnaddClick(Sender: TObject);
procedure btndelClick(Sender: TObject);
procedure btnclearClick(Sender: TObject);
procedure AddTypeLV();
function GetStr( selItem : TListItem; iNum : integer ):string;
procedure BitBtn1Click(Sender: TObject);
function GetRandomStr( iType:integer ):string;
function GetRandomPersonInfo( iType,iNum :integer ):string;
function GetRandomHKAddress( iNum :integer ):string;
procedure BitBtn3Click(Sender: TObject);
private
{ Private declarations }
path: string;
ini : TIniFile;
public
{ Public declarations }
end;
var
frmAdd: TfrmAdd;
implementation
uses Udbm;
{$R *.dfm}
procedure TfrmAdd.btnlink1Click(Sender: TObject);
var
i,a: integer;
ss : string;
begin
Database1.Connected := false;
Database1.Params.Clear();
Database1.DatabaseName := edita2.Text ;
Database1.Params.Values['DATABASE NAME']:= edita2.Text ;
Database1.Params.Values['SERVER NAME'] := edita1.Text ;
Database1.Params.Values['USER NAME'] := edita3.Text ;
Database1.Params.Values['PASSWORD'] := edita4.Text ;
//}
try
Database1.Connected := true;
except
Application.MessageBox('數據庫鏈接錯誤，請重新設置!','提示',MB_OK+MB_ICONINFORMATION);
exit;
end;
if Database1.Connected = true then
begin
btnlink1.Enabled := false;
Query3.DatabaseName := Database1.DatabaseName ;
Query1.DatabaseName := Database1.DatabaseName ;
Query1.Close();
Query1.SQL.Text := 'select * from '+ edita5.Text ;
try
Query1.Open();
except
exit;
end;
a := DBGrid1.FieldCount;
cbx1.Clear();
for i := 0 to a-1 do
begin
ss := DBGrid1.Columns.Items[i].FieldName;
cbx1.Items.Add(ss);
end;
cbx1.ItemIndex := 0;
lv1.Items.Clear();
//btnall.Enabled := true;
end;
end;
procedure TfrmAdd.btnunlink1Click(Sender: TObject);
begin
Query1.Close();
cbx1.Clear();
Query1.Active := false;
Database1.Connected := false;
btnlink1.Enabled := true;
//btnall.Enabled := false;
lv1.Items.Clear();
end;
procedure TfrmAdd.Database3AfterConnect(Sender: TObject);
begin
StatusBar1.Panels.Items[0].Text := ' '+edita1.Text + ' < '+edita2.Text+' > 連接成功';
end;
procedure TfrmAdd.Database3AfterDisconnect(Sender: TObject);
begin
StatusBar1.Panels.Items[0].Text := ' '+edita1.Text + ' < '+edita2.Text+' > 斷開連接!';
end;
procedure TfrmAdd.btnoutClick(Sender: TObject);
begin
Close;
end;
procedure TfrmAdd.FormShow(Sender: TObject);
begin
path := ExtractFilePath(application.ExeName);
ini := TIniFile.Create(path+'config.may');
edita1.Text := ini.ReadString('Insert', 'Server1', 'why-08');
edita2.Text := ini.ReadString('Insert', 'Database1','newhis');
edita3.Text := ini.ReadString('Insert', 'user1', 'sa');
edita4.Text := ini.ReadString('Insert', 'pass1', 'sa');
edita5.Text := ini.ReadString('Insert', 'table1', 'operator');
cbxType.ItemIndex := 0;
AddTypeLV;
pbr.Position := 0;
end;
procedure TfrmAdd.FormDestroy(Sender: TObject);
begin
Database1.Connected := false;
ini.WriteString('Insert', 'Server1', edita1.Text );
ini.WriteString('Insert', 'Database1',edita2.Text );
ini.WriteString('Insert', 'user1', edita3.Text );
ini.WriteString('Insert', 'pass1', edita4.Text );
ini.WriteString('Insert', 'table1', edita5.Text );
ini.Free;
end;
procedure TfrmAdd.CheckBox1Click(Sender: TObject);
var
iType : integer;
begin
{
整型
浮點型
字符型
日期性
}
iType := cbxType.ItemIndex;
if iType = 0 then
begin
end;
end;
procedure TfrmAdd.btngoClick(Sender: TObject);
var
sc,ss : string;
i : integer;
p : TListItem;
sql,sfield,svalue,stype : string;
iCount,j : integer;
begin
if lv1.Items.Count = 0 then
begin
exit;
end;
//btngo.Enabled := false;
//==================}
iCount := SpinEdit1.Value;
pbr.Max := iCount;
sql := 'insert into '+edita5.Text +' (';
for j := 1 to iCount do
begin
p := lv1.Items.Item[0];
sfield := p.Caption;
stype := p.SubItems.Strings[2];
ss := GetStr( p , j );//獲取值
svalue := ''''+ss+'''';
for i := 1 to lv1.Items.Count-1 do
begin
p := lv1.Items.Item[i];
sc := p.Caption ;
stype := p.SubItems.Strings[2];
ss := GetStr( p , j );//獲取值
sfield := sfield +',' + sc;
svalue := svalue +','''+ ss+'''';
end;
Query3.Close();
Query3.SQL.Text := sql+sfield+') values ('+svalue+')';
try
Query3.ExecSQL;
except
end;
pbr.Position := j;
//pbr.Refresh;
end;
Query1.Close;
Query1.SQL.Text := 'select * from '+edita5.Text;
try
Query1.Open;
except
end;
Application.MessageBox( '插入完畢!','提示',MB_OK+MB_ICONINFORMATION);
pbr.Position := 0;
end;
procedure TfrmAdd.btnaddClick(Sender: TObject);
var
item,sel : TListItem;
sval : string;
iType: integer;
begin
if (Trim(cbx1.Text) = '') or ( lv.Selected = nil ) then
begin
exit;
end;
//--------------------
sel := lv.Selected;
sval := sel.Caption;
iType := StrToIntDef(sval,1);
case iType of
1: sval := edit1.Text ;//整數
2: sval := edit1.Text ;//自增整數,初值
3: sval := edit1.Text ;//字符串
4: sval := '<隨機字符串>' ;//隨機字符串
5: sval := DateTimeToStr(dtpDate.DateTime);//日期
6: sval := '33910';//隨機姓名
7: sval := '85';//隨機戶口地址
8: sval := '33910';//隨機生日
9: sval := '隨機手機(11)';//隨機手機
10: sval := edit1.Text ;//常住兒童主鍵主鍵
11: sval := edit1.Text ;//流動兒童主鍵主鍵
12: sval := '33910';//隨機地址
13: sval := '1,2';//隨機性別
else ;
sval := '(未知)';
end;
//-------------------------------
item := lv1.Items.Add;
item.Caption := cbx1.Text ;
item.SubItems.Add( sel.SubItems.Strings[0] );
item.SubItems.Add( sval );
item.SubItems.Add( sel.Caption );
btngo.Enabled := true;
btndel.Enabled := true;
btnclear.Enabled := true;
end;
procedure TfrmAdd.btndelClick(Sender: TObject);
begin
if lv1.Selected = nil then
begin
exit;
end;
lv1.Items.Delete(lv1.Selected.Index);
if lv1.Items.Count = 0 then
begin
btngo.Enabled := false;
btndel.Enabled := false;
btnclear.Enabled := false;
end;
end;
procedure TfrmAdd.btnclearClick(Sender: TObject);
begin
lv1.Items.Clear();
btngo.Enabled := false;
btndel.Enabled := false;
btnclear.Enabled := false;
end;
procedure TfrmAdd.AddTypeLV();
var
item : TListItem;
sname: string;
begin
lv.Items.Clear;
//-------------------------------
item := lv.Items.Add;
item.Caption := '1';
sname := '整數';
item.SubItems.Add( sname );
//-------------------------------
item := lv.Items.Add;
item.Caption := '2';
sname := '自增整數';
item.SubItems.Add( sname );
//-------------------------------
item := lv.Items.Add;
item.Caption := '3';
sname := '字符串';
item.SubItems.Add( sname );
//-------------------------------
item := lv.Items.Add;
item.Caption := '4';
sname := '隨機字符串';
item.SubItems.Add( sname );
//-------------------------------
item := lv.Items.Add;
item.Caption := '5';
sname := '日期';
item.SubItems.Add( sname );
//-------------------------------
item := lv.Items.Add;
item.Caption := '6';
sname := '隨機姓名';
item.SubItems.Add( sname );
//-------------------------------
item := lv.Items.Add;
item.Caption := '7';
sname := '隨機戶口地址';
item.SubItems.Add( sname );
//-------------------------------
item := lv.Items.Add;
item.Caption := '8';
sname := '隨機生日';
item.SubItems.Add( sname );
//-------------------------------
item := lv.Items.Add;
item.Caption := '9';
sname := '隨機手機';
item.SubItems.Add( sname );
//-------------------------------
item := lv.Items.Add;
item.Caption := '10';
sname := '隨機地址';
item.SubItems.Add( sname );
//-------------------------------
item := lv.Items.Add;
item.Caption := '11';
sname := '隨機性別';
item.SubItems.Add( sname );
//-------------------------------
end;
function TfrmAdd.GetStr( selItem : TListItem; iNum :integer ):string;
var
iType : integer;
sType : string;
sValu : string;
begin
sType := selItem.SubItems.Strings[2];
iType := StrToIntDef(sType,1);
sValu := selItem.SubItems.Strings[1];
//-------------------------------
case iType of
1: GetStr := sValu;//整數
2: GetStr := IntToStr( StrToIntDef(sValu,0)+iNum );//自增整數
3: GetStr := sValu;//字符串
4: GetStr := GetRandomStr( 1 );//隨機字符串
5: GetStr := sValu;//日期
6: GetStr := GetRandomPersonInfo(1,33910);//隨機姓名
7: GetStr := GetRandomHKAddress( 85 );//隨機戶口地址
8: GetStr := GetRandomPersonInfo(5,33910);//隨機生日
9: GetStr := GetRandomStr( 2 );//隨機手機//GetRandomPersonInfo(3,33910);//隨機電話
10: GetStr := GetRandomPersonInfo(2,33910);//隨機地址
11: GetStr := IntToStr( (Random(2)+1) );//隨機性別
else ;
GetStr := '';
end;
//-------------------------------
end;
procedure TfrmAdd.BitBtn1Click(Sender: TObject);
var
i:integer;
begin
//a-z: 97-122
//A-Z: 65-90
//0-9: 48-57
//i := 97+random(26);
Randomize;
i := 1+random(121);
self.Caption := char(i);
for i := 1 to SpinEdit1.Value do
begin
//mo.Lines.Add( IntToStr(i)+' -> '+IntToStr(random(121)) );
mo.Lines.Add( GetRandomStr(1) );
end;
end;
function TfrmAdd.GetRandomStr( iType:integer ):string;
var
i,j:integer;
sa,sb,sc:string;
begin
//a-z: 97-122
//A-Z: 65-90
//0-9: 48-57
//~~~~~~~~~~~~~~~~~~~~~~~~
if iType = 1 then//任意字符串
begin
for j := 1 to 5 do
begin
i := 65+random(26);
sa := sa + char(i);
i := 97+random(26);
sb := sb + char(i);
i := 48+random(10);
sc := sc + char(i);
end;
GetRandomStr := sb + sc + sa;
exit;
end;
//~~~~~~~~~~~~~~~~~~~~~~~~
if iType = 2 then//隨機手機
begin
for j := 1 to 9 do
begin
i := 48+random(10);
sc := sc + char(i);
end;
GetRandomStr := '13'+sc;
end;
//~~~~~~~~~~~~~~~~~~~~~~~~
end;
function TfrmAdd.GetRandomPersonInfo( iType,iNum :integer ):string;
var
iID : integer;
begin
iID := 1+random(iNum);
with adoQry do
begin
Close;
case iType of
1: SQL.Text := 'select cname as svalues from person where id=:id';//姓名
2: SQL.Text := 'select address as svalues from person where id=:id';//地址
3: SQL.Text := 'select telephone as svalues from person where id=:id';//電話
4: SQL.Text := 'select postCode as svalues from person where id=:id';//郵編
5: SQL.Text := 'select birthday as svalues from person where id=:id';//生日
6: SQL.Text := 'select IDNumber as svalues from person where id=:id';//身份證
else ;
SQL.Text := 'select cname as svalues from person where id=:id';
end;
Parameters.ParamByName('id').Value := iID;
try
Open;
except
GetRandomPersonInfo := '空';
exit;
end;
if not IsEmpty then
begin
GetRandomPersonInfo := Trim(FieldByName('svalues').AsString);
exit;
end
else
begin
GetRandomPersonInfo := '空';
exit;
end;
end;
//-------------------------------
end;
function TfrmAdd.GetRandomHKAddress( iNum :integer ):string;
var
iID : integer;
begin
iID := 1+random(iNum);
with adoQry do
begin
Close;
SQL.Text := 'select c_id from p_address where id=:id';
Parameters.ParamByName('id').Value := iID;
try
Open;
except
GetRandomHKAddress := '空';
exit;
end;
if not IsEmpty then
begin
GetRandomHKAddress := Trim(FieldByName('c_id').AsString);
exit;
end
else
begin
GetRandomHKAddress := '空';
exit;
end;
end;
//-------------------------------
end;
procedure TfrmAdd.BitBtn3Click(Sender: TObject);
begin
edit1.Text := GetRandomPersonInfo(1,33910);//隨機姓名
edit1.SetFocus;
edit1.SelectAll;
SendMessage (ActiveControl.Handle, WM_Copy, 0, 0);
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -