164 lines
3.8 KiB
ObjectPascal
164 lines
3.8 KiB
ObjectPascal
|
|
{******************************************}
|
|
{ }
|
|
{ FastReport VCL }
|
|
{ ADO components design editors }
|
|
{ }
|
|
{ Copyright (c) 1998-2021 }
|
|
{ by Fast Reports Inc. }
|
|
{ }
|
|
{******************************************}
|
|
|
|
unit frxADOEditor;
|
|
|
|
interface
|
|
|
|
{$I frx.inc}
|
|
|
|
implementation
|
|
|
|
uses
|
|
Windows, Classes, SysUtils, Forms, frxADOComponents, frxCustomDB,
|
|
frxDsgnIntf, frxRes
|
|
{$IFDEF DELPHI16}
|
|
, Data.DB, Data.Win.ADODB, Winapi.ADOInt
|
|
{$ELSE}
|
|
, DB, ADODB, ADOInt
|
|
{$ENDIF}
|
|
{$IFDEF Delphi6}
|
|
, Variants
|
|
{$ENDIF};
|
|
|
|
|
|
type
|
|
TfrxDatabaseNameProperty = class(TfrxStringProperty)
|
|
public
|
|
function GetAttributes: TfrxPropertyAttributes; override;
|
|
function Edit: Boolean; override;
|
|
end;
|
|
|
|
TfrxDatabaseProperty = class(TfrxComponentProperty)
|
|
public
|
|
function GetValue: String; override;
|
|
end;
|
|
|
|
TfrxTableNameProperty = class(TfrxStringProperty)
|
|
public
|
|
function GetAttributes: TfrxPropertyAttributes; override;
|
|
procedure GetValues; override;
|
|
procedure SetValue(const Value: String); override;
|
|
end;
|
|
|
|
TfrxIndexNameProperty = class(TfrxStringProperty)
|
|
public
|
|
function GetAttributes: TfrxPropertyAttributes; override;
|
|
procedure GetValues; override;
|
|
end;
|
|
|
|
|
|
{ TfrxDatabaseNameProperty }
|
|
|
|
function TfrxDatabaseNameProperty.GetAttributes: TfrxPropertyAttributes;
|
|
begin
|
|
Result := [paDialog];
|
|
end;
|
|
|
|
function TfrxDatabaseNameProperty.Edit: Boolean;
|
|
var
|
|
SaveConnected: Boolean;
|
|
db: TADOConnection;
|
|
fName: String;
|
|
begin
|
|
db := TfrxADODatabase(Component).Database;
|
|
|
|
SaveConnected := db.Connected;
|
|
db.Connected := False;
|
|
fName := PromptDataSource(Application.Handle, db.ConnectionString);
|
|
Result := fName <> '';
|
|
if Result then
|
|
db.ConnectionString := fName;
|
|
db.Connected := SaveConnected;
|
|
end;
|
|
|
|
|
|
{ TfrxDatabaseProperty }
|
|
|
|
function TfrxDatabaseProperty.GetValue: String;
|
|
var
|
|
db: TfrxADODatabase;
|
|
begin
|
|
db := TfrxADODatabase(GetOrdValue);
|
|
if db = nil then
|
|
begin
|
|
if (ADOComponents <> nil) and (ADOComponents.DefaultDatabase <> nil) then
|
|
Result := ADOComponents.DefaultDatabase.Name
|
|
else
|
|
Result := frxResources.Get('prNotAssigned');
|
|
end
|
|
else
|
|
Result := inherited GetValue;
|
|
end;
|
|
|
|
|
|
{ TfrxTableNameProperty }
|
|
|
|
function TfrxTableNameProperty.GetAttributes: TfrxPropertyAttributes;
|
|
begin
|
|
Result := [paMultiSelect, paValueList, paSortList];
|
|
end;
|
|
|
|
procedure TfrxTableNameProperty.GetValues;
|
|
begin
|
|
inherited;
|
|
with TfrxADOTable(Component).Table do
|
|
if Connection <> nil then
|
|
frxADOGetTableNames(Connection, Values, False);
|
|
end;
|
|
|
|
procedure TfrxTableNameProperty.SetValue(const Value: String);
|
|
begin
|
|
inherited;
|
|
Designer.UpdateDataTree;
|
|
end;
|
|
|
|
|
|
{ TfrxIndexProperty }
|
|
|
|
function TfrxIndexNameProperty.GetAttributes: TfrxPropertyAttributes;
|
|
begin
|
|
Result := [paMultiSelect, paValueList];
|
|
end;
|
|
|
|
procedure TfrxIndexNameProperty.GetValues;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
inherited;
|
|
try
|
|
with TfrxADOTable(Component).Table do
|
|
if (TableName <> '') and (IndexDefs <> nil) then
|
|
begin
|
|
IndexDefs.Update;
|
|
for i := 0 to IndexDefs.Count - 1 do
|
|
if IndexDefs[i].Name <> '' then
|
|
Values.Add(IndexDefs[i].Name);
|
|
end;
|
|
except
|
|
end;
|
|
end;
|
|
|
|
|
|
initialization
|
|
frxPropertyEditors.Register(TypeInfo(String), TfrxADODataBase, 'DatabaseName',
|
|
TfrxDataBaseNameProperty);
|
|
frxPropertyEditors.Register(TypeInfo(TfrxADODatabase), TfrxADOTable, 'Database',
|
|
TfrxDatabaseProperty);
|
|
frxPropertyEditors.Register(TypeInfo(TfrxADODatabase), TfrxADOQuery, 'Database',
|
|
TfrxDatabaseProperty);
|
|
frxPropertyEditors.Register(TypeInfo(String), TfrxADOTable, 'TableName',
|
|
TfrxTableNameProperty);
|
|
frxPropertyEditors.Register(TypeInfo(String), TfrxADOTable, 'IndexName',
|
|
TfrxIndexNameProperty);
|
|
|
|
end.
|