Chip 2001 December/Chip_2001-12_cd1.bin/zkuste/delphi/kolekce/d3456/ALEXSOFT.ZIP/FRMDSRCE.PAS

Pascal/Delphi Source File | 2001-09-29 | 16.9 KB | 589 lines

(*////////////////////////////////////////////////////////////////////////////
//   Part of AlexSoft VCL/DLL Library.                                      //
//   All rights reserved. (c) Copyright 1998.                               //
//   Created by: Alex Rabichooc                                             //
//**************************************************************************//
//  Users of this unit must accept this disclaimer of warranty:             //
//    "This unit is supplied as is. The author disclaims all warranties,    //
//    expressed or implied, including, without limitation, the warranties   //
//    of merchantability and of fitness for any purpose.                    //
//    The author assumes no liability for damages, direct or                //
//    consequential, which may result from the use of this unit."           //
//                                                                          //
//  This Unit is donated to the public as public domain.                    //
//                                                                          //
//  This Unit can be freely used and distributed in commercial and          //
//  private environments provided this notice is not modified in any way.   //
//                                                                          //
//  If you do find this Unit handy and you feel guilty for using such a     //
//  great product without paying someone - sorry :-)                        //
//                                                                          //
//  Please forward any comments or suggestions to Alex Rabichooc at:        //
//                                                                          //
//  [e-mail] or [e-mail]                         //
/////////////////////////////////////////////////////////////////////////////*)
{---------------------------------------------------------------------------
  Extended DataSource Components.
     properties
       FormClassName: String;
          Name of a class of the form, which edits (or shows) given DataSet.
          Note:
             This form should be inherited from TDBForm.
       FormCaption: String;
          A Caption of this Form.
       ModalForm: boolean;
          Determines whether this Form is a modal form or not.
----------------------------------------------------------------------------}

unit FrmDSrce;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db, DbClient, DBTables, DBForms
  {$IFNDEF VER120}
  {$IFNDEF VER110},ADOdb
  {$ENDIF}
  {$ENDIF};

type
  TRaTable = class(ttable)
  private
    FFormClass: TDBFormClass;
    FFormClassName: String;
    FFormCaption: String;
    FModalForm: boolean;
    FFreeOnClose: boolean;
  protected
    function GetFormClass: String;
    procedure SetFormClass(Value: String);
  public
    property FormClass: TDBFormClass read FFormClass write FFormClass;
  published
    property FormClassName: String read GetFormClass write SetFormClass;
    property FormCaption: String read FFormCaption write FFormCaption;
    property ModalForm: Boolean read FModalForm write FModalForm;
    property FreeOnClose: Boolean read FFreeOnClose write FFreeOnClose;
  end;

  TRaQuery = class(TQuery)
  private
    FFormClass: TDBFormClass;
    FFormClassName: String;
    FFormCaption: String;
    FModalForm: boolean;
    FFreeOnClose: boolean;
  protected
    function GetFormClass: String;
    procedure SetFormClass(Value: String);
  public
    property FormClass: TDBFormClass read FFormClass write FFormClass;
  published
    property FormClassName: String read GetFormClass write SetFormClass;
    property FormCaption: String read FFormCaption write FFormCaption;
    property ModalForm: Boolean read FModalForm write FModalForm;
    property FreeOnClose: Boolean read FFreeOnClose write FFreeOnClose;
  end;

  TRaStoredProc = class(TStoredProc)
  private
    FFormClass: TDBFormClass;
    FFormClassName: String;
    FFormCaption: String;
    FModalForm: boolean;
    FFreeOnClose: boolean;
  protected
    function GetFormClass: String;
    procedure SetFormClass(Value: String);
  public
    property FormClass: TDBFormClass read FFormClass write FFormClass;
  published
    property FormClassName: String read GetFormClass write SetFormClass;
    property FormCaption: String read FFormCaption write FFormCaption;
    property ModalForm: Boolean read FModalForm write FModalForm;
    property FreeOnClose: Boolean read FFreeOnClose write FFreeOnClose;
  end;

  TRaClientDataSet = class(TClientDataSet)
  private
    FFormClass: TDBFormClass;
    FFormClassName: String;
    FFormCaption: String;
    FModalForm: boolean;
    FFreeOnClose: boolean;
  protected
    function GetFormClass: String;
    procedure SetFormClass(Value: String);
  public
    property FormClass: TDBFormClass read FFormClass write FFormClass;
  published
    property FormClassName: String read GetFormClass write SetFormClass;
    property FormCaption: String read FFormCaption write FFormCaption;
    property ModalForm: Boolean read FModalForm write FModalForm;
    property FreeOnClose: Boolean read FFreeOnClose write FFreeOnClose;
  end;

{$IFNDEF VER120}
{$IFNDEF VER110}
  TRaADODataSet = class(TADODataSet)
  private
    FFormClass: TDBFormClass;
    FFormClassName: String;
    FFormCaption: String;
    FModalForm: boolean;
    FFreeOnClose: boolean;
  protected
    function GetFormClass: String;
    procedure SetFormClass(Value: String);
  public
    property FormClass: TDBFormClass read FFormClass write FFormClass;
  published
    property FormClassName: String read GetFormClass write SetFormClass;
    property FormCaption: String read FFormCaption write FFormCaption;
    property ModalForm: Boolean read FModalForm write FModalForm;
    property FreeOnClose: Boolean read FFreeOnClose write FFreeOnClose;
  end;

  TRaADOTable = class(TADOTable)
  private
    FFormClass: TDBFormClass;
    FFormClassName: String;
    FFormCaption: String;
    FModalForm: boolean;
    FFreeOnClose: boolean;
  protected
    function GetFormClass: String;
    procedure SetFormClass(Value: String);
  public
    property FormClass: TDBFormClass read FFormClass write FFormClass;
  published
    property FormClassName: String read GetFormClass write SetFormClass;
    property FormCaption: String read FFormCaption write FFormCaption;
    property ModalForm: Boolean read FModalForm write FModalForm;
    property FreeOnClose: Boolean read FFreeOnClose write FFreeOnClose;
  end;

  TRaADOQuery = class(TADOQuery)
  private
    FFormClass: TDBFormClass;
    FFormClassName: String;
    FFormCaption: String;
    FModalForm: boolean;
    FFreeOnClose: boolean;
  protected
    function GetFormClass: String;
    procedure SetFormClass(Value: String);
  public
    property FormClass: TDBFormClass read FFormClass write FFormClass;
  published
    property FormClassName: String read GetFormClass write SetFormClass;
    property FormCaption: String read FFormCaption write FFormCaption;
    property ModalForm: Boolean read FModalForm write FModalForm;
    property FreeOnClose: Boolean read FFreeOnClose write FFreeOnClose;
  end;

  TRaADOStoredProc = class(TADOStoredProc)
  private
    FFormClass: TDBFormClass;
    FFormClassName: String;
    FFormCaption: String;
    FModalForm: boolean;
    FFreeOnClose: boolean;
  protected
    function GetFormClass: String;
    procedure SetFormClass(Value: String);
  public
    property FormClass: TDBFormClass read FFormClass write FFormClass;
  published
    property FormClassName: String read GetFormClass write SetFormClass;
    property FormCaption: String read FFormCaption write FFormCaption;
    property ModalForm: Boolean read FModalForm write FModalForm;
    property FreeOnClose: Boolean read FFreeOnClose write FFreeOnClose;
  end;

{$ENDIF}
{$ENDIF}

function GetFormClass(ADataSet: TDataSet): TDBFormClass;
function GetFormCaption(ADataSet: TDataSet): String;
function IsModalForm(ADataSet: TDataSet): Boolean;
function MustFreeForm(ADataSet: TDataSet): Boolean;

implementation

function GetFormClass(ADataSet: TDataSet): TDBFormClass;
begin
   if ADataSet is TRaTable then
      Result := (ADataSet as TRaTable).FormClass
     else
   if ADataSet is TRaQuery then
      Result := (ADataSet as TRaQuery).FormClass
     else
   if ADataSet is TRaStoredProc then
      Result := (ADataSet as TRaStoredProc).FormClass
     else
   if ADataSet is TRaClientDataSet then
      Result := (ADataSet as TRaClientDataSet).FormClass
     else
      Result := nil;
end;

function GetFormCaption(ADataSet: TDataSet): String;
begin
   if ADataSet is TRaTable then
      Result := (ADataSet as TRaTable).FormCaption
     else
   if ADataSet is TRaQuery then
      Result := (ADataSet as TRaQuery).FormCaption
     else
   if ADataSet is TRaStoredProc then
      Result := (ADataSet as TRaStoredProc).FormCaption
     else
   if ADataSet is TRaClientDataSet then
      Result := (ADataSet as TRaClientDataSet).FormCaption
     else
      Result := '';
end;

function IsModalForm(ADataSet: TDataSet): Boolean;
begin
   if ADataSet is TRaTable then
      Result := (ADataSet as TRaTable).ModalForm
     else
   if ADataSet is TRaQuery then
      Result := (ADataSet as TRaQuery).ModalForm
     else
   if ADataSet is TRaStoredProc then
      Result := (ADataSet as TRaStoredProc).ModalForm
     else
   if ADataSet is TRaClientDataSet then
      Result := (ADataSet as TRaClientDataSet).ModalForm
     else
      Result := True;
end;

function MustFreeForm(ADataSet: TDataSet): Boolean;
begin
  if ADataSet is TRaTable then
     Result := (ADataSet as TRaTable).FreeOnClose
    else
  if ADataSet is TRaQuery then
     Result := (ADataSet as TRaQuery).FreeOnClose
    else
  if ADataSet is TRaStoredProc then
     Result := (ADataSet as TRaStoredProc).FreeOnClose
    else
  if ADataSet is TRaClientDataSet then
     Result := (ADataSet as TRaClientDataSet).FreeOnClose
    else
     Result := True;
end;

{TRaTable}
procedure TRaTable.SetFormClass(Value: String);
begin
   if Value <> FFormClassName then
   begin
      FFormClassName := Value;
      FFormClassName := GetFormClass;
   end;
end;

function TRaTable.GetFormClass: String;
var AClass: TPersistentClass;
begin
   if not (csDesigning in ComponentState) then
   begin
      try
        AClass := FindClass(FFormClassName);
        if AClass.InheritsFrom(TDBForm) then
          FFormClass := TDBFormClass(AClass)
         else
         begin
            FFormClass := nil;
            FFormClassName := '';
         end;
      except
         on E: EClassNotFound do
            begin
              FFormClass := nil;
              FFormClassName := '';
            end
           else
             raise;
      end;
   end;
   Result := FFormClassName;
end;

{TRaQuery}
procedure TRaQuery.SetFormClass(Value: String);
begin
   if Value <> FFormClassName then
   begin
      FFormClassName := Value;
      FFormClassName := GetFormClass;
   end;
end;

function TRaQuery.GetFormClass: String;
var AClass: TPersistentClass;
begin
   if not (csDesigning in ComponentState) then
   begin
      try
        AClass := FindClass(FFormClassName);
        if AClass.InheritsFrom(TDBForm) then
          FFormClass := TDBFormClass(AClass)
         else
         begin
            FFormClass := nil;
            FFormClassName := '';
         end;
      except
         on E: EClassNotFound do
            begin
              FFormClass := nil;
              FFormClassName := '';
            end
           else
             raise;
      end;
   end;
   Result := FFormClassName;
end;

{TRaStoredProc}
procedure TRaStoredProc.SetFormClass(Value: String);
begin
   if Value <> FFormClassName then
   begin
      FFormClassName := Value;
      FFormClassName := GetFormClass;
   end;
end;

function TRaStoredProc.GetFormClass: String;
var AClass: TPersistentClass;
begin
   if not (csDesigning in ComponentState) then
   begin
      try
        AClass := FindClass(FFormClassName);
        if AClass.InheritsFrom(TDBForm) then
          FFormClass := TDBFormClass(AClass)
         else
         begin
            FFormClass := nil;
            FFormClassName := '';
         end;
      except
         on E: EClassNotFound do
            begin
              FFormClass := nil;
              FFormClassName := '';
            end
           else
             raise;
      end;
   end;
   Result := FFormClassName;
end;

{TRaClientDataSet}
procedure TRaClientDataSet.SetFormClass(Value: String);
begin
   if Value <> FFormClassName then
   begin
      FFormClassName := Value;
      FFormClassName := GetFormClass;
   end;
end;

function TRaClientDataSet.GetFormClass: String;
var AClass: TPersistentClass;
begin
   if not (csDesigning in ComponentState) then
   begin
      try
        AClass := FindClass(FFormClassName);
        if AClass.InheritsFrom(TDBForm) then
          FFormClass := TDBFormClass(AClass)
         else
         begin
            FFormClass := nil;
            FFormClassName := '';
         end;
      except
         on E: EClassNotFound do
            begin
              FFormClass := nil;
              FFormClassName := '';
            end
           else
             raise;
      end;
   end;
   Result := FFormClassName;
end;

{$IFNDEF VER120}
{$IFNDEF VER110}
{ TRaADODataSet }

procedure TRaADODataSet.SetFormClass(Value: String);
begin
   if Value <> FFormClassName then
   begin
      FFormClassName := Value;
      FFormClassName := GetFormClass;
   end;
end;

function TRaADODataSet.GetFormClass: String;
var AClass: TPersistentClass;
begin
   if not (csDesigning in ComponentState) then
   begin
      try
        AClass := FindClass(FFormClassName);
        if AClass.InheritsFrom(TDBForm) then
          FFormClass := TDBFormClass(AClass)
         else
         begin
            FFormClass := nil;
            FFormClassName := '';
         end;
      except
         on E: EClassNotFound do
            begin
              FFormClass := nil;
              FFormClassName := '';
            end
           else
             raise;
      end;
   end;
   Result := FFormClassName;
end;

{ TRaADOTable }

procedure TRaADOTable.SetFormClass(Value: String);
begin
   if Value <> FFormClassName then
   begin
      FFormClassName := Value;
      FFormClassName := GetFormClass;
   end;
end;

function TRaADOTable.GetFormClass: String;
var AClass: TPersistentClass;
begin
   if not (csDesigning in ComponentState) then
   begin
      try
        AClass := FindClass(FFormClassName);
        if AClass.InheritsFrom(TDBForm) then
          FFormClass := TDBFormClass(AClass)
         else
         begin
            FFormClass := nil;
            FFormClassName := '';
         end;
      except
         on E: EClassNotFound do
            begin
              FFormClass := nil;
              FFormClassName := '';
            end
           else
             raise;
      end;
   end;
   Result := FFormClassName;
end;

{ TRaADOQuery }

procedure TRaADOQuery.SetFormClass(Value: String);
begin
   if Value <> FFormClassName then
   begin
      FFormClassName := Value;
      FFormClassName := GetFormClass;
   end;
end;

function TRaADOQuery.GetFormClass: String;
var AClass: TPersistentClass;
begin
   if not (csDesigning in ComponentState) then
   begin
      try
        AClass := FindClass(FFormClassName);
        if AClass.InheritsFrom(TDBForm) then
          FFormClass := TDBFormClass(AClass)
         else
         begin
            FFormClass := nil;
            FFormClassName := '';
         end;
      except
         on E: EClassNotFound do
            begin
              FFormClass := nil;
              FFormClassName := '';
            end
           else
             raise;
      end;
   end;
   Result := FFormClassName;
end;

{ TRaADOStoredProc }

procedure TRaADOStoredProc.SetFormClass(Value: String);
begin
   if Value <> FFormClassName then
   begin
      FFormClassName := Value;
      FFormClassName := GetFormClass;
   end;
end;

function TRaADOStoredProc.GetFormClass: String;
var AClass: TPersistentClass;
begin
   if not (csDesigning in ComponentState) then
   begin
      try
        AClass := FindClass(FFormClassName);
        if AClass.InheritsFrom(TDBForm) then
          FFormClass := TDBFormClass(AClass)
         else
         begin
            FFormClass := nil;
            FFormClassName := '';
         end;
      except
         on E: EClassNotFound do
            begin
              FFormClass := nil;
              FFormClassName := '';
            end
           else
             raise;
      end;
   end;
   Result := FFormClassName;
end;
{$ENDIF}
{$ENDIF}

end.