{*******************************************************}
{                                                       }
{       Borland Delphi Visual Component Library         }
{       Master/Detail Field Links Editor                }
{                                                       }
{       Copyright (c) 1997,99 Inprise Corporation       }
{                                                       }
{*******************************************************}

//-----------------------------------------------------//
//                                                     //
//  Modified by ComponentAce                           //
//                                                     //
//-----------------------------------------------------//    


unit ABSFldLinks;

interface

{$I ABSVER.Inc}

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

  // ABSoluteDatabase Unit

  ABSExcept,
  ABSConst,
  {$IFDEF DEBUG_LOG}
  ABSDebug,
  {$ENDIF}

 {$IFDEF D6H}
  DesignIntf, DesignEditors;
 {$ELSE}
  DSGNINTF;
 {$ENDIF}

type


////////////////////////////////////////////////////////////////////////////////
//
// TABSBaseFieldLinkProperty
//
////////////////////////////////////////////////////////////////////////////////


  TABSBaseFieldLinkProperty = class(TStringProperty)
  private
    FChanged: Boolean;
    FDataSet: TDataSet;
  protected
    function GetDataSet: TDataSet;
    procedure GetFieldNamesForIndex(List: TStrings); virtual;
    function GetIndexBased: Boolean; virtual;
    function GetIndexDefs: TIndexDefs; virtual;
    function GetIndexFieldNames: AnsiString; virtual;
    function GetIndexName: AnsiString; virtual;
    function GetMasterFields: AnsiString; virtual; ABStract;
    procedure SetIndexFieldNames(const Value: AnsiString); virtual;
    procedure SetIndexName(const Value: AnsiString); virtual;
    procedure SetMasterFields(const Value: AnsiString); virtual; ABStract;
  public
    constructor CreateWith(ADataSet: TDataSet); virtual;
    procedure GetIndexNames(List: TStrings);
    property IndexBased: Boolean read GetIndexBased;
    property IndexDefs: TIndexDefs read GetIndexDefs;
    property IndexFieldNames: AnsiString read GetIndexFieldNames write SetIndexFieldNames;
    property IndexName: AnsiString read GetIndexName write SetIndexName;
    property MasterFields: AnsiString read GetMasterFields write SetMasterFields;
    property Changed: Boolean read FChanged;
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
    property DataSet: TDataSet read GetDataSet;
  end;


////////////////////////////////////////////////////////////////////////////////
//
// TABSLinkFields
//
////////////////////////////////////////////////////////////////////////////////


  TABSLinkFields = class(TForm)
    DetailList: TListBox;
    MasterList: TListBox;
    BindList: TListBox;
    Label30: TLabel;
    Label31: TLabel;
    IndexList: TComboBox;
    IndexLabel: TLabel;
    Label2: TLabel;
    Bevel1: TBevel;
    Bevel2: TBevel;
    AddButton: TButton;
    DeleteButton: TButton;
    ClearButton: TButton;
    Button1: TButton;
    Button2: TButton;
    Help: TButton;
    procedure FormCreate(Sender: TObject);
    procedure BindingListClick(Sender: TObject);
    procedure AddButtonClick(Sender: TObject);
    procedure DeleteButtonClick(Sender: TObject);
    procedure BindListClick(Sender: TObject);
    procedure ClearButtonClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure HelpClick(Sender: TObject);
    procedure IndexListChange(Sender: TObject);
  private
    FDataSet: TDataSet;
    FMasterDataSet: TDataSet;
    FDataSetProxy: TABSBaseFieldLinkProperty;
    FFullIndexName: AnsiString;
    MasterFieldList: AnsiString;
    IndexFieldList: AnsiString;
    OrderedDetailList: TStringList;
    OrderedMasterList: TStringList;
    procedure OrderFieldList(OrderedList, List: TStrings);
    procedure AddToBindList(const Str1, Str2: AnsiString);
    procedure Initialize;
    property FullIndexName: AnsiString read FFullIndexName;
    procedure SetDataSet(Value: TDataSet);
  public
    property DataSet: TDataSet read FDataSet write SetDataSet;
    property DataSetProxy: TABSBaseFieldLinkProperty read FDataSetProxy write FDataSetProxy;
    function Edit: Boolean;
  end;

