Компонентик не потестируете?

← →
Ega23 © (2007-02-22 11:17) [0]

Короче, задолбавшись с реализациями различных DBLookupCombo, написал свой.
Всё до тупого просто: компоненту даётся набор данных, дальше, при навигации по нему курсор набора данных смещается. Соответственно, при смещении курсора данных - обновляется текущее значение в комбике.
Основные свойства:

published
LookupSource : TDataSource - ссылка на источник данных
KeyField : string - ключевое поле в наборе данных (для нескольких полей не пробовал)
ListField : string - поле из НД, которое будет отображаться в Strings комбика.
Остальные - для расположения на форме (фрейме или что там у вас)

public
фактически, нужно только одно:
KeyValue : Variant - на чтение - получаем текущее значение ключевого поля в НД, при записи - позиционируемся на данное значение ключевого поля в НД.

← →
Ega23 © (2007-02-22 11:18) [1]

Исходник:
unit uKdrDBLookupCombo; interface {$i KdrDBLookupCombo.inc} uses {$IFDEF D7} Variants, {$ENDIF} SysUtils, Classes, Controls, StdCtrls, ExtCtrls, DB, Contnrs; type TCustomKdrDBLookupCombo = class; TLookupItem = class (TObject) private FItemIndex: Integer; FKeyValue: Variant; public property ItemIndex : Integer read FItemIndex write FItemIndex; property KeyValue : Variant read FKeyValue write FKeyvalue; end; TLookupItemsList = class (TObjectList) public function AddItem(Item : TLookupItem) : Integer; function GetItemByIndex(const Index : Integer) : TLookupItem; function GetItemByKey(const KeyValue : Variant) : TLookupItem; end; TLookupComboDataLink = class (TDataLink) private FCombo : TCustomKdrDBLookupCombo; protected constructor Create(ACombo:TCustomKdrDBLookupCombo); procedure DataSetChanged; override; procedure ActiveChanged; override; procedure RecordChanged(Field: TField); override; end; TCustomKdrDBLookupCombo = class (TCustomComboBox) private FChangeItemsLock : Boolean; FLookupItems : TLookupItemsList; FDataLink : TLookupComboDataLink; FDataSource: TDataSource; FKeyField: string; FListField: string; FKeyValue : Variant; FKeyValueChanged : Boolean; procedure SetFDataSource(const Value: TDataSource); function GetKeyValue: Variant; procedure SetKeyValue(const Value: Variant); procedure OnItemChange(Sender : TObject); protected procedure ActiveChanged; virtual; procedure DataChanged; virtual; procedure RecordChanged(Field: TField); virtual; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function AddLookupItem : Integer; procedure ClearAll; property LookupSource : TDataSource read FDataSource write SetFDataSource; property KeyField : string read FKeyField write FKeyField; property ListField : string read FListField write FListField; property KeyValue : Variant read GetKeyValue write SetKeyValue; end; TKdrDBLookupCombo = class (TCustomKdrDBLookupCombo) published property Anchors; property LookupSource; property KeyField; property ListField; property DropDownCount; property Enabled; property Font; property Color; property ParentFont; end; procedure Register; implementation procedure Register; begin RegisterComponents("KedrVCL", [TKdrDBLookupCombo]); end; //***************************************************************************** { TLookupItemsList } //***************************************************************************** function TLookupItemsList.AddItem(Item: TLookupItem): Integer; begin Result := -1; if Item=nil then Exit; Result := Add(Item); end; //***************************************************************************** function TLookupItemsList.GetItemByIndex( const Index: Integer): TLookupItem; var i : Integer; begin Result := nil; for i:=0 to Count-1 do if TLookupItem(Items[i]).ItemIndex = Index then begin Result := TLookupItem(Items[i]); Break; end; end; //***************************************************************************** function TLookupItemsList.GetItemByKey( const KeyValue: Variant): TLookupItem; var i : Integer; begin Result := nil; for i:=0 to Count-1 do if TLookupItem(Items[i]).KeyValue = KeyValue then begin Result := TLookupItem(Items[i]); Break; end; end; //*****************************************************************************

← →
Ega23 © (2007-02-22 11:18) [2]

