rmd_editorldlinks.pas

这是一个功能强大

unit RMD_Editorldlinks;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms,
  StdCtrls, ExtCtrls, DB, Buttons, Dialogs, RMD_DBWrap, RM_PropInsp;

const
  SPrimary = 'Primary';
  SLinkDesigner = 'SLinkDesigner';

type

{ TFieldLink }

  TRMDFieldLinkProperty = class(TELStringPropEditor)
  private
  	FFullIndexName: string;
    FChanged: Boolean;
    FDataSet: TRMDDataSet;
    FIndexName: string;
    FIndexFieldNames: string;
  protected
    function GetDataSet: TRMDDataSet;
    procedure GetFieldNamesForIndex(aList: TStrings); virtual;
    function GetIndexBased: Boolean; virtual;
    function GetIndexDefs: TIndexDefs; virtual;
    function GetIndexFieldNames: string; virtual;
    function GetMasterFields: string; virtual; abstract;

    procedure SetIndexFieldNames(const Value: string); virtual;
    procedure SetIndexName(const Value: string); virtual;
    function GetIndexName: string; virtual;
    procedure SetMasterFields(const Value: string); virtual; abstract;
  public
    constructor CreateWith(ADataSet: TRMDDataSet); virtual;
    procedure GetIndexNames(List: TStrings);
    property IndexBased: Boolean read GetIndexBased;
    property IndexDefs: TIndexDefs read GetIndexDefs;
    property IndexFieldNames: string read GetIndexFieldNames write SetIndexFieldNames;
    property IndexName: string read GetIndexName write SetIndexName;
    property MasterFields: string read GetMasterFields write SetMasterFields;
    property Changed: Boolean read FChanged;
    property DataSet: TRMDDataSet read GetDataSet;
    property FullIndexName: string read FFullIndexName;

    function GetAttrs: TELPropAttrs; override;
    procedure Edit; override;
  end;

{ TLink Fields }

  TRMDFieldsLinkForm = class(TForm)
    MasterList: TListBox;
    BindList: TListBox;
    Label30: TLabel;
    Label31: TLabel;
    IndexList: TComboBox;
    IndexLabel: TLabel;
    Label2: TLabel;
    Bevel1: TBevel;
    Bevel2: TBevel;
    btnAdd: TButton;
    btnDelete: TButton;
    btnClear: TButton;
    btnOK: TButton;
    btnCancel: TButton;
    DetailList: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure BindingListClick(Sender: TObject);
    procedure btnAddClick(Sender: TObject);
    procedure btnDeleteClick(Sender: TObject);
    procedure BindListClick(Sender: TObject);
    procedure btnClearClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure IndexListChange(Sender: TObject);
  private
    FDetailDataSet: TRMDDataSet;
    FMasterDataSet: TDataSet;
    FDataSetProxy: TRMDFieldLinkProperty;
    FFullIndexName: string;
    MasterFieldList: string;
    IndexFieldList: string;
    OrderedDetailList: TStringList;
    OrderedMasterList: TStringList;
    procedure OrderFieldList(OrderedList, List: TStrings);
    procedure AddToBindList(const Str1, Str2: string);
    procedure Localize;
    procedure Initialize;
    procedure SetDataSet(Value: TRMDDataSet);
  public
    function Edit: Boolean;
    //property MasterDS: TDataSet read FMasterDataSet write FMasterDataSet;
    property DetailDS: TRMDDataSet read FDetailDataSet write SetDataSet;
    property DataSetProxy: TRMDFieldLinkProperty read FDataSetProxy write FDataSetProxy;
    property FullIndexName: string read FFullIndexName;
  end;

implementation

uses
  RM_Const, RM_Const1, RM_Utils;

{$R *.dfm}

{ Utility Functions }

function StripFieldName(const Fields: string; var Pos: Integer): string;
var
  I: Integer;
begin
  I := Pos;
  while (I <= Length(Fields)) and (Fields[I] <> ';') do Inc(I);
  Result := Copy(Fields, Pos, I - Pos);
  if (I <= Length(Fields)) and (Fields[I] = ';') then Inc(I);
  Pos := I;
end;

function StripDetail(const Value: string): string;
var
  S: string;
  I: Integer;
begin
  S := Value;
  I := 0;
  while Pos('->', S) > 0 do
  begin
    I := Pos('->', S);
    S[I] := ' ';
  end;
  Result := Copy(Value, 0, I - 2);
end;

function StripMaster(const Value: string): string;
var
  S: string;
  I: Integer;
begin
  S := Value;
  I := 0;
  while Pos('->', S) > 0 do
  begin
    I := Pos('->', S);
    S[I] := ' ';
  end;
  Result := Copy(Value, I + 3, Length(Value));
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMDFieldLinkProperty }

