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 >
Wrap
Pascal/Delphi Source File
|
1995-08-10
|
4KB
|
126 lines
unit Main;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, ExtCtrls, DBCtrls, Grids, DBGrids, DB, DBTables, StdCtrls,
dbiprocs, DbiTypes, DbiErrs;
type
TForm1 = class(TForm)
DataSource1: TDataSource;
Table1: TTable;
DBNavigator1: TDBNavigator;
DataSource2: TDataSource;
Table2: TTable;
pbCopy: TButton;
GroupBox1: TGroupBox;
DBGrid1: TDBGrid;
GroupBox2: TGroupBox;
DBGrid3: TDBGrid;
procedure pbCopyClick(Sender: TObject);
procedure DBGrid1Enter(Sender: TObject);
procedure DBGrid2Enter(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
function Scatter( ATable : TTable; var pRecordBuf: PChar ): boolean;
function Gather( ATable : TTable; pRecordBuf: PChar ): boolean;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.pbCopyClick(Sender: TObject);
var
pRecBuf: PChar; { Pointer to the record buffer }
begin
if Scatter( Table1, pRecBuf ) then {both return booleans, }
Gather( Table2, pRecBuf ); {so they can be checked if necessary}
end;
{=============================================================================================
{ Scatter
{ scatters/extracts the current record into a buffer
{=============================================================================================}
function Scatter( ATable : TTable; var pRecordBuf: PChar ): boolean;
var
curProp : CURProps; { Properties of the table }
begin
Result := False;
try
{ read cursor properties }
Check(DbiGetCursorProps( ATable.Handle, curProp));
{ allocate memory for the record buffer }
GetMem( pRecordBuf, curProp.iRecBufSize);
if Assigned (pRecordBuf) then
{ 'initialise' record buffer as per bde }
Check(DbiInitRecord( ATable.Handle, pRecordBuf));
{ read current record }
Result := ATable.GetCurrentRecord( pRecordBuf );
except
{ if an error occurs, release memory }
if Assigned(pRecordBuf) then
FreeMem( pRecordBuf, curProp.iRecBufSize);
end;
end;
{=============================================================================================
{ Gather
{ gathers/updates the current record from a buffer
{=============================================================================================}
function Gather( ATable : TTable; pRecordBuf: PChar ): boolean;
var
curProp: CURProps; { Properties of the table }
CurrActiveBuf: PChar; { current active buffer of the table}
begin
Result := False;
if Assigned(pRecordBuf) then
begin
try
with ATable do
begin
Check(DbiGetCursorProps( Handle, curProp));
Edit;
CurrActiveBuf := ActiveBuffer;
Move( pRecordBuf^, CurrActiveBuf^, curProp.iRecBufSize );
Post;
Refresh;
Result := True; {any exception will not allow this line to run}
end;
finally
{ even if an error occurs, release memory }
if Assigned(pRecordBuf) then
FreeMem( pRecordBuf, curProp.iRecBufSize);
end;
end;
end;
procedure TForm1.DBGrid1Enter(Sender: TObject);
begin
DBNavigator1.DataSource := DataSource1;
end;
procedure TForm1.DBGrid2Enter(Sender: TObject);
begin
DBNavigator1.DataSource := DataSource2;
end;
end.