rmd_editorldlinks.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 621 行 · 第 1/2 页

unit RMD_Editorldlinks;

interface

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

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

type

{ TFieldLink }

  TFieldLinkProperty = class(TObject)
  private
    FChanged: Boolean;
    FDataSet: TRMDTable;
    FIndexName: string;
    FIndexFieldNames: string;
    FMasterFields: string;
  protected
    function GetDataSet: TRMDTable;
    procedure SetDataSet(Value: TRMDTable);
    procedure GetFieldNamesForIndex(List: TStrings);
    function GetIndexBased: Boolean;
    function GetIndexDefs: TIndexDefs;
    function GetIndexFieldNames: string;
    procedure SetIndexFieldNames(const Value: string);
    function GetIndexName: string;
    procedure SetIndexName(const Value: string);
    function GetMasterFields: string;
    procedure SetMasterFields(const Value: string);
  public
    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: TRMDTable read GetDataSet write SetDataSet;
  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: TRMDTable;
    FMasterDataSet: TDataSet;
    FDataSetProxy: TFieldLinkProperty;
    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: TRMDTable);
  public
    function Edit: Boolean;

    property MasterDS: TDataSet read FMasterDataSet write FMasterDataSet;
    property DetailDS: TRMDTable read FDetailDataSet write SetDataSet;
    property DataSetProxy: TFieldLinkProperty 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;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TFieldLinkProperty }

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

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

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

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

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

procedure TFieldLinkProperty.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 TFieldLinkProperty.GetFieldNamesForIndex(List: TStrings);
var
  i: Integer;
  str: string;

  procedure _SetFieldNames(aField: string);
  var
    lPos: Integer;
    lStr: string;
  begin
    List.Clear;
    lPos := 1;
    while lPos > 0 do
    begin
      lStr := RMstrGetToken(aField, ';', lPos);
      List.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;

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

function TFieldLinkProperty.GetDataSet: TRMDTable;
begin
  Result := FDataSet;
end;

procedure TFieldLinkProperty.SetDataSet(Value: TRMDTable);
begin
  FDataSet := Value;
  IndexName := FDataSet.IndexName;
  IndexFieldNames := FDataSet.IndexFieldNames;
  MasterFields := FDataSet.MasterFields;
end;

function TFieldLinkProperty.GetMasterFields: string;
begin
  Result := FMasterFields;
end;

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

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

procedure TRMDFieldsLinkForm.FormCreate(Sender: TObject);
begin
  FDataSetProxy := TFieldLinkProperty.Create;

  OrderedDetailList := TStringList.Create;
  OrderedMasterList := TStringList.Create;
end;

procedure TRMDFieldsLinkForm.FormDestroy(Sender: TObject);
begin
  FDataSetProxy.Free;

  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
              lFound := True;
              FFullIndexName := '';
              DataSetProxy.IndexFieldNames := DataSetProxy.IndexDefs.Items[i].Fields;
            end;
          end;
        end;
      end;

      if not lFound then
        DataSetProxy.IndexName := FullIndexName;