constructor TRMDFieldLinkProperty.CreateWith(aDataSet: TRMDDataSet);
begin
  FDataSet := aDataSet;
end;

function TRMDFieldLinkProperty.GetAttrs: TELPropAttrs;
begin
  Result := [praDialog, praReadOnly];
end;

procedure TRMDFieldLinkProperty.Edit;
var
	tmp: TRMDFieldsLinkForm;
begin
	tmp := TRMDFieldsLinkForm.Create(nil);
  try
  	tmp.DataSetProxy := Self;
    tmp.DetailDS := DataSet;
    FChanged := tmp.Edit;
    if FChanged then
    begin
    	FFullIndexName := tmp.FullIndexName;
			Modified;
    end;
  finally
  	tmp.Free;
  end;
end;

function TRMDFieldLinkProperty.GetIndexBased: Boolean;
begin
  Result := FDataSet.IndexBased;
end;

function TRMDFieldLinkProperty.GetIndexDefs: TIndexDefs;
begin
  Result := FDataSet.IndexDefs;
end;

function TRMDFieldLinkProperty.GetIndexFieldNames: string;
begin
  Result := FIndexFieldNames;
end;

procedure TRMDFieldLinkProperty.SetIndexFieldNames(const Value: string);
begin
  FIndexFieldNames := Value;
end;

procedure TRMDFieldLinkProperty.GetIndexNames(List: TStrings);
var
  i: Integer;
begin
  if IndexDefs <> nil then
  begin
    for i := 0 to IndexDefs.Count - 1 do
    begin
      if (ixPrimary in IndexDefs.Items[i].Options) and (IndexDefs.Items[i].Name = '') then
        List.Add(SPrimary)
      else
        List.Add(IndexDefs.Items[i].Name);
    end;
  end;
end;

procedure TRMDFieldLinkProperty.GetFieldNamesForIndex(aList: TStrings);
var
  i: Integer;
  str: string;

  procedure _SetFieldNames(aField: string);
  var
    lPos: Integer;
    lStr: string;
  begin
    aList.Clear;
    lPos := 1;
    while lPos > 0 do
    begin
      lStr := RMstrGetToken(aField, ';', lPos);
      aList.Add(lStr);
    end;
  end;

begin
  if IndexDefs <> nil then
  begin
    for i := 0 to IndexDefs.Count - 1 do
    begin
      if FIndexName = SPrimary then
      begin
        if (ixPrimary in IndexDefs.Items[i].Options) and (IndexDefs.Items[i].Name = '') then
        begin
          str := IndexDefs.Items[i].Fields;
          _SetFieldNames(str);
        end;
      end
      else if FIndexName = IndexDefs.Items[i].Name then
      begin
        str := IndexDefs.Items[i].Fields;
          _SetFieldNames(str);
      end;
    end;
  end;
end;

function TRMDFieldLinkProperty.GetIndexName: string;
begin
  Result := FIndexName;
end;

procedure TRMDFieldLinkProperty.SetIndexName(const Value: string);
begin
  FIndexName := Value;
end;

function TRMDFieldLinkProperty.GetDataSet: TRMDDataset;
begin
  if FDataSet = nil then
    FDataSet := TRMDDataSet(GetInstance(0));

  Result := FDataSet;
end;

{function TRMDFieldLinkProperty.GetMasterFields: string;
begin
  Result := FMasterFields;
end;

procedure TRMDFieldLinkProperty.SetMasterFields(const Value: string);
begin
  FMasterFields := Value;
end;}

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMDFieldsLinkForm }

procedure TRMDFieldsLinkForm.FormCreate(Sender: TObject);
begin
  OrderedDetailList := TStringList.Create;
  OrderedMasterList := TStringList.Create;
end;

procedure TRMDFieldsLinkForm.FormDestroy(Sender: TObject);
begin
  OrderedDetailList.Free;
  OrderedMasterList.Free;
end;

function TRMDFieldsLinkForm.Edit;
var
  i: Integer;
  lFound: Boolean;
begin
  Localize;
  Initialize;
  if ShowModal = mrOK then
  begin
    if FullIndexName <> '' then
    begin
      lFound := False;
      if FullIndexName = SPrimary then
      begin
        if DataSetProxy.IndexBased and (DataSetProxy.IndexDefs <> nil) then
        begin
          for i := 0 to DataSetProxy.IndexDefs.Count - 1 do
          begin
            if (ixPrimary in DataSetProxy.IndexDefs.Items[i].Options) and (DataSetProxy.IndexDefs.Items[i].Name = '') then
            begin