function EditMasterFields(ADataSet: TDataSet; ADataSetProxy: TABSBaseFieldLinkProperty): Boolean;

implementation

{$R *.DFM}

uses Dialogs, DBConsts, LibHelp, TypInfo;

{ Utility Functions }

function StripFieldName(const Fields: AnsiString; var Pos: Integer): AnsiString;
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: AnsiString): AnsiString;
var
  S: AnsiString;
  i: Integer;
begin
  S := Value;
  i := 0;
  while Pos('->', {$ifdef D16H}String(S){$else}S{$endif}) > 0 do
   begin
    i := Pos('->', {$ifdef D16H}String(S){$else}S{$endif});
    S[i] := ' ';
   end;
  Result := Copy(Value, 0, i - 2);
end;

function StripMaster(const Value: AnsiString): AnsiString;
var
  S: AnsiString;
  i: Integer;
begin
  S := Value;
  i := 0;
  while Pos('->', {$ifdef D16H}String(S){$else}S{$endif}) > 0 do
   begin
    i := Pos('->', {$ifdef D16H}String(S){$else}S{$endif});
    S[i] := ' ';
   end;
  Result := Copy(Value, i + 3, Length(Value));
end;

function EditMasterFields(ADataSet: TDataSet; ADataSetProxy: TABSBaseFieldLinkProperty): Boolean;
begin
{$IFDEF DEBUG_TRACE_DATASET}
aaWriteToLog('EditMasterFields start');
{$ENDIF}
  with TABSLinkFields.Create(nil) do
   try
{$IFDEF DEBUG_TRACE_DATASET}
aaWriteToLog('EditMasterFields 1');
{$ENDIF}
    DataSetProxy := ADataSetProxy;
{$IFDEF DEBUG_TRACE_DATASET}
aaWriteToLog('EditMasterFields 2');
{$ENDIF}
    DataSet := ADataSet;
{$IFDEF DEBUG_TRACE_DATASET}
aaWriteToLog('EditMasterFields 3');
{$ENDIF}
    Result := Edit;
{$IFDEF DEBUG_TRACE_DATASET}
aaWriteToLog('EditMasterFields 4');
{$ENDIF}
   finally
    Free;
   end;
{$IFDEF DEBUG_TRACE_DATASET}
aaWriteToLog('EditMasterFields finish');
{$ENDIF}
end;


////////////////////////////////////////////////////////////////////////////////
//
// TABSBaseFieldLinkProperty
//
////////////////////////////////////////////////////////////////////////////////


function TABSBaseFieldLinkProperty.GetIndexBased: Boolean;
begin
  Result := False;
end;

function TABSBaseFieldLinkProperty.GetIndexDefs: TIndexDefs;
begin
  Result := nil;
end;

function TABSBaseFieldLinkProperty.GetIndexFieldNames: AnsiString;
begin
  Result := '';
end;

function TABSBaseFieldLinkProperty.GetIndexName: AnsiString;
begin
  Result := '';
end;

procedure TABSBaseFieldLinkProperty.GetIndexNames(List: TStrings);
var
  i: Integer;
begin
  if (IndexDefs <> nil) then
    for i := 0 to IndexDefs.Count - 1 do
      List.Add(IndexDefs.Items[i].Name);
end;

procedure TABSBaseFieldLinkProperty.GetFieldNamesForIndex(List: TStrings);
begin
end;

procedure TABSBaseFieldLinkProperty.SetIndexFieldNames(const Value: AnsiString);
begin
end;

procedure TABSBaseFieldLinkProperty.SetIndexName(const Value: AnsiString);
begin
end;

function TABSBaseFieldLinkProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog];
end;

