utablefield.pas

进销存以及BOM管理,SQl Server数据库程序

unit utablefield;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Base, StdCtrls, Grids, DBGridEh, DB, DBClient, ADODB;

type
  Tfrmtablefield = class(TfrmBase)
    Button4: TButton;
    Button5: TButton;
    Label1: TLabel;
    Edit1: TEdit;
    GroupBox1: TGroupBox;
    Grid: TDBGridEh;
    dsgrid: TDataSource;
    Qbaseinfo: TADOQuery;
    Button1: TButton;
    Qfieldtype: TADOQuery;
    Qfieldtypefid: TAutoIncField;
    Qfieldtypeffieldtype: TWideStringField;
    Qbaseinfofid: TAutoIncField;
    Qbaseinfoftablename: TWideStringField;
    Qbaseinfoffieldname: TWideStringField;
    Qbaseinfoffielddesc: TWideStringField;
    Qbaseinfoffieldtype: TIntegerField;
    Qbaseinfoffieldlong: TWideStringField;
    Qbaseinfofisnull: TBooleanField;
    Qbaseinfofdefaultvalue: TWideStringField;
    Qbaseinfofisvisible: TBooleanField;
    Qbaseinfoftype: TStringField;
    procedure Button5Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure GridGetCellParams(Sender: TObject; Column: TColumnEh;
      AFont: TFont; var Background: TColor; State: TGridDrawState);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure GridKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    procedure OpenQbase;
    procedure dochangetables;
    procedure docreatetables;
    function isUniquef():Boolean;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmtablefield: Tfrmtablefield;

implementation

uses Data, Global;

{$R *.dfm}

procedure Tfrmtablefield.Button5Click(Sender: TObject);
begin
  inherited;
  Close;
end;

procedure Tfrmtablefield.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  inherited;
  frmtablefield:=nil;
end;

procedure Tfrmtablefield.GridGetCellParams(Sender: TObject;
  Column: TColumnEh; AFont: TFont; var Background: TColor;
  State: TGridDrawState);
begin
  inherited;
  if Grid.SumList.RecNo mod 2=1 then
    BackGround:=$00EAEFED
    else
    BackGround:=clWhite;
end;

procedure Tfrmtablefield.FormCreate(Sender: TObject);
begin
  inherited;
  Grid.Enabled:=False;
  openQbase;
end;

procedure Tfrmtablefield.OpenQbase;
begin
  if Trim(Edit1.Text)<>'' then
    begin
      Screen.Cursor :=crSqlWait;
      try
        Qbaseinfo.Close; 
        with Qbaseinfo do
          begin
             parameters.ParamValues['ftablename']:=Trim(edit1.Text);
             open;
          end;
      except
        Screen.Cursor:=crDefault;
        Abort;
      end;
        Screen.Cursor:=crDefault;
    end;

  if not Qfieldtype.Active then Qfieldtype.Open else Qfieldtype.Requery;
end;

procedure Tfrmtablefield.Button1Click(Sender: TObject);
begin
  inherited;
  openQbase;
    Grid.Enabled:=True;
end;

procedure Tfrmtablefield.Button4Click(Sender: TObject);
var
  ListT:TStringList;
  I:integer;
  Isinclude:boolean;
  ps:String;
begin
  inherited;
  Isinclude:=False;

  if Qbaseinfo.State in [dsInsert,dsEdit] then
    Qbaseinfo.Post;
  Qbaseinfo.First;
  while not Qbaseinfo.Eof do
    begin
      ps:=Qbaseinfo.fieldbyname('ftype').AsString;
      Qbaseinfo.Edit;
      if ps='bigint' then
        Qbaseinfo.fieldbyname('ffieldlong').AsString:='8';
      if ps='bit' then
        Qbaseinfo.fieldbyname('ffieldlong').AsString:='1';
      if ps='datetime' then
        Qbaseinfo.fieldbyname('ffieldlong').AsString:='8';
      if ps='int' then
        Qbaseinfo.fieldbyname('ffieldlong').AsString:='4';
      if ps='ntext' then
        Qbaseinfo.fieldbyname('ffieldlong').AsString:='16';
      if ps='numeric' then
        Qbaseinfo.fieldbyname('ffieldlong').AsString:='9,2';
      if ps='tinyint' then
        Qbaseinfo.fieldbyname('ffieldlong').AsString:='1';
      if ps='text' then
        Qbaseinfo.fieldbyname('ffieldlong').AsString:='16';
      Qbaseinfo.Post;
      Qbaseinfo.Next;
    end;

  try
    ListT:=TStringList.Create;
    Datam.AdoConnection.GetTableNames(ListT,False);
    for i:=0 to ListT.Count-1 do
      Begin
        if upperCase(Trim(ListT[I]))=upperCase(Trim(Edit1.Text)) then
          begin
            Isinclude:=True;
            if messagedlg('您是否保存对数据表结构的修改呢 ? 这样将会清除当前表所有资料 ! ',
                                mtconfirmation,[mbok,mbcancel],0)=mrok then
              begin
                Dochangetables;
                break;
              end;
          end;
      end;
    if not Isinclude then
      begin
        if messagedlg('您是否要创建这个新表 ? ',mtconfirmation,[mbok,mbcancel],0)=mrok then
           begin
             Docreatetables;
           end;
      end;
  finally
    ListT.Free;
  end;
  Grid.Enabled:=False;
