Помогите написать компонент с 2 полями TDataField

← →
denissoft © (2005-10-12 13:00) [0]

Написал компонент для базы данных в котором два поля
Наследник от TcomboBox
В котором
1) property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;

2) property DataItemField: string read GetDataField write SetDataField;
property DataItemSource: TDataSource read GetDataSource write SetDataSource;
Для первого список с именами полей БД есть а для второго нету, в чем причина?
Во втором случаи надо вводить имя поля руками, неудобно все таки.

← →
denissoft © (2005-10-12 13:08) [1]

unit DBcomItemEdit;

interface

uses
Windows, Messages, SysUtils, Classes, Controls, StdCtrls, DbcomboBoxEdit,db,adodb,DBCtrls;

type
TDBcomItemEdit = class(TDbcomboBoxEdit)
private
FDataLink: TFieldDataLink;
FTexT:string;
Fid:string;
procedure DataChange( Sender: TObject );
procedure UpdateData( Sender: TObject );
Function TextToId:String;
Function GetTextFromId:String;

{ Private declarations }
protected
procedure Change; override;
function GetComboText: string;
function GetDataField: string;
procedure SetDataField( const Value: string );
function GetDataSource: TDataSource;
procedure SetDataSource( Value: TDataSource );
procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
procedure CMExit(var Message: TCMExit); message CM_EXIT;
procedure SetComboText( const Value: string );
{ Protected declarations }
public
destructor Destroy; override;
constructor Create( AOwner: TComponent ); override;
{ Public declarations }
published
property DataItemField: string read GetDataField write SetDataField;
property DataItemSource: TDataSource read GetDataSource write SetDataSource;
property ID:string read Fid write Fid;

{ Published declarations }
end;

procedure Register;

implementation
Function TDBcomItemEdit.TextToId:String;
begin
DataItemSource.DataSet.Filter:=DataItemField+" = "+#39+text+#39;
DataItemSource.DataSet.Filtered:=true;
FText:=DataItemSource.DataSet.FieldByName(Fid).AsString;
result:=Ftext;
if DataItemSource.DataSet.RecordCount = 0 then begin
DataItemSource.DataSet.Append;
DataItemSource.DataSet.FieldByName(DataItemField).AsString:=text;
DataItemSource.DataSet.Post;
FText:=DataItemSource.DataSet.FieldByName(Fid).AsString;
result:=Ftext;
end;
DataItemSource.DataSet.Filtered:=false;
end;
procedure TDBcomItemEdit.CMExit(var Message: TCMExit);
begin
try
FDataLink.UpdateRecord;
except
SetFocus;
raise;
end;
inherited;
end;

destructor TDBcomItemEdit.Destroy;
begin

FDataLink.Free;
FDataLink := nil;
inherited Destroy;
end;

Function TDBcomItemEdit.GetTextFromId:String;
begin
result:="";
if DataItemSource<>nil then
if DataItemSource.DataSet<>nil then begin
if DataSource.dataset.FieldByName(DataField).AsString<>"" then begin
DataItemSource.DataSet.Filter:=Fid+"= "+#39+ DataSource.dataset.FieldByName(DataField).AsString+#39;
DataItemSource.DataSet.Filtered:=true;
if not DataItemSource.DataSet.Active then
DataItemSource.DataSet.Active:=true;
if DataItemSource.DataSet.Active then begin
text:=DataItemSource.DataSet.Name;
Text:=DataItemSource.DataSet.FieldByName(DataItemField).AsString;
result:=text;
DataItemSource.DataSet.Filtered:=false;
end;
end;
end;
end;

procedure TDBcomItemEdit.Change;
begin
FDataLink.Edit;
inherited Change;
FDataLink.Modified;
end;

Function TDBcomItemEdit.GetComboText: string;
begin
Result := Text
end;
procedure TDBcomItemEdit.DataChange( Sender: TObject );
begin

if not ( Style = csSimple ) and DroppedDown then
Exit;
if DataLink<>nil then
if DataLink.Field <> nil then
SetComboText( GetTextFromId )
else
if csDesigning in ComponentState then
SetComboText( Name )
else
SetComboText( "" );

