Текущий архив: 2005.08.07;
Скачать: CL | DM;

Вниз

Требуется помощь в изменении компонента.   Найти похожие ветки 

← →
Константин Рязанкин   (2004-08-09 21:11) [0]

Доброго времени суток.
Есть такой компонент:

unit BitBtnSelect;

interface

uses
 SysUtils, Classes, Controls, StdCtrls, Buttons,Dialogs,Select_book,ADODB,DB,DBCtrls;

type
 TBitBtnSelect = class(TBitBtn)
 private
   FSelect:TF_Select;
   FCaption:TCaption;
   Fado:TADOConnection;
   FTableSelect:string;
   FKeyField:string;
   FValueField:string;
   procedure SetFormField(Value:TWinControl);
   procedure SetCaption(Value:TCaption);
   procedure SetADO(Value:TADOConnection);
   procedure SetTableSelect(Value:string);
   procedure SetKeyField(Value:string);
   procedure SetValueField(Value:string);
 public
   constructor Create(AOwner: TComponent); override;
 published
   property AdoConnection:TADOConnection read Fado write SetAdo;
   property TableSelect:string read FTableSelect write SetTableSelect;
   property KeyField   :string read FKeyField    write SetKeyField;
   property ValueField :string read FValueField  write SetValueField;
 end;

procedure Register;

implementation

procedure Register;
begin
 RegisterComponents("My Component", [TBitBtnSelect]);
end;

constructor TBitBtnSelect.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 FAdo:=nil;
 Caption:="";
 FCaption:="";
 FTableSelect:="";
 FKeyField:="";
 FValueField:="";
end;

procedure TBitBtnSelect.SetADO(Value:TADOConnection);
begin
 if Value <> FADO then
 begin
   FAdo := Value;
   Invalidate;
 end;
end;

procedure TBitBtnSelect.SetTableSelect(Value:string);
begin
 FTableSelect := Value;
end;

procedure TBitBtnSelect.SetKeyField(Value:string);
begin
   FKeyField := Value;
end;

procedure TBitBtnSelect.SetValueField(Value:string);
begin
   FValueField := Value;
end;
end.

Хотелось TableSelect не вводить ручками, а выбирать из списка, полученного из RecordSet:
rc:=Fado.Execute("select name from sysobjects")

---

← →
Юрий Зотов ©   (2004-08-10 09:27) [1]

1. Из всех методов нужен только SetADO. Остальные (включая конструктор) ничего не делают и их можно совершенно спокойно убрать.

2. В SetAdo не хватает FreeNotification, а еще требуется замещение Notification. Иначе после удаления компонента, на который ссылается поле FADO будете получать Access Violation.

2. По сабжу - нужно написать редактор свойства. Отнаследуйте его от TStringProperty, заместите методы GetAttributes и  GetValues. Подробности см. в справке по TPropertyEditor и в коде модуля DesignEditors.

---

← →
Константин Рязанкин   (2004-08-10 10:03) [2]

Юрий Зотов ©   (10.08.04 09:27) [1]
Писать редактор свойства пробовал. Проблема в том, что у меня не получается из ф-ции GetValues достучаться до Fado.

---

← →
Юрий Зотов ©   (2004-08-10 10:11) [3]

TBitBtnSelect(GetComponent(0)).AdoConnection

---

← →
Sandman25 ©   (2004-08-10 10:21) [4]

Константин Рязанкин  

Очень рекомендую писать const перед описанием формальных параметров типа String.

---

← →
Константин Рязанкин   (2004-08-10 10:43) [5]

Юрий Зотов ©   (10.08.04 10:11) [3]

Получилось следующее:
type
 TTSPropED=class(TPropertyEditor)
 public
   procedure GetValues(proc:TGetStrProc); override;
   function GetAttributes:TPropertyAttributes; override;
 end;

function TTSPropED.GetAttributes:TPropertyAttributes;
begin
 Result:=[paValueList];
end;

procedure TTSPropED.GetValues(proc:TGetStrProc);
var
dd:TADOConnection;
 cc:_Recordset;
 sql:string;
begin
 dd:=TSpdBtnSelect(GetComponent(0)).AdoConnection;
 if dd <> nil then
 begin
   sql:="select name from sysobjects";
   cc:=dd.Execute(sql);
   ShowMessage("select yes");
   while not cc.EOF do
     begin
       proc(cc.Fields["name"].Value);
       cc.MoveNext;
     end;
   cc:=nil;
 end;
end;

 TSpdBtnSelect = class(TSpeedButton)
 private
...
   FTableSelect:TStringList;
...
   procedure SetTableSelect(Value:TStringList);
 published
   property TableSelect:TStringList read FTableSelect write SetTableSelect;
...


Список получен, но выбранное значение не отображется в свойстве TableSelect

---

← →
Юрий Зотов ©   (2004-08-10 19:39) [6]

Наследуйтесь от TStringProperty. И исправьте GetAttributes:
Result := inherited GetAttributes + [paValueList]

---

Страницы: 1 вся ветка

Текущий архив: 2005.08.07;
Скачать: CL | DM;

Наверх

Память: 0.48 MB
Время: 0.05 c