rmd_dbx.pas

这是一个功能强大

  RMReadWord(aStream);
end;

procedure TRMDDBXQuery.SaveToStream(aStream: TStream);
begin
  inherited SaveToStream(aStream);
  RMWriteWord(aStream, 0);
end;

function TRMDDBXQuery.GetParamCount: Integer;
begin
  Result := FQuery.Params.Count;
end;

function TRMDDBXQuery.GetSQL: string;
begin
{$IFDEF COMPILER7_UP}
  Result := FQuery.DataSet.CommandText
{$ELSE}
  Result := FQuery.CommandText
{$ENDIF}
end;

procedure TRMDDBXQuery.SetSQL(Value: string);
begin
  FQuery.Close;
{$IFDEF COMPILER7_UP}
  FQuery.DataSet.CommandText := Value;
{$ELSE}
  FQuery.CommandText := Value;
{$ENDIF}
end;

function TRMDDBXQuery.GetDatabaseName: string;

  function _GetDataBase(Owner: TComponent; d: TSQLConnection): string;
  begin
    Result := '';
    if d <> nil then
    begin
      Result := d.Name;
      if d.Owner <> Owner then
        Result := d.Owner.Name + '.' + Result;
    end;
  end;

begin
{$IFDEF COMPILER7_UP}
  Result := _GetDataBase(FQuery.Owner, FQuery.Connection)
{$ELSE}
  Result := _GetDataBase(FQuery.Owner, FQuery.DBConnection)
{$ENDIF}
end;

procedure TRMDDBXQuery.SetDatabaseName(const Value: string);
var
  liComponent: TComponent;
begin
  FQuery.Close;
  liComponent := RMFindComponent(FQuery.Owner, Value);
{$IFDEF COMPILER7_UP}
  if (liComponent <> nil) and (liComponent is TSQLConnection) then
    FQuery.Connection := TSQLConnection(liComponent)
  else
    FQuery.Connection := nil;
{$ELSE}
  if (liComponent <> nil) and (liComponent is TSQLConnection) then
    FQuery.DBConnection := TSQLConnection(liComponent)
  else
    FQuery.DBConnection := nil;
{$ENDIF}
end;

function TRMDDBXQuery.GetFilter: string;
begin
  Result := FQuery.Filter;
end;

procedure TRMDDBXQuery.SetFilter(Value: string);
begin
  FQuery.Active := False;
  FQuery.Filter := Value;
  FQuery.Filtered := Value <> '';
end;

function TRMDDBXQuery.GetDataSource: string;
begin
  Result := RMGetDataSetName(FQuery.Owner, FQuery.DataSource)
end;

procedure TRMDDBXQuery.SetDataSource(Value: string);
var
  liComponent: TComponent;
begin
  liComponent := RMFindComponent(FQuery.Owner, Value);
  if (liComponent <> nil) and (liComponent is TDataSet) then
    FQuery.MasterSource := RMGetDataSource(FQuery.Owner, TDataSet(liComponent))
  else
    FQuery.MasterSource := nil;
end;

procedure TRMDDBXQuery.GetDatabases(sl: TStrings);
var
  liStringList: TStringList;
begin
  liStringList := TStringList.Create;
  try
    RMGetComponents(RMDialogForm, TSQLConnection, liStringList, nil);
    liStringList.Sort;
    sl.Assign(liStringList);
  finally
    liStringList.Free;
  end;
end;

procedure TRMDDBXQuery.GetTableNames(DB: string; Strings: TStrings);
var
  sl: TStringList;
begin
{$IFDEF COMPILER7_UP}
  if FQuery.Connection <> nil then
{$ELSE}
  if FQuery.DBConnection <> nil then
{$ENDIF}
  begin
    sl := TStringList.Create;
    try
      try
{$IFDEF COMPILER7_UP}
        FQuery.Connection.GetTableNames(sl);
{$ELSE}
        FQuery.DBConnection.GetTableNames(sl);
{$ENDIF}
        sl.Sort;
        Strings.Assign(sl);
      except
      end;
    finally
      sl.Free;
    end;
  end;
end;

procedure TRMDDBXQuery.GetTableFieldNames(const DB, TName: string; sl: TStrings);
var
  i: Integer;
  lStrings: TStringList;
  t: TSQLTable;
begin
  lStrings := TStringList.Create;
  t := TSQLTable.Create(RMDialogForm);
  try
{$IFDEF COMPILER7_UP}
    t.SQLConnection := FQuery.Connection;
{$ELSE}
    t.SQLConnection := FQuery.DBConnection;
{$ENDIF}
    t.TableName := tName;
    try
      t.FieldDefs.UpDate;
      for i := 0 to t.FieldDefs.Count - 1 do
        lStrings.Add(t.FieldDefs.Items[i].Name);
      lStrings.Sort;
      sl.Assign(lStrings);
    except;
    end;
  finally
    lStrings.Free;
    t.Free;
  end;
