{----------------------------------------------------------------------------- The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/MPL-1.1.html Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for the specific language governing rights and limitations under the License. The Original Code is: JvDBEditors.PAS, released on 2002-05-26. The Initial Developer of the Original Code is John Doe. Portions created by John Doe are Copyright (C) 2003 John Doe. All Rights Reserved. Contributor(s): You may retrieve the latest version of this file at the Project JEDI's JVCL home page, located at http://jvcl.delphi-jedi.org Known Issues: -----------------------------------------------------------------------------} // $Id: JvDBEditors.pas 12461 2009-08-14 17:21:33Z obones $ unit JvDBEditors; {$I jvcl.inc} interface uses SysUtils, Classes, DesignIntf, DesignEditors, VCLEditors, JvDataSourceIntf; type {**************** from Delphi2\Lib\DBReg.pas } TJvDBStringProperty = class(TStringProperty) public function GetAttributes: TPropertyAttributes; override; procedure GetValueList(List: TStrings); virtual; abstract; procedure GetValues(Proc: TGetStrProc); override; end; TJvDataFieldProperty = class(TJvDBStringProperty) public function GetDataSourcePropName: string; virtual; procedure GetValueList(List: TStrings); override; end; TJvListFieldProperty = class(TJvDataFieldProperty) public function GetDataSourcePropName: string; override; end; { For TJvDBLookupList, TJvDBLookupCombo components } TJvLookupSourceProperty = class(TJvDBStringProperty) public procedure GetValueList(List: TStrings); override; function GetDataSourcePropName: string; virtual; end; implementation uses DB, TypInfo; //=== { TJvDBStringProperty } ================================================ function TJvDBStringProperty.GetAttributes: TPropertyAttributes; begin Result := [paValueList, paSortList, paMultiSelect]; end; procedure TJvDBStringProperty.GetValues(Proc: TGetStrProc); var I: Integer; Values: TStringList; begin Values := TStringList.Create; try GetValueList(Values); for I := 0 to Values.Count - 1 do Proc(Values[I]); finally Values.Free; end; end; //=== { TJvDataFieldProperty } =============================================== function TJvDataFieldProperty.GetDataSourcePropName: string; begin Result := 'DataSource'; end; procedure TJvDataFieldProperty.GetValueList(List: TStrings); var Instance: TComponent; PropInfo: PPropInfo; DataSource: TDataSource; DataSourceIntf: IJvDataSource; begin Instance := TComponent(GetComponent(0)); PropInfo := TypInfo.GetPropInfo(Instance.ClassInfo, GetDataSourcePropName); if (PropInfo <> nil) and (PropInfo^.PropType^.Kind = tkClass) then begin DataSource := TObject(GetOrdProp(Instance, PropInfo)) as TDataSource; if (DataSource <> nil) and (DataSource.DataSet <> nil) then begin {$IFDEF COMPILER10_UP} {$WARN SYMBOL_DEPRECATED OFF} DataSource.DataSet.GetFieldNames(List); {$WARN SYMBOL_DEPRECATED ON} {$ELSE} DataSource.DataSet.GetFieldNames(List); {$ENDIF COMPILER10_UP} end; end else if (PropInfo <> nil) and (PropInfo^.PropType^.Kind = tkInterface) then begin if Supports(GetInterfaceProp(Instance, PropInfo), IJvDataSource, DataSourceIntf) then begin if DataSourceIntf.DataSet <> nil then begin {$IFDEF COMPILER10_UP} {$WARN SYMBOL_DEPRECATED OFF} DataSourceIntf.GetFieldNames(List); {$WARN SYMBOL_DEPRECATED ON} {$ELSE} DataSourceIntf.GetFieldNames(List); {$ENDIF COMPILER10_UP} end; end; end; end; //=== { TJvListFieldProperty } =============================================== function TJvListFieldProperty.GetDataSourcePropName: string; begin Result := 'ListSource'; end; //=== { TJvLookupSourceProperty } =================================================== function TJvLookupSourceProperty.GetDataSourcePropName: string; begin Result := 'LookupSource'; end; procedure TJvLookupSourceProperty.GetValueList(List: TStrings); var Instance: TComponent; PropInfo: PPropInfo; DataSource: TDataSource; DataSourceIntf: IJvDataSource; begin Instance := TComponent(GetComponent(0)); PropInfo := TypInfo.GetPropInfo(Instance.ClassInfo, GetDataSourcePropName); if (PropInfo <> nil) and (PropInfo^.PropType^.Kind = tkClass) then begin DataSource := TObject(GetOrdProp(Instance, PropInfo)) as TDataSource; if (DataSource <> nil) and (DataSource.DataSet <> nil) then {$IFDEF COMPILER10_UP} {$WARN SYMBOL_DEPRECATED OFF} DataSource.DataSet.GetFieldNames(List); {$WARN SYMBOL_DEPRECATED ON} {$ELSE} DataSource.DataSet.GetFieldNames(List); {$ENDIF COMPILER10_UP} end else if (PropInfo <> nil) and (PropInfo^.PropType^.Kind = tkInterface) then begin if Supports(GetInterfaceProp(Instance, PropInfo), IJvDataSource, DataSourceIntf) then begin if DataSourceIntf.DataSet <> nil then begin {$IFDEF COMPILER10_UP} {$WARN SYMBOL_DEPRECATED OFF} DataSourceIntf.GetFieldNames(List); {$WARN SYMBOL_DEPRECATED ON} {$ELSE} DataSourceIntf.GetFieldNames(List); {$ENDIF COMPILER10_UP} end; end; end; end; end.