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

Вниз

Разработка компонента "TDBCheckListBox"   Найти похожие ветки 

← →
zorik ©   (2006-12-14 10:54) [0]

Помогите, пожалуйста, с написанием компонента. Компонент должен формировать список СheckListBox с DataSet. Причем, выделение (Checked) никак не повязано с данными. Оно используется для выбора нужных записей. Входные параметры DataSource и DataField. При навигации по списке, должна происходить синхронная навигация по DataSet и наоборот.
Не могу определится кокой клас связи с БД выбрать - TFieldDataLink или TDataSourceLink. И в каком методе TFieldDataLink или TDataSourceLink прописать "перерисование", тоесть где меняется входной набор данных


 TZDBCheckListBox = class;

 
 TZDataLink = class(TFieldLink)
 private
   FCheckListBox: TZDBCheckListBox;
 ...
 TZDBCheckListBox = class(TDBLookupControl)
 private
   FDataLink: TZDatalink;



---

← →
DimaBr   (2006-12-14 11:25) [1]

Мне кажется почти ваш случай
http://www.rsdn.ru/article/delphi/dbaware.xml#EGB

---

← →
zorik ©   (2006-12-14 12:34) [2]

> DimaBr   (14.12.06 11:25) [1]
> Мне кажется почти ваш случайhttp://www.rsdn.ru/article/delphi/dbaware.
> xml#EGB


У меня книжка есть.
Сделал по примеру. Но там есть одно НО: если меняется набор DataSource, то не меняется список. Если попроще: Ставлю на форму две TQuery - master i details. свой компонент связываю c details. Если передвигатся по master, то вид моего компонента не изменяется. Не могу найти событие которое отвечает за это.

---

← →
DimaBr   (2006-12-14 13:36) [3]

fDataLink.OnDataChange

---

← →
zorik ©   (2006-12-14 14:00) [4]

OnDataChange вызывается при "любых" изменениях, даже при скролинге. Пробовал - зацикливается. Иду копать DBGrid может выкопаю :)

---

← →
DimaBr   (2006-12-14 14:24) [5]

Если вы объясните нормальным русским языком ( с примерами ) то можем поговорить ....

---

← →
zorik ©   (2006-12-14 15:13) [6]

Есть две таблици одна главная, вторая подчиненная. Если поставить 2 грида и связать их с этими таблицами, то при скролинге главной таблици (грида), содержимое подчниненной (второго грида) АВТОМАТИЧЕСКИ меняется. В моем случае такого АВТОМАТИЧЕСКИ не происходит, только если переоткрыть подчиненную таблицу, или вызвать метод который обновляет список моего компонента. Ищу в класcах TDataLink или в его потомках или в DataSet процедуру, событие которое отвечают за это изменение набора данных. Скорей всего это прячется где-то в DataSet. Цытата: DataSetChanged – отвечает за изменения содержимого набора данных. Все события, которые изменяют содержимое набора данных (активизация режима редактирования набора данных, вставка или удаление записей) форсируют вызов данного метода. События, специфичные представлению данных в наборе в контексте data-aware компонента (скроллинг, смена расположения информации) также ведут к вызову данного метода. Тем не менее функциональность этого метода сводится к тому, чтобы просто вызвать метод RecordChanged. Классы-наследники могут перекрыть данный метод с целью обеспечения дополнительной функциональности. Из этого следует что этот метод не подходит.
Вот что я на данный момент наваял:

unit ZDBCheckListBox;

interface

uses
 Windows, Messages, SysUtils, Classes, Controls, StdCtrls, CheckLst, DBCtrls,
 DB, ComCtrls, Forms, Variants;

type

 TZDBCheckListBox = class;

 TZDataLink = class(TDataSourceLink)
 private
   FCheckListBox: TZDBCheckListBox;
 protected
   procedure FocusControl(Field: TFieldRef); override;
   procedure ActiveChanged; override;
   procedure LayoutChanged; override;
   procedure RecordChanged(Field: TField); override;
   procedure DataSetChanged; override;
 public
   constructor Create(AOwner: TZDBCheckListBox); reintroduce; virtual;
 end;

 TZDBCheckListBox = class(TCheckListBox)
 private
   FDataLink: TZDataLink;
   FDataFieldName: String;
   FDataField: TField;
   procedure SetDataField(const Value: String);
   procedure SetDataSource(const Value: TDataSource);
   function GetDataSource: TDataSource;
 protected
   procedure RefreshList; virtual;
 public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
 published
   property DataSource: TDataSource read GetDataSource write SetDataSource;
   property DataField: string read FDataFieldName write SetDataField;
 end;

