Отобразить определенного формата файлы базы данныхDelphi , Базы данных , База данныхОтобразить определенного формата файлы базы данных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 и FreePascal. Комментарии и вопросыМатериалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта. :: Главная :: База данных ::
|
||||
©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007 |