end;

function TRMDDBXQuery.GetParamName(Index: Integer): string;
begin
  Result := FQuery.Params[Index].Name;
end;

function TRMDDBXQuery.GetParamType(Index: Integer): TFieldType;
begin
  Result := FQuery.Params[Index].DataType;
end;

procedure TRMDDBXQuery.SetParamType(Index: Integer; Value: TFieldType);
begin
  FQuery.Params[Index].DataType := Value;
end;

function TRMDDBXQuery.GetParamKind(Index: Integer): TRMParamKind;
begin
  Result := rmpkValue;
  if not FQuery.Params[Index].Bound then
    Result := rmpkAssignFromMaster;
end;

procedure TRMDDBXQuery.SetParamKind(Index: Integer; Value: TRMParamKind);
begin
  if Value = rmpkAssignFromMaster then
  begin
    FQuery.Params[Index].Bound := False;
    FParams.Delete(FParams.IndexOf(FQuery.Params[Index].Name));
  end
  else
  begin
    FQuery.Params[Index].Clear;
    FQuery.Params[Index].Bound := True;
    FParams[FQuery.Params[Index].Name] := '';
  end;
end;

function TRMDDBXQuery.GetParamText(Index: Integer): string;
begin
  Result := '';
  if ParamKind[Index] = rmpkValue then
    Result := FParams[FQuery.Params[Index].Name];
end;

procedure TRMDDBXQuery.SetParamText(Index: Integer; Value: string);
begin
  if ParamKind[Index] = rmpkValue then
    FParams[FQuery.Params[Index].Name] := Value;
end;

function TRMDDBXQuery.GetParamValue(Index: Integer): Variant;
begin
  Result := FQuery.Params[Index].Value;
end;

procedure TRMDDBXQuery.SetParamValue(Index: Integer; Value: Variant);
begin
  FQuery.Params[Index].Value := Value;
end;

procedure TRMDDBXQuery.OnSQLTextChangedEvent(Sender: TObject);
begin
  try
    FQuery.Open;
    FQuery.Close;
  except
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TDBEditForm}

procedure TRMDFormDbxDBProp.Localize;
begin
  Font.Name := RMLoadStr(SRMDefaultFontName);
  Font.Size := StrToInt(RMLoadStr(SRMDefaultFontSize));
  Font.Charset := StrToInt(RMLoadStr(SCharset));

  btnOK.Caption := RMLoadStr(SOK);
  btnCancel.Caption := RMLoadStr(SCancel);
end;

procedure TRMDFormDbxDBProp.btnOKClick(Sender: TObject);
begin
  ModalResult := mrNone;
  try
  except
    raise;
  end;
  ModalResult := mrOk;
end;

procedure TRMDFormDbxDBProp.FormCreate(Sender: TObject);
begin
  FValueListEditor := TValueListEditor.Create(Self);
  with FValueListEditor do
  begin
    Parent := Self;
    Left := 8;
    Top := 7;
    Width := 412;
    Height := 233;
    KeyOptions := [keyEdit, keyAdd, keyDelete];
    PopupMenu := StringEditorMenu;
  end;

  Localize;
end;

procedure TRMDFormDbxDBProp.LoadItemClick(Sender: TObject);
begin
  with OpenDialog do
  begin
    if Execute then
      FValueListEditor.Strings.LoadFromFile(FileName);
  end;
end;

procedure TRMDFormDbxDBProp.SaveItemClick(Sender: TObject);
begin
  SaveDialog.FileName := OpenDialog.FileName;
  with SaveDialog do
  begin
    if Execute then
      FValueListEditor.Strings.SaveToFile(FileName);
  end;
end;


