myldbedit.pas

一个本地database引擎,支持中文T_Sql查询,兼容DELPHI标准数据库控件

unit MYLDBEdit;

interface

uses
 Classes, Db, Dialogs, Forms, SysUtils,
 MYLDBFldLinks, MYLDBMain, MYLDBConst,
 {$IFDEF DEBUG_LOG}
 MYLDBDebug,
 {$ENDIF}
  DesignIntf, DesignEditors, Variants
 ;

 type

////////////////////////////////////////////////////////////////////////////////
//
// TMYLDBFieldLinkProperty
//
////////////////////////////////////////////////////////////////////////////////


  TMYLDBFieldLinkProperty = class(TMYLDBBaseFieldLinkProperty)
  private
    FTable: TMYLDBTable;
  protected
    procedure GetFieldNamesForIndex(List: TStrings); override;
    function GetIndexBased: Boolean; override;
    function GetIndexDefs: TIndexDefs; override;
    function GetIndexFieldNames: string; override;
    function GetIndexName: string; override;
    function GetMasterFields: string; override;
    procedure SetIndexFieldNames(const Value: string); override;
    procedure SetIndexName(const Value: string); override;
    procedure SetMasterFields(const Value: string); override;
  public
    procedure Edit; override;

    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;

  end;


////////////////////////////////////////////////////////////////////////////////
//
// TMYLDBDBStringProperty
//
////////////////////////////////////////////////////////////////////////////////


  TMYLDBDBStringProperty = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValueList(List: TStrings); virtual;
    procedure GetValues(Proc: TGetStrProc); override;
  end;


////////////////////////////////////////////////////////////////////////////////
//
// TMYLDBIndexFieldNamesProperty
//
////////////////////////////////////////////////////////////////////////////////


  // editor for indexFieldNames property
  TMYLDBIndexFieldNamesProperty = class(TMYLDBDBStringProperty)
  public
    procedure GetValueList(List: TStrings); override;
  end;


////////////////////////////////////////////////////////////////////////////////
//
// TMYLDBIndexNameProperty
//
////////////////////////////////////////////////////////////////////////////////


  // editor for indexName property
  TMYLDBIndexNameProperty = class(TMYLDBDBStringProperty)
  public
    procedure GetValueList(List: TStrings); override;
  end;


////////////////////////////////////////////////////////////////////////////////
//
// TMYLDBTableNameProperty
//
////////////////////////////////////////////////////////////////////////////////


  // editor for TableName property
  TMYLDBTableNameProperty = class(TMYLDBDBStringProperty)
  public
    procedure GetValueList(List: TStrings); override;
  end;


////////////////////////////////////////////////////////////////////////////////
//
// TMYLDBDatabaseNameProperty
//
////////////////////////////////////////////////////////////////////////////////


  // editor for DatabaseName property
  TMYLDBDatabaseNameProperty = class(TMYLDBDBStringProperty)
  public
    procedure GetValueList(List: TStrings); override;
  end;


////////////////////////////////////////////////////////////////////////////////
//
// TMYLDBDatabaseFileNameProperty
//
////////////////////////////////////////////////////////////////////////////////


 // file open dialog - for selecting database file name
 TMYLDBDatabaseFileNameProperty = class (TStringProperty)
   public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
   end;


////////////////////////////////////////////////////////////////////////////////
//
// TMYLDBSessionNameProperty
//
////////////////////////////////////////////////////////////////////////////////


 // TMYLDBSessionNameProperty
 TMYLDBSessionNameProperty = class(TMYLDBDBStringProperty)
   public
      procedure GetValueList(List: TStrings); override;
   end;


function GetPropertyValue(Instance: TPersistent; const PropName: string): TPersistent;


implementation

uses TypInfo;

////////////////////////////////////////////////////////////////////////////////
//
// TMYLDBFieldLinkProperty
//
////////////////////////////////////////////////////////////////////////////////


procedure TMYLDBFieldLinkProperty.GetFieldNamesForIndex(List: TStrings);
var
  i: Integer;
begin
  for i := 0 to FTable.IndexFieldCount - 1 do
    List.Add(FTable.IndexFields[i].FieldName);
end;

function TMYLDBFieldLinkProperty.GetIndexBased: Boolean;
begin
  Result := True;
end;

