absfldlinks.pas

Absolute Database 是来替代BDE[Borland数据库引擎]的用于Delphi 和 C++ Builder 开发用的数据库引擎. 它小巧, 高速, 健壮, 易于使用. 它能直接编译进

{$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: string;

  procedure SetUpLists(const MasterFieldList, DetailFieldList: string);
  var
    I, J: Integer;
    MasterFieldName, DetailFieldName: string;
  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(MasterFieldName) <> -1) and
        (OrderedDetailList.IndexOf(DetailFieldName) <> -1) then
      begin
        with OrderedDetailList do
          Objects[IndexOf(DetailFieldName)] := TObject(True);
        with DetailList.Items do
          Delete(IndexOf(DetailFieldName));
        with MasterList.Items do
          Delete(IndexOf(MasterFieldName));
        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(IndexFieldNames).Name
     else SIndexName := IndexName;
      if ((SIndexName <> '') and (IndexList.Items.IndexOf(SIndexName) >= 0)) then
       IndexList.ItemIndex := IndexList.Items.IndexOf(SIndexName)
      else
       IndexList.ItemIndex := 0;
    end;
  with DataSetProxy do
   begin
    MasterFieldList := MasterFields;
    if ((IndexFieldNames = '') and (IndexName <> '') and
        (IndexDefs.IndexOf(IndexName) >= 0)) then
      IndexFieldList := IndexDefs[IndexDefs.IndexOf(IndexName)].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: String;
begin
  DetailList.Items.Clear;
  if (DataSetProxy.IndexBased) then
   begin
    DataSetProxy.IndexName := IndexList.Text;
    I := DataSetProxy.IndexDefs.IndexOf(DataSetProxy.IndexName);
    if (I <> -1) then
      IndexExp := DataSetProxy.IndexDefs.Items[I].Expression;
    if (IndexExp <> '') then
      DetailList.Items.Add(IndexExp)
    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: string);
var
  I:        Integer;
  NewField: String;
  NewIndex: Integer;
begin
  NewIndex := OrderedDetailList.IndexOf(Str1);
  NewField := Format('%s -> %s', [Str1, Str2]);
  with BindList.Items do
   begin
    for I := 0 to Count - 1 do
     begin
      if OrderedDetailList.IndexOf(StripDetail(Strings[I])) > NewIndex then
       begin
        Insert(I, NewField);
        Exit;
      end;
     end;
    Add(NewField);
   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: string;
begin
  for I := 0 to BindList.Items.Count - 1 do
   begin
    BindValue := BindList.Items[I];
    DetailList.Items.Add(StripDetail(BindValue));
    MasterList.Items.Add(StripMaster(BindValue));
   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(StripDetail(Items[I]));
        MasterList.Items.Add(StripMaster(Items[I]));
        with OrderedDetailList do
          Objects[IndexOf(StripDetail(Items[I]))] := 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.