autodb.pas

来自「delphi编程控件」· PAS 代码 · 共 526 行

unit AutoDB;
(*
 COPYRIGHT (c) RSD software 1997 - 98
 All Rights Reserved.
*)

{$I aclver.inc}
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DB, DBTables, afilter;

type
  TAutoQuery = class(TQuery)
  private
    FMacros: TMacros;
    FSQLPattern: TStrings;
    FFilter : String;
{$IFNDEF DELPHI3_0}
    FFiltered : Boolean;
{$ENDIF}
    FMacrosFreeze : TMacrosFreeze;
    FFilterFlag : Boolean;

    procedure SetSQL(Value: TStrings);
    procedure PatternChanged(Sender: TObject);
    procedure SetFilter(Value : String);
{$IFDEF DELPHI3_0}
    procedure SetFiltered(Value : Boolean); override;
    procedure SetFilterText(const Value : String); override;   
{$ELSE}
    procedure SetFiltered(Value : Boolean);
{$ENDIF}
    procedure RecreateMacros;
    procedure Expand(Query: TStrings);
    function GetMacroCount: Word;
  protected
{$IFDEF DELPHI3_0}
    procedure OpenCursor(InfoQuery: Boolean); override;
{$ELSE}
    procedure OpenCursor; override;
{$ENDIF}
    procedure Loaded; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ExpandMacros;
    function MacroByName(const Value: string): TMacro;

    property MacroCount: Word read GetMacroCount;
  published
    property Filter : String read FFilter write SetFilter;
{$IFNDEF DELPHI3_0}
    property Filtered : Boolean read FFiltered write SetFiltered;
{$ENDIF}
    property SQL: TStrings read FSQLPattern write SetSQL;
    property Macros: TMacros read FMacros write FMacros;
    property MacrosFreeze : TMacrosFreeze read FMacrosFreeze write FMacrosFreeze;
  end;

  TAutoStoredProc = class(TStoredProc)
  private
    FMacros: TMacros;
    FFilter : String;
{$IFNDEF DELPHI3_0}
    FFiltered : Boolean;
{$ENDIF}
    FMacrosFreeze : TMacrosFreeze;
    FFilterFlag : Boolean;

    procedure SetFilter(Value : String);
{$IFDEF DELPHI3_0}
    procedure SetFiltered(Value : Boolean); override;
    procedure SetFilterText(const Value : String); override;
{$ELSE}
    procedure SetFiltered(Value : Boolean);
{$ENDIF}
    procedure RecreateMacros;
    function GetMacroCount: Word;
  protected
    procedure Loaded; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function MacroByName(const Value: string): TMacro;

    property MacroCount: Word read GetMacroCount;
  published
    property Filter : String read FFilter write SetFilter;
{$IFNDEF DELPHI3_0}
    property Filtered : Boolean read FFiltered write SetFiltered;
{$ENDIF}
    property Macros: TMacros read FMacros write FMacros;
    property MacrosFreeze : TMacrosFreeze read FMacrosFreeze write FMacrosFreeze;
  end;

  TAutoTable = class(TTable)
  private
    FMacros: TMacros;
    FFilter : String;
{$IFNDEF DELPHI3_0}
    FFiltered : Boolean;
{$ENDIF}
    FMacrosFreeze : TMacrosFreeze;
    FFilterFlag : Boolean;

    procedure SetFilter(Value : String);    
{$IFDEF DELPHI3_0}
    procedure SetFiltered(Value : Boolean); override;
    procedure SetFilterText(const Value : String); override;   
{$ELSE}
    procedure SetFiltered(Value : Boolean);
{$ENDIF}
    procedure RecreateMacros;
    function GetMacroCount: Word;
  protected
    procedure Loaded; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function MacroByName(const Value: string): TMacro;

    property MacroCount: Word read GetMacroCount;
  published
    property Filter : String read FFilter write SetFilter;
{$IFNDEF DELPHI3_0}
    property Filtered : Boolean read FFiltered write SetFiltered;
{$ENDIF}    
    property Macros: TMacros read FMacros write FMacros;
    property MacrosFreeze : TMacrosFreeze read FMacrosFreeze write FMacrosFreeze;
  end;

implementation

uses aclconst, TypInfo;

{Procedure for TAutoDataSet}
function ReplaceMacrosInString(const S: string; AutoDataSet : TDataSet): string;
var
  I, P: Integer;
  Macro: TMacro;
  Temp: string;
  Macros : TMacros;
  PropInfo : PPropInfo;  
