home *** CD-ROM | disk | FTP | other *** search
/ Chip: Shareware for Win 95 / Chip-Shareware-Win95.bin / ostatni / delphi / delphi1 / scatter.exe / DELPHI / DEMOS / DATA / SCATTER / MAIN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-08-10  |  3.7 KB  |  126 lines
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, ExtCtrls, DBCtrls, Grids, DBGrids, DB, DBTables, StdCtrls,
  8.   dbiprocs, DbiTypes, DbiErrs;
  9.  
  10.  
  11. type
  12.   TForm1 = class(TForm)
  13.     DataSource1: TDataSource;
  14.     Table1: TTable;
  15.     DBNavigator1: TDBNavigator;
  16.     DataSource2: TDataSource;
  17.     Table2: TTable;
  18.     pbCopy: TButton;
  19.     GroupBox1: TGroupBox;
  20.     DBGrid1: TDBGrid;
  21.     GroupBox2: TGroupBox;
  22.     DBGrid3: TDBGrid;
  23.     procedure pbCopyClick(Sender: TObject);
  24.     procedure DBGrid1Enter(Sender: TObject);
  25.     procedure DBGrid2Enter(Sender: TObject);
  26.   private
  27.     { Private declarations }
  28.   public
  29.     { Public declarations }
  30.   end;
  31.  
  32.   function Scatter( ATable : TTable; var pRecordBuf: PChar ): boolean;
  33.   function Gather( ATable : TTable; pRecordBuf: PChar ): boolean;
  34.    
  35. var
  36.   Form1: TForm1;
  37.  
  38. implementation
  39.  
  40. {$R *.DFM}
  41.  
  42.    procedure TForm1.pbCopyClick(Sender: TObject);
  43.    var
  44.        pRecBuf: PChar;                    { Pointer to the record buffer }
  45.    begin
  46.       if Scatter( Table1, pRecBuf ) then  {both return booleans, }
  47.          Gather( Table2, pRecBuf );       {so they can be checked if necessary}
  48.    end;
  49.  
  50.    {=============================================================================================
  51.    { Scatter
  52.    { scatters/extracts the current record into a buffer
  53.    {=============================================================================================}
  54.    function Scatter( ATable : TTable; var pRecordBuf: PChar ): boolean;
  55.    var
  56.       curProp : CURProps;                 { Properties of the table }
  57.    begin 
  58.       Result := False;
  59.       try
  60.          { read cursor properties }
  61.          Check(DbiGetCursorProps( ATable.Handle, curProp));
  62.  
  63.          { allocate memory for the record buffer }
  64.          GetMem( pRecordBuf, curProp.iRecBufSize);
  65.  
  66.          if Assigned (pRecordBuf) then
  67.             { 'initialise' record buffer as per bde }
  68.             Check(DbiInitRecord( ATable.Handle, pRecordBuf));
  69.  
  70.          { read current record }
  71.          Result := ATable.GetCurrentRecord( pRecordBuf );
  72.  
  73.       except 
  74.          { if an error occurs, release memory }
  75.          if Assigned(pRecordBuf) then
  76.             FreeMem( pRecordBuf, curProp.iRecBufSize);
  77.       end;
  78.    end;
  79.                    
  80.  
  81.    {=============================================================================================
  82.    { Gather
  83.    { gathers/updates the current record from a buffer
  84.    {=============================================================================================}
  85.    function Gather( ATable : TTable; pRecordBuf: PChar ): boolean;
  86.    var
  87.       curProp: CURProps;                 { Properties of the table }
  88.       CurrActiveBuf: PChar;              { current active buffer of the table}
  89.    begin
  90.       Result := False;
  91.  
  92.       if Assigned(pRecordBuf) then
  93.       begin
  94.          try
  95.             with ATable do
  96.             begin
  97.                Check(DbiGetCursorProps( Handle, curProp));
  98.                Edit;
  99.                CurrActiveBuf := ActiveBuffer;
  100.                Move( pRecordBuf^, CurrActiveBuf^, curProp.iRecBufSize );
  101.                Post;
  102.                Refresh;
  103.                Result := True;          {any exception will not allow this line to run}
  104.             end;            
  105.          finally
  106.             { even if an error occurs, release memory }
  107.             if Assigned(pRecordBuf) then
  108.                FreeMem( pRecordBuf, curProp.iRecBufSize);
  109.          end;
  110.       end;
  111.  
  112.    end;  
  113.    
  114. procedure TForm1.DBGrid1Enter(Sender: TObject);
  115. begin
  116.     DBNavigator1.DataSource := DataSource1;
  117. end;
  118.  
  119. procedure TForm1.DBGrid2Enter(Sender: TObject);
  120. begin
  121.     DBNavigator1.DataSource := DataSource2;
  122. end;
  123.  
  124. end.
  125.  
  126.