function TMYLDBFieldLinkProperty.GetIndexDefs: TIndexDefs;
begin
  Result := FTable.IndexDefs;
end;

function TMYLDBFieldLinkProperty.GetIndexFieldNames: string;
begin
  Result := FTable.IndexFieldNames;
end;

function TMYLDBFieldLinkProperty.GetIndexName: string;
begin
  Result := FTable.IndexName;
end;

function TMYLDBFieldLinkProperty.GetMasterFields: string;
begin
  Result := FTable.MasterFields;
end;

procedure TMYLDBFieldLinkProperty.SetIndexFieldNames(const Value: string);
begin
  FTable.IndexFieldNames := Value;
end;

procedure TMYLDBFieldLinkProperty.SetIndexName(const Value: string);
begin
  FTable.IndexName := Value;
end;

procedure TMYLDBFieldLinkProperty.SetMasterFields(const Value: string);
begin
  FTable.MasterFields := Value;
end;

procedure TMYLDBFieldLinkProperty.Edit;
var
  Table:  TMYLDBTable;
  s :     String;
begin
  Table := DataSet as TMYLDBTable;
  FTable := TMYLDBTable.Create(nil);
  try
    FTable.DatabaseName := Table.DatabaseName;
    FTable.SessionName := Table.SessionName;
    FTable.InMemory := Table.InMemory;
    FTable.Temporary := Table.Temporary;
    FTable.TableName := Table.TableName;
    FTable.ReadOnly := Table.ReadOnly;
    FTable.FieldDefs.Assign(Table.FieldDefs);
    FTable.IndexDefs.Assign(Table.IndexDefs);
    FTable.AdvFieldDefs.Assign(Table.AdvFieldDefs);
    FTable.AdvIndexDefs.Assign(Table.AdvIndexDefs);

{$IFDEF DEBUG_TRACE_DATASET}
aaWriteToLog('TMYLDBFieldLinkProperty.Edit 0');
{$ENDIF}
    FTable.Open;
{$IFDEF DEBUG_TRACE_DATASET}
aaWriteToLog('TMYLDBFieldLinkProperty.Edit 1');
{$ENDIF}
    if (Table.IndexFieldNames <> '') then
     FTable.IndexFieldNames := Table.IndexFieldNames
    else
     FTable.IndexName := Table.IndexName;
    FTable.MasterFields := Table.MasterFields;
{$IFDEF DEBUG_TRACE_DATASET}
aaWriteToLog('TMYLDBFieldLinkProperty.Edit 2');
{$ENDIF}
    inherited Edit;
{$IFDEF DEBUG_TRACE_DATASET}
aaWriteToLog('TMYLDBFieldLinkProperty.Edit 3');
{$ENDIF}
   if Changed then
    begin
      Table.MasterFields := FTable.MasterFields;
      if FTable.IndexFieldNames <> '' then
       begin
        // index field names
        Table.IndexFieldNames := FTable.IndexFieldNames;
        s := FTable.IndexFieldNames;
       end
      else
       begin
        // index name
        Table.IndexName := FTable.IndexName;
        s := FTable.IndexName;
       end;
    end;
{$IFDEF DEBUG_TRACE_DATASET}
aaWriteToLog('TMYLDBFieldLinkProperty.Edit 4');
{$ENDIF}
  finally
    FTable.Free;
  end;
{$IFDEF DEBUG_TRACE_DATASET}
aaWriteToLog('TMYLDBFieldLinkProperty.Edit finish');
{$ENDIF}
end;


////////////////////////////////////////////////////////////////////////////////
//
// TMYLDBDBStringProperty
//
////////////////////////////////////////////////////////////////////////////////


function TMYLDBDBStringProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paValueList, paSortList, paMultiSelect];
end;

procedure TMYLDBDBStringProperty.GetValueList(List: TStrings);
begin
end;

procedure TMYLDBDBStringProperty.GetValues(Proc: TGetStrProc);
var
  I:      Integer;
  Values: TStringList;
begin
  Values := TStringList.Create;
  try
    GetValueList(Values);
    for I := 0 to Values.Count - 1 do
      Proc(Values[I]);
  finally
    Values.Free;
  end;
end;


function GetIndexDefs(Component: TPersistent): TIndexDefs;
var
  DataSet: TMYLDBTable;
  a : Boolean;
