Delphi World - Отобразить определенного формата файлы базы данных
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Отобразить определенного формата файлы базы данных

unit DdhDynDb;

interface

uses
  Controls, Db, Forms, Classes, DbTables;

function ConvertClass(FieldClass: TFieldClass): TControlClass;

procedure NormalizeString(var S: string);

procedure ConnectDataFields(DbComp: TControl;
  DataSource: TDataSource; FieldName: string);

function GenerateForm(StrList: TStringList;
  SourceTable: TTable): TForm;

function GenerateSource(AForm: TForm;
  FormName, UnitName: string): string;

implementation

uses
  TypInfo, DbCtrls, SysUtils, StdCtrls, ExtCtrls, Windows;

const
  FieldTypeCount = 15;

type
  CVTable = array[1..FieldTypeCount, 1..2] of TClass;

  // TBytesField and TVarBytesField are missing
const
  ConvertTable: CVTable = (
    (TAutoIncField, TDBEdit),
    (TStringField, TDBEdit),
    (TIntegerField, TDBEdit),
    (TSmallintField, TDBEdit),
    (TWordField, TDBEdit),
    (TFloatField, TDBEdit),
    (TCurrencyField, TDBEdit),
    (TBCDField, TDBEdit),
    (TBooleanField, TDBCheckBox),
    (TDateTimeField, TDBEdit),
    (TDateField, TDBEdit),
    (TTimeField, TDBEdit),
    (TMemoField, TDBMemo),
    (TBlobField, TDBImage), {just a guess}
    (TGraphicField, TDBImage));

function ConvertClass(FieldClass: TFieldClass):
  TControlClass;
var
  I: Integer;
begin
  Result := nil;
  for I := 1 to FieldTypeCount do
    if ConvertTable[I, 1] = FieldClass then
    begin
      Result := TControlClass(
        ConvertTable[I, 2]);
      break; // jump out of for loop
    end;
  if Result = nil then
    raise Exception.Create('ConvertClass failed');
end;

procedure NormalizeString(var S: string);
var
  N: Integer;
begin
  // remove the T
  Delete(S, 1, 1);
  {chek if the string is a valid Pascal identifier:
  if not, replace spaces and other characters with underscores}
  if not IsValidIdent(S) then
    for N := 1 to Length(S) do
      if not ((S[N] in ['A'..'Z']) or (S[N] in ['a'..'z'])
        or ((S[N] in ['0'..'9']) and (N <> 1))) then
        S[N] := '_';
end;

procedure ConnectDataFields(DbComp: TControl;
  DataSource: TDataSource; FieldName: string);
var
  PropInfo: PPropInfo;
begin
  if not Assigned(DbComp) then
    raise Exception.Create(
      'ConnectDataFields failed: Invalid control');

  // set the DataSource property
  PropInfo := GetPropInfo(
    DbComp.ClassInfo, 'DataSource');
  if PropInfo = nil then
    raise Exception.Create(
      'ConnectDataFields failed: Missing DataSource property');
  SetOrdProp(DbComp, PropInfo,
    Integer(Pointer(DataSource)));

  // set the DataField property
  PropInfo := GetPropInfo(
    DbComp.ClassInfo, 'DataField');
  if PropInfo = nil then
    raise Exception.Create(
      'ConnectDataFields failed: Missing DataField property');
  SetStrProp(DbComp, PropInfo, FieldName);
end;

function GenerateForm(StrList: TStringList;
  SourceTable: TTable): TForm;
var
  I, NumField, YComp, HForm, Hmax: Integer;
  NewName: string;
  NewLabel: TLabel;
  NewDBComp: TControl;
  CtrlClass: TControlClass;
  ATable: TTable;
  ADataSource: TDataSource;
  APanel: TPanel;
  ANavigator: TDBNavigator;
  AScrollbox: TScrollBox;