{ TLookupComboDataLink } //***************************************************************************** procedure TLookupComboDataLink.ActiveChanged; var i:Integer; begin inherited; FCombo.ClearAll; if Assigned(DataSet) and (DataSet.Active) and (FCombo<>nil) and (dsBrowse in [DataSet.State]) then begin BufferCount:=DataSet.RecordCount; i:=0; ActiveRecord:=i; While (i<BufferCount) do begin FCombo.AddLookupItem; Inc(i); ActiveRecord:=i; end; ActiveRecord:=0; FCombo.ActiveChanged; end; end; //***************************************************************************** constructor TLookupComboDataLink.Create(ACombo: TCustomKdrDBLookupCombo); begin inherited Create; FCombo := ACombo; VisualControl:=True; end; //***************************************************************************** procedure TLookupComboDataLink.DataSetChanged; begin inherited; if (DataSet.Active) and (FCombo<>nil) and (dsBrowse in [DataSet.State]) then FCombo.DataChanged; end; //***************************************************************************** procedure TLookupComboDataLink.RecordChanged(Field: TField); begin inherited; if Assigned(DataSet) and (DataSet.Active) and (FCombo<>nil) and (dsBrowse in [DataSet.State]) then FCombo.RecordChanged(Field); end; //***************************************************************************** { TCustomKdrDBLookupCombo } //***************************************************************************** procedure TCustomKdrDBLookupCombo.ActiveChanged; begin Enabled := (FLookupItems.Count>0); if Enabled then begin FChangeItemsLock := True; try ItemIndex := 0; finally FChangeItemsLock := False; end; end; end; //***************************************************************************** function TCustomKdrDBLookupCombo.AddLookupItem: Integer; begin Result := -1; if (KeyField="") or (ListField="") then Exit; Result := FLookupItems.AddItem(TLookupItem.Create); TLookupItem(FLookupItems.Items[Result]).ItemIndex := Items.Add(FDataSource.DataSet.FieldByName(ListField).AsString); TLookupItem(FLookupItems.Items[Result]).KeyValue := FDataSource.DataSet.FieldByName(KeyField).Value; end; //***************************************************************************** procedure TCustomKdrDBLookupCombo.ClearAll; begin Items.Clear; FLookupItems.Clear; Enabled := False; end; //***************************************************************************** constructor TCustomKdrDBLookupCombo.Create(AOwner: TComponent); begin inherited; FChangeItemsLock := False; FKeyValueChanged := False; Style := csDropDownList; Enabled := False; FLookupItems := TLookupItemsList.Create(True); FDataLink := TLookupComboDataLink.Create(Self); OnChange := OnItemChange; end; //***************************************************************************** procedure TCustomKdrDBLookupCombo.DataChanged; var key : Variant; lcItem : TLookupItem; begin key := FDataSource.DataSet.FieldByName(KeyField).Value; lcItem:= FLookupItems.GetItemByKey(key); if lcItem=nil then begin // DataSet"s Data changed FDataLink.ActiveChanged; FKeyValueChanged := True; end else begin if FKeyValue=key then Exit; FChangeItemsLock := True; try ItemIndex := lcItem.ItemIndex; finally FChangeItemsLock := False; end; end; end; //***************************************************************************** destructor TCustomKdrDBLookupCombo.Destroy; begin FDataLink.Free; FLookupItems.Free; inherited; end; //***************************************************************************** function TCustomKdrDBLookupCombo.GetKeyValue: Variant; begin Result := null; if (not FDataSource.DataSet.Active) or (FDataSource.DataSet.IsEmpty) or (FDataSource.DataSet.ControlsDisabled) then Exit; Result := FDataSource.DataSet.FieldByName(KeyField).Value; end; //***************************************************************************** procedure TCustomKdrDBLookupCombo.OnItemChange(Sender: TObject); begin if FChangeItemsLock then Exit; FDataSource.DataSet.Locate(KeyField, FLookupItems.GetItemByIndex(ItemIndex).KeyValue, []); end; //***************************************************************************** procedure TCustomKdrDBLookupCombo.RecordChanged(Field: TField); begin end; //***************************************************************************** procedure TCustomKdrDBLookupCombo.SetFDataSource(const Value: TDataSource); begin if (Value<>nil) and (FDataSource<>Value) then begin FDataSource := Value; FDataLink.DataSource:=Value; end; end; //***************************************************************************** procedure TCustomKdrDBLookupCombo.SetKeyValue(const Value: Variant); begin if FChangeItemsLock then Exit; FKeyValueChanged := False; FDataSource.DataSet.Locate(KeyField, Value, []); if FKeyValueChanged then FKeyValue := Value; FKeyValueChanged := False; end; //***************************************************************************** end.

