absfldlinks.pas

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

{*******************************************************}
{                                                       }
{       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: string; virtual;
    function GetIndexName: string; virtual;
    function GetMasterFields: string; virtual; ABStract;
    procedure SetIndexFieldNames(const Value: string); virtual;
    procedure SetIndexName(const Value: string); virtual;
    procedure SetMasterFields(const Value: string); virtual; ABStract;
  public
    constructor CreateWith(ADataSet: TDataSet); 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;
    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: string;
    MasterFieldList: string;
    IndexFieldList: string;
    OrderedDetailList: TStringList;
    OrderedMasterList: TStringList;
    procedure OrderFieldList(OrderedList, List: TStrings);
    procedure AddToBindList(const Str1, Str2: string);
    procedure Initialize;
    property FullIndexName: string 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: 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;

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: string;
begin
  Result := '';
end;

function TABSBaseFieldLinkProperty.GetIndexName: string;
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: string);
begin
end;

procedure TABSBaseFieldLinkProperty.SetIndexName(const Value: string);
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;