end;

procedure Tfrmtablefield.dochangetables;
var
  Qexecs:Tadoquery;
  cmdStr:String;
begin
  try
    Qexecs:=Tadoquery.Create(nil);
    Qexecs.Connection:=Datam.AdoConnection;

    try
      cmdStr:='Drop Table '+edit1.Text;
      With Qexecs do
        begin
          close;
          sql.Clear;
          sql.Add(cmdStr);
          ExecSQL;
        end;

      cmdStr:='Delete from ttablefield where ftablename='+Vartosql(edit1.Text);
      with Qexecs do
        begin
          close;
          sql.Clear;
          sql.Add(cmdStr);
          ExecSQL;
        end;
    except
      on E:exception do
        begin
          messagedlg('修改数据库失败 ! ',mtError,[mbok],0);
          Abort;
        end;
    end;

    DocreateTables;

  finally
    Qexecs.Free;
  end;
end;

procedure Tfrmtablefield.docreatetables;
var
  Qexec:Tadoquery;
  cmdStr:String;
begin
  if Qbaseinfo.RecordCount=0 then Exit;
  cmdStr:='';

  if isUniquef then
    begin
      Messagedlg('不能出现重复的字段名 ! ',mtError,[mbok],0);
      Exit;
    end;

  try
    Screen.Cursor:=crSQLwait;
    Qexec:=Tadoquery.Create(nil);
    Qexec.Connection:=Datam.AdoConnection;

    Qbaseinfo.First;
    while not Qbaseinfo.Eof do
      begin
        if (Trim(Qbaseinfo.FieldByName('ffieldname').AsString) = '') or
         (Trim(Qbaseinfo.fieldbyname('ftype').AsString)='') then
            begin
              messagedlg('数据表的设置错误 ! ',mtError,[mbok],0);
              Break;
            end;
            try
              with Qexec do
                begin
                  Close;
                  sql.Clear;
                  sql.Text:='Insert into ttablefield(ftablename,ffieldname,ffielddesc,ffieldtype';
                  sql.Text:=sql.Text+',ffieldlong,fisnull,fdefaultvalue,fisvisible) values(';
                  sql.Text:=sql.Text+vartosql(trim(edit1.Text))+',';
                  sql.Text:=Sql.Text+vartosql(Qbaseinfo.fieldbyname('ffieldname').AsString)+',';
                  sql.Text:=Sql.Text+vartosql(Qbaseinfo.fieldbyname('ffielddesc').AsString)+',';
                  sql.Text:=Sql.Text+vartosql(Qbaseinfo.fieldbyname('ffieldtype').AsString)+',';
                  sql.Text:=Sql.Text+vartosql(Qbaseinfo.fieldbyname('ffieldlong').AsString)+',';
                  sql.Text:=Sql.Text+vartosql(Qbaseinfo.fieldbyname('fisnull').AsBoolean)+',';
                  sql.Text:=Sql.Text+vartosql(Qbaseinfo.fieldbyname('fdefaultvalue').AsString)+',';
                  sql.Text:=Sql.Text+vartosql(Qbaseinfo.fieldbyname('fisvisible').asBoolean)+')';
                  ExecSql;
                end;
            except
              on E:exception do
                begin
                  Screen.Cursor:=crDefault;
                  Messagedlg('字段设置不正确 ! '+#10#13+E.Message,mtError,[mbok],0);
                  Abort;
                end;
            end;

          if cmdStr='' then
            begin
                cmdStr:='CREATE TABLE ['+Edit1.Text+'] ([fid] [int] IDENTITY (1, 1) NOT NULL ,['+
                  Qbaseinfo.fieldbyname('ffieldname').AsString+'] ['+
                  Qbaseinfo.fieldbyname('ftype').AsString+'] ';

                  if (Trim(Qbaseinfo.FieldByName('ftype').AsString)='char') or
                     (Trim(Qbaseinfo.FieldByName('ftype').AsString)='varchar') or
                     (Trim(Qbaseinfo.FieldByName('ftype').AsString)='nvarchar') then
                     cmdStr:=cmdStr+'('+Qbaseinfo.fieldbyname('ffieldlong').AsString+') ';

                  if Qbaseinfo.FieldByName('fisnull').AsBoolean then
                      cmdStr:=cmdStr+' NULL '
                    else
                      cmdStr:=cmdStr+' NOT NULL ';
                  if Trim(Qbaseinfo.FieldByName('fdefaultvalue').AsString)<>'' then
                    begin
                      if Qbaseinfo.FieldByName('ftype').AsString='bit' then
                          cmdStr:=cmdStr+' DEFAULT('+Qbaseinfo.FieldByName('fdefaultvalue').AsString+')'
                        else
                          cmdStr:=cmdStr+' DEFAULT('+vartosql(Qbaseinfo.FieldByName('fdefaultvalue').AsString)+')';
                    end;
            end
            else
            begin
              cmdStr:=cmdStr+','+ '['+
                  Qbaseinfo.fieldbyname('ffieldname').AsString+'] ['+
                  Qbaseinfo.fieldbyname('ftype').AsString+'] ';

                  if (Trim(Qbaseinfo.FieldByName('ftype').AsString)='char') or
                     (Trim(Qbaseinfo.FieldByName('ftype').AsString)='varchar') or
                     (Trim(Qbaseinfo.FieldByName('ftype').AsString)='nvarchar') then
                     cmdStr:=cmdStr+'('+Qbaseinfo.fieldbyname('ffieldlong').AsString+') ';

                  if Qbaseinfo.FieldByName('fisnull').AsBoolean then
                      cmdStr:=cmdStr+' NULL '
                    else
                      cmdStr:=cmdStr+' NOT NULL ';
                  if Trim(Qbaseinfo.FieldByName('fdefaultvalue').AsString)<>'' then
                    begin
                      if Qbaseinfo.FieldByName('ftype').AsString='bit' then
                          cmdStr:=cmdStr+' DEFAULT('+Qbaseinfo.FieldByName('fdefaultvalue').AsString+')'
                        else
                          cmdStr:=cmdStr+' DEFAULT('+vartosql(Qbaseinfo.FieldByName('fdefaultvalue').AsString)+')';
                    end;
            end;

        Qbaseinfo.Next;
      end;

      try
        if Trim(cmdStr)<>'' then
          begin
            cmdStr:=cmdStr+', PRIMARY KEY  CLUSTERED ';
            cmdStr:=cmdStr+' ( ';
            cmdStr:=cmdStr+' [fid] ';
            cmdStr:=cmdStr+'	)  ON [PRIMARY] ';
            cmdStr:=cmdStr+') ON [PRIMARY] ';
          end;
      with Qexec do
        begin
          close;
          Sql.Clear;
          sql.Add(cmdStr);
          ExecSQL;
        end;

        Screen.Cursor:=crDefault;
        if application.MessageBox(pchar('恭喜您 ! '+Trim(edit1.Text)+'数据表创建成功 , 您还要创建吗? '),
            '提示信息:', MB_OKCancel+MB_iconwarning+MB_applModal)=idok then
            begin
              Edit1.Text:='';
              Qbaseinfo.Close;
              edit1.SetFocus; 
            end
            else
            Close;

      except
          on E:exception do
            begin
              Screen.Cursor:=crDefault;
              Messagedlg('创建数据表失败 ! 请检查字段的设置是否正确 ! '+#10#13+E.Message,mtError,[mbok],0);
              Abort;
            end;
      end;
      Screen.Cursor:=crDefault;
  finally
    Qexec.Free;
  end;
  Screen.Cursor:=crDefault;
end;

function Tfrmtablefield.isUniquef(): Boolean;
var
  Qea:Tadoquery;
  I,J:integer;
  cfn:String;
begin
  Result:=False;
  I:=0;
  Qbaseinfo.First;
  while not Qbaseinfo.Eof do
    begin
      cfn:=Qbaseinfo.fieldbyname('ffieldname').AsString;
        Qbaseinfo.First;
        for j:=0 to Qbaseinfo.RecordCount-1 do
          begin
            if Qbaseinfo.FieldByName('ffieldname').AsString = cfn then
              I:=I+1;
            Qbaseinfo.Next;   
          end;

        if I>1 then
          Result:=True;
        I:=0;
        cfn:='';
      Qbaseinfo.Next;
    end;
end;

procedure Tfrmtablefield.GridKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  inherited;
  if Qbaseinfo.RecordCount > 0 then
    begin
      if key =46 then
        if messagedlg('您是否要删除当前记录 ? ',mtconfirmation,[mbok,mbcancel],0)=mrok then
          begin
             Qbaseinfo.Delete;
          end;
    end;
end;

end.