procedure Register;

implementation

procedure Register;
begin
 RegisterComponents("BBIC", [TZDBCheckListBox]);
end;

{
TZDataLink
Êàíàë çâ"ÿçó ç áàçîþ äàíèõ
--------------------------------------------------------------------------------
}

constructor TZDataLink.Create(AOwner: TZDBCheckListBox);
begin
 inherited Create;
 FCheckListBox := AOwner;
end;

procedure TZDataLink.ActiveChanged;
begin
 inherited;
 if FCheckListBox <> nil then FCheckListBox.RefreshList;
end;

procedure TZDataLink.FocusControl(Field: TFieldRef);
begin
 inherited;
 if (Field^ <> nil) and (Field^ = FCheckListBox.FDataField) and
   (FCheckListBox <> nil) and FCheckListBox.CanFocus then
 begin
   Field^ := nil;
   FCheckListBox.SetFocus;
 end;
end;

procedure TZDataLink.LayoutChanged;
begin
 inherited;
 if FCheckListBox <> nil then FCheckListBox.RefreshList;
end;

procedure TZDataLink.RecordChanged(Field: TField);
begin
 inherited;
 //if FCheckListBox <> nil then
 //  if DataSource.OnDataChange
 //  FCheckListBox.RefreshList;
end;

procedure TZDataLink.DataSetChanged;
begin
 inherited;
 //if FCheckListBox <> nil then FCheckListBox.RefreshList;
end;

{
TZDBCheckListBox
&#202;&#238;&#236;&#239;&#238;&#237;&#229;&#237;&#242;. &#209;&#239;&#232;&#241;&#238;&#234; &#231; &#226;&#232;&#225;&#238;&#240;&#238;&#236;, &#239;&#238;&#226;"&#255;&#231;&#224;&#237;&#232;&#233; &#231; &#239;&#238;&#235;&#229;&#236; &#225;&#224;&#231;&#232; &#228;&#224;&#237;&#232;&#245;
--------------------------------------------------------------------------------
}

constructor TZDBCheckListBox.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 FDataLink := TZDataLink.Create(Self);
end;

destructor TZDBCheckListBox.Destroy;
begin
 FDataLink.Free;
 inherited Destroy;
end;

procedure TZDBCheckListBox.SetDataSource(const Value: TDataSource);
begin
 FDataLink.DataSource := Value;
 RefreshList;
end;

procedure TZDBCheckListBox.SetDataField(const Value: String);
begin
 if FDataFieldName = Value then Exit;
 FDataFieldName := Value;
 RefreshList;
end;

function TZDBCheckListBox.GetdataSource: TDataSource;
begin
 Result := FDataLink.DataSource;
end;

procedure TZDBCheckListBox.RefreshList;
begin
 if FDataLink.DataSet = nil then Exit;
 Items.Clear;
 with FDataLink.DataSet do
   if Active then
   begin
     DisableControls;
     First;
     while not EOF do
     begin
       Items.Add(FieldByName(FDataFieldName).AsString);
       Next;
     end;
     EnableControls;
   end;
end;

end.


---

← →
zorik ©   (2006-12-14 15:31) [7]

