git-svn-id: https://svn.code.sf.net/p/kolmck/code@8 91bb2d04-0c0c-4d2d-88a5-bbb6f4c1fa07
This commit is contained in:
dkolmck
526
Addons/mckKOLTable.pas
Normal file
526
Addons/mckKOLTable.pas
Normal file
@ -0,0 +1,526 @@
|
||||
unit mckKOLTable;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows, Classes, Messages, Forms, SysUtils,
|
||||
mirror, mckCtrls, Graphics, KOLEdb, ADOdb,
|
||||
ADOConEd, mckListEdit, DB, KOL,
|
||||
ExptIntf, ToolIntf, EditIntf, // DsgnIntf
|
||||
//////////////////////////////////////////////////
|
||||
{$IFDEF VER140} //
|
||||
DesignIntf, DesignEditors, DesignConst, //
|
||||
Variants //
|
||||
{$ELSE} //
|
||||
DsgnIntf //
|
||||
{$ENDIF} //
|
||||
//////////////////////////////////////////////////
|
||||
{$IFNDEF VER90}{$IFNDEF VER100}, ToolsAPI{$ENDIF}{$ENDIF},
|
||||
TypInfo, Consts;
|
||||
|
||||
type
|
||||
|
||||
PKOLDataSource =^TKOLDataSource;
|
||||
TKOLDataSource = class(TKOLObj)
|
||||
private
|
||||
fConnection: WideString;
|
||||
AQ: TADOQuery;
|
||||
protected
|
||||
function AdditionalUnits: string; override;
|
||||
function TypeName: string; override;
|
||||
function CompareFirst( c, n: string): boolean; override;
|
||||
procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;
|
||||
function GetConnection: WideString;
|
||||
procedure SetConnection(Value: WideString);
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
published
|
||||
property Connection: WideString read GetConnection write SetConnection;
|
||||
end;
|
||||
|
||||
TKOLSession = class(TKOLObj)
|
||||
private
|
||||
fDataSource: TKOLDataSource;
|
||||
protected
|
||||
function AdditionalUnits: string; override;
|
||||
function TypeName: string; override;
|
||||
function CompareFirst( c, n: string): boolean; override;
|
||||
procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;
|
||||
procedure SetDataSource(DS: TKOLDataSource);
|
||||
published
|
||||
property DataSource: TKOLDataSource read fDataSource write SetDataSource;
|
||||
end;
|
||||
|
||||
TKOLQuery = class(TKOLObj)
|
||||
private
|
||||
fSession: TKOLSession;
|
||||
fTableName: WideString;
|
||||
fText: string;
|
||||
protected
|
||||
function AdditionalUnits: string; override;
|
||||
function TypeName: string; override;
|
||||
function CompareFirst( c, n: string): boolean; override;
|
||||
procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;
|
||||
procedure SetSession(SS: TKOLSession);
|
||||
procedure SetText (Tt: string);
|
||||
function GetTableName: WideString;
|
||||
procedure SetTableName(Value: WideString);
|
||||
published
|
||||
property Session: TKOLSession read fSession write SetSession;
|
||||
property SQL: string read fText write SetText;
|
||||
property TableName: WideString read GetTableName write SetTableName;
|
||||
end;
|
||||
|
||||
TTableStringProperty = class(TStringProperty)
|
||||
public
|
||||
function GetAttributes: TPropertyAttributes; override;
|
||||
procedure Edit; override;
|
||||
end;
|
||||
|
||||
TTableNameProperty = class(TStringProperty)
|
||||
private
|
||||
FConnection: TADOConnection;
|
||||
public
|
||||
function AutoFill: Boolean; override;
|
||||
function GetAttributes: TPropertyAttributes; override;
|
||||
function GetConnection(Opened: Boolean): TADOConnection;
|
||||
procedure GetValueList(List: TStrings);
|
||||
procedure GetValues(Proc: TGetStrProc); override;
|
||||
end;
|
||||
|
||||
TKOLListData = class(TKOLListEdit)
|
||||
private
|
||||
fAutoOpen: boolean;
|
||||
fOnRowChanged: TOnEvent;
|
||||
fQuery: TKOLQuery;
|
||||
fColCount: integer;
|
||||
protected
|
||||
function AdditionalUnits: string; override;
|
||||
procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;
|
||||
procedure SetupLast( SL: TStringList; const AName, AParent, Prefix: String ); override;
|
||||
procedure AssignEvents( SL: TStringList; const AName: String ); override;
|
||||
procedure SetAutoOpen(Value: boolean);
|
||||
function GetColCount: integer;
|
||||
procedure SetColCount(Value: integer);
|
||||
procedure SetQuery(Value: TKOLQuery);
|
||||
procedure SetOnRowChanged(Value: TOnEvent);
|
||||
procedure DoRequest(Full: boolean);
|
||||
procedure Loaded; override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure UpdateColumns; override;
|
||||
published
|
||||
property AutoOpen: boolean read fAutoOpen write SetAutoOpen;
|
||||
property ColCount read GetColCount write SetColCount;
|
||||
property Query: TKOLQuery read fQuery write SetQuery;
|
||||
property OnRowChanged: TOnEvent read fOnRowChanged write SetOnRowChanged;
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
|
||||
implementation
|
||||
|
||||
uses Ustr;
|
||||
|
||||
{$R *.dcr}
|
||||
|
||||
function TTableStringProperty.GetAttributes: TPropertyAttributes;
|
||||
begin
|
||||
Result := [paDialog];
|
||||
end;
|
||||
|
||||
procedure TTableStringProperty.Edit;
|
||||
begin
|
||||
if EditConnectionString((GetComponent(0) as TKOLDataSource).AQ) then begin
|
||||
Modified;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TKOLDataSource.Create;
|
||||
begin
|
||||
inherited;
|
||||
AQ := TADOQuery.Create(self);
|
||||
end;
|
||||
|
||||
function TKOLDataSource.AdditionalUnits;
|
||||
begin
|
||||
Result := ', OLETable, KOLEdb';
|
||||
end;
|
||||
|
||||
function TKOLDataSource.TypeName;
|
||||
begin
|
||||
Result := 'TKOLDataSource';
|
||||
end;
|
||||
|
||||
function TKOLDataSource.CompareFirst;
|
||||
begin
|
||||
Result := False;
|
||||
if c = '' then Result := True;
|
||||
end;
|
||||
|
||||
procedure TKOLDataSource.SetupFirst;
|
||||
var s: string;
|
||||
c: string;
|
||||
t: string;
|
||||
begin
|
||||
SL.Add( Prefix + AName + ' := NewDataSource(');
|
||||
c := '''' + fConnection + ''');';
|
||||
repeat
|
||||
t := Prefix + copy(c, 1, 77 - length(Prefix));
|
||||
delete(c, 1, 77 - length(Prefix));
|
||||
if c <> '' then begin
|
||||
t := t + ''' +';
|
||||
c := '''' + c;
|
||||
end;
|
||||
SL.Add(t);
|
||||
until length(c) = 0;
|
||||
end;
|
||||
|
||||
function TKOLDataSource.GetConnection;
|
||||
begin
|
||||
fConnection := AQ.ConnectionString;
|
||||
Result := fConnection;
|
||||
end;
|
||||
|
||||
procedure TKOLDataSource.SetConnection;
|
||||
begin
|
||||
fConnection := Value;
|
||||
AQ.ConnectionString := Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
function TKOLSession.AdditionalUnits;
|
||||
begin
|
||||
Result := ', OLETable, KOLEdb';
|
||||
end;
|
||||
|
||||
function TKOLSession.TypeName;
|
||||
begin
|
||||
Result := 'TKOLSession';
|
||||
end;
|
||||
|
||||
function TKOLSession.CompareFirst;
|
||||
begin
|
||||
Result := False;
|
||||
if c = '' then Result := True;
|
||||
if c = 'TKOLDataSource' then Result := True;
|
||||
end;
|
||||
|
||||
procedure TKOLSession.SetupFirst;
|
||||
begin
|
||||
SL.Add( Prefix + AName + ' := NewSession( Result.' + fDataSource.Name + ' );' );
|
||||
end;
|
||||
|
||||
procedure TKOLSession.SetDataSource;
|
||||
begin
|
||||
fDataSource := DS;
|
||||
Change;
|
||||
end;
|
||||
|
||||
function TKOLQuery.AdditionalUnits;
|
||||
begin
|
||||
Result := ', OLETable, KOLEdb';
|
||||
end;
|
||||
|
||||
function TKOLQuery.TypeName;
|
||||
begin
|
||||
Result := 'TKOLQuery';
|
||||
end;
|
||||
|
||||
function TKOLQuery.CompareFirst;
|
||||
begin
|
||||
Result := False;
|
||||
if c = '' then Result := True;
|
||||
if c = 'TKOLDataSource' then Result := True;
|
||||
if c = 'TKOLSession' then Result := True;
|
||||
end;
|
||||
|
||||
procedure TKOLQuery.SetupFirst;
|
||||
begin
|
||||
SL.Add( Prefix + AName + ' := NewQuery( Result.' + fSession.Name + ' );' );
|
||||
if fText <> '' then begin
|
||||
SL.Add( Prefix + AName + '.Text := ''' + fText + ''';');
|
||||
end else
|
||||
if fTableName <> '' then begin
|
||||
SL.Add( Prefix + AName + '.Text := ''Select * from ' + fTableName + ''';');
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TKOLQuery.SetSession;
|
||||
begin
|
||||
fSession := SS;
|
||||
Change;
|
||||
end;
|
||||
|
||||
procedure TKOLQuery.SetText;
|
||||
begin
|
||||
fText := Tt;
|
||||
Change;
|
||||
end;
|
||||
|
||||
function TTableNameProperty.GetAttributes: TPropertyAttributes;
|
||||
begin
|
||||
Result := [paValueList, paSortList, paMultiSelect];
|
||||
end;
|
||||
|
||||
function TTableNameProperty.GetConnection(Opened: Boolean): TADOConnection;
|
||||
var
|
||||
Component: TComponent;
|
||||
Connection: string;
|
||||
begin
|
||||
Result := FConnection;
|
||||
Component := (GetComponent(0) as TKOLQuery).Session.DataSource;
|
||||
Connection := TypInfo.GetStrProp(Component,
|
||||
TypInfo.GetPropInfo(Component.ClassInfo, 'Connection'));
|
||||
if Connection = '' then Exit;
|
||||
FConnection := TADOConnection.Create(nil);
|
||||
FConnection.ConnectionString := Connection;
|
||||
FConnection.LoginPrompt := False;
|
||||
Result := FConnection;
|
||||
Result.Open;
|
||||
end;
|
||||
|
||||
procedure TTableNameProperty.GetValueList(List: TStrings);
|
||||
var
|
||||
Connection: TADOConnection;
|
||||
begin
|
||||
Connection := GetConnection(True);
|
||||
if Assigned(Connection) then
|
||||
try
|
||||
Connection.GetTableNames(List);
|
||||
finally
|
||||
FConnection.Free;
|
||||
FConnection := nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTableNameProperty.GetValues;
|
||||
var l: TStringList;
|
||||
i: integer;
|
||||
begin
|
||||
l := TStringList.Create;
|
||||
GetValueList(l);
|
||||
for i := 0 to l.Count - 1 do
|
||||
Proc(l[i]);
|
||||
l.Free;
|
||||
end;
|
||||
|
||||
function TTableNameProperty.AutoFill: Boolean;
|
||||
var
|
||||
Connection: TADOConnection;
|
||||
begin
|
||||
Connection := GetConnection(False);
|
||||
Result := Assigned(Connection) and Connection.Connected;
|
||||
end;
|
||||
|
||||
constructor TKOLListData.Create;
|
||||
begin
|
||||
inherited;
|
||||
IsListData := True;
|
||||
end;
|
||||
|
||||
destructor TKOLListData.Destroy;
|
||||
begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TKOLListData.AdditionalUnits;
|
||||
begin
|
||||
Result := ', OLETable, KOLEdb';
|
||||
end;
|
||||
|
||||
procedure TKOLListData.SetupFirst;
|
||||
begin
|
||||
inherited;
|
||||
DoRequest(True);
|
||||
if fQuery <> nil then begin
|
||||
if not fQuery.fSession.fDataSource.AQ.Active then fAutoOpen := False;
|
||||
SL.Add( Prefix + AName + '.Query := Result.' + fQuery.Name + ';');
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TKOLListData.SetupLast;
|
||||
begin
|
||||
inherited;
|
||||
if fQuery <> nil then begin
|
||||
if fAutoOpen then
|
||||
SL.Add( Prefix + AName + '.Open;' );
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TKOLListData.AssignEvents;
|
||||
begin
|
||||
inherited;
|
||||
DoAssignEvents( SL, AName,
|
||||
[ 'OnRowChanged'],
|
||||
[ @OnRowChanged ]);
|
||||
end;
|
||||
|
||||
procedure TKOLListData.SetAutoOpen;
|
||||
begin
|
||||
fAutoOpen := Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
function TKOLListData.GetColCount;
|
||||
begin
|
||||
Result := fColCount;
|
||||
end;
|
||||
|
||||
procedure TKOLListData.SetColCount;
|
||||
var i: integer;
|
||||
n: integer;
|
||||
a: TADOQuery;
|
||||
t: TListEditColumnsItem;
|
||||
e: boolean;
|
||||
begin
|
||||
if Value > 0 then begin
|
||||
fColCount := Value;
|
||||
end;
|
||||
while Columns.Count > fColCount do begin
|
||||
Columns.Delete(Columns.Count - 1);
|
||||
end;
|
||||
DoRequest(True);
|
||||
a := nil;
|
||||
if fQuery <> nil then begin
|
||||
if fQuery.fSession <> nil then begin
|
||||
if fQuery.fSession.fDataSource <> nil then begin
|
||||
a := fQuery.fSession.fDataSource.AQ;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
if a <> nil then begin
|
||||
for i := 0 to a.FieldCount - 1 do begin
|
||||
e := True;
|
||||
for n := 0 to Columns.Count - 1 do begin
|
||||
t := Columns.Items[n];
|
||||
if t.FieldName = a.Fields[i].FieldName then begin
|
||||
e := False;
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
if e and (Columns.Count < fColCount) then begin
|
||||
t := TListEditColumnsItem(Columns.Add);
|
||||
t.Caption := a.Fields[i].FieldName;
|
||||
t.FieldName := a.Fields[i].FieldName;
|
||||
case a.Fields[i].DataType of
|
||||
ftString,
|
||||
ftWideString: t.Alignment := taLeftJustify;
|
||||
else
|
||||
t.Alignment := taRightJustify;
|
||||
end;
|
||||
t.Width := Canvas.TextWidth(Replicate('Q', a.Fields[i].DisplayWidth));
|
||||
end;
|
||||
end;
|
||||
UpDateColumns;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TKOLListData.SetOnRowChanged;
|
||||
begin
|
||||
fOnRowChanged := Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
procedure TKOLListData.DoRequest;
|
||||
begin
|
||||
if fQuery <> nil then begin
|
||||
if fQuery.fText <> '' then begin
|
||||
fQuery.fSession.fDataSource.AQ.SQL.Clear;
|
||||
{ fQuery.fSession.fDataSource.AQ.SQL.Add(fQuery.fText);}
|
||||
fQuery.fSession.fDataSource.AQ.SQL.Add('Select * from ' + fQuery.fTableName);
|
||||
try
|
||||
fQuery.fSession.fDataSource.AQ.Open;
|
||||
except
|
||||
on E: Exception do MsgOK(E.Message);
|
||||
end;
|
||||
end else
|
||||
if fQuery.fTableName <> '' then begin
|
||||
fQuery.fSession.fDataSource.AQ.SQL.Clear;
|
||||
fQuery.fSession.fDataSource.AQ.SQL.Add('Select * from ' + fQuery.fTableName);
|
||||
try
|
||||
fQuery.fSession.fDataSource.AQ.Open;
|
||||
except
|
||||
on E: Exception do MsgOK(E.Message);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TKOLListData.Loaded;
|
||||
var i: integer;
|
||||
n: integer;
|
||||
a: TADOQuery;
|
||||
t: TListEditColumnsItem;
|
||||
e: boolean;
|
||||
begin
|
||||
inherited;
|
||||
DoRequest(True);
|
||||
a := nil;
|
||||
if fQuery <> nil then begin
|
||||
if fQuery.fSession <> nil then begin
|
||||
if fQuery.fSession.fDataSource <> nil then begin
|
||||
a := fQuery.fSession.fDataSource.AQ;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
if a <> nil then begin
|
||||
Columns.FieldNames.Clear;
|
||||
for i := 0 to a.FieldCount - 1 do begin
|
||||
Columns.FieldNames.Add(a.Fields[i].FieldName);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TKOLListData.UpdateColumns;
|
||||
var s: string;
|
||||
i: integer;
|
||||
f: string;
|
||||
begin
|
||||
s := '';
|
||||
for i := 0 to Columns.Count - 1 do begin
|
||||
if Columns.Items[i].FieldName <> '' then begin
|
||||
s := s + '[' + Columns.Items[i].FieldName + ']' + ',';
|
||||
end;
|
||||
end;
|
||||
s := copy(s, 1, length(s) - 1);
|
||||
if fQuery = nil then begin
|
||||
MsgOK('Query is not defined !');
|
||||
exit;
|
||||
end;
|
||||
i := pos('FROM', UpSt(fQuery.fText));
|
||||
if i > 0 then f := copy(fQuery.fText, i + 5, length(fQuery.fText) - i - 4)
|
||||
else f := fQuery.TableName;
|
||||
if trim(s) = '' then s := '*';
|
||||
if trim(f) = '' then f := fQuery.TableName;
|
||||
fQuery.fText := 'Select ' + s + ' from ' + f;
|
||||
Change;
|
||||
end;
|
||||
|
||||
function TKOLQuery.GetTableName;
|
||||
begin
|
||||
Result := fTableName;
|
||||
end;
|
||||
|
||||
procedure TKOLQuery.SetTableName;
|
||||
begin
|
||||
fTableName := Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
procedure TKOLListData.SetQuery;
|
||||
begin
|
||||
fQuery := Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterComponents ('KOLData', [TKOLDataSource, TKOLSession, TKOLQuery, TKOLListData]);
|
||||
RegisterPropertyEditor (TypeInfo(WideString), TKOLDataSource, 'Connection', TTableStringProperty);
|
||||
RegisterPropertyEditor (TypeInfo(WideString), TKOLQuery, 'TableName', TTableNameProperty);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user