begin
  // generate the form and connect the table
  Result := TForm.Create(Application);
  Result.Position := poScreenCenter;
  Result.Width := Screen.Width div 2;
  Result.Caption := 'Table Form';

  // create a Table component in the result form
  ATable := TTable.Create(Result);
  ATable.DatabaseName := SourceTable.DatabaseName;
  ATable.TableName := SourceTable.TableName;
  ATable.Active := True;
  ATable.Name := 'Table1';
  // component position (at design time)
  ATable.DesignInfo := MakeLong(20, 20);

  // create a DataSource
  ADataSource := TDataSource.Create(Result);
  ADataSource.DataSet := ATable;
  ADataSource.Name := 'DataSource1';
  // component position (at design time)
  ADataSource.DesignInfo := MakeLong(60, 20);

  // create a toolbar panel
  APanel := TPanel.Create(Result);
  APanel.Parent := Result;
  APanel.Align := alTop;
  APanel.Name := 'Panel1';
  APanel.Caption := '';

  // place a DBNavigator inside it
  ANavigator := TDBNavigator.Create(Result);
  ANavigator.Parent := APanel;
  ANavigator.Left := 8;
  ANavigator.Top := 8;
  ANAvigator.Height := APanel.Height - 16;
  ANavigator.DataSource := ADataSource;
  ANavigator.Name := 'DbNavigator1';

  // create a scroll box
  AScrollbox := TScrollBox.Create(Result);
  AScrollbox.Parent := Result;
  AScrollbox.Width := Result.ClientWidth;
  AScrollbox.Align := alClient;
  AScrollbox.BorderStyle := bsNone;
  AScrollbox.Name := 'ScrollBox1';

  // generates field editors
  YComp := 10;
  for I := 0 to StrList.Count - 1 do
  begin
    NumField := Integer(StrList.Objects[I]);

    // create a label with the field name
    NewLabel := TLabel.Create(Result);
    NewLabel.Parent := AScrollBox;
    NewLabel.Name := 'Label' + IntToStr(I);
    NewLabel.Caption := StrList[I];
    NewLabel.Top := YComp;
    NewLabel.Left := 10;
    NewLabel.Width := 120;

    // create the data aware control
    CtrlClass := ConvertClass(
      ATable.FieldDefs[NumField].FieldClass);
    NewDBComp := CtrlClass.Create(Result);
    NewDBComp.Parent := AScrollBox;
    NewName := CtrlClass.ClassName +
      ATable.FieldDefs[NumField].Name;
    NormalizeString(NewName);
    NewDBComp.Name := NewName;
    NewDBComp.Top := YComp;
    NewDBComp.Left := 140;
    NewDbComp.Width :=
      AScrollBox.Width - 150; // width of label plus border

    // connect the control with the data source
    // and field using RTTI support
    ConnectDataFields(NewDbComp,
      ADataSource,
      ATable.FieldDefs[NumField].Name);

    // compute the position of the next component
    Inc(YComp, NewDBComp.Height + 10);
  end; // for each field

  // computed requested height for client area
  HForm := YComp + APanel.Height;
  // max client area hight = screen height - 40 - form border
  HMax := (Screen.Height - 40 -
    (Result.Height - Result.ClientHeight));
  // limit form height to HMax and reserve space for scrollbar
  if HForm > HMax then
  begin
    HForm := HMax;
    Result.Width := Result.Width +
      GetSystemMetrics(SM_CXVSCROLL);
  end;
  Result.ClientHeight := HForm;
end;

function GenerateSource(AForm: TForm;
  FormName, UnitName: string): string;
var
  I: Integer;
begin
  SetLength(Result, 20000);

  // generate the first part of the unit source
  Result :=
    'unit ' + UnitName + ';'#13#13 +
    'interface'#13#13 +
    'uses'#13 +
    '  SysUtils, WinTypes, WinProcs, Messages, Classes,'#13 +
    '  Forms, Graphics, Controls, Dialogs, DB, DBCtrls,'#13 +
    '  DBTables, ExtCtrls;'#13#13 +
    'type'#13 +
    '  T' + FormName + ' = class(TForm)'#13;

  // add each component of the form
  for I := 0 to AForm.ComponentCount - 1 do
    Result := Result +
      '    ' + AForm.Components[I].Name +
      ': ' + AForm.Components[I].ClassName + ';'#13;

  // generate the final part of the source code
  Result := Result +
    '  private'#13 +
    '    { Private declarations }'#13 +
    '  public'#13 +
    '    { Public declarations }'#13 +
    '  end;'#13#13 +
    'var'#13 +
    '  ' + FormName + ': T' + FormName + ';'#13#13 +
    'implementation'#13#13 +
    '{$R *.DFM}'#13#13 +
    'end.'#13;