end;
procedure TDBcomItemEdit.SetComboText( const Value: string );
var
I: Integer;
Redraw: Boolean;
begin
if Value <> GetComboText then
begin
if Style <> csDropDown then
begin
Redraw := ( Style <> csSimple ) and HandleAllocated;
if Redraw then
SendMessage( Handle, wm_SetRedraw, 0, 0 );
try
if Value = "" then
I := -1
else
I := Items.IndexOf( Value );
ItemIndex := I;
finally
if Redraw then
begin
SendMessage( Handle, wm_SetRedraw, 1, 0 );
Invalidate;
end;
end;

if I >= 0 then
Exit;
end;
if Style in [ csDropDown, csSimple ] then
Text := Value;
end;
end;
procedure TDBcomItemEdit.CMEnter(var Message: TCMEnter);
var x:integer;
TBL:TADOQuery;
begin
if FDataLink.DataSource<>nil then begin
try
begin

if FDataLink.DataSource.DataSet.ClassType =ADODB.TADOTable then begin
try

TBL:=TADOQuery.Create(nil);
if TADOTable(FDataLink.DataSource.DataSet).Connection<>nil then
tbl.Connection:=TADOTable(FDataLink.DataSource.DataSet).Connection
else
tbl.ConnectionString:= TADOTable(FDataLink.DataSource.DataSet).ConnectionString;
TBL.SQL.Clear;
TBL.SQL.add("Select "+GetDataField);
TBL.SQL.add("From "+TADOTable(FDataLink.DataSource.DataSet).TableName);
TBL.SQL.add("GROUP BY "+GetDataField+";");

tbl.Active:=true;

tbl.Filter:=FDataLink.DataSource.DataSet.Filter;
tbl.Filtered:=FDataLink.DataSource.DataSet.Filtered;
items.Clear;
if tbl.Active = true then
for x:=1 to tbl.RecordCount do begin
tbl.RecNo:=x;

items.Add(tbl.FieldByName(GetDataField).AsString);
end;

finally
TBL.Free;

end;

end;
end;
finally

end;
end;
end;

function TDBcomItemEdit.GetDataField: string;
begin
Result := FDataLink.FieldName;
end;
procedure TDBcomItemEdit.SetDataField( const Value: string );
begin

FDataLink.FieldName := Value;
end;

function TDBcomItemEdit.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;
procedure TDBcomItemEdit.SetDataSource( Value: TDataSource );
begin
if not ( FDataLink.DataSourceFixed and ( csLoading in ComponentState ) ) then
begin
FDataLink.DataSource := Value;
if Value <> nil then
Value.FreeNotification( Self );
if DataLink<>nil then
if DataLink.Field <> nil then
SetComboText( GetTextFromId );

end;
end;

constructor TDBcomItemEdit.Create( AOwner: TComponent );
begin
inherited Create( AOwner );
ControlStyle := ControlStyle + [ csReplicatable, csSetCaption ];
FDataLink := TFieldDataLink.Create;
FDataLink.Control := Self;
if DataLink<>nil then begin
DataLink.OnDataChange := DataChange;
DataLink.OnUpdateData := UpdateData;
end;

end;
procedure TDBcomItemEdit.UpdateData( Sender: TObject );
begin
if DataLink<>nil then
DataLink.Field.Text := TextToId;
end;

procedure Register;
begin
RegisterComponents("Data Controls", [TDBcomItemEdit]);
end;

end.

← →
Юрий Зотов © (2005-10-12 14:06) [2]

> Для первого список с именами полей БД есть а для второго нету,
> в чем причина?

В том, что редактор свойства TDataFieldProperty в VCL регистрируется для свойств с именем DataField и ни с каким другим. Вот выдержка из DBReg.pas:

RegisterPropertyEditor(TypeInfo(string), TComponent, "DataField", TDataFieldProperty);

Естественно, к свойству с другим именем (DataItemField) редактор не подключается и выпадающего списка полей нет. А чтобы он подключился и список появился, добавьте в Вашу процедуру регистрации строку:

RegisterPropertyEditor(TypeInfo(string), TDBcomItemEdit, "DataItemField", TDataFieldProperty);

И не забудьте подключить в Uses модуль DBReg.

Спасибо за информацию про RegisterPropertyEditor(TypeInfo(string), TComponent, "DataField", TDataFieldProperty);

В вот модуля я вот эти взял/
DBReg,DesignIntf, DesignEditors
http://community.borland.com/article/0,1410,27717,00.html

Помогите написать компонент с 2 полями TDataField Найти похожие ветки