begin
  Result := S;
  PropInfo := GetPropInfo(AutoDataSet.ClassInfo, 'Macros');
  if(PropInfo <> Nil) then
    Macros := TMacros(GetOrdProp(AutoDataSet, PropInfo))
  else Macros := Nil;
  if(Macros = Nil) then exit;

  for I := 0 to Macros.Count - 1 do begin
    Macro := Macros[I];
    repeat
      P := Pos(acMacrosChar + Macro.Name, Result);
      if P > 0 then begin
        Temp := GetMacroText(AutoDataSet, Macro.Name);
        if(Temp = '') then
          Temp := Macro.Text;
        Result := Copy(Result, 1, P - 1) + Temp + Copy(Result,
        P + Length(Macro.Name) + 1, MaxInt);
      end;
    until P = 0;
  end;
  Result := Trim(Result);
  Temp := UpperCase(Result);
  if(Pos('OR ', Temp) = 1) then
    Result := Copy(Result, 3, 1000);
  if(Pos('AND ', Temp) = 1) then
    Result := Copy(Result, 4, 1000);
end;


{TAutoQuery}

constructor TAutoQuery.Create(Aowner : TComponent);
begin
  inherited Create(Aowner);

  FFilterFlag := False;
  FSQLPattern := TStringList.Create;
  TStringList(SQL).OnChange := PatternChanged;
  FMacros := TMacros.Create;
  FMacrosFreeze := mfNever;
end;

destructor TAutoQuery.Destroy;
begin
  FMacros.Free;
  FSQLPattern.Free;

  inherited Destroy;
end;

{$IFDEF DELPHI3_0}
procedure TAutoQuery.OpenCursor(InfoQuery: Boolean);
begin
  ExpandMacros;
  inherited;
end;
{$ELSE}
procedure TAutoQuery.OpenCursor;
begin
  ExpandMacros;
  inherited;
end;
{$ENDIF}

procedure TAutoQuery.Loaded;
begin
  inherited;
  try
    inherited Filter := ReplaceMacrosInString(FFilter, self);
  except
    raise;
  end;
end;


procedure TAutoQuery.SetSQL(Value: TStrings);
begin
  Disconnect;
  TStringList(SQL).OnChange := nil;
  SQL.Assign(Value);
  TStringList(SQL).OnChange := PatternChanged;
  PatternChanged(nil);
end;

procedure TAutoQuery.PatternChanged(Sender: TObject);
begin
  Disconnect;
  RecreateMacros;
  ExpandMacros;
end;

procedure TAutoQuery.ExpandMacros;
var
  ExpandedSQL: TStringList;
begin
  ExpandedSQL := TStringList.Create;
  try
    Expand(ExpandedSQL);
    inherited SQL := ExpandedSQL;
  finally
    ExpandedSQL.Free;
  end;
end;

procedure TAutoQuery.RecreateMacros;
var
  List: TMacros;
  PCharFilter : PChar;
begin
  List := TMacros.Create;
  try
    CreateMacros(List, SQL.GetText, [moSQL]);

    PCharFilter := StrAlloc(Length(FFilter) + 1);
    PCharFilter := StrPCopy(PCharFilter, FFilter);
    CreateMacros(List, PCharFilter, [moFilter]);
    StrDispose(PCharFilter);

    List.AssignValues(FMacros);
    FMacros.Free;
    FMacros := List;
  except
    List.Free;
  end;
end;

procedure TAutoQuery.Expand(Query: TStrings);
var
  I: Integer;
begin
  for I := 0 to SQL.Count - 1 do
    Query.Add(ReplaceMacrosInString(SQL[I], self));
end;

function TAutoQuery.GetMacroCount: Word;
begin
  Result := FMacros.Count;
end;

function TAutoQuery.MacroByName(const Value: string): TMacro;
begin
  Result := FMacros.MacroByName(Value);
end;

procedure TAutoQuery.SetFilter(Value : String);
begin
  FFilter := Value;
  RecreateMacros;
  if  Not (csLoading in ComponentState) then
    inherited Filter := ReplaceMacrosInString(Value, self);
end;

procedure TAutoQuery.SetFiltered(Value : Boolean);
begin
  if FFilterFlag then exit;
  FFilterFlag := True;

  {$IFDEF DELPHI3_0}
  inherited SetFiltered(False);
  {$ELSE}
  FFiltered := Value;
  inherited Filtered := False;
  {$ENDIF}
  if Value then begin
    if Not (csLoading in ComponentState) then
      inherited Filter := ReplaceMacrosInString(FFilter, self);
    {$IFDEF DELPHI3_0}
    inherited SetFiltered(Value);
    {$ELSE}
    inherited Filtered := Value;
    {$ENDIF}
  end;
  FFilterFlag := False;
end;

{$IFDEF DELPHI3_0}
procedure TAutoQuery.SetFilterText(const Value : String);
begin
  if(Macros.Count = 0) then
    FFilter := Value;
  inherited SetFilterText(Value);
end;
{$ENDIF}

{TAutoStoredProc}
constructor TAutoStoredProc.Create(Aowner : TComponent);
begin
  inherited Create(Aowner);

  FFilterFlag := False;  
  FMacros := TMacros.Create;
  FMacrosFreeze := mfNever;
