rm_dbctrls.pas

中小企业管理系统------ ERP系统原代码

{******************************************}
{                                          }
{   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;
		procedure GetKeyFields(Sender: TObject);
		procedure GetListFields(Sender: TObject);
		procedure GetListSource(Sender: TObject);
  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.GetKeyFields(Sender: TObject);
var
  liProp: PRMPropRec;
  sl: TStringList;
  ds: TDataSet;
begin
  liProp := PropRec['KeyField'];
	liProp^.Enum.Clear;
  if (FLookup.ListSource = nil) or (FLookup.ListSource.DataSet = nil) then
    Exit;

  sl := TStringList.Create;
	try
	  ds := FLookup.ListSource.DataSet;
  	RMGetFieldNames(TDataSet(ds), sl);
    liProp^.Enum.Assign(sl);
  finally
	  sl.Free;
  end;
end;

procedure TRMDBLookupControl.GetListFields(Sender: TObject);
var
  liProp: PRMPropRec;
  sl: TStringList;
  ds: TDataSet;
begin
  liProp := PropRec['ListField'];
	liProp^.Enum.Clear;
  if (FLookup.ListSource = nil) or (FLookup.ListSource.DataSet = nil) then
    Exit;

  sl := TStringList.Create;
	try
	  ds := FLookup.ListSource.DataSet;
  	RMGetFieldNames(TDataSet(ds), sl);
    liProp^.Enum.Assign(sl);
  finally
	  sl.Free;
  end;
end;

procedure TRMDBLookupControl.GetListSource(Sender: TObject);
var
  liProp: PRMPropRec;
  sl: TStringList;
begin
  liProp := PropRec['ListSource'];
  sl := TStringList.Create;
	try
  	RMGetComponents(RMDialogForm, TDataSet, sl, nil);
	  sl.Sort;
    liProp^.Enum.Assign(sl);
  finally
	  sl.Free;
  end;
end;

procedure TRMDBLookupControl.DefineProperties;
begin
  inherited DefineProperties;
  AddEnumProperty('KeyField', '', [Null], GetKeyFields);
  AddEnumProperty('ListField', '', [Null], GetListFields);
  AddEnumProperty('ListSource', '', [Null], GetListSource);
  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.



//此源码由程序太平洋收集整理发布,任何人都可自由转载,但需保留本站信息
//╭⌒╮┅~ ¤　欢迎光临程序太平洋╭⌒╮
//╭⌒╭⌒╮╭⌒╮～╭⌒╮  ︶  ,︶︶
//,︶︶︶︶,''︶~~ ,''~︶︶　 ,''
//╔　╱◥███◣═╬╬╬╬╬╬╬╬╬╗
//╬ ︱田︱田 田 ︱　　　　　　　　　 ╬
//╬　　　　　　　http://www.5ivb.net ╬
//╬　 ╭○╮●　                   　╬
//╬　　/■\/■\　　                  ╬
//╬　　 <|　||　   有希望,就有成功！ ╬
//╬　　　　　　　　　　　　　　　　　╬
//╚╬╬╬╬╬╬╬╬╬╬╗  ╔╬╬╬╬╝
//
//说明：
//专业提供VB、．NET、Delphi、ASP、PB源码下载
//包括:程序源码,控件,商业源码,系统方案，开发工具，书籍教程，技术文档