17

.
.
:


.

. .
:
X : .
X .
X TrakBar ProgressBar .
X .
X .
X .
X .

DataSource DataSource .
DataSource Data link
TDataLink .
.

DataSource.DataField
DataSource DataLink .
)
( .
.


) .(One-to-many
)
( .

TDataLink
.DB
. " " .
.
:
TDataLink

)TDataLink = class(TPersistent
protected
;procedure ActiveChanged; virtual
;procedure CheckBrowseMode; virtual
;procedure DataSetChanged; virtual
;procedure DataSetScrolled(Distance: Integer); virtual
;procedure FocusControl(Field: TFieldRef); virtual
;procedure EditingChanged; virtual
;procedure LayoutChanged; virtual
;procedure RecordChanged(Field: TField); virtual
;procedure UpdateData; virtual

DataEvent
) .(TDataEvent
.
DataEvent .
NotifyDataLinks
OnDataChange OnUpdateData .

 .17

TDataLink .

. TFieldDataLink
TDataLink
.
TFieldDataLink .

TDataLink . TFieldDataLink
.
.
:
;procedure TFieldDataLink.ActiveChanged
begin
;UpdateField
;)if Assigned(FOnActiveChange) then FOnActiveChange(Self
;end

TFieldDataLink Field FieldName

.
.Control

.
ProgressBar .TrackBar ) (
. .
: MdDataPack
.
.

ProgressBar
ProgressBar
.
:
type
TMdDbProgress = class(TProgressBar)
private
FDataLink: TFieldDataLink;
function GetDataField: string;
procedure SetDataField (Value: string);
function GetDataSource: TDataSource;
procedure SetDataSource (Value: TDataSource);
function GetField: TField;
protected
// data link event handler
procedure DataChange (Sender: TObject);
// useless
{procedure Notification (AComponent: TComponent;
Operation: TOperation); override;}
public
constructor Create (AOwner: TComponent); override;
destructor Destroy; override;
property Field: TField read GetField;
published
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write
SetDataSource;
end;

DataField DataSource
.
:
function TMdDbProgress.GetDataField: string;
begin
Result := FDataLink.FieldName;
end;
procedure TMdDbProgress.SetDataField (Value: string);
begin
FDataLink.FieldName := Value;
end;
function TMdDbProgress.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;
procedure TMdDbProgress.SetDataSource (Value: TDataSource);
begin

.17

;FDataLink.DataSource := Value
;end
;function TMdDbProgress.GetField: TField
begin
;Result := FDataLink.Field
;end

:
;)constructor TMdDbProgress.Create (AOwner: TComponent
begin
;)inherited Create (AOwner
;FDataLink := TFieldDataLink.Create
;FDataLink.Control := self
;FDataLink.OnDataChange := DataChange
;end
;destructor TMdDbProgress.Destroy
begin
;FDataLink.Free
;FDataLink := nil
;inherited Destroy
;end

.
.
:
;)procedure TMdDbProgress.DataChange (Sender: TObject
begin
if FDataLink.Field is TNumericField then
Position := FDataLink.Field.AsInteger
else
;Position := Min
;end

VCL
.
SetDataField .

17-1 DbProgr
.
.
MdProgr .
.
DBCtrlGrid .

:17-1

ProgressBar .DbProgr

: Notification
.
.
Notification VCL
.

DBCtrlGrid .
MdRepPr MdDataPack
RepProgr HTML .
DBCtrlGrid : .
) (buffer
.
DBCtlGrid csReplicatable
.
cm_GeTDataLink .
Paint ) (Canvas
wm_Paint csPaintCopy ControlState .True
DBCtrlGrid
.
:

 .17

TrackBar

.

.
FieldDataLink .
TrackBar
. .
) MdTrack :(MdDataPack
type
)TMdDbTrack = class(TTrackBar
private
;FDataLink: TFieldDataLink
;function GetDataField: string
;)procedure SetDataField (Value: string
;function GetDataSource: TDataSource
;)procedure SetDataSource (Value: TDataSource
;function GetField: TField
;procedure CNHScroll(var Message: TWMHScroll); message CN_HSCROLL
;procedure CNVScroll(var Message: TWMVScroll); message CN_VSCROLL
;procedure CMExit(var Message: TCMExit); message CM_EXIT
protected
// data link event handlers

procedure DataChange (Sender: TObject);

procedure UpdateData (Sender: TObject);
procedure ActiveChange (Sender: TObject);
public
constructor Create (AOwner: TComponent); override;
destructor Destroy; override;
property Field: TField read GetField;
published
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write
SetDataSource;
end;

: .
constructor TMdDbTrack.Create (AOwner: TComponent);
begin
inherited Create (AOwner);
FDataLink := TFieldDataLink.Create;
FDataLink.Control := self;
FDataLink.OnDataChange := DataChange;
FDataLink.OnUpdateData := UpdateData;
FDataLink.OnActiveChange := ActiveChange;
Enabled := False;
end;

TMdDbProgress DataChange

:
procedure TMdDbTrack.SetDataSource (Value: TDataSource);
begin
FDataLink.DataSource := Value;
Enabled := FDataLink.Active and (FDataLink.Field <> nil) and
not FDataLink.Field.ReadOnly;
end;

. :
.

: try/Finally
procedure TMdDbTrack.SetDataField (Value: string);
begin
try
FDataLink.FieldName := Value;
finally

 .17

Enabled := FDataLink.Active and (FDataLink.Field <> nil) and

;not FDataLink.Field.ReadOnly
;end
;end

:
;)procedure TMdDbTrack.ActiveChange (Sender: TObject
begin
Enabled := FDataLink.Active and (FDataLink.Field <> nil) and
;not FDataLink.Field.ReadOnly
;end

.

) ( . :
;)procedure TMdDbTrack.CNHScroll(var Message: TWMHScroll
begin
// edit mode
;FDataLink.Edit
// update data
;inherited
// let the system know
;FDataLink.Modified
;end
;)procedure TMdDbTrack.CNVScroll(var Message: TWMVScroll
begin
// edit mode
;FDataLink.Edit
// update data
;inherited
// let the system know
;FDataLink.Modified
;end

(
) Post
OnUpdateData :TFieldDataLink
;)procedure TMdDbTrack.UpdateData (Sender: TObject
begin
if FDataLink.Field is TNumericField then
;FDataLink.Field.AsInteger := Position
;end

.
) (

. .

CMExit VCL :
;)procedure TMdDbTrack.CMExit(var Message: TCMExit
begin
try
;FDataLink.UpdateRecord
except
;SetFocus
;raise
;end
;inherited
;end

DBTrack . 17-2 .

TrackBar .
.TrackBar

:17-2

) (TrackBar DbTrack
. .

- -
TFieldDataLink .
" : " .record viewer

.17

.
.

. DBGrid DBCtrlGrid
.
:
.
.

implementation .
VCL . :
type
)TMdRecordLink = class (TDataLink
private
;RView: TMdRecordView
public
;)constructor Create (View: TMdRecordView
;procedure ActiveChanged; override
;procedure RecordChanged(Field: TField); override
;end

)
activation ) ( .
.TFieldDataLink
:
;)constructor TMdRecordLink.Create (View: TMdRecordView
begin
;inherited Create
;RView := View
;end

:
;procedure TMdRecordLink.ActiveChanged
var
;I: Integer
begin
// set number of rows

if Assigned (DataSet) then

begin
RView.RowCount := DataSet.FieldCount;
// double the height of memo and graphics
for I := 0 to DataSet.FieldCount - 1 do
if DataSet.Fields [I] is TBlobField then
RView.RowHeights [I] := RView.DefaultRowHeight * 2;
// repaint all...
RView.Invalidate;
end;
end;
procedure TMdRecordLink.RecordChanged;
begin
inherited;
// repaint all...
RView.Invalidate;
end;

. .
TCustomGrid
.

( protected)
:( ) .
type
TMdRecordView = class(TCustomGrid)
private
// data-aware support
FDataLink: TDataLink;
function GetDataSource: TDataSource;
procedure SetDataSource (Value: TDataSource);
protected
// redefined TCustomGrid methods
procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
AState: TGridDrawState); override;
procedure ColWidthsChanged; override;
procedure RowHeightsChanged; override;
public
constructor Create (AOwner: TComponent); override;
destructor Destroy; override;
procedure SetBounds (ALeft, ATop, AWidth, AHeight: Integer);
override;
// public parent properties (omitted...)
published
// data-aware properties
property DataSource: TDataSource read GetDataSource write
SetDataSource;
// published parent properties (omitted...)
end;