Есть две таблици одна главная, вторая подчиненная. Если поставить 2 грида и связать их с этими таблицами, то при скролинге главной таблици (грида), содержимое подчниненной (второго грида) АВТОМАТИЧЕСКИ меняется. В моем случае такого АВТОМАТИЧЕСКИ не происходит, только если переоткрыть подчиненную таблицу, или вызвать метод который обновляет список моего компонента. Ищу в класcах TDataLink или в его потомках или в DataSet процедуру, событие которое отвечают за это изменение набора данных. Скорей всего это прячется где-то в DataSet. Цытата: DataSetChanged – отвечает за изменения содержимого набора данных. Все события, которые изменяют содержимое набора данных (активизация режима редактирования набора данных, вставка или удаление записей) форсируют вызов данного метода. События, специфичные представлению данных в наборе в контексте data-aware компонента (скроллинг, смена расположения информации) также ведут к вызову данного метода. Тем не менее функциональность этого метода сводится к тому, чтобы просто вызвать метод RecordChanged. Классы-наследники могут перекрыть данный метод с целью обеспечения дополнительной функциональности. Из этого следует что этот метод не подходит.
Вот что я на данный момент наваял:

unit ZDBCheckListBox;

interface

uses
 Windows, Messages, SysUtils, Classes, Controls, StdCtrls, CheckLst, DBCtrls,
 DB, ComCtrls, Forms, Variants;

type

 TZDBCheckListBox = class;

 TZDataLink = class(TDataSourceLink)
 private
   FCheckListBox: TZDBCheckListBox;
 protected
   procedure FocusControl(Field: TFieldRef); override;
   procedure ActiveChanged; override;
   procedure LayoutChanged; override;
   procedure RecordChanged(Field: TField); override;
   procedure DataSetChanged; override;
 public
   constructor Create(AOwner: TZDBCheckListBox); reintroduce; virtual;
 end;

 TZDBCheckListBox = class(TCheckListBox)
 private
   FDataLink: TZDataLink;
   FDataFieldName: String;
   FDataField: TField;
   procedure SetDataField(const Value: String);
   procedure SetDataSource(const Value: TDataSource);
   function GetDataSource: TDataSource;
 protected
   procedure RefreshList; virtual;
 public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
 published
   property DataSource: TDataSource read GetDataSource write SetDataSource;
   property DataField: string read FDataFieldName write SetDataField;
 end;

procedure Register;

implementation

procedure Register;
begin
 RegisterComponents("BBIC", [TZDBCheckListBox]);
end;

{
TZDataLink
Êàíàë çâ"ÿçó ç áàçîþ äàíèõ
--------------------------------------------------------------------------------
}

constructor TZDataLink.Create(AOwner: TZDBCheckListBox);
begin
 inherited Create;
 FCheckListBox := AOwner;
end;

procedure TZDataLink.ActiveChanged;
begin
 inherited;
 if FCheckListBox <> nil then FCheckListBox.RefreshList;
end;

procedure TZDataLink.FocusControl(Field: TFieldRef);
begin
 inherited;
 if (Field^ <> nil) and (Field^ = FCheckListBox.FDataField) and
   (FCheckListBox <> nil) and FCheckListBox.CanFocus then
 begin
   Field^ := nil;
   FCheckListBox.SetFocus;
 end;
end;

procedure TZDataLink.LayoutChanged;
begin
 inherited;
 if FCheckListBox <> nil then FCheckListBox.RefreshList;
end;

procedure TZDataLink.RecordChanged(Field: TField);
begin
 inherited;
 //if FCheckListBox <> nil then
 //  if DataSource.OnDataChange
 //  FCheckListBox.RefreshList;
end;

procedure TZDataLink.DataSetChanged;
begin
 inherited;
 //if FCheckListBox <> nil then FCheckListBox.RefreshList;
end;

{
TZDBCheckListBox
&#202;&#238;&#236;&#239;&#238;&#237;&#229;&#237;&#242;. &#209;&#239;&#232;&#241;&#238;&#234; &#231; &#226;&#232;&#225;&#238;&#240;&#238;&#236;, &#239;&#238;&#226;"&#255;&#231;&#224;&#237;&#232;&#233; &#231; &#239;&#238;&#235;&#229;&#236; &#225;&#224;&#231;&#232; &#228;&#224;&#237;&#232;&#245;
--------------------------------------------------------------------------------
}

constructor TZDBCheckListBox.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 FDataLink := TZDataLink.Create(Self);
end;

destructor TZDBCheckListBox.Destroy;
begin
 FDataLink.Free;
 inherited Destroy;
end;

