Отобразить определенного формата файлы базы данных

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

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.

Скачать весь проект

{/codecitation}

Добавить комментарий