end;

destructor TAutoStoredProc.Destroy;
begin
  FMacros.Free;

  inherited Destroy;
end;

procedure TAutoStoredProc.Loaded;
begin
  inherited;
  try
    inherited Filter := ReplaceMacrosInString(FFilter, self);
  except
    raise;
  end;
end;

procedure TAutoStoredProc.RecreateMacros;
var
  List: TMacros;
  PCharFilter : PChar;
begin
  List := TMacros.Create;
  try
    PCharFilter := StrAlloc(Length(FFilter) + 1);
    PCharFilter := StrPCopy(PCharFilter, FFilter);
    CreateMacros(List, PCharFilter, [moFilter]);
    StrDispose(PCharFilter);
    List.AssignValues(FMacros);
    FMacros.Free;
    FMacros := List;
  except
    List.Free;
  end;
end;

function TAutoStoredProc.MacroByName(const Value: string): TMacro;
begin
  Result := FMacros.MacroByName(Value);
end;

function TAutoStoredProc.GetMacroCount: Word;
begin
  Result := FMacros.Count;
end;

procedure TAutoStoredProc.SetFilter(Value : String);
begin
  FFilter := Value;
  RecreateMacros;
  if  Not (csLoading in ComponentState) then
    inherited Filter := ReplaceMacrosInString(Value, self);
end;

procedure TAutoStoredProc.SetFiltered(Value : Boolean);
begin
  if FFilterFlag then exit;
  FFilterFlag := True;

  {$IFDEF DELPHI3_0}
  inherited SetFiltered(False);
  {$ELSE}
  FFiltered := Value;
  inherited Filtered := False;
  {$ENDIF}
  if Value then begin
    if Not (csLoading in ComponentState) then
      inherited Filter := ReplaceMacrosInString(FFilter, self);
    {$IFDEF DELPHI3_0}
    inherited SetFiltered(Value);
    {$ELSE}
    inherited Filtered := Value;
    {$ENDIF}
  end;
  FFilterFlag := False;
end;

{$IFDEF DELPHI3_0}
procedure TAutoStoredProc.SetFilterText(const Value : String);
begin
  if(Macros.Count = 0) then
    FFilter := Value;
  inherited SetFilterText(Value);
end;
{$ENDIF}

{TAutoTable}
constructor TAutoTable.Create(Aowner : TComponent);
begin
  inherited Create(Aowner);

  FFilterFlag := False;  
  FMacros := TMacros.Create;
  FMacrosFreeze := mfNever;
end;

destructor TAutoTable.Destroy;
begin
  FMacros.Free;

  inherited Destroy;
end;

procedure TAutoTable.Loaded;
begin
  inherited;
  try
    inherited Filter := ReplaceMacrosInString(FFilter, self);
  except
    raise;
  end;
end;

procedure TAutoTable.RecreateMacros;
var
  List: TMacros;
  PCharFilter : PChar;
begin
  List := TMacros.Create;
  try
    PCharFilter := StrAlloc(Length(FFilter) + 1);
    PCharFilter := StrPCopy(PCharFilter, FFilter);
    CreateMacros(List, PCharFilter, [moFilter]);
    StrDispose(PCharFilter);
    List.AssignValues(FMacros);
    FMacros.Free;
    FMacros := List;
  except
    List.Free;
  end;
end;

function TAutoTable.MacroByName(const Value: string): TMacro;
begin
  Result := FMacros.MacroByName(Value);
end;

function TAutoTable.GetMacroCount: Word;
begin
  Result := FMacros.Count;
end;

procedure TAutoTable.SetFilter(Value : String);
begin
  FFilterFlag := True;
  FFilter := Value;
  RecreateMacros;
  if  Not (csLoading in ComponentState) then
    inherited Filter := ReplaceMacrosInString(Value, self);
 FFilterFlag := False;
end;

procedure TAutoTable.SetFiltered(Value : Boolean);
begin
  if FFilterFlag then exit;
  FFilterFlag := True;

  {$IFDEF DELPHI3_0}
  inherited SetFiltered(False);
  {$ELSE}
  FFiltered := Value;
  inherited Filtered := False;
  {$ENDIF}
  if Value then begin
    if Not (csLoading in ComponentState) then
      inherited Filter := ReplaceMacrosInString(FFilter, self);
    {$IFDEF DELPHI3_0}
    inherited SetFiltered(Value);
    {$ELSE}
    inherited Filtered := Value;
    {$ENDIF}
  end;
  FFilterFlag := False;
end;

{$IFDEF DELPHI3_0}
procedure TAutoTable.SetFilterText(const Value : String);
begin
  if(Macros.Count = 0) then
    FFilter := Value;
  inherited SetFilterText(Value);
end;
{$ENDIF}

end.