procedure TZDBCheckListBox.SetDataSource(const Value: TDataSource);
begin
 FDataLink.DataSource := Value;
 RefreshList;
end;

procedure TZDBCheckListBox.SetDataField(const Value: String);
begin
 if FDataFieldName = Value then Exit;
 FDataFieldName := Value;
 RefreshList;
end;

function TZDBCheckListBox.GetdataSource: TDataSource;
begin
 Result := FDataLink.DataSource;
end;

procedure TZDBCheckListBox.RefreshList;
begin
 if FDataLink.DataSet = nil then Exit;
 Items.Clear;
 with FDataLink.DataSet do
   if Active then
   begin
     DisableControls;
     First;
     while not EOF do
     begin
       Items.Add(FieldByName(FDataFieldName).AsString);
       Next;
     end;
     EnableControls;
   end;
end;

end.


---

← →
DimaBr   (2006-12-14 15:35) [8]

> Есть две таблици одна главная, вторая подчиненная. Если
> поставить 2 грида и связать их с этими таблицами, то при
> скролинге главной таблици (грида), содержимое подчниненной
> (второго грида) АВТОМАТИЧЕСКИ меняется

Вы ошибаетесь, не автоматически а через связку Master-Details которая устанавливается путём назначения DataSource Master к Details.
Метод подходит, просто вы не умеете им пользоваться, посмотрите как реализовано в TTable.

constructor TTable.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 FIndexDefs := TIndexDefs.Create(Self);
 FMasterLink := TMasterDataLink.Create(Self);
 FMasterLink.OnMasterChange := MasterChanged;
 FMasterLink.OnMasterDisable := MasterDisabled;
 FIndexFiles := TIndexFiles.Create(Self);
 FDefaultIndex := True;
end;

---

← →
zorik ©   (2006-12-14 17:05) [9]

Запутался. TTable - это же невизуальный компонент. В общем случае его можна заменить на TDataSet. Меня интересует откуда TDBGrid знает что поменялось FMasterLink в связаной с ним TTable (TDataSet) и что ему нужно перерисовать себя. Можеn в событии OnDataChange узнать что изменился MasterLink. Но как?

---

← →
DimaBr   (2006-12-15 08:47) [10]

О-о-о-о-о-о-о-о....
Так вы батенька вообще к датасету прицепится не можете ?
http://www.akzhan.midi.ru/devcorner/akdbtnt-content/akdbtnt-0037.html

---

← →
zorik ©   (2006-12-15 09:20) [11]

Почему, я прицепился нормально. Но событие OnDataChange возникает при любіх манипуляциях - в результате зацикливание и переполнение

---

← →
zorik ©   (2006-12-15 10:17) [12]

Фу, сделал! Но как-то "примитивно":

constructor TZDataLink.Create(AOwner: TZDBCheckListBox);
begin
 inherited Create;
 FCheckListBox := AOwner;
 FBool := False;
end;

...

procedure TZDataLink.RecordChanged(Field: TField);
begin
 inherited;
 if not FBool then Exit;
   FCheckListBox.RefreshList;
end;

...

procedure TZDBCheckListBox.RefreshList;
var
 VOldPlace: TBookmark;
begin
 if FDataLink.DataSet = nil then Exit;
 with FDataLink.DataSet do
   if Active then
   begin
     FDataLink.FBool := False; //перед перерисовкой отключаем событие
     DisableControls;
     VOldPlace := GetBookmark;
     Items.Clear;
     First;
     while not EOF do
     begin
       Items.Add(FieldByName(FDataFieldName).AsString);
       Next;
     end;
     GotoBookmark(VOldPlace);
     EnableControls;
     FDataLink.FBool := True; //в конце включаем событие
   end;
end;



---

← →
DimaBr   (2006-12-15 10:23) [13]

Я думаю ваш код никто не читал.

---

← →
zorik ©   (2006-12-15 12:42) [14]

Да. Что-то глухо в разделе "компоненты". Спасибо и за это. Если нормально сделаю, может выложу

---

← →
DimaBr   (2006-12-15 12:47) [15]

Да не глухо, просто слишком большие участки кода нечитабельны.

---

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

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

Наверх

Память: 0.53 MB
Время: 0.016 c