home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 March / Chip_1999-03_cd.bin / zkuste / delphi / D234C13 / RALIB.ZIP / RALib / Lib / RAIDb.pas < prev    next >
Pascal/Delphi Source File  |  1998-08-24  |  4KB  |  177 lines
  1. {***********************************************************
  2.                 R&A Library
  3.        Copyright (C) 1996-98 R&A
  4.  
  5.        component   : TRAIField
  6.        description : Calclulated DB Field
  7.  
  8.        programer   : black
  9.        e-mail      : blacknbs@chat.ru
  10.        www         : www.chat.ru\~blacknbs\ralib
  11. ************************************************************}
  12.  
  13. {$INCLUDE RA.INC}
  14.  
  15. unit RAIDb;
  16.  
  17. interface
  18.  
  19. uses
  20.   SysUtils, Classes, Db, 
  21.   RAIIntf, RAIClas, RAIImpl, RAISystem;
  22.  
  23. type
  24.  
  25.   TSetGetInfo = RAIIntf.TSetGetInfo;
  26.   TSetGetVarEvent = procedure (Sender : TObject; var SGI : TSetGetInfo; var Done : boolean) of object;
  27.  
  28.   TRAIField = class(TField)
  29.   protected
  30.     FRAIObject  : TIInterObject;
  31.     FProgramSource : string;
  32.     FOnSyncSetGetVar : TSetGetVarEvent;
  33.     procedure GetText(var Text: string; DisplayText: Boolean); override;
  34.     procedure SetProgramSource(AValue : string);
  35.   public
  36.     constructor Create(AOwner : TComponent); override;
  37.     destructor Destroy; override;
  38.     property RAIObject : TIInterObject read FRAIObject;
  39.   published
  40.     property ProgramSource : string read FProgramSource write SetProgramSource;
  41.     property OnSyncSetGetVar : TSetGetVarEvent read FOnSyncSetGetVar write FOnSyncSetGetVar;
  42.   end;
  43.  
  44. implementation
  45.  
  46. {*********************** TRAIField *********************}
  47. type
  48.  
  49.   TIBOF = class(TIInterObject)
  50.   protected
  51.     MainOwner : TComponent;
  52.     Field : TRAIField;
  53.     function SyncSetGetVar(var SGI : TSetGetInfo) : boolean; override;
  54.   public
  55.     constructor Create;
  56.     procedure Calc(Pr : string);
  57.   end;
  58.  
  59.   TIDataSet = class(TIThreadObject)
  60.   public
  61.     FDataSet : TDataSet;
  62.     constructor Create(ADataSet : TDataSet);
  63.     function SyncSetGetVar(var SGI : TSetGetInfo) : boolean; override;
  64.   end;
  65.  
  66. constructor TIBOF.Create;
  67. begin
  68.   inherited Create;
  69.  {Add available modules}
  70.   SysObjs.Add(TISystem.Create);
  71.   SysObjs.Add(TISysUtils.Create);
  72. end;
  73.  
  74. procedure TIBOF.Calc(Pr : string);
  75. begin
  76.   Formula := Pr;
  77.   Run;
  78. end;
  79.  
  80. function TIBOF.SyncSetGetVar(var SGI : TSetGetInfo) : boolean;
  81. var
  82.   Comp : TComponent;
  83.   Done : boolean;
  84. begin
  85.  {Find DataSet}
  86.   Result := inherited SyncSetGetVar(SGI);
  87.   if Assigned(Field.FOnSyncSetGetVar) then
  88.   begin
  89.     Done := false;
  90.     Field.FOnSyncSetGetVar(Field, SGI, Done);
  91.     Result := Done;
  92.   end;
  93.   with SGI do
  94.   if not Result and Get then
  95.   begin
  96.     Comp := MainOwner.FindComponent(Name);
  97.     if (Comp <> nil) and (Comp is TDataSet) then
  98.     begin
  99.       Result := true;
  100.       Res.vObject := TIDataSet.Create(Comp as TDataSet);
  101.       Res.vObject._Release;
  102.     end else
  103.       with TIDataSet.Create(Field.DataSet) do
  104.       try
  105.         Result := SyncSetGetVar(SGI);
  106.       finally
  107.         _Release;
  108.       end;
  109.   end;
  110. end;
  111.  
  112. constructor TIDataSet.Create(ADataSet : TDataSet);
  113. begin
  114.   inherited Create;
  115.   FDataSet := ADataSet;
  116. end;
  117.  
  118. function TIDataSet.SyncSetGetVar(var SGI : TSetGetInfo) : boolean;
  119. var
  120.   Field : TField;
  121.   DSState : TDataSetState;
  122. begin
  123.  {Find field}
  124.   Result := inherited SyncSetGetVar(SGI);
  125.   with SGI do
  126.   if not Result then
  127.   begin
  128.     Field := FDataSet.FindField(Name);
  129.     Result := Field <> nil;
  130.     if Result then
  131.       if Get then
  132.         case Field.DataType of
  133.           ftString : Res.vString := PChar(Field.AsString);
  134.           else Res.Str := PChar(Field.AsString)
  135.         end
  136.       else {Set} begin
  137.         DSState := Field.DataSet.State;
  138.         Field.DataSet.Edit;
  139.         Field.AsString := Res.Str;
  140.         if DSState = dsBrowse then Field.DataSet.Post;
  141.       end;
  142.   end;
  143. end;
  144.  
  145. constructor TRAIField.Create(AOwner : TComponent);
  146. begin
  147.   inherited Create(AOwner);
  148.   FRAIObject := TIBOF.Create;
  149.   (FRAIObject as TIBOF).MainOwner := AOwner;
  150.   (FRAIObject as TIBOF).Field := Self;
  151.   FieldKind := fkCalculated;
  152.   SetDataType(ftString);
  153. end;
  154.  
  155. destructor TRAIField.Destroy;
  156. begin
  157.   FRAIObject.Release;
  158.   inherited Destroy;
  159. end;
  160.  
  161. procedure TRAIField.GetText(var Text: string; DisplayText: Boolean);
  162. begin
  163.   (FRAIObject as TIBOF).Calc(FProgramSource);
  164.   if FRAIObject.ErrCode = ieOk then
  165.     Text := FRAIObject.Res.AsString else
  166.     Text := FRAIObject.ErrMessage;
  167. end;
  168.  
  169. procedure TRAIField.SetProgramSource(AValue : string);
  170. begin
  171.   FProgramSource := AValue;
  172.   if not (csLoading in ComponentState) then DataChanged;
  173. end;
  174.  
  175.  
  176. end.
  177.