← →
Ega23 © (2007-02-22 11:19) [3]

Содержимое inc-файла:
{$DEFINE D7}

← →
Ega23 © (2007-02-22 11:20) [4]

to Kerk:
Рома, можешь в кладовку положить. Если не трудно - свяжись со мной по мылу, я тебе dpk для Delphi7 пришлю.

← →
default © (2007-02-22 11:21) [5]

хм, странная просьба, потестировать...

← →
Ega23 © (2007-02-22 11:21) [6]

2 All:
Принимается любая критика, пожелания и прочее.

← →
Ega23 © (2007-02-22 11:22) [7]

> хм, странная просьба, потестировать...

Ничего странного. Нужная мне функциональность достигнута и проверена. компонент уже внедрён в проект.
Просто может чего-то не хватает, или что-то упущено?

← →
Rouse_ © (2007-02-22 11:39) [8]

Если включен в настройках Complete boolean eval, то вот тут можешь влететь:
if Assigned(DataSet) and (DataSet.Active)

← →
Ega23 © (2007-02-22 11:44) [9]

> Rouse_ © (22.02.07 11:39) [8]

Точно... Учтём...

← →
Rouse_ © (2007-02-22 11:47) [10]

Вместо

> Содержимое inc-файла:
> {$DEFINE D7}

напиши:

{$IFDEF VER180} {$DEFINE USE_VARIANTS} {$ELSE} {$IFDEF VER170} {$DEFINE USE_VARIANTS} {$ELSE} {$IFDEF VER160} {$DEFINE USE_VARIANTS} {$ELSE} {$IFDEF VER150} {$DEFINE USE_VARIANTS} {$ENDIF} {$ENDIF} {$ENDIF} {$ENDIF}

и соответственно
{$IFDEF USE_VARIANTS} Variants, {$ENDIF}

← →
Reindeer Moss Eater © (2007-02-22 11:48) [11]

Просто может чего-то не хватает, или что-то упущено?

Код не смотрел, но интересно:
Есть ли возможность заюзать этот комбобокс, если нет редактируемого датасета? То есть случай, когда нужно выбрать что-то из справочника, но при этом ключ получить просто в переменную, а не в поле датасета.

← →
Ega23 © (2007-02-22 11:50) [12]

> То есть случай, когда нужно выбрать что-то из справочника,
> но при этом ключ получить просто в переменную, а не в поле
> датасета.

Не понял?

← →
Reindeer Moss Eater © (2007-02-22 11:51) [13]

И лукапится ли значение при ручном вводе ключа в поле (без открытия комбо). В том числе если введенное значение относится к листфилду, а не к ключевому полю?

← →
Reindeer Moss Eater © (2007-02-22 11:52) [14]

Не понял?

Нужно получить ключ записи справочника. Но при этом нет редактируемого датасета (туда, куда этот ключ пишется). Просто нужна переменная со значением ключа.

← →
Ega23 © (2007-02-22 11:54) [15]

> И лукапится ли значение при ручном вводе ключа в поле (без
> открытия комбо). В том числе если введенное значение относится
> к листфилду, а не к ключевому полю?

Скажем так: для редактируемых НД я вообще не проверял. Ибо нигде такого не использую.
А в остальном: двигаешь курсор НД - изменяется значение.

Кстати, только сейчас вспомнил: надо будет проверить поведение на EnableControls....

← →
Ega23 © (2007-02-22 11:57) [16]

> Нужно получить ключ записи справочника. Но при этом нет
> редактируемого датасета (туда, куда этот ключ пишется).
> Просто нужна переменная со значением ключа.

В наборе данных: Select DataID, DataName from ....
соответственно KeyField:="DataID", ListField:="DataName".

Потом - через KeyValue получаешь значение текущего ключа в любую переменную.

← →
Loginov Dmitry © (2007-02-22 12:11) [17]