end;

end.
unit DdhDbwF;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ExtCtrls, Grids, DB, DBTables,
  Buttons, Mask, DBCtrls;

type
  TFormDbWiz = class(TForm)
    Notebook1: TNotebook;
    Label1: TLabel;
    ListDatabases: TListBox;
    BitBtnNext1: TBitBtn;
    BitBtnNext2: TBitBtn;
    Label2: TLabel;
    ListTables: TListBox;
    BitBtnBack2: TBitBtn;
    ListFields: TListBox;
    Label3: TLabel;
    BitBtnNext3: TBitBtn;
    BitBtnBack3: TBitBtn;
    Label4: TLabel;
    BitBtnNext4: TBitBtn;
    BitBtnBack4: TBitBtn;
    GroupFilter: TRadioGroup;
    BitBtnAll: TBitBtn;
    BitBtnNone: TBitBtn;
    StringGrid1: TStringGrid;
    Table1: TTable;
    procedure Notebook1PageChanged(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ListDatabasesClick(Sender: TObject);
    procedure BitBtnNext1Click(Sender: TObject);
    procedure ListTablesClick(Sender: TObject);
    procedure BitBtnBack2Click(Sender: TObject);
    procedure BitBtnNext2Click(Sender: TObject);
    procedure BitBtnBack3Click(Sender: TObject);
    procedure BitBtnAllClick(Sender: TObject);
    procedure BitBtnNoneClick(Sender: TObject);
    procedure BitBtnNext3Click(Sender: TObject);
    procedure BitBtnBack4Click(Sender: TObject);
    procedure ListFieldsClick(Sender: TObject);
    procedure BitBtnNext4Click(Sender: TObject);
  private
    { Private declarations }
  public
    SourceCode, FormName, UnitName: string;
    ResultForm: TForm;
    procedure GeneratedFormClose(
      Sender: TObject; var Action: TCloseAction);
  end;

var
  FormDbWiz: TFormDbWiz;

implementation

{$R *.DFM}

uses
  DdhDynDb, ExptIntf;

////// form code //////

procedure TFormDbWiz.Notebook1PageChanged(Sender: TObject);
begin
  // copy the name of the page into the caption
  Caption := Format(
    'Ddh DB Form Wizard - Page %d/%d: ',
    [NoteBook1.PageIndex + 1,
    NoteBook1.Pages.Count,
      NoteBook1.ActivePage]);
end;

procedure TFormDbWiz.FormCreate(Sender: TObject);
begin
  // fill the first listbox with database names
  Session.GetDatabaseNames(
    ListDatabases.Items);
  // start in the first page
  Notebook1.PageIndex := 0;
  // default values (modified by the wizard)
  FormName := 'TResultForm';
  UnitName := 'ResultUnit';
end;

procedure TFormDbWiz.ListDatabasesClick(Sender: TObject);
begin
  // database selected: enable the Next button
  BitBtnNext1.Enabled := True;
end;

procedure TFormDbWiz.BitBtnNext1Click(Sender: TObject);
var
  CurrentDB, CurrentFilter: string;
begin
  // get the database and filters
  CurrentDB := ListDatabases.Items[
    ListDatabases.ItemIndex];
  CurrentFilter := GroupFilter.Items[
    GroupFilter.ItemIndex];
  // retrieve the tables
  Session.GetTableNames(CurrentDB,
    CurrentFilter, True, False, ListTables.Items);
  // move to the next page
  NoteBook1.PageIndex := 1;
  BitBtnNext2.Enabled := False;
end;

procedure TFormDbWiz.ListTablesClick(Sender: TObject);
begin
  // table selected: enable next button
  BitBtnNext2.Enabled := True;
end;

procedure TFormDbWiz.BitBtnBack2Click(Sender: TObject);
begin
  // go back to first page
  NoteBook1.PageIndex := 0;
end;

procedure TFormDbWiz.BitBtnNext2Click(Sender: TObject);
var
  I: Integer;
begin
  // set the properties of the selected table
  with Table1 do
  begin
    DatabaseName := ListDatabases.Items[
      ListDatabases.ItemIndex];
    TableName := ListTables.Items[
      ListTables.ItemIndex];
    // load the field definitions
    FieldDefs.Update;
  end;
  // clear the list box, then fill it
  ListFields.Clear;
  for I := 0 to Table1.FieldDefs.Count - 1 do
    // add number, name, and class name of each field
    ListFields.Items.Add(Format(
      '%d) %s [%s]',
      [Table1.FieldDefs[I].FieldNo,
      Table1.FieldDefs[I].Name,
        Table1.FieldDefs[I].FieldClass.ClassName]));
  // move to the next page
  NoteBook1.PageIndex := 2;
  BitBtnNext3.Enabled := False;
end;

procedure TFormDbWiz.BitBtnBack3Click(Sender: TObject);
begin
  // back to the second page
  NoteBook1.PageIndex := 1;
end;

procedure TFormDbWiz.BitBtnAllClick(Sender: TObject);
var
  I: Integer;
begin
  // select every available field
  for I := 0 to ListFields.Items.Count - 1 do
    ListFields.Selected[I] := True;
  // enable Next button
  BitBtnNext3.Enabled := True;
end;

procedure TFormDbWiz.BitBtnNoneClick(Sender: TObject);
var
  I: Integer;
begin
  // deselect all the fields
  for I := 0 to ListFields.Items.Count - 1 do
    ListFields.Selected[I] := False;
  // disable next button (no fields are selected)
  BitBtnNext3.Enabled := False;
end;

procedure TFormDbWiz.ListFieldsClick(Sender: TObject);
begin
  // enable button if there at least one field selected
  BitBtnNext3.Enabled := ListFields.SelCount > 0;
end;

procedure TFormDbWiz.BitBtnNext3Click(Sender: TObject);
var
  I, RowNum: Integer;
begin
  // reserve enough rows in the string grid
  StringGrid1.RowCount := ListFields.Items.Count;
  // empty the string grid
  for I := 0 to StringGrid1.RowCount - 1 do
  begin
    StringGrid1.Cells[0, I] := '';
    StringGrid1.Cells[1, I] := '';
  end;
  // for each field, if selected list it with the
  // corresponding data aware component
  RowNum := 0;
  for I := 0 to ListFields.Items.Count - 1 do
    if ListFields.Selected[I] then
    begin
      StringGrid1.Cells[0, RowNum] := Format('%d) %s [%s]',
        // field number, name, classname of data aware control
        [Table1.FieldDefs[I].FieldNo,
        Table1.FieldDefs[I].Name,
          ConvertClass(Table1.FieldDefs[I].FieldClass).ClassName]);
      StringGrid1.Cells[1, RowNum] := Table1.FieldDefs[I].Name;
      Inc(RowNum);
    end;
  // set the real number of rows
  StringGrid1.RowCount := RowNum;
  NoteBook1.PageIndex := 3;
end;

procedure TFormDbWiz.BitBtnBack4Click(Sender: TObject);
begin
  NoteBook1.PageIndex := 2;
end;

// generate button

procedure TFormDbWiz.BitBtnNext4Click(Sender: TObject);
var
  StrList: TStringList;
  I, RowNum: Integer;
begin
  StrList := TStringList.Create;
  Screen.Cursor := crHourGlass;
  try
    RowNum := 0;
    for I := 0 to ListFields.Items.Count - 1 do
      if ListFields.Selected[I] then
      begin
        StrList.AddObject(
          StringGrid1.Cells[1, RowNum], TObject(I));
        // move to next row in string grid
        Inc(RowNum);
      end;
    ResultForm := GenerateForm(StrList, Table1);
    if not Assigned(ToolServices) then
    begin
      // stand alone form
      ResultForm.OnClose := GeneratedFormClose;
      ResultForm.Show;
    end
    else
    begin
      // wizard
      SourceCode := GenerateSource(ResultForm,
        FormName, UnitName);
      ModalResult := mrOK;
    end;
  finally
    Screen.Cursor := crDefault;
    StrList.Free;
  end;
end;

procedure TFormDbWiz.GeneratedFormClose(
  Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
end;

end.
Скачать весь проект
Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования