ufrmmain.pas

面向对象数据库开发时

  for i := 0 to clbTable.Items.Count - 1 do
  begin
    if clbTable.Checked[i] then
    begin
      ClassInfoList.Add(TableToClassInfo(clbTable.Items[i]).Text);
      ProgressBar1.Position := ProgressBar1.Position + 1;
    end;
  end;
  mmFile.Text := ClassInfoList.Text;
  MessageBox(Handle, '类生信息成完毕！', '提示', MB_OK);
  ProgressBar1.Position := 0;
end;

procedure TFrmMain.GenerateUnitFile;
var
  i: integer;
  UnitList, TempList: TStringList;
  ClassList1, ClassList2: TStringList;
begin
  inherited;
  mmFile.Clear;
  ProgressBar1.Max := GetSelTableCount(clbTable);
  ProgressBar1.Position := 0;

  UnitList := TStringList.Create;
  UnitList.Clear;
  ClassList1 := TStringList.Create;
  ClassList1.Clear;
  ClassList2 := TStringList.Create;
  ClassList2.Clear;

  TempList := TStringList.Create;
  TempList.Clear;

  UnitList.Add('//Made in TableToClass');
  UnitList.Add('unit UbusinessClass;');
  UnitList.Add('');
  UnitList.Add('interface');
  UnitList.Add('');
  UnitList.Add('uses Classes, Controls;');
  UnitList.Add('');
  UnitList.Add('type');

  for i := 0 to clbTable.Items.Count - 1 do
  begin
    if clbTable.Checked[i] then
    begin
      ClassList1.Clear;
      ClassList2.Clear;
      TableToClassInfo1(clbTable.Items[i], ClassList1, ClassList2);
      UnitList.Add(ClassList1.Text);
      TempList.Add('{T' + clbTable.Items[i] +'}');
      TempList.Add(ClassList2.Text);
    end;
    ProgressBar1.Position := ProgressBar1.Position + 1;
  end;

  UnitList.Add('implementation');
  UnitList.Add(TempList.Text);
  UnitList.Add('end.');

  {mmFile.Lines.Add(UnitList.Text);
  MessageBox(Handle, '类生成完毕！', '提示', MB_OK);
  //mmFile.Lines.Add(TempList.Text);
  Add(TempList);
  MessageBox(Handle, '类生成完毕2！', '提示', MB_OK);
  mmFile.Lines.Add('end.');}
  SaveToFile(UnitList);
  ProgressBar1.Position := 0;

  UnitList.Free;
  TempList.Free;
  ClassList1.Free;
  ClassList2.Free;
end;

procedure TFrmMain.TableToClassInfo1(ATableName: string; var AClassList1, AClassList2: TStringList);
var
  FieldList, SetMethodList, PropertyList: TStringList;
  ColumnName, ColumnType, MethodDefine: string;
  Fields: string;