{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
type
  TParamsEditor = class(TELStringPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure Edit; override;
  end;

  TConnectionNameEditor = class(TELStringPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure GetValues(AValues: TStrings); override;
  end;

  TDriverNameEditor = class(TELStringPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure GetValues(AValues: TStrings); override;
  end;

  TDatabaseEditor = class(TELStringPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure GetValues(AValues: TStrings); override;
  end;

  TIndexNameEditor = class(TELStringPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure GetValues(AValues: TStrings); override;
  end;

  TTableNameEditor = class(TELStringPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure GetValues(AValues: TStrings); override;
  end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TParamsEditor }

function TParamsEditor.GetAttrs: TELPropAttrs;
begin
  Result := [praDialog];
end;

procedure TParamsEditor.Edit;
begin
  TRMDDBXDatabase(GetInstance(0)).ShowEditor;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TConnectionNameEditor }

function TConnectionNameEditor.GetAttrs: TELPropAttrs;
begin
  Result := [praValueList, praSortList];
end;

procedure TConnectionNameEditor.GetValues(AValues: TStrings);
begin
  GetConnectionNames(AValues);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TDriverNameEditor }

function TDriverNameEditor.GetAttrs: TELPropAttrs;
begin
  Result := [praValueList, praSortList];
end;

procedure TDriverNameEditor.GetValues(AValues: TStrings);
begin
  GetDriverNames(AValues);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TDatabaseEditor }

function TDatabaseEditor.GetAttrs: TELPropAttrs;
begin
  Result := [praValueList, praSortList];
end;

procedure TDatabaseEditor.GetValues(AValues: TStrings);
begin
  try
    RMGetComponents(RMDialogForm, TSQLConnection, AValues, nil);
  finally
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TIndexNameEditor }

function TIndexNameEditor.GetAttrs: TELPropAttrs;
begin
  Result := [praValueList, praSortList];
end;

procedure TIndexNameEditor.GetValues(AValues: TStrings);
var
  liTable: TRMDDBXTable;
begin
  liTable := TRMDDBXTable(GetInstance(0));
  liTable.GetIndexNames(aValues);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TTableNameEditor }

function TTableNameEditor.GetAttrs: TELPropAttrs;
begin
  Result := [praValueList, praSortList];
end;

procedure TTableNameEditor.GetValues(AValues: TStrings);
var
  liTable: TSQLTable;
begin
  liTable := TRMDDBXTable(GetInstance(0)).FTable;
  if liTable.SQLConnection <> nil then
  begin
    liTable.SQLConnection.GetTableNames(AValues);
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}

procedure TRMDDBXQuery_ExecSql(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TRMDDBXQuery(Args.Obj).OnBeforeOpenQueryEvent(TRMDDBXQuery(Args.Obj).FQuery);
  TRMDDBXQuery(Args.Obj).FQuery.Execute;
end;

const
	cReportMachine = 'RMD_Dbx';

procedure RM_RegisterRAI2Adapter(RAI2Adapter: TJvInterpreterAdapter);
begin
  with RAI2Adapter do
  begin
    AddClass(cReportMachine, TRMDDBXDatabase, 'TRMDDBXDataset');
    AddClass(cReportMachine, TRMDDBXTable, 'TRMDDBXTable');
    AddClass(cReportMachine, TRMDDBXQuery, 'TRMDDBXQuery');

    AddGet(TRMDDataset, 'ExecSql', TRMDDBXQuery_ExecSql, 0, [0], varEmpty);
  end;
end;

initialization
//  RMRegisterControl(TRMDDBXDatabase, 'RMD_DBXDB', RMLoadStr(SInsertDB) + '(DBX)');
//  RMRegisterControl(TRMDDBXTable, 'RMD_DBXTable', RMLoadStr(SInsertTable) + '(DBX)');
//  RMRegisterControl(TRMDDBXQuery, 'RMD_DBXQUERY', RMLoadStr(SInsertQuery) + '(DBX)');
  RMRegisterControls('DBX', 'RMD_DBXPATH', True,
    [TRMDDBXDatabase, TRMDDBXTable, TRMDDBXQuery],
    ['RMD_DBXDB', 'RMD_DBXTable', 'RMD_DBXQUERY'],
    [RMLoadStr(SInsertDB), RMLoadStr(SInsertTable), RMLoadStr(SInsertQuery)]);

  RMRegisterPropEditor(TypeInfo(string), TRMDDBXDatabase, 'Params', TParamsEditor);
  RMRegisterPropEditor(TypeInfo(string), TRMDDBXDatabase, 'ConnectionName', TConnectionNameEditor);
  RMRegisterPropEditor(TypeInfo(string), TRMDDBXDatabase, 'DriverName', TDriverNameEditor);


  RMRegisterPropEditor(TypeInfo(string), TRMDDBXTable, 'DatabaseName', TDatabaseEditor);
  RMRegisterPropEditor(TypeInfo(string), TRMDDBXTable, 'IndexName', TIndexNameEditor);
  RMRegisterPropEditor(TypeInfo(string), TRMDDBXTable, 'TableName', TTableNameEditor);

  RMRegisterPropEditor(TypeInfo(string), TRMDDBXQuery, 'DatabaseName', TDatabaseEditor);

  RM_RegisterRAI2Adapter(GlobalJvInterpreterAdapter);

finalization

{$ENDIF}
end.