rm_dbctrls.pas

report machine 2.3 功能强大

{******************************************}
{                                          }
{   Report Machine v2.0 - DB components    }
{         Standard Dialog controls         }
{                                          }
{******************************************}

unit RM_DBCtrls;

interface

{$I RM.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, RM_Class, StdCtrls,
  Controls, Forms, Menus, Dialogs, DB, DBCtrls, RM_DCtrl
{$IFDEF Delphi6}, Variants{$ENDIF};

type
 { TRMDBLookupControl }
  TRMDBLookupControl = class(TRMStdControl)
  private
    FLookup: TDBLookupComboBox;
    FListSource: string;
  protected
    procedure SetPropValue(Index: string; Value: Variant); override;
    function GetPropValue(Index: string): Variant; override;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure DefineProperties; override;
    procedure Loaded; override;
  end;


implementation

uses RM_CmpReg, RM_Utils, RM_DBRel, RM_Const, RMD_DBWrap;

{-----------------------------------------------------------------------------}
{-----------------------------------------------------------------------------}
{ TRMDBLookupControl }

constructor TRMDBLookupControl.Create;
begin
  inherited Create;
  FLookup := TDBLookupComboBox.Create(nil);
  FLookup.Parent := RMDialogForm;
  AssignControl(FLookup);
  BaseName := 'DBLookupComboBox';
  dx := 145; dy := 21;
end;

destructor TRMDBLookupControl.Destroy;
begin
  FLookup.Free;
  inherited Destroy;
end;

procedure TRMDBLookupControl.DefineProperties;

  function GetFields: string;
  var
    i: Integer;
    sl: TStringList;
    ds: TDataSet;
  begin
    Result := '';
    if (FLookup.ListSource = nil) or (FLookup.ListSource.DataSet = nil) then Exit;
    ds := FLookup.ListSource.DataSet;
    sl := TStringList.Create;
    RMGetFieldNames(TDataSet(ds), sl);
    for i := 0 to sl.Count - 1 do
      Result := Result + sl[i] + ';';
    sl.Free;
  end;

  function GetListSource: string;
  var
    i: Integer;
    sl: TStringList;
  begin
    Result := '';
    sl := TStringList.Create;
    RMGetComponents(RMDialogForm, TDataSet, sl, nil);
    sl.Sort;
    for i := 0 to sl.Count - 1 do
      Result := Result + sl[i] + ';';
    sl.Free;
  end;

begin
  inherited DefineProperties;
  AddEnumProperty('KeyField', GetFields, [Null]);
  AddEnumProperty('ListField', GetFields, [Null]);
  AddEnumProperty('ListSource', GetListSource, [Null]);
  AddProperty('Text', [], nil);
end;

procedure TRMDBLookupControl.SetPropValue(Index: string; Value: Variant);
var
  d: TDataset;
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  if Index = 'TEXT' then
  begin
  	try
	    FLookup.KeyValue := Value;
    except
    end;
  end
  else if Index = 'KEYFIELD' then
  begin
  	try
	    FLookup.KeyField := Value;
    except
    end;
  end    
  else if Index = 'LISTFIELD' then
  begin
  	try
	    FLookup.ListField := Value;
    except
    end;
  end
  else if Index = 'LISTSOURCE' then
  begin
    d := RMFindComponent(RMDialogForm, Value) as TDataSet;
    FLookup.ListSource := RMGetDataSource(RMDialogForm, d);
  end;
  FLookup.DropDownAlign := daLeft;
end;

function TRMDBLookupControl.GetPropValue(Index: string): Variant;
begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then Exit;
  if Index = 'TEXT' then
    Result := FLookup.KeyValue
  else if Index = 'KEYFIELD' then
    Result := FLookup.KeyField
  else if Index = 'LISTFIELD' then
    Result := FLookup.ListField
  else if Index = 'LISTSOURCE' then
    Result := RMGetDataSetName(RMDialogForm, FLookup.ListSource)
end;

procedure TRMDBLookupControl.LoadFromStream(Stream: TStream);
begin
  inherited LoadFromStream(Stream);
  FListSource := RMReadString(Stream);
  Prop['ListSource'] := FListSource;
  Prop['KeyField'] := RMReadString(Stream);
  Prop['ListField'] := RMReadString(Stream);
end;

procedure TRMDBLookupControl.SaveToStream(Stream: TStream);
begin
  LVersion := 0;
  inherited SaveToStream(Stream);
  RMWriteString(Stream, Prop['ListSource']);
  RMWriteString(Stream, Prop['KeyField']);
  RMWriteString(Stream, Prop['ListField']);
end;

procedure TRMDBLookupControl.Loaded;
begin
  Prop['ListSource'] := FListSource;
  inherited Loaded;
end;

initialization
  RMRegisterControl(TRMDBLookupControl, 'RM_DBLOOKUPCONTROL', RMLoadStr(SInsertDBLookup));

finalization

end.