begin
  Fields := '//';

  //字段列表
  FieldList := TStringList.Create;
  FieldList.Clear;

  //Set方法列表
  SetMethodList := TStringList.Create;
  SetMethodList.Clear;

  //保存属性声明
  PropertyList := TStringList.Create;
  PropertyList.Clear;

  with DM do
  begin
    qryTemp.Close;
    qryTemp.SQL.Text := 'SELECT C.name as ColumnName, C.xtype AS ColumnType '
      + 'FROM sysobjects T,syscolumns C WHERE T.id =C.id AND T.xtype=''U'' '
      + 'AND T.name=''' + ATableName + '''';
    qryTemp.Open;

    qryTemp.First;
    FieldList.Add('  T' + ATableName + ' = class(' + BaseClassName + ')');
    FieldList.Add('  private');

    PropertyList.Add('  public' );
    while not qryTemp.Eof do
    begin
      ColumnName := qryTemp.FieldByName('ColumnName').AsString;
      ColumnType := GetColumnType(qryTemp.FieldByName('ColumnType').AsInteger);
      if (not cbAutoID.Checked) and (qryTemp.FieldByName('ColumnType').AsInteger = 108) then //自动编号字段
      begin
        qryTemp.Next;
        continue;
      end;

      Fields := Fields + ColumnName + ',';
      
      if cbNote.Checked = False then
        FieldList.Add('    F' + ColumnName + ': ' + ColumnType + ';')
      else
        FieldList.Add('    F' + ColumnName + ': ' + ColumnType + ';'
          + GetDBColumnType(qryTemp.FieldByName('ColumnType').AsInteger));

      //方法的声明部分    
      SetMethodList.Add('    procedure Set' + ColumnName + '(const Value: ' + ColumnType + ');');
      //属性的声明部分
      PropertyList.Add('    property ' + ColumnName + ': '  + ColumnType
        + ' read F' + ColumnName + ' write Set' + ColumnName + ';');   

      //以下是方法体

      //if 'procedure T' + ATableName + '.Set' + ColumnName
        //+ '(const Value: ' + ColumnType + ');' ='procedure TBankLoanPercent.SetID(const Value: integer);' then
        //showmessage('Have');
      AClassList2.Add('');
      AClassList2.Add('procedure T' + ATableName + '.Set' + ColumnName
        + '(const Value: ' + ColumnType + ');');
      AClassList2.Add('begin');
      AClassList2.Add('  F' + ColumnName + ' := Value;');
      AClassList2.Add('end;');

      qryTemp.Next;
    end;
    FieldList.Add('');

    PropertyList.Add('');
    if cbInsert.Checked then
      PropertyList.Add('    function Insert: boolean;');
    if cbAmend.Checked then
      PropertyList.Add('    function Amend: boolean;');
    if cbDelete.Checked then
      PropertyList.Add('    function Delete: boolean;');
    if cbSetFieldValues.Checked then
    begin
      qryTemp2.Close;
      qryTemp2.SQL.Text := 'sp_pkeys ' + ATableName;
      qryTemp2.Open;

      MethodDefine := 'SetFieldValues';
      if not qryTemp2.IsEmpty then //有主键
      begin
        MethodDefine := 'SetFieldValues(';
        qryTemp2.First;
        while not qryTemp2.Eof do
        begin
          qryTemp.Filtered := False;
          qryTemp.Filter := 'ColumnName=''' + qryTemp2.FieldByName('COLUMN_NAME').AsString + '''';
          qryTemp.Filtered := True;

          if not qryTemp.IsEmpty then
          begin
            if MethodDefine <> 'SetFieldValues(' then
              MethodDefine := MethodDefine + '; '
                + qryTemp.FieldByName('ColumnName').AsString
                + ':' + GetColumnType(qryTemp.FieldByName('ColumnType').AsInteger)
            else
              MethodDefine := MethodDefine
                + qryTemp.FieldByName('ColumnName').AsString
                + ':' + GetColumnType(qryTemp.FieldByName('ColumnType').AsInteger);
          end;
          qryTemp2.Next;
        end;
        MethodDefine := MethodDefine + ')';
        qryTemp.Filter := '';
      end;

      PropertyList.Add('    function ' + MethodDefine + ': boolean;');
    end;

    PropertyList.Add('  end;' );
    AClassList1.Text := Fields + #13#10 + FieldList.Text + SetMethodList.Text + PropertyList.Text ;

    if cbInsert.Checked then
    begin
      AClassList2.Add('');
      AClassList2.Add('function T' + ATableName + '.Insert: boolean;');
      AClassList2.Add('begin');
      AClassList2.Add('');
      AClassList2.Add('end;');
    end;

    if cbAmend.Checked then
    begin
      AClassList2.Add('');
      AClassList2.Add('function T' + ATableName + '.Amend: boolean;');
      AClassList2.Add('begin');
      AClassList2.Add('');
      AClassList2.Add('end;');
    end;

    if cbDelete.Checked then
    begin
      AClassList2.Add('');
      AClassList2.Add('function T' + ATableName + '.Delete: boolean;');
      AClassList2.Add('begin');
      AClassList2.Add('');
      AClassList2.Add('end;');
    end;
  end;

  if cbSetFieldValues.Checked then
  begin
    AClassList2.Add('');
    AClassList2.Add('function T' + ATableName + '.' + MethodDefine + ': boolean;');
    AClassList2.Add('begin');
    AClassList2.Add('');
    AClassList2.Add('end;');
  end;

  FieldList.Free;
  PropertyList.Free;
  SetmethodList.Free;
end;

function TFrmMain.GetFileName(AFileName: string): string;
var
  i: integer;
begin
  Result := '';
  for i := 1 to Length(AFileName) do
  begin
    if AFileName[i] = '.' then
    begin
      Result := Trim(Result);
      Exit;
    end;
    Result := Result + AFileName[i];
  end;
end;

procedure TFrmMain.SpeedButton1Click(Sender: TObject);
var
  i: integer;
begin
  inherited;
  for i := 0 to clbTable.Items.Count - 1 do
  begin
    clbTable.Checked[i] := True;
  end;
end;

procedure TFrmMain.SpeedButton2Click(Sender: TObject);
var
  i: integer;
begin
  inherited;
  for i := 0 to clbTable.Items.Count - 1 do
  begin
    clbTable.Checked[i] := False;
  end;
end;

procedure TFrmMain.SpeedButton3Click(Sender: TObject);
var
  i: integer;
begin
  inherited;
  for i := 0 to clbTable.Items.Count - 1 do
  begin
    clbTable.Checked[i] := not clbTable.Checked[i];
  end;
end;

procedure TFrmMain.SaveToFile(AList: TStringList = nil);
var
  UnitName, ExtendName: string;
begin
  inherited;
  if AList.Text = '' then
  begin
    MessageBox(Handle, '没有生成任何类代码，不能保存！', '提示', MB_OK);
    Exit;
  end;

  SaveDialog1.FileName := Trim(cbxDBName.Text);

  case rdgFileType.ItemIndex of
    0:
      begin
        ExtendName := '.pas';
        SaveDialog1.FilterIndex := 2;
      end;
    1:
      begin
        ExtendName := '.txt';
        SaveDialog1.FilterIndex := 1;
      end;
  end;
  if SaveDialog1.Execute then
  begin
    UnitName := GetFileName(ExtractFileName(SaveDialog1.FileName));
    AList[1] := 'Unit ' + UnitName + ';';
    SaveDialog1.FileName := UnitName + ExtendName;
    AList.SaveToFile(SaveDialog1.FileName);
  end;
end;

procedure TFrmMain.ToolButton4Click(Sender: TObject);
begin
  inherited;
  SaveToFile(ClassInfoList);
end;

function TFrmMain.GetSelTableCount(AclbTable: TCheckListBox): integer;
var
  i: integer;
begin
  Result := 0;
  for i := 0 to AclbTable.Items.Count - 1 do
  begin
    if AclbTable.Checked[i] then
      inc(Result);
  end;
end;

procedure TFrmMain.rdgFileTypeClick(Sender: TObject);
begin
  inherited;
  case rdgFileType.ItemIndex of
    0:
      begin
        cbInsert.Enabled := True;
        cbAmend.Enabled := True;
        cbDelete.Enabled := True;
        cbSetFieldValues.Enabled := True;
      end;
    1:
      begin
        cbInsert.Enabled := False;
        cbAmend.Enabled := False;
        cbDelete.Enabled := False;
        cbSetFieldValues.Enabled := False;
      end;
  end;
end;

end.