DataSource

.17

. DataField .
:
;)constructor TMdRecordView.Create (AOwner: TComponent
begin
;)FDataLink := TMdRecordLink.Create (self
;)inherited Create (AOwner
// set numbers of cells and fixed cells
RowCount := 2; // default
;ColCount := 2
;FixedCols := 1
;FixedRows := 0
{grid options -- choose among:
goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,
goRangeSelect, goDrawFocusSelected, goRowSizing, goColSizing,
goRowMoving, goColMoving, goEditing, goTabs, goRowSelect,
}goAlwaysShowEditor, goThumbTracking
Options := [goFixedVertLine, goFixedHorzLine,
;]goVertLine, goHorzLine, goRowSizing, goColSizing
;DefaultDrawing := False
;ScrollBars := ssVertical
;FSaveCellExtents := False
;end

) (
.
.
: .DBGrid
. .

. )

( .
) ( :
procedure TMdRecordView.SetBounds (ALeft, ATop,
;)AWidth, AHeight: Integer
begin
;inherited
;]ColWidths [1] := ClientWidth - ColWidths[0
;end

.
- DefaultColWidth - .
DrawCell .

. . 17-1
)][( .
.
. DBGrid DisplayName
DisplayText
.(memo AsString )
RECORDVIEW DRAWCELL

procedure TMdRecordView.DrawCell(ACol, ARow: Longint;

ARect: TRect; AState: TGridDrawState);
var
Text: string;
CurrField: TField;
Bmp: TBitmap;
begin
CurrField := nil;
Text := '[]'; // default
// paint background
if (ACol = 0) then
Canvas.Brush.Color := FixedColor
else
Canvas.Brush.Color := Color;
Canvas.FillRect (ARect);
// leave small border
InflateRect (ARect, -2, -2);
if (FDataLink.DataSource <> nil) and
FDataLink.Active then
begin
CurrField := FDataLink.DataSet.Fields[ARow];
if ACol = 0 then
Text := CurrField.DisplayName
else if CurrField is TMemoField then
Text := TMemoField (CurrField).AsString
else
Text := CurrField.DisplayText;
end;
if (ACol = 1) and (CurrField is TGraphicField) then
begin
Bmp := TBitmap.Create;
try
Bmp.Assign (CurrField);
Canvas.StretchDraw (ARect, Bmp);
finally
Bmp.Free;
end;
end
else if (ACol = 1) and (CurrField is TMemoField) then

:17-1

 .17

begin
DrawText (Canvas.Handle,
PChar (Text), Length (Text),
)ARect, dt_WordBreak or dt_NoPrefix
end
else // draw single line vertically centered
DrawText (Canvas.Handle,
PChar (Text), Length (Text), ARect,
;)dt_vcenter or dt_SingleLine or dt_NoPrefix
if gdFocused in AState then
;)Canvas.DrawFocusRect (ARect
;end

memo .
TMemoField DrawText dt_SingleLine
dt_WorldBreak .

.
DefaultDrawing False
.DrawCell InflatRect
) (API . API
Windows DrawText .
) (17-3 .


.
. ) (TCustomGrid
.BLOB
BLOB .
.
ActiveChanged RowHeightsChanged
DefaultRowHeight :
;procedure TMdRecordLink.ActiveChanged
var
;I: Integer
begin
// set number of rows

if Assigned (DataSet) then

begin
;RView.RowCount := DataSet.FieldCount
// double the height of memo and graphics
for I := 0 to DataSet.FieldCount - 1 do
if DataSet.Fields [I] is TBlobField then
;RView.RowHeights [I] := RView.DefaultRowHeight * 2
// repaint all...
;RView.Invalidate
;end
;end

:17-3

ViewGrid RecordView BioLife

.Borland

. TCustomGrid
DefineProperties RowHeights .ColHeights
) inherited (
FSaveCellExtents ) (.
DBGrid
DBGrid
. DBGrid
RecordView memo .


. 17-4 .

 .17

:17-4

MDbGrid .memo

.
.
: DBGrid

.
DBGrid
.
.

.
:
type
)TMdDbGrid = class(TDbGrid
private
;FLinesPerRow: Integer
;)procedure SetLinesPerRow (Value: Integer
protected
;procedure DrawColumnCell(const Rect: TRect; DataCol: Integer
;Column: TColumn; State: TGridDrawState); override
;procedure LayoutChanged; override
public

constructor Create (AOwner: TComponent); override;

published
property LinesPerRow: Integer
read FLinesPerRow write SetLinesPerRow default 1;
end;

: .FLinesPerRow
procedure TMdDbGrid.SetLinesPerRow(Value: Integer);
begin
if (Value <> FLinesPerRow) and (Value > 0) then
begin
FLinesPerRow := Value;
LayoutChanged;
end;
end;

LayoutChanged
.
.
. TCustomDBGrid

( ) Wg)
: .(
procedure TMdDbGrid.LayOutChanged;
var
PixelsPerRow, PixelsTitle, I: Integer;
begin
inherited LayOutChanged;
Canvas.Font := Font;
PixelsPerRow := Canvas.TextHeight('Wg') + 3;
if dgRowLines in Options then
Inc (PixelsPerRow, GridLineWidth);
Canvas.Font := TitleFont;
PixelsTitle := Canvas.TextHeight('Wg') + 4;
if dgRowLines in Options then
Inc (PixelsTitle, GridLineWidth);
// set number of rows
RowCount := 1 + (Height - PixelsTitle) div
(PixelsPerRow * FLinesPerRow);
// set the height of each row
DefaultRowHeight := PixelsPerRow * FLinesPerRow;
RowHeights [0] := PixelsTitle;
for I := 1 to RowCount - 1 do
RowHeights [I] := PixelsPerRow * FLinesPerRow;

.17

// send a WM_SIZE message to let the base component recompute

// the visible rows in the private UpdateRowCount method
PostMessage (Handle, WM_SIZE, 0, MakeLong(Width, Height));
end;
TitleFont Font :
. . DBGrid

.
DefaultRowHeight
DefaultRowHeight
VisibleRowCount )
( ) .(
.
:
RecordView
procedure TMdDbGrid.DrawColumnCell(const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
var
Bmp: TBitmap;
OutRect: TRect;
begin
if FLinesPerRow = 1 then
inherited DrawColumnCell(Rect, DataCol, Column, State)
else
begin
// clear area
Canvas.FillRect (Rect);
// copy the rectangle
OutRect := Rect;
// restrict output
InflateRect (OutRect, -2, -2);
// output field data
if Column.Field is TGraphicField then
begin
Bmp := TBitmap.Create;
try
Bmp.Assign (Column.Field);
Canvas.StretchDraw (OutRect, Bmp);
finally
Bmp.Free;
end;
end
else if Column.Field is TMemoField then
begin
DrawText (Canvas.Handle,
PChar (Column.Field.AsString),

Length (Column.Field.AsString),
)OutRect, dt_WordBreak or dt_NoPrefix
end
else // draw single line vertically centered
DrawText (Canvas.Handle,
PChar (Column.Field.DisplayText),
Length (Column.Field.DisplayText),
;)OutRect, dt_vcenter or dt_SingleLine or dt_NoPrefix
;end
;end

memo . .
.GridDemo
.
.

TDataSet .
.

.
.
)
( . Borland
.
.
TDataSet )) (abstarct 23
5 ( . )
( . TDataSet .
) TDataSet
(record buffering .
) (buffers .
.

.17

) (buffers
.
.
.

. TDataSet
.
VCL .TDataSet
.

.TMdCustomDataSet
.
.

:
. 17-2
. ) (Virtual methods
) (Protected Fields
. record :
) .(buffers
:
:17-2

TMdCustomDataSet.TMdDataSetStream

// in unit MdDsCustom
type
;)EMdDataSetError = class (Exception
TMdRecInfo = record
;Bookmark: Longint
;BookmarkFlag: TBookmarkFlag
;end
;PMdRecInfo = ^TMdRecInfo
)TMdCustomDataSet = class(TDataSet

protected
// status
FIsTableOpen: Boolean;
// record data
FRecordSize, // the size of the actual data
FRecordBufferSize, // data + housekeeping (TRecInfo)
FCurrentRecord, // current record (0 to FRecordCount - 1)
BofCrack, // before the first record (crack)
EofCrack: Integer; // after the last record (crack)
// create, close, and so on
procedure InternalOpen; override;
procedure InternalClose; override;
function IsCursorOpen: Boolean; override;
// custom functions
function InternalRecordCount: Integer; virtual; abstract;
procedure InternalPreOpen; virtual;
procedure InternalAfterOpen; virtual;
procedure InternalLoadCurrentRecord(Buffer: PChar);
virtual; abstract;
// memory management
function AllocRecordBuffer: PChar; override;
procedure InternalInitRecord(Buffer: PChar); override;
procedure FreeRecordBuffer(var Buffer: PChar); override;
function GetRecordSize: Word; override;
// movement and optional navigation (used by grids)
function GetRecord(Buffer: PChar; GetMode: TGetMode;
DoCheck: Boolean): TGetResult; override;
procedure InternalFirst; override;
procedure InternalLast; override;
function GetRecNo: Longint; override;
function GetRecordCount: Longint; override;
procedure SetRecNo(Value: Integer); override;
// bookmarks
procedure InternalGotoBookmark(Bookmark: Pointer); override;
procedure InternalSetToRecord(Buffer: PChar); override;
procedure SetBookmarkData(Buffer: PChar; Data: Pointer);
override;
procedure GetBookmarkData(Buffer: PChar; Data: Pointer);
override;
procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
override;
function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
override;
// editing (dummy vesions)
procedure InternalDelete; override;
procedure InternalAddRecord(Buffer: Pointer; Append: Boolean);
override;

.17

procedure InternalPost; override;

procedure InternalInsert; override;
// other
procedure InternalHandleException; override;
published
// redeclared data set properties
property Active;
property BeforeOpen;
property AfterOpen;
property BeforeClose;
property AfterClose;
property BeforeInsert;
property AfterInsert;
property BeforeEdit;
property AfterEdit;
property BeforePost;
property AfterPost;
property BeforeCancel;
property AfterCancel;
property BeforeDelete;
property AfterDelete;
property BeforeScroll;
property AfterScroll;
property OnCalcFields;
property OnDeleteError;
property OnEditError;
property OnFilterRecord;
property OnNewRecord;
property OnPostError;
end;
// in unit MdDsStream
type
TMdDataFileHeader = record
VersionNumber: Integer;
RecordSize: Integer;
RecordCount: Integer;
end;
TMdDataSetStream = class(TMdCustomDataSet)
private
procedure SetTableName(const Value: string);
protected
FDataFileHeader: TMdDataFileHeader;
FDataFileHeaderSize, // file header size
FRecordCount: Integer; // current number of records
FStream: TStream; // the physical table
FTableName: string; // table path and file name
FFieldOffset: TList; // field offsets in the buffer
Protected
// open and close
procedure InternalPreOpen; override;
procedure InternalAfterOpen; override;

procedure InternalClose; override;

procedure InternalInitFieldDefs; override;
// edit support
procedure InternalAddRecord(Buffer: Pointer; Append: Boolean);
override;
procedure InternalPost; override;
// fields
procedure SetFieldData(Field: TField; Buffer: Pointer);
override;
// custom dataset virutal methods
function InternalRecordCount: Integer; override;
procedure InternalLoadCurrentRecord(Buffer: PChar); override;
public
procedure CreateTable;
function GetFieldData(Field: TField; Buffer: Pointer): Boolean;
override;
published
property TableName: string read FTableName write SetTableName;
end;

) (
.
.

:I

.

. TFields
FieldsDef
:InternalOpen .TField
procedure TMdCustomDataSet.InternalOpen;
begin
InternalPreOpen; // custom method for subclasses
// initialize the field definitions
// (another virtual abstract method of TDataSet)
InternalInitFieldDefs;
// if there are no persistent field objects,
// create the fields dynamically
if DefaultFields then
CreateFields;
// connect the TField objects with the actual fields

.17

BindFields (True);
InternalAfterOpen; // custom method for subclasses
// sets cracks and record position and size
BofCrack := -1;
EofCrack := InternalRecordCount;
FCurrentRecord := BofCrack;
FRecordBufferSize := FRecordSize + sizeof (TMdRecInfo);
BookmarkSize := sizeOf (Integer);
// everything OK: table is now open
FIsTableOpen := True;
end;

BookmarkSize
InternalAfterOpen InternalPreOpen .TDataSet
InternalPreOpen .

.
.
.
:
const
HeaderVersion = 10;
// I: open the table/file
procedure TMdDataSetStream.InternalPreOpen;
begin
// the size of the header
FDataFileHeaderSize := sizeOf (TMdDataFileHeader);
// check if the file exists
if not FileExists (FTableName) then
raise EMdDataSetError.Create ('Open: Table file not found');
// create a stream for the file
FStream := TFileStream.Create (FTableName, fmOpenReadWrite);
// initialize local data (loading the header)
FStream.ReadBuffer (FDataFileHeader, FDataFileHeaderSize);
if FDataFileHeader.VersionNumber <> HeaderVersion then
raise EMdDataSetError.Create ('Illegal File Version');
// let's read this, double check later
FRecordCount := FDataFileHeader.RecordCount;
end;
procedure TMdDataSetStream.InternalAfterOpen;
begin

// check the record size

if FDataFileHeader.RecordSize <> FRecordSize then
;)'raise EMdDataSetError.Create ('File record size mismatch
// check the number of records against the file size
>< )if (FDataFileHeaderSize + FRecordCount * FRecordSize
FStream.Size then
;)'raise EMdDataSetError.Create ('InternalOpen: Invalid Record Size
;end

InternalAfterOpen

.InternalInitFieldDefs
. .
.
InternalOpen InternalInitFieldDefs
) ( .
) INI ( .
.String 17-3
Contrib .INI .
:17-3

Contrib.INI .

][Fields
Number=6
][Field1
Type=ftString
Name=Name
Size=30
][Field2
Type = ftInteger
Name = Level
][Field3
Type = ftDate
Name = BirthDate
][Field4
Type = ftCurrency
Name = Stipend
][Field5
Type = ftString
Name = Email
Size = 50

.17

[Field6]
Type = ftBoolean
Name = Editor

) (
(17-4 ) InternalInitFieldDefs .
.
TList . TList
. ( buffer)
. InternalInitFieldDefs

procedure TMdDataSetStream.InternalInitFieldDefs;
var
IniFileName, FieldName: string;
IniFile: TIniFile;
nFields, I, TmpFieldOffset, nSize: Integer;
FieldType: TFieldType;
begin
FFieldOffset := TList.Create;
FieldDefs.Clear;
TmpFieldOffset := 0;
IniFilename := ChangeFileExt(FTableName, '.ini');
Inifile := TIniFile.Create (IniFilename);
// protect ini file
try
nFields := IniFile.ReadInteger ('Fields', 'Number', 0);
if nFields = 0 then
raise EMdDataSetError.Create ('InitFieldsDefs: 0 fields?');
for I := 1 to nFields do
begin
// create the field
FieldType := TFieldType (GetEnumValue (
TypeInfo (TFieldType),
IniFile.ReadString (
'Field' + IntToStr (I), 'Type', '')));
FieldName := IniFile.ReadString (
'Field' + IntToStr (I), 'Name', '');
if FieldName = '' then
raise EMdDataSetError.Create (
'InitFieldsDefs: No name for field ' +
IntToStr (I));
nSize := IniFile.ReadInteger (
'Field' + IntToStr (I), 'Size', 0);
FieldDefs.Add (FieldName,
FieldType, nSize, False);
// save offset and compute size
FFieldOffset.Add (Pointer (TmpFieldOffset));

:17-4

case FieldType of
ftString:
Inc (TmpFieldOffset, nSize + 1);
ftBoolean, ftSmallInt, ftWord:
Inc (TmpFieldOffset, 2);
ftInteger, ftDate, ftTime:
Inc (TmpFieldOffset, 4);
ftFloat, ftCurrency, ftDateTime:
Inc (TmpFieldOffset, 8);
else
raise EMdDataSetError.Create (
'InitFieldsDefs: Unsupported field type');
end;
end; // for
finally
IniFile.Free;
end;
FRecordSize := TmpFieldOffset;
end;

.( )

:

Procedure TMCustomDataSet.InternalClose;
begin
// disconnect field objects
BindFields (False);
// destroy field object (if not persistent)
if DefaultFields then
DestroyFiels;
// close the file
FIsTableOpen := False;
end;

procedure TMdDataSetStream.InternalClose;
begin
// if required, save updated header
if (FDataFileHeader.RecordCount <> FRecordCount) or
(FDataFileHeader.RecordSize = 0) then
begin
FDataFileHeader.RecordSize := FRecordSize;
FDataFileHeader.RecordCount := FRecordCount;
if Assigned (FStream) then
begin
FStream.Seek (0, soFromBeginning);
FStream.WriteBuffer (
FDataFileHeader, FDataFileHeaderSize);
end;
end;
// free the internal list field offsets and the stream

 .17

;FFieldOffset.Free
;FStream.Free
;inherited InternalClose
;end

;function TMdCustomDataSet.IsCursorOpen: Boolean

begin
;Result := FIsTableOpen
;end

.
. CreateTable
: )
( ) (:
;procedure TMdDataSetStream.CreateTable
begin
;CheckInactive
;InternalInitFieldDefs
// create the new file
if FileExists (FTableName) then
raise EMdDataSetError.Create ('File ' + FTableName +
;)'' already exists
FStream := TFileStream.Create (FTableName,
;)fmCreate or fmShareExclusive
try
// save the header
;FDataFileHeader.VersionNumber := HeaderVersion
FDataFileHeader.RecordSize := 0; // used later
FDataFileHeader.RecordCount := 0; // empty
( FStream.WriteBuffer
;)FDataFileHeader, FDataFileHeaderSize
finally
// close the file
;FStream.Free
;end
;end

:II

.
. .
) .(Pointers
.

.
TMdRecInfo .
) (buffer :
type
;)TBookmarkFlag = (bfCurrent, bfBOF, bfEOF, bfInserted

.
17-5 .

:17-5

) (buffer
.

PMdRecInfo TMdRecInfo
. :
( procedure TMdCustomDataSet.SetBookmarkData
;)Buffer: PChar; Data: Pointer
begin
=PMdRecInfo(Buffer + FRecordSize).Bookmark :
;)^Integer(Data
;end
;function TMdCustomDataSet.GetRecordCount: Longint
begin
;CheckActive
;Result := InternalRecordCount
;end

.Data
:integer

.17

procedure TMdCustomDataSet.GetBookmarkData (
Buffer: PChar; Data: Pointer);
begin
Integer(Data^) :=
PMdRecInfo(Buffer + FRecordSize).Bookmark;
end;
procedure TMdCustomDataSet.SetBookmarkData (
Buffer: PChar; Data: Pointer);
begin
PMdRecInfo(Buffer + FRecordSize).Bookmark :=
Integer(Data^);
end;

InternalGotoBookmark
- .
GetRecord ) -
) (
.( InternalLast InternalFirst
InternalGotoBookmark
InternalSetToRecord .( derference)

.InternalGotoBookmark InternalSetToRecord
:
procedure TMdCustomDataSet.InternalGotoBookmark (Bookmark: Pointer);
var
ReqBookmark: Integer;
begin
ReqBookmark := Integer (Bookmark^);
if (ReqBookmark >= BofCrack) and (ReqBookmark <=
InternalRecordCount) then
FCurrentRecord := ReqBookmark
else
raise EMdDataSetError.Create ('Bookmark ' +
IntToStr (ReqBookmark) + ' not found');
end;
procedure TMdCustomDataSet.InternalSetToRecord (Buffer: PChar);
var
ReqBookmark: Integer;
begin
ReqBookmark := PMdRecInfo(Buffer + FRecordSize).Bookmark;
InternalGotoBookmark (@ReqBookmark);
end;

.

. : Borland ) .(Cracks
BofCrack ) -1 (InternalOpen
. EofCrack
.FRecordCount-1 EofCrack BofCrack
:
;procedure TMdCustomDataSet.InternalFirst
begin
;FCurrentRecord := BofCrack
;end
// II: Go to a special position after the last record
;procedure TMdCustomDataSet.InternalLast
begin
;EofCrack := InternalRecordCount
;FCurrentRecord := EofCrack
;end

InternalRecordCount ) (Virtual TMdCustomDataSet

)
stream (FRecordCount .
)
DBGrid (
FCurrentField 0
. 1 :
;function TMdCustomDataSet.GetRecordCount: Longint
begin
;CheckActive
;Result := InternalRecordCount
;end
;function TMdCustomDataSet.GetRecNo: Longint
begin
;UpdateCursorPos
if FCurrentRecord < 0 then
Result := 1
else
;Result := FCurrentRecord + 1
;end
;)procedure TMdCustomDataSet.SetRecNo(Value: Integer
begin

 .17

;CheckBrowseMode
if (Value >= 1) and (Value <= InternalRecordCount) then
begin
;FCurrentRecord := Value - 1
;)][(Resync
;end
;end

.
stream .

:III
.
- ) stream( TField
.
.
;function TMdCustomDataSet.AllocRecordBuffer: PChar
begin
;)GetMem (Result, FRecordBufferSize
;end
;)procedure TMdCustomDataSet.FreeRecordBuffer (var Buffer: PChar
begin
;)FreeMem (Buffer
;end

.

AllocRecordBuffer
. :InternalOpen
;)FRecordBufferSize := FRecordSize + sizeof (TMdRecInfo

) (buffer
) (InternalInitRecord .
.
) RecordSize (
.VCL GetRecordSize FRecordSize
.

:GetRecord : InternalPost :InternalAddRecord

:InternalDelete
.
GetRecord .
) (buffer
. GetMode:
type
;)TGetMode = (gmCurrent, gmNext, gmPrior

.
) ( .

. :
type
;)TGetResult = (grOK, grBOF, grEOF, grError

.

.
CurrentRecord >= InternalRecordCount gmCurrent
.Case .
.
DBGrid
GetRecord GetRecord .grEOF
GetRecord:
// III: Retrieve data for current, previous, or next record
// (eventually moving to it) and return the status
;function TMdCustomDataSet.GetRecord(Buffer: PChar
;GetMode: TGetMode; DoCheck: Boolean): TGetResult
begin
Result := grOK; // default
case GetMode of
gmNext: // move on
if FCurrentRecord < InternalRecordCount - 1 then
)Inc (FCurrentRecord
else
Result := grEOF; // end of file
gmPrior: // move back
if FCurrentRecord > 0 then
)Dec (FCurrentRecord
else
Result := grBOF; // begin of file
gmCurrent: // check if empty
if (FCurrentRecord >= InternalRecordCount) or

.17

(FCurrentRecord < 0) then

Result := grError;
end;
// load the data
if Result = grOK then
InternalLoadCurrentRecord (Buffer)
else
if (Result = grError) and DoCheck then
raise EMdDataSetError.Create ('GetRecord: Invalid record');
end;

. GetRecord True DoCheck

.( )
( )

: GetRecord
procedure TMdDataSetStream.InternalLoadCurrentRecord (Buffer: PChar);
begin
FStream.Position := FDataFileHeaderSize +
FRecordSize * FCurrentRecord;
FStream.ReadBuffer (Buffer^, FRecordSize);
with PMdRecInfo(Buffer + FRecordSize)^ do
begin
BookmarkFlag := bfCurrent;
Bookmark := FCurrentRecord;
end;
end;

AddRecord InternalAddRecord
.AppendRecord InsertRecord

. (Public)

. AppendRecord InsertRecord
:InternalPost
procedure TMdDataSetOne.InternalAddRecord(Buffer: Pointer;
Append: Boolean);
begin
// always append at the end
InternalLast;
FStream.Seek (0, soFromEnd);
FStream.WriteBuffer (ActiveBuffer^, FRecordSize);
Inc (FRecordCount);
end;

.
.
.

:IV
.

) .(buffer GetData :
SetData
.
.

FFieldOffset .TList
FieldDataSize .
Field .Buffer

Buffer
.
GetData SetData
) .(infinite recursion - - ActiveBuffer

. Buffer .
.
function TMdDataSetOne.GetFieldData (Field: TField; Buffer:
;Pointer): Boolean
var
;FieldOffset: Integer
;Ptr: PChar
begin
;Result := False
if not IsEmpty and (Field.FieldNo > 0) then
begin
;)]FieldOffset := Integer (FFieldOffset [Field.FieldNo - 1
;Ptr := ActiveBuffer
;)Inc (Ptr, FieldOffset
if Assigned (Buffer) then

 .17

;)Move (Ptr^, Buffer^, Field.DataSize

;Result := True
if (Field is TDateTimeField) and (Integer(Ptr^) = 0) then
;Result := False
;end
;end
;)procedure TMdDataSetOne.SetFieldData(Field: TField; Buffer: Pointer
var
;FieldOffset: Integer
;Ptr: PChar
begin
if Field.FieldNo >= 0 then
begin
( FieldOffset := Integer
;)]FFieldOffset [Field.FieldNo - 1
;Ptr := ActiveBuffer
;)Inc (Ptr, FieldOffset
if Assigned (Buffer) then
)Move (Buffer^, Ptr^, Field.DataSize
else
( raise Exception.Create
;)''Very bad error in TMdDataSetStream.SetField data
;))DataEvent (deFieldChange, Longint(Field
;end
;end

GetField True False

) .(null
. : ptr^<>#0
.
) null (
. .False
) (
.
/ .
) TDataTime
( .

: IsNull
GetFieldData ) (buffer
. ) if Assigned(Buffer .

InternalHandleException

.
StreamDSDemo .17-6
DBGrid .
17-6
. INI )
( .

:17-6

StreamDSDemo
.

Fields Editor
. .

.
TableName
:
. TableName

.17

.
:Create New Table
;)procedure TForm1.Button1Click(Sender: TObject
begin
;MdDataSetStream1.CreateTable
;MdDataSetStream1.Open
;CheckBox1.Checked := MdDataSetStream1.Active
;end

CreateTable .
) TTable .(CreateTable
:
;)procedure TForm1.CheckBox1Click(Sender: TObject
begin
;MdDataSetStream1.Active := CheckBox1.Checked
;end

) (set
. SQL

XML.
.
) (TObjectList
.
.
:
dbn.borland.com/articale/0,1410,20587,00.html

TMdLisTDataSet

.
) (Buffer
. :
type
)TMdListDataSet = class (TMdCustomDataSet
protected
// the list holding the data
;FList: TObjectList
// dataset virtual methods
;procedure InternalPreOpen; override
;procedure InternalClose; override
// custom dataset virtual methods
;function InternalRecordCount: Integer; override
;procedure InternalLoadCurrentRecord (Buffer: PChar); override
;end

TDataSet
) ( .

):(Buffer
;procedure TMdListDataSet.InternalPreOpen
begin
FList := TObjectList.Create (True); // owns objects
FRecordSize := 4; // an integer, the list item id
;end

.
:
.ClientDataSet
.

) ( :
;function TMdListDataSet.InternalRecordCount: Integer
begin
;Result := fList.Count
;end

. )
(:

.17

procedure TMdListDataSet.InternalLoadCurrentRecord (Buffer: PChar);

begin
PInteger (Buffer)^ := fCurrentRecord;
with PMdRecInfo(Buffer + FRecordSize)^ do
begin
BookmarkFlag := bfCurrent;
Bookmark := fCurrentRecord;
end;
end;

.
:((C:\docs\*.txt ) )
type
TMdDirDataset = class(TMdListDataSet)
private
FDirectory: string;
procedure SetDirectory(const NewDirectory: string);
protected
// TDataSet virtual methods
procedure InternalInitFieldDefs; override;
procedure SetFieldData(Field: TField; Buffer: Pointer); override;
function GetCanModify: Boolean; override;
// custom dataset virtual methods
procedure InternalAfterOpen; override;
public
function GetFieldData(Field: TField; Buffer: Pointer):
Boolean; override;
published
property Directory: string read FDirectory write SetDirectory;
end;

TDataSet GetCanModify
.False .
.(abstract virtual) SetFieldData
.
:TFieldData TSearchRec
type
TFileData = class
public
ShortFileName: string;
Time: TDateTime;
Size: Integer;
Attr: Integer;
constructor Create (var FileInfo: TSearchRec);

end;
constructor TFileData.Create(var FileInfo: TSearchRec);
begin
ShortFileName := FileInfo.Name;
Time := FileDateToDateTime (FileInfo.Time);
Size := FileInfo.Size;
Attr := FileInfo.Attr;
end;

:
procedure TMdDirDataset.InternalAfterOpen;
var
Attr: Integer;
FileInfo: TSearchRec;
FileData: TFileData;
begin
// scan all files
Attr := faAnyFile;
FList.Clear;
if SysUtils.FindFirst(fDirectory, Attr, FileInfo) = 0 then
repeat
FileData := TFileData.Create (FileInfo);
FList.Add (FileData);
until SysUtils.FindNext(FileInfo) <> 0;
SysUtils.FindClose(FileInfo);
end;

:
procedure TMdDirDataset.InternalInitFieldDefs;
begin
if fDirectory = '' then
raise EMdDataSetError.Create ('Missing directory');
// field definitions
FieldDefs.Clear;
FieldDefs.Add ('FileName', ftString, 40, True);
FieldDefs.Add ('TimeStamp', ftDateTime);
FieldDefs.Add ('Size', ftInteger);
FieldDefs.Add ('Attributes', ftString, 3);
FieldDefs.Add ('Folder', ftBoolean);
end;

.GetFieldData ( ActiveBuffer )
StrCopy Move
( system S read-Only R hidden H)
: .

.17

function TMdDirDataset.GetFieldData (
Field: TField; Buffer: Pointer): Boolean;
var
FileData: TFileData;
Bool1: WordBool;
strAttr: string;
t: TDateTimeRec;
begin
FileData := fList [Integer(ActiveBuffer^)] as TFileData;
case Field.Index of
0: // filename
StrCopy (Buffer, pchar(FileData.ShortFileName));
1: // timestamp
begin
t := DateTimeToNative (ftdatetime, FileData.Time);
Move (t, Buffer^, sizeof (TDateTime));
end;
2: // size
Move (FileData.Size, Buffer^, sizeof (Integer));
3: begin // attributes
strAttr := '
';
if (FileData.Attr and SysUtils.faReadOnly) > 0 then
strAttr [1] := 'R';
if (FileData.Attr and SysUtils.faSysFile) > 0 then
strAttr [2] := 'S';
if (FileData.Attr and SysUtils.faHidden) > 0 then
strAttr [3] := 'H';
StrCopy (Buffer, pchar(strAttr));
end;
4: begin // folder
Bool1 := FileData.Attr and SysUtils.faDirectory > 0;
Move (Bool1, Buffer^, sizeof (WordBool));
end;
end; // case
Result := True;
end;

TDataTime ./
TTimeStamp
VCL .native date and time format
:/
function DateTimeToNative(DataType: TFieldType; Data: TDateTime):
TDateTimeRec;
var
TimeStamp: TTimeStamp;
begin
TimeStamp := DateTimeToTimeStamp(Data);
case DataType of
ftDate: Result.Date := TimeStamp.Date;

;ftTime: Result.Time := TimeStamp.Time

else
;)Result.DateTime := TimeStampToMSecs(TimeStamp
;end
;end

) ) (17-7 (
DBGrid )
.(ShellTreeView Root \.C:
OnChange ShellTreeView
:
;)procedure TForm1.ShellTreeView1Change(Sender: TObject; Node: TTreeNode
begin
;MdDirDataset1.Close
;'*MdDirDataset1.Directory := ShellTreeView1.Path + '\*.
;MdDirDataset1.Open
;end

:17-7

DirDemo .

: Windows Shell
DirDemoNoShell
.Windows 3.1

.
.TFieldData

RTTI .

.17

. TMdListDataSet
) ObjectClass :
:(17-5 TMdObjDataSet
:TMdObjDataSet

type
TMdObjDataSet = class(TMdListDataSet)
private
PropList: PPropList;
nProps: Integer;
FObjClass: TPersistentClass;
ObjClone: TPersistent;
FChangeToClone: Boolean;
procedure SetObjClass(const Value: TPersistentClass);
function GetObjects(I: Integer): TPersistent;
procedure SetChangeToClone(const Value: Boolean);
protected
procedure InternalInitFieldDefs; override;
procedure InternalClose; override;
procedure InternalInsert; override;
procedure InternalPost; override;
procedure InternalCancel; override;
procedure InternalEdit; override;
procedure SetFieldData(Field: TField; Buffer: Pointer); override;
function GetCanModify: Boolean; override;
procedure InternalPreOpen; override;
public
function GetFieldData(Field: TField; Buffer: Pointer):
Boolean; override;
property Objects [I: Integer]: TPersistent read GetObjects;
function Add: TPersistent;
published
property ObjClass: TPersistentClass read FObjClass write
SetObjClass;
property ChangesToClone: Boolean read FChangeToClone
write SetChangeToClone default False;
end;

InternalInitFieldDefs
:RTTI .( published)
procedure TMdObjDataSet.InternalInitFieldDefs;
var
i: Integer;
begin
if FObjClass = nil then
raise Exception.Create ('TMdObjDataSet: Unassigned class');

:17-5

// field definitions
FieldDefs.Clear;
nProps := GetTypeData(fObjClass.ClassInfo)^.PropCount;
GetMem(PropList, nProps * SizeOf(Pointer));
GetPropInfos (fObjClass.ClassInfo, PropList);
for i := 0 to nProps - 1 do
case PropList [i].PropType^.Kind of
tkInteger, tkEnumeration, tkSet:
FieldDefs.Add (PropList [i].Name, ftInteger, 0);
tkChar: FieldDefs.Add (PropList [i].Name, ftFixedChar, 0);
tkFloat: FieldDefs.Add (PropList [i].Name, ftFloat, 0);
tkString, tkLString:
FieldDefs.Add (PropList [i].Name, ftString, 50); // TODO:
fix size
tkWString: FieldDefs.Add (PropList [i].Name, ftWideString, 50);
// TODO: fix size
end;
end;

SetFieldData GetFieldData RTTI

.

.
OOP ) ( business rules)

.(
:( ) GetFieldData
function TMdObjDataSet.GetFieldData (
Field: TField; Buffer: Pointer): Boolean;
var
Obj: TPersistent;
TypeInfo: PTypeInfo;
IntValue: Integer;
FlValue: Double;
begin
if FList.Count = 0 then
begin
Result := False;
exit;
end;
Obj := fList [Integer(ActiveBuffer^)] as TPersistent;
TypeInfo := PropList [Field.FieldNo-1]^.PropType^;
case TypeInfo.Kind of
tkInteger, tkChar, tkWChar, tkClass, tkEnumeration, tkSet:
begin
IntValue := GetOrdProp(Obj, PropList [Field.FieldNo-1]);
Move (IntValue, Buffer^, sizeof (Integer));
end;

 .17

tkFloat:
begin
;)]FlValue := GetFloatProp(Obj, PropList [Field.FieldNo-1
;))Move (FlValue, Buffer^, sizeof (Double
;end
tkString, tkLString, tkWString:
StrCopy (Buffer, pchar(GetStrProp(Obj, PropList
;)))][Field.FieldNo-1
;end
;Result := True
;end

) (Pointer
. )
( TypeInfo .


) ( .
ChangesToClone
. DoClone RTTI
) (.
ChangesToClone

Post
.Cancel :
;Procedure TobjDataSet.InternalEdit
begin
)DoClone (fList[FCurrentRecord] as TdbPers, ObjClone
;end
Procedure
begin
if FchangeToClone and Assigend (ObjClone) then
;))]DoClone (ObjClone, TdbPers (fLIst [fCurrentRecord
;end
;procedure TMdObjDataSet.InternalCancel
begin
if not FChangeToClone and Assigned (ObjClone) then
;))]DoClone (ObjClone, TPersistent(fList [fCurrentRecord
;end

SetFieldData .
GetFieldData

)
(.
17-5 Objects
OOP Add Add ) .(Collection
Add :
;function TMdObjDataSet.Add: TPersistent
begin
if not Active then
;Open
;Result := fObjClass.Create
;)fList.Add (Result
;end

ObjDataSetDemo .
.17-8
.
DBGrid TDemo
.

:17-8

ObjDataSetDemo .RTTI

TDataSet .
- -
.

 .17

.
.7
Web
XML SOAP .