> [8] Rouse_ © (22.02.07 11:39)
> Если включен в настройках Complete boolean eval, то вот
> тут можешь влететь:
> if Assigned(DataSet) and (DataSet.Active)

А зачем нужны подобные настройки? Вообще кто-нибуть (тот же Борланд в своей VCL) предусматривает работу с {$B+} ?

← →
Rouse_ © (2007-02-22 12:19) [18]

Закон Мерфи - если что-то может сломаться - оно обязательно сломается :)
Если галка есть, ее обязательно кто-нибудь включит и потом будет на Олегыча орать, что у него руки кривые :)

← →
stone © (2007-02-22 12:23) [19]

> Ega23 © (22.02.07 11:17)

А в чем принципиальное отличие от стандартного?

← →
Reindeer Moss Eater © (2007-02-22 12:34) [20]

Потом - через KeyValue получаешь значение текущего ключа в любую переменную.

Все это понятно.
Я имею ввиду раскроется ли комбобокс, если у него нет ни DataSource, ни DataField?

← →
Ega23 © (2007-02-22 13:47) [21]

> А в чем принципиальное отличие от стандартного?

1. После открытия НД не надо выставлять первую запись принудительно.
2. Detail-запросы не переоткрываютс, пока не выберешь конкретную запись, т.е. когда комбик раскрыл, скроллом перемещаешься - курсор у НД не меняется.

← →
Ega23 © (2007-02-22 13:48) [22]

> Я имею ввиду раскроется ли комбобокс, если у него нет ни
> DataSource, ни DataField?

Нет. Полной универсальности я и не собирался достигать.

> [18] Rouse_ © (22.02.07 12:19)
> если что-то может сломаться - оно обязательно сломается :)

Это-то понятно. Есть еще поговорка одна "С дуру-то можно и ... сломать" :)
Так что я тоже не вижу смысла в этой галке. В принципе можно добавить в inc
{$IFOPT B+}
{$DEFINE COMPLETE_BOOLEAN_EVAL}
{$B-}
{$ENDIF}
и в конце модуля другой inc
{$IFDEF COMPLETE_BOOLEAN_EVAL}
{$B+}
{$ENDIF}

> Компонентик не потестируете?

А самому влом, да?

> [24] oldman © (22.02.07 16:00)

Как говаривал Володя Шарапов :
потому что у наблюдателя от целого дня напряженного всматривания глаз, что называется,
замыливался; он, чего и не было, видел и, наоборот, не замечал порой того,
что внове появлялось. Понимаете?

> и в конце модуля другой inc
> {$IFDEF COMPLETE_BOOLEAN_EVAL}
> {$B+}
> {$ENDIF}

В конце не нужно - эта директива локальна :)

Тода уж проще наверное в начале модуля добавить {$B-} и не заморачиваться.

проще всего разнести на два if-а и не заморачиваться с инклудами :)

Кстати, при использовании VCL можно о флаге {$B+} не заботиться. VCL построена без учета данного флага, и в ней подобное if Assigned(DataSet) and (DataSet.Active) частенько встречается, причем в базовых классах.
Авторский код также использует VCL :)

if TLookupItem(Items[i]).KeyValue = KeyValue

Сравнивать так варианты некошерно. Если одна из частей Unassigned (или Null) и Win2k(SP1), то Varant Conversion Error (или типа этого) обеспечен. Используй VarCompareValue

FLookupItems не упорядочен ни по Value ни по ItemIndex, поэтому для поиска используется самый медленный вариан - перебор.
Самый оптимальный вариант - хранение в упорядоченном по Value + быстрый, хотя бы половинное деление, поиск. Порядок в подстановочном списке, естественно, тот же, что и в LookupSource, а
GetItemByIndex(const Index: Integer): TLookupItem должен быть
Result := TLookupItem(Items[Index]);

Reindeer Moss Eater © (22.02.07 12:34) [11], [14], [20]
Ega23 © (22.02.07 13:48) [22]
> Я имею ввиду раскроется ли комбобокс, если у него нет ни
> DataSource, ни DataField?
Нет. Полной универсальности я и не собирался достигать.

Да. Ибо никакого DataSource и DataField у этого компонента нет и он предназначен именно для навигации по LookupSource, а не для корректировки Lookup-полей.

Компонентик не потестируете? Найти похожие ветки