begin
  Result := nil;
  DataSet := Component as TMYLDBTable;
  if (Dataset.Exists) then
    begin
      a := DataSet.Active;
      if (not a) then
       DataSet.Open;
      Result := GetPropertyValue(DataSet, 'IndexDefs') as TIndexDefs;
      if Assigned(Result) then
      begin
        Result.Updated := False;
        Result.Update;
      end;
      if (not a) then
       DataSet.Close;
    end;
end;


////////////////////////////////////////////////////////////////////////////////
//
// TMYLDBIndexFieldNamesProperty
//
////////////////////////////////////////////////////////////////////////////////


procedure TMYLDBIndexFieldNamesProperty.GetValueList(List: TStrings);
var
  I: Integer;
  IndexDefs: TIndexDefs;
begin
  try
    IndexDefs := GetIndexDefs(GetComponent(0));
    if (IndexDefs <> nil) then
      for I := 0 to IndexDefs.Count - 1 do
        with IndexDefs[I] do
          if (Options * [ixExpression, ixDescending] = []) and (Fields <> '') then
            List.Add(Fields);
  except
  end;
end;


////////////////////////////////////////////////////////////////////////////////
//
// TMYLDBIndexNameProperty
//
////////////////////////////////////////////////////////////////////////////////


procedure TMYLDBIndexNameProperty.GetValueList(List: TStrings);
var
  IndexDefs: TIndexDefs;
begin
  try
    IndexDefs := GetIndexDefs(GetComponent(0));
    if (IndexDefs <> nil) then
      IndexDefs.GetItemNames(List);
  except
  end;
end;


////////////////////////////////////////////////////////////////////////////////
//
// TMYLDBTableNameProperty
//
////////////////////////////////////////////////////////////////////////////////


procedure TMYLDBTableNameProperty.GetValueList(List: TStrings);
var
  Table: TMYLDBTable;
begin
  Table := TMYLDBTable(GetComponent(0));
  try
    Table.DBSession.GetTableNames(Table.DatabaseName, List);
  except
  end;
end;


////////////////////////////////////////////////////////////////////////////////
//
// TMYLDBDatabaseNameProperty
//
////////////////////////////////////////////////////////////////////////////////


procedure TMYLDBDatabaseNameProperty.GetValueList(List: TStrings);
begin
 TMYLDBDataset(GetComponent(0)).GetDatabaseNameList(List);
end;


////////////////////////////////////////////////////////////////////////////////
//
// TMYLDBDatabaseFileNameProperty
//
////////////////////////////////////////////////////////////////////////////////


//------------------------------------------------------------------------------
// file name editor (extension is subtracted from name)
//------------------------------------------------------------------------------
procedure TMYLDBDatabaseFileNameProperty.Edit;
var
  td : TOpenDialog;
begin
 td := TOpenDialog.Create(Application);
 td.Options := [ofFileMustExist];
 td.Filter := 'MYLDBolute Database (*'+MYLDBDatabaseFileExtension+')|*'+MYLDBDatabaseFileExtension;
 if (td.Execute) then
   SetStrValue(td.FileName);
 td.Free;
end; // Edit


//------------------------------------------------------------------------------
// file name editor's attributes (paDialog - for ... button in design mode)
//------------------------------------------------------------------------------
function TMYLDBDatabaseFileNameProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog, paRevertable];
end; // GetAttributes




////////////////////////////////////////////////////////////////////////////////
//
// TMYLDBSessionNameProperty
//
////////////////////////////////////////////////////////////////////////////////


//------------------------------------------------------------------------------
//  TMYLDBSession names
//------------------------------------------------------------------------------
procedure TMYLDBSessionNameProperty.GetValueList(List: TStrings);
begin
  Sessions.GetSessionNames(List);
end;

{ Utility Functions }

function GetPropertyValue(Instance: TPersistent; const PropName: string): TPersistent;
var
  PropInfo: PPropInfo;
begin
  Result := nil;
  PropInfo := TypInfo.GetPropInfo(Instance.ClassInfo, PropName);
  if (PropInfo <> nil) and (PropInfo^.PropType^.Kind = tkClass) then
    Result := TObject(GetOrdProp(Instance, PropInfo)) as TPersistent;
end;


end.