procedure TABSBaseFieldLinkProperty.Edit;
begin
{$IFDEF DEBUG_TRACE_DATASET}
aaWriteToLog('TABSBaseFieldLinkProperty.Edit start');
{$ENDIF}
  FChanged := EditMasterFields(DataSet, Self);
{$IFDEF DEBUG_TRACE_DATASET}
aaWriteToLog('TABSBaseFieldLinkProperty.Edit 1');
{$ENDIF}
  if (FChanged) then
   begin
    Modified;
   end;
{$IFDEF DEBUG_TRACE_DATASET}
aaWriteToLog('TABSBaseFieldLinkProperty.Edit finish');
{$ENDIF}
end;

constructor TABSBaseFieldLinkProperty.CreateWith(ADataSet: TDataSet);
begin
  FDataSet := ADataSet;
end;

function TABSBaseFieldLinkProperty.GetDataSet: TDataSet;
begin
  if (FDataSet) = nil then
    FDataSet := TDataSet(GetComponent(0));
  Result := FDataSet;
end;


////////////////////////////////////////////////////////////////////////////////
//
// TABSLinkFields
//
////////////////////////////////////////////////////////////////////////////////


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

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

function TABSLinkFields.Edit;
begin
{$IFDEF DEBUG_TRACE_DATASET}
aaWriteToLog('TABSLinkFields.Edit start');
{$ENDIF}
  Initialize;
{$IFDEF DEBUG_TRACE_DATASET}
aaWriteToLog('TABSLinkFields.Edit 0');
{$ENDIF}
  if (ShowModal = mrOK) then
   begin
{$IFDEF DEBUG_TRACE_DATASET}
aaWriteToLog('TABSLinkFields.Edit 1');
{$ENDIF}
    if (FullIndexName <> '') then
      DataSetProxy.IndexName := FullIndexName
    else
      DataSetProxy.IndexFieldNames := IndexFieldList;
{$IFDEF DEBUG_TRACE_DATASET}
aaWriteToLog('TABSLinkFields.Edit 2');
{$ENDIF}
    DataSetProxy.MasterFields := MasterFieldList;
{$IFDEF DEBUG_TRACE_DATASET}
aaWriteToLog('TABSLinkFields.Edit 3');
{$ENDIF}
    Result := True;
   end
  else
   Result := False;
{$IFDEF DEBUG_TRACE_DATASET}
aaWriteToLog('TABSLinkFields.Edit finish');
{$ENDIF}
end;

procedure TABSLinkFields.SetDataSet(Value: TDataSet);
var
  IndexDefs: TIndexDefs;
begin
{$IFDEF DEBUG_TRACE_DATASET}
aaWriteToLog('TABSLinkFields.SetDataSet start');
if (Value = nil) then
  aaWriteToLog('TABSLinkFields.SetDataSet Value = nil');
if (Value.FieldDefs = nil) then
  aaWriteToLog('TABSLinkFields.SetDataSet Value.FieldDefs = nil');
{$ENDIF}
 Value.Open;
{$IFDEF DEBUG_TRACE_DATASET}
aaWriteToLog('TABSLinkFields.SetDataSet 0');
{$ENDIF}
  Value.FieldDefs.Update;
{$IFDEF DEBUG_TRACE_DATASET}
aaWriteToLog('TABSLinkFields.SetDataSet 0.1');
{$ENDIF}
 Value.Close;

{$IFDEF DEBUG_TRACE_DATASET}
if (Value.FieldDefs.Updated) then
 aaWriteToLog('TABSLinkFields.SetDataSet updated!')
else
 aaWriteToLog('TABSLinkFields.SetDataSet not updated!');

aaWriteToLog('TABSLinkFields.SetDataSet 1');
{$ENDIF}
  IndexDefs := DataSetProxy.IndexDefs;
{$IFDEF DEBUG_TRACE_DATASET}
aaWriteToLog('TABSLinkFields.SetDataSet 2');
{$ENDIF}
  if (Assigned(IndexDefs)) then
    IndexDefs.Update;
{$IFDEF DEBUG_TRACE_DATASET}
aaWriteToLog('TABSLinkFields.SetDataSet 3');
{$ENDIF}
  if ((not Assigned(Value.DataSource)) or
      (not Assigned(Value.DataSource.DataSet))) then
    DatabaseError(ErrorLMissingDataSource, Value);
{$IFDEF DEBUG_TRACE_DATASET}
aaWriteToLog('TABSLinkFields.SetDataSet 4');
{$ENDIF}
Value.DataSource.DataSet.Open;
{$IFDEF DEBUG_TRACE_DATASET}
aaWriteToLog('TABSLinkFields.SetDataSet 4.5');
{$ENDIF}
  Value.DataSource.DataSet.FieldDefs.Update;
{$IFDEF DEBUG_TRACE_DATASET}
aaWriteToLog('TABSLinkFields.SetDataSet 4.6');
{$ENDIF}
Value.DataSource.DataSet.Close;
{$IFDEF DEBUG_TRACE_DATASET}
if (Value.FieldDefs.Updated) then
 aaWriteToLog('TABSLinkFields.SetDataSet updated2 !')
else
 aaWriteToLog('TABSLinkFields.SetDataSet not updated2 !');
aaWriteToLog('TABSLinkFields.SetDataSet 5');
{$ENDIF}
  FDataSet := Value;
{$IFDEF DEBUG_TRACE_DATASET}
aaWriteToLog('TABSLinkFields.SetDataSet 6');
{$ENDIF}
  FMasterDataSet := Value.DataSource.DataSet;
{$IFDEF DEBUG_TRACE_DATASET}
aaWriteToLog('TABSLinkFields.SetDataSet finish');
{$ENDIF}
end;

procedure TABSLinkFields.Initialize;
var
  SIndexName: AnsiString;

  procedure SetUpLists(const MasterFieldList, DetailFieldList: AnsiString);
  var
    I, J: Integer;
    MasterFieldName, DetailFieldName: AnsiString;
  begin
    I := 1;
    J := 1;
    while ((I <= Length(MasterFieldList)) and (J <= Length(DetailFieldList))) do
    begin
      MasterFieldName := StripFieldName(MasterFieldList, I);
      DetailFieldName := StripFieldName(DetailFieldList, J);
      if (MasterList.Items.IndexOf({$ifdef D16H}String(MasterFieldName){$else}MasterFieldName{$endif}) <> -1) and
        (OrderedDetailList.IndexOf({$ifdef D16H}String(DetailFieldName){$else}DetailFieldName{$endif}) <> -1) then
      begin
        with OrderedDetailList do
          Objects[IndexOf({$ifdef D16H}String(DetailFieldName){$else}DetailFieldName{$endif})] := TObject(True);
        with DetailList.Items do
          Delete(IndexOf({$ifdef D16H}String(DetailFieldName){$else}DetailFieldName{$endif}));
        with MasterList.Items do
          Delete(IndexOf({$ifdef D16H}String(MasterFieldName){$else}MasterFieldName{$endif}));
        BindList.Items.Add(Format('%s -> %s',
          [DetailFieldName, MasterFieldName]));
        ClearButton.Enabled := True;
      end;
    end;
  end;

begin
  if (not DataSetProxy.IndexBased) then
   begin
    IndexLabel.Visible := False;
    IndexList.Visible := False;
   end
  else
   with DataSetProxy do
    begin
     GetIndexNames(IndexList.Items);
     if (IndexFieldNames <> '') then
      SIndexName := IndexDefs.FindIndexForFields({$ifdef D16H}String(IndexFieldNames){$else}IndexFieldNames{$endif}).Name
     else SIndexName := {$ifdef D16H}AnsiString(IndexName){$else}IndexName{$endif};
      if ((SIndexName <> '') and (IndexList.Items.IndexOf({$ifdef D16H}String(SIndexName){$else}SIndexName{$endif}) >= 0)) then
       IndexList.ItemIndex := IndexList.Items.IndexOf({$ifdef D16H}String(SIndexName){$else}SIndexName{$endif})
      else
       IndexList.ItemIndex := 0;
    end;
  with DataSetProxy do
   begin
    MasterFieldList := MasterFields;
    if ((IndexFieldNames = '') and (IndexName <> '') and
        (IndexDefs.IndexOf({$ifdef D16H}String(IndexName){$else}IndexName{$endif}) >= 0)) then
      IndexFieldList := IndexDefs[IndexDefs.IndexOf({$ifdef D16H}String(IndexName){$else}IndexName{$endif})].Fields
    else
      IndexFieldList := IndexFieldNames;
   end;
  IndexListChange(nil);
  FMasterDataSet.GetFieldNames(MasterList.Items);
  OrderedMasterList.Assign(MasterList.Items);
  SetUpLists(MasterFieldList, IndexFieldList);
end;

procedure TABSLinkFields.IndexListChange(Sender: TObject);
var
  I:        Integer;
  IndexExp: AnsiString;
begin
  DetailList.Items.Clear;
  if (DataSetProxy.IndexBased) then
   begin
    DataSetProxy.IndexName := IndexList.Text;
    I := DataSetProxy.IndexDefs.IndexOf({$ifdef D16H}String(DataSetProxy.IndexName){$else}DataSetProxy.IndexName{$endif});
    if (I <> -1) then
      IndexExp := DataSetProxy.IndexDefs.Items[I].Expression;
    if (IndexExp <> '') then
      DetailList.Items.Add({$ifdef D16H}String(IndexExp){$else}IndexExp{$endif})
    else
      DataSetProxy.GetFieldNamesForIndex(DetailList.Items);
   end
  else
   DataSet.GetFieldNames(DetailList.Items);
  MasterList.Items.Assign(OrderedMasterList);
  OrderedDetailList.Assign(DetailList.Items);
  for I := 0 to OrderedDetailList.Count - 1 do
    OrderedDetailList.Objects[I] := TObject(False);
  BindList.Clear;
  AddButton.Enabled := False;
  ClearButton.Enabled := False;
  DeleteButton.Enabled := False;
  MasterList.ItemIndex := -1;
end;

procedure TABSLinkFields.OrderFieldList(OrderedList, List: TStrings);
var
  I, J:                         Integer;
  MinIndex, Index, FieldIndex:  Integer;
begin
  for J := 0 to List.Count - 1 do
  begin
    MinIndex := $7FFF;
    FieldIndex := -1;
    for I := J to List.Count - 1 do
    begin
      Index := OrderedList.IndexOf(List[I]);
      if Index < MinIndex then
      begin
        MinIndex := Index;
        FieldIndex := I;
      end;
    end;
    List.Move(FieldIndex, J);
  end;
end;

procedure TABSLinkFields.AddToBindList(const Str1, Str2: AnsiString);
var
  I:        Integer;
  NewField: AnsiString;
  NewIndex: Integer;
begin
  NewIndex := OrderedDetailList.IndexOf({$ifdef D16H}String(Str1){$else}Str1{$endif});
  NewField := Format('%s -> %s', [Str1, Str2]);
  with BindList.Items do
   begin
    for I := 0 to Count - 1 do
     begin
      if OrderedDetailList.IndexOf({$ifdef D16H}String(StripDetail(Strings[I])){$else}StripDetail(Strings[I]){$endif}) > NewIndex then
       begin
        Insert(I, {$ifdef D16H}String(NewField){$else}NewField{$endif});
        Exit;
      end;
     end;
    Add({$ifdef D16H}String(NewField){$else}NewField{$endif});
   end;
end;

procedure TABSLinkFields.BindingListClick(Sender: TObject);
begin
  AddButton.Enabled := (DetailList.ItemIndex <> LB_ERR) and
    (MasterList.ItemIndex <> LB_ERR);
end;

procedure TABSLinkFields.AddButtonClick(Sender: TObject);
var
  DetailIndex: Integer;
  MasterIndex: Integer;
begin
  DetailIndex := DetailList.ItemIndex;
  MasterIndex := MasterList.ItemIndex;
  AddToBindList(DetailList.Items[DetailIndex],
    MasterList.Items[MasterIndex]);
  with OrderedDetailList do
    Objects[IndexOf(DetailList.Items[DetailIndex])] := TObject(True);
  DetailList.Items.Delete(DetailIndex);
  MasterList.Items.Delete(MasterIndex);
  ClearButton.Enabled := True;
  AddButton.Enabled := False;
end;

procedure TABSLinkFields.ClearButtonClick(Sender: TObject);
var
  I: Integer;
  BindValue: AnsiString;
begin
  for I := 0 to BindList.Items.Count - 1 do
   begin
    BindValue := BindList.Items[I];
    DetailList.Items.Add({$ifdef D16H}String(StripDetail(BindValue)){$else}StripDetail(BindValue){$endif});
    MasterList.Items.Add({$ifdef D16H}String(StripMaster(BindValue)){$else}StripMaster(BindValue){$endif});
   end;
  BindList.Clear;
  ClearButton.Enabled := False;
  DeleteButton.Enabled := False;
  OrderFieldList(OrderedDetailList, DetailList.Items);
  DetailList.ItemIndex := -1;
  MasterList.Items.Assign(OrderedMasterList);
  for I := 0 to OrderedDetailList.Count - 1 do
    OrderedDetailList.Objects[I] := TObject(False);
  AddButton.Enabled := False;
end;

procedure TABSLinkFields.DeleteButtonClick(Sender: TObject);
var
  I: Integer;
begin
  with BindList do
   begin
    for I := Items.Count - 1 downto 0 do
     begin
      if Selected[I] then
       begin
        DetailList.Items.Add({$ifdef D16H}String(StripDetail(Items[I])){$else}StripDetail(Items[I]){$endif});
        MasterList.Items.Add({$ifdef D16H}String(StripMaster(Items[I])){$else}StripMaster(Items[I]){$endif});
        with OrderedDetailList do
          Objects[IndexOf({$ifdef D16H}String(StripDetail(Items[I])){$else}StripDetail(Items[I]){$endif})] := TObject(False);
        Items.Delete(I);
       end;
     end;
    if (Items.Count > 0) then
      Selected[0] := True;
    DeleteButton.Enabled := Items.Count > 0;
    ClearButton.Enabled := Items.Count > 0;
    OrderFieldList(OrderedDetailList, DetailList.Items);
    DetailList.ItemIndex := -1;
    OrderFieldList(OrderedMasterList, MasterList.Items);
    MasterList.ItemIndex := -1;
    AddButton.Enabled := False;
   end;
end;

procedure TABSLinkFields.BindListClick(Sender: TObject);
begin
  DeleteButton.Enabled := BindList.ItemIndex <> LB_ERR;
end;

procedure TABSLinkFields.BitBtn1Click(Sender: TObject);
var
  Gap:          Boolean;
  I:            Integer;
  FirstIndex:   Integer;
begin
  FirstIndex := -1;
  MasterFieldList := '';
  IndexFieldList := '';
  FFullIndexName := '';
  if (DataSetProxy.IndexBased) then
   begin
    Gap := False;
    for I := 0 to OrderedDetailList.Count - 1  do
     begin
      if Boolean(OrderedDetailList.Objects[I]) then
       begin
        if Gap then
         begin
          MessageDlg(Format(ErrorLLinkDesigner,
            [OrderedDetailList[FirstIndex]]), mtError, [mbOK], 0);
          ModalResult := 0;
          DetailList.ItemIndex := DetailList.Items.IndexOf(OrderedDetailList[FirstIndex]);
          Exit;
         end;
       end
      else
       begin
        Gap := True;
        if (FirstIndex = -1) then
          FirstIndex := I;
       end;
     end;
    if (not Gap) then
      FFullIndexName := DataSetProxy.IndexName;
   end;
  with (BindList) do
   begin
    for I := 0 to Items.Count - 1 do
     begin
      MasterFieldList := Format('%s%s;', [MasterFieldList, StripMaster(Items[I])]);
      IndexFieldList := Format('%s%s;', [IndexFieldList, StripDetail(Items[I])]);
     end;
    if (MasterFieldList <> '') then
      SetLength(MasterFieldList, Length(MasterFieldList) - 1);
    if (IndexFieldList <> '') then
      SetLength(IndexFieldList, Length(IndexFieldList) - 1);
   end;
end;

procedure TABSLinkFields.HelpClick(Sender: TObject);
begin
  Application.HelpContext(HelpContext);
end;

end.
