In Chapter 9, "Writing Delphi Components," we explored the development of Delphi components in depth. Now that I've discussed database programming, we can get back to the earlier topic and focus on the development of database-related components.
There are basically two families of such components: data-aware controls you can use to present the data of a field or an entire record to the users of a program; and dataset components you can define to provide data to existing data-aware controls, reading the data from a database or any other data source. In this chapter, I'll cover both topics.
When you write a Delphi database program, you generally connect some data-aware controls to a DataSource component, and then connect the DataSource component to a dataset. The connection between the data-aware control and the DataSource is called a data link and is represented by an object of class TDataLink or descendant. The data-aware control creates and manages this object and represents its only connection to the data. From a more practical perspective, to make a component data-aware, you need to add a data link to it and surface some of the properties of this internal object, such as the DataSource and DataField properties.
Delphi uses the DataSource and DataLink objects for bidirectional communication. The dataset uses the connection to notify the data-aware controls that new data is available (because the dataset has been activated, or the current record has changed, and so on). Data-aware controls use the connection to ask for the current value of a field or to update it, notifying the dataset of this event.
The relations among all these components are complicated by the fact that some of the connections can be one-to-many. For example, you can connect multiple data sources to the same dataset, you generally have multiple data links to the same data source (simply because you need one link for every data-aware component), and in most cases you connect multiple data-aware controls to each data source.
We'll work for much of this chapter with TDataLink and its derived classes, which are defined in the DB unit. This class has a set of protected virtual methods, which have a role similar to events. They are "almost-do-nothing" methods you can override in a specific subclass to intercept user operations and other data-source events. Here is a list, extracted from the class's source code:
type 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;
All these virtual methods are called by the DataEvent private method, which is a sort of window procedure for a data source, triggered by several data events (see the TDataEvent enumeration). These events originate in the dataset, fields, or data source, and are generally applied to a dataset. The DataEvent method of the dataset component dispatches the events to the connected data sources. Each data source calls the NotifyDataLinks method to forward the event to each connected data link, and then the data source triggers its own OnDataChange or OnUpdateData event.
The TDataLink class is not technically an abstract class, but you'll seldom use it directly. When you need to create data-aware controls, you'll need to use one of its derived classes or derive a new one yourself. The most important class derived from TDataLink is the TFieldDataLink class, which is used by data-aware controls that relate to a single field of the dataset. Most data-aware controls fall into this category, and the TFieldDataLink class solves the most common problems of this type of component.
All the table- or record-oriented data-aware controls define specific subclasses of TDataLink, as we'll do later. The TFieldDataLink class has a list of events corresponding to the virtual methods of the base class it overrides. This makes the class simpler to customize, because you can use event handlers instead of having to inherit a new class from it. Here's an example of an overridden method, which fires the corresponding event, if available:
procedure TFieldDataLink.ActiveChanged; begin UpdateField; if Assigned(FOnActiveChange) then FOnActiveChange(Self); end;
The TFieldDataLink class also contains the Field and FieldName properties that let you connect the data-aware control to a specific field of the dataset. The link keeps a reference to the current visual component, using the Control property.
Now that you understand the theory of how the data link classes work, let's begin building some data-aware controls. The first two examples are data-aware versions of the ProgressBar and TrackBar common controls. You can use the first to display a numeric value, such as a percentage, in a visual way. You can use the second to allow a user to change the numeric value.
The code for all of the components built in this chapter is in the MdDataPack folder, which also includes a similarly named package for installing them all. Other folders include sample programs that use these components.
A data-aware version of the ProgressBar control is a relatively simple case of a data-aware control, because it is read-only. This component is derived from the version that's not data-aware and adds a few properties of the data link object it encapsulates:
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); 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;
As with every data-aware component that connects to a single field, this control makes available the DataSource and DataField properties. There is little code to write; simply export the properties from the internal data link object, as follows:
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 FDataLink.DataSource := Value; end; function TMdDbProgress.GetField: TField; begin Result := FDataLink.Field; end;
Of course, to make this component work, you must create and destroy the data link when the component itself is created or destroyed:
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;
In the preceding constructor, notice that the component installs one of its own methods as an event handler for the data link. This is where the component's most important code resides. Every time the data changes, you modify the output of the progress bar to reflect the value of the current field:
procedure TMdDbProgress.DataChange (Sender: TObject); begin if FDataLink.Field is TNumericField then Position := FDataLink.Field.AsInteger else Position := Min; end;
Following the convention of the VCL data-aware controls, if the field type is invalid, the component doesn't display an error message—it disables the output. Alternatively, you might want to check the field type when the SetDataField method assigns it to the control.
In Figure 17.1 you can see an example of the DbProgr application's output, which uses both a label and a progress bar to display an order's quantity information. Thanks to this visual clue, you can step through the records and easily spot orders for many items. One obvious benefit to this component is that the application contains almost no code, because all the important code is in the MdProgr unit that defines the component.
Figure 17.1: The data-aware ProgressBar in action in the DbProgr example
As you've seen, a read-only data-aware component is not difficult to write. However, it becomes extremely complex to use such a component inside a DBCtrlGrid container.
If you remember the discussion of the Notification method in Chapter 9, you might wonder what happens if the data source referenced by the data-aware control is destroyed. The good news is that the data source has a destructor that removes itself from its own data links. So, there is no need for a Notification method for data-aware controls, although you'll see books and articles suggesting it, and VCL includes plenty of this useless code.
Replicable Data-Aware Controls
Extending a data-aware control to support its use inside a DBCtrlGrid component is complex and not well documented. You can find a complete replicable version of the progress bar in the MdRepPr unit of the MdDataPack package and an example of its use in the RepProgr folder, along with an HTML file describing its development. The DBCtrlGrid component has a peculiar behavior: It displays on screen multiple versions of the same physical control, using smoke and mirrors. The grid can attach the control to a data buffer other than the current record and redirects the control paint operations to another portion of the monitor.
In short, to appear in the DBCtrlGrid, a component's csReplicatable control style must be set; this flag indicates that your component supports being hosted by a control grid. First, the component must respond to the cm_GetDataLink Delphi message and return a pointer to the data link, so that the control grid can use and change it. Second, it needs a custom Paint method to draw the output in the appropriate canvas object, which is provided in a parameter of the wm_Paint message if the ControlState property's csPaintCopy flag is set.
The example code is involved, and the DBCtrlGrid component is not heavily used, so I decided not to give you full details here; you can find the full code and more information in the source code. Here's the output of a test program that uses this component:
The next step is to write a component that allows a user to modify the data in a database, not just browse it. The overall structure of this type of component isn't very different from the previous version, but there are a few extra elements. In particular, when the user begins interacting with the component, the code should put the dataset into edit mode and then notify the dataset that the data has changed. The dataset will then use a FieldDataLink event handler to ask for the updated value.
To demonstrate how you can create a data-aware component that modifies the data, I extended the TrackBar control. This isn't the simplest example, but it demonstrates several important techniques.
Here's the definition of the component's class (from the MdTrack unit of the MdDataPack package):
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;
Compared to the read-only data-aware control you built earlier, this class is more complex, because it has three message handlers, including component notification handlers, and two new event handlers for the data link. The component installs these event handlers in the constructor, which also disables the component:
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;
The get and set methods and the DataChange event handler are similar to those in the TMdDbProgress component. The only difference is that whenever the data source or data field changes, the component checks the current status to see whether it should enable itself:
procedure TMdDbTrack.SetDataSource (Value: TDataSource); begin FDataLink.DataSource := Value; Enabled := FDataLink.Active and (FDataLink.Field <> nil) and not FDataLink.Field.ReadOnly; end;
This code tests three conditions: the data link should be active, the link should refer to an actual field, and the field shouldn't be read-only.
When the user changes the field, the component should consider that the field name might be invalid; to test for this condition, the component uses a try/finally block:
procedure TMdDbTrack.SetDataField (Value: string); begin try FDataLink.FieldName := Value; finally Enabled := FDataLink.Active and (FDataLink.Field <> nil) and not FDataLink.Field.ReadOnly; end; end;
The control executes the same test when the dataset is enabled or disabled:
procedure TMdDbTrack.ActiveChange (Sender: TObject); begin Enabled := FDataLink.Active and (FDataLink.Field <> nil) and not FDataLink.Field.ReadOnly; end;
The most interesting portion of this component's code is related to its user interface. When a user begins moving the scroll thumb, the component puts the dataset into edit mode, lets the base class update the thumb position, and alerts the data link (and therefore the data source) that the data has changed. Here's the code:
procedure TMdDbTrack.CNHScroll(var Message: TWMHScroll); begin // enter edit mode FDataLink.Edit; // update data inherited; // let the system know FDataLink.Modified; end; procedure TMdDbTrack.CNVScroll(var Message: TWMVScroll); begin // enter edit mode FDataLink.Edit; // update data inherited; // let the system know FDataLink.Modified; end;
When the dataset needs new data—for example, to perform a Post operation—it requests it from the component via the TFieldDataLink class's OnUpdateData event:
procedure TMdDbTrack.UpdateData (Sender: TObject); begin if FDataLink.Field is TNumericField then FDataLink.Field.AsInteger := Position; end;
If the proper conditions are met, the component updates the data in the proper table field. Finally, if the component loses the input focus, it should force a data update (if the data has changed) so that any other data-aware components showing the value of that field will display the correct value as soon as the user moves to a different field. If the data hasn't changed, the component doesn't bother updating the data in the table. This is the standard CMExit code for components used by VCL and borrowed for this component:
procedure TMdDbTrack.CMExit(var Message: TCMExit); begin try FDataLink.UpdateRecord; except SetFocus; raise; end; inherited; end;
A demo program is available for testing this component; you can see its output in Figure 17.2. The DbTrack program contains a check box to enable and disable the table, the visual components, and a couple of buttons you can use to detach the vertical TrackBar component from the field it relates to. I placed these on the form to test enabling and disabling the track bar.
Figure 17.2: The DbTrack example's track bars let you enter data in a database table. The check box and buttons test the enabled status of the components.
The data-aware controls I've built up to this point all refer to specific fields of the dataset, so I used a TFieldDataLink object to establish the connection with a data source. Now let's build a data-aware component that works with a dataset as a whole: a record viewer.
Delphi's database grid shows the value of several fields and several records simultaneously. My record viewer component lists all the fields of the current record, using a customized grid. This example will show you how to build a customized grid control and a custom data link to go with it.
In Delphi there are no data-aware components that manipulate multiple fields of a single record without displaying other records. The only two components that display multiple fields from the same table are the DBGrid and the DbCtrlGrid, which generally display multiple fields and multiple records.
The record viewer component I'll describe in this section is based on a two-column grid; the first column displays the table's field names, and the second column displays the corresponding field values. The number of rows in the grid corresponds to the number of fields, with a vertical scroll bar in case they can't fit in the visible area.
The data link you need in order to build this component is a class connected only to the record viewer component and declared directly in the implementation portion of its unit. This is the same approach used by VCL for some specific data links. Here's the definition of the new class:
type TMdRecordLink = class (TDataLink) private RView: TMdRecordView; public constructor Create (View: TMdRecordView); procedure ActiveChanged; override; procedure RecordChanged (Field: TField); override; end;
As you can see, the class overrides the methods related to the principal event—in this case, the activation and data (or record) change. Alternatively, you could export events and then let the component handle them, as the TFieldDataLink does.
The constructor requires the associated component as its only parameter:
constructor TMdRecordLink.Create (View: TMdRecordView); begin inherited Create; RView := View; end;
After you store a reference to the associated component, the other methods can operate on it directly:
procedure TMdRecordLink.ActiveChanged; var I: Integer; begin // set number of rows RView.RowCount := DataSet.FieldCount; // repaint all... RView.Invalidate; end; procedure TMdRecordLink.RecordChanged; begin inherited; // repaint all... RView.Invalidate; end;
The record link code is simple. Most of the difficulties in building this example result from the use of a grid. To avoid dealing with useless properties, I derived the record viewer grid from the TCustomGrid class. This class incorporates much of the code for grids, but most of its properties, events, and methods are protected. For this reason, the class declaration is quite long, because it needs to publish many existing properties. Here is an excerpt (excluding the base class properties):
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;
In addition to redeclaring the properties to publish them, the component defines a data link object and the DataSource property. There's no DataField property for this component, because it refers to an entire record. The component's constructor is very important. It sets the values of many unpublished properties, including the grid options:
constructor TMdRecordView.Create (AOwner: TComponent); begin inherited Create (AOwner); FDataLink := TMdRecordLink.Create (self); // set numbers of cells and fixed cells RowCount := 2; // default ColCount := 2; FixedCols := 1; FixedRows := 0; Options:= [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRowSizing]; DefaultDrawing := False; ScrollBars := ssVertical; FSaveCellExtents := False; end;
The grid has two columns (one of them fixed) and no fixed rows. The fixed column is used for resizing each row of the grid. Unfortunately, a user cannot drag the fixed row to resize the columns, because you can't resize fixed elements, and the grid already has a fixed column.
An alternative approach could be to have an extra empty column, like the DBGrid control. You could resize the two other columns after adding a fixed row. Overall, though, I prefer my implementation.
I used an alternative approach to resize the columns. The first column (holding the field names) can be resized either using programming code or visually at design time, and the second column (holding the values of the fields) is resized to use the remaining area of the component:
procedure TMdRecordView.SetBounds (ALeft, ATop, AWidth, AHeight: Integer); begin inherited; ColWidths  := ClientWidth - ColWidths; end;
This resizing takes place when the component size changes and when either of the columns change. With this code, the DefaultColWidth property of the component becomes, in practice, the fixed width of the first column.
After everything has been set up, the key method of the component is the overridden DrawCell method, detailed in Listing 17.1. In this method, the control displays the information about the fields and their values. It needs to draw three things. If the data link is not connected to a data source, the grid displays an empty element sign (). When drawing the first column, the record viewer shows the DisplayName of the field, which is the same value used by the DBGrid for the heading. When drawing the second column, the component accesses the textual representation of the field value, extracted with the DisplayText property (or with the AsString property for memo fields).
Listing 17.1: TheDrawCell Method of the Custom RecordView Component
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 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;
In the final portion of the method, the component considers memo and graphic fields. If the field is a TMemoField, the DrawText function call doesn't specify the dt_SingleLine flag, but uses dt_WordBreak flag to wrap the words when there's no more room. For a graphic field, the component uses a completely different approach, assigning the field image to a temporary bitmap and then stretching it to fill the surface of the cell.
Notice that the component sets the DefaultDrawing property to False, so it's also responsible for drawing the background and the focus rectangle, as it does in the DrawCell method. The component also calls the InflateRect API function to leave a small area between the cell border and the output text. The output is produced by calling another Windows API function, DrawText, which centers the text vertically in its cell.
This drawing code works both at run time, as you can see in Figure 17.3, and at design time. The output may not be perfect, but this component can be useful in many cases. To display the data for a single record, instead of building a custom form with labels and data-aware controls, you can easily use this record viewer grid. It's important to remember that the record viewer is a read-only component. It's possible to extend it to add editing capabilities (they're already part of the TCustomGrid class); however, instead of adding this support, I decided to make the component more complete by adding support for displaying BLOB fields.
Figure 17.3: The ViewGrid example demon-strates the output of the RecordView component, using Borland's sample BioLife database table.
To improve the graphical output, the control makes the lines for BLOB fields twice as high as those for plain text fields. This operation is accomplished when the dataset connected to the data-aware control is activated. The data link's ActiveChanged method is also triggered by the RowHeightsChanged methods connected to the DefaultRowHeight property of the base class:
procedure TMdRecordLink.ActiveChanged; var I: Integer; begin // set number of rows 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;
At this point, you stumble into a minor problem. In the DefineProperties method, the TCustomGrid class saves the values of the RowHeights and ColHeights properties. You could disable this streaming by overriding the method and not calling inherited (which is generally a bad technique), but you can also toggle the FSaveCellExtents protected field to disable this feature (as I've done in the component's code).
In addition to writing new, custom, data-aware components, Delphi programmers commonly customize the DBGrid control. The goal for the next component is to enhance the DBGrid with the same kind of custom output I used for the RecordView component, directly displaying graphic and memo fields. To do this, the grid needs to make the row height resizable, to allow space for graphics and a reasonable amount of text. You can see an example of this grid at design time in Figure 17.4.
Figure 17.4: An example of the MdDbGrid component at design time. Notice the output of the graphics and memo fields.
Although creating the output was a simple matter of adapting the code used in the record viewer component, setting the height of the grid cells ended up being a difficult problem to solve. The lines of code for that operation may be few, but they cost me hours of work!
Unlike the generic grid used earlier, a DBGrid is a virtual view on the dataset—there is no relation between the number of rows shown on the screen and the number of rows of data in the dataset. When you scroll up and down through the data records of the dataset, you are not scrolling through the rows of the DBGrid; the rows are stationary, and the data moves from one row to the next to give the appearance of movement. For this reason, the program doesn't try to set the height of an individual row to suit its data; it sets the height of all the data rows to a multiline height value.
This time the control doesn't have to create a custom data link, because it is deriving from a component that already has a complex connection with the data. The new class has a new property to specify the number of lines of text for each row and overrides a few virtual methods:
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;
The constructor sets the default value for the FLinesPerRow field. Here is the set method for the property:
procedure TMdDbGrid.SetLinesPerRow(Value: Integer); begin if Value <> FLinesPerRow then begin FLinesPerRow := Value; LayoutChanged; end; end;
The side effect of changing the number of lines is a call to the LayoutChanged virtual method. The system calls this method frequently when one of the many output parameters changes. In the method's code, the component first calls the inherited version and then sets the height of each row. As a basis for this computation, it uses the same formula as the TCustomDBGrid class: The text height is calculated using the sample word Wg in the current font (this text is used because it includes both a full-height uppercase character and a lowercase letter with a descender). Here's the code:
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  := PixelsTitle; for I := 1 to RowCount - 1 do RowHeights [I] := PixelsPerRow * FLinesPerRow; // 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;
Font and TitleFont are the grid defaults, which can be overridden by properties of the individual DBGrid column objects. This component currently ignores those settings.
The difficult part of this method was getting the final statements right. You can set the Default-RowHeight property, but in that case the title row will probably be too high. First I tried setting the DefaultRowHeight and then the height of the first row, but this approach complicated the code used to compute the number of visible rows in the grid (the read-only VisibleRowCount property). If you specify the number of rows (to avoid having rows hidden beneath the lower edge of the grid), the base class keeps recomputing it. Here's the code used to draw the data, ported from the RecordView component and adapted slightly for the grid:
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;
In this code you can see that if the user displays a single line, the grid uses the standard drawing technique with no output for memo and graphic fields. However, as soon as you increase the line count, you'll see better output.
To see this code in action, run the GridDemo example. This program has two buttons you can use to increase or decrease the row height of the grid, and two more buttons to change the font. This is an important test because the height in pixels of each cell is the height of the font multiplied by the number of lines.
When discussing the TDataSet class and the alternative families of dataset components available in Delphi in Chapter 13, "Delphi's Database Architecture," I mentioned the possibility of writing a custom dataset class. Now it's time to look at an example. The reasons for writing a custom dataset relate to the fact that you won't need to deploy a database engine, but you'll still be able to take full advantage of Delphi's database architecture, including things like persistent database fields and data-aware controls.
Writing a custom dataset is one of the most complex tasks for a component developer, so this is one of the most advanced areas (as far as low-level coding practices, including tons of pointers) in the book. Moreover, Borland hasn't released any official documentation about writing custom datasets. If you are early in your experience with Delphi, you might want to skip the rest of this chapter and come back later.
TDataSet is an abstract class that declares several virtual abstract methods—23 in Delphi 5, now only a handful, as most have been replaced by empty virtual methods (which you still have to override). Every subclass of TDataSet must override all those methods.
Before discussing the development of a custom dataset, we need to explore a few technical elements of the TDataSet class—in particular, record buffering. The class maintains a list of buffers that store the values of different records. These buffers store the data, but they also usually store further information for the dataset to use when managing the records. These buffers don't have a predefined structure, and each custom dataset must allocate the buffers, fill them, and destroy them. The custom dataset must also copy the data from the record buffers to the various fields of the dataset, and vice versa. In other words, the custom dataset is entirely responsible for handling these buffers.
In addition to managing the data buffers, the component is responsible for navigating among the records, managing the bookmarks, defining the structure of the dataset, and creating the proper data fields. The TDataSet class is nothing more than a framework; you must fill it with the appropriate code. Fortunately, most of the code follows a standard structure, which the TDataSet-derived VCL classes use. Once you've grasped the key ideas, you'll be able to build multiple custom datasets borrowing quite a lot of code.
To simplify this type of reuse, I've collected the common features required by any custom dataset in a TMdCustomDataSet class. However, I'm not going to discuss the base class first and the specific implementation later, because it would be difficult to understand. Instead, I'll detail the code required by a dataset, presenting methods of the generic and specific classes at the same time, according to a logical flow.
The starting point, as usual, is the declaration of the two classes discussed in this section: the generic custom dataset I've written and a specific component storing data in a file stream. The declaration of these classes is available in Listing 17.2. In addition to virtual methods, the classes contain a series of protected fields used to manage the buffers, track the current position and record count, and handle many other features. You'll also notice another record declaration at the beginning: a structure used to store the extra data for every data record you place in a buffer. The dataset places this information in each record buffer, following the data.
Listing 17.2: The Declaration of TMdCustomDataSet and TMdDataSetStream
// in the 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 versions) procedure InternalDelete; override; procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override; procedure InternalPost; override; procedure InternalInsert; override; // other procedure InternalHandleException; override; published // redeclared dataset 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 the 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, // optional 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; procedure InternalInsert; 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;
When I divided the methods into sections (as you can see by looking at the source code files), I marked each one with a roman number. You'll see those numbers in a comment describing the method, so that while browsing this long listing you'll immediately know which of the four sections you are in.
The first methods I'll examine are responsible for initializing the dataset and for opening and closing the file stream used to store the data. In addition to initializing the component's internal data, these methods are responsible for initializing and connecting the proper TFields objects to the dataset component. To make this work, all you need to do is to initialize the FieldsDef property with the definitions of the fields for your dataset, and then call a few standard methods to generate and bind the TField objects. This is the general InternalOpen method:
procedure TMdCustomDataSet.InternalOpen; begin InternalPreOpen; // custom method for subclasses // initialize the field definitions InternalInitFieldDefs; // if there are no persistent field objects, create the fields dynamically if DefaultFields then CreateFields; // connect the TField objects with the actual fields 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;
You'll notice that the method sets most of the local fields of the class, and also the BookmarkSize field of the base TDataSet class. Within this method, I call two custom methods I introduced in my custom dataset hierarchy: InternalPreOpen and InternalAfterOpen. The first, InternalPreOpen, is used for operations required at the very beginning, such as checking whether the dataset can be opened and reading the header information from the file. The code checks an internal version number for consistency with the value saved when the table is first created, as you'll see later. By raising an exception in this method, you can eventually stop the open operation.
Here is the code for the two methods in the derived stream-based dataset:
const HeaderVersion = 10; 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;
The second method, InternalAfterOpen, is used for operations required after the field definitions have been set and is followed by code that compares the record size read from the file against the value computed in the InternalInitFieldDefs method. The code also checks that the number of records read from the header is compatible with the size of the file. This test can fail if the dataset wasn't closed properly: You might want to modify this code to let the dataset refresh the record size in the header anyway.
The InternalOpen method of the custom dataset class is specifically responsible for calling InternalInitFieldDefs, which determines the field definitions (at either design time or run time). For this example, I decided to base the field definitions on an external file—an INI file that provides a section for every field. Each section contains the name and data type of the field, as well as its size if it is string data. Listing 17.3 shows the Contrib.INI file used in the component's demo application.
Listing 17.3: The Contrib.INI File for the Demo Application
[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 [Field6] Type = ftBoolean Name = Editor
This file, or a similar one, must use the same name as the table file and must be in the same directory. The InternalInitFieldDefs method (shown in Listing 17.4) will read it, using the values it finds to set up the field definitions and determine the size of each record. The method also initializes an internal TList object that stores the offset of every field inside the record. You use this TList to access fields' data within the record buffer, as you can see in the code listing.
Listing 17.4: The InternalInitFieldDefs Method of the Stream-Based Dataset
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 EDataSetOneError.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 EDataSetOneError.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)); 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 EDataSetOneError.Create ( 'InitFieldsDefs: Unsupported field type'); end; end; // for finally IniFile.Free; end; FRecordSize := TmpFieldOffset; end;
Closing the table is a matter of disconnecting the fields (using some standard calls). Each class must dispose of the data it allocated and update the file header, the first time records are added and each time the record count has changed:
procedure TMdCustomDataSet.InternalClose; begin // disconnect field objects BindFields (False); // destroy field object (if not persistent) if DefaultFields then DestroyFields; // 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 FFieldOffset.Free; FStream.Free; inherited InternalClose; end;
Another related function is used to test whether the dataset is open, something you can solve using the corresponding local field:
function TMdCustomDataSet.IsCursorOpen: Boolean; begin Result := FIsTableOpen; end;
These are the opening and closing methods you need to implement in any custom dataset. However, most of the time, you'll also add a method to create the table. In this example, the CreateTable method creates an empty file and inserts information in the header: a fixed version number, a dummy record size (you don't know the size until you initialize the fields), and the record count (which is zero to start):
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;
As mentioned earlier, every dataset must implement bookmark management, which is necessary for navigating through the dataset. Logically, a bookmark is a reference to a specific dataset record, something that uniquely identifies the record so a dataset can access it and compare it to other records. Technically, bookmarks are pointers. You can implement them as pointers to specific data structures that store record information, or you can implement them as record numbers. For simplicity, I'll use the latter approach.
Given a bookmark, you should be able to find the corresponding record; but given a record buffer, you should also be able to retrieve the corresponding bookmark. This is the reason for appending the TMdRecInfo structure to the record data in each record buffer. This data structure stores the bookmark for the record in the buffer, as well as some bookmark flags defined as follows:
type TBookmarkFlag = (bfCurrent, bfBOF, bfEOF, bfInserted);
The system will request that you store these flags in each record buffer and will later ask you to retrieve the flags for a given record buffer.
To summarize, the structure of a record buffer stores the record data, the bookmark, and the bookmark flags, as you can see in Figure 17.5.
Figure 17.5: The structure of each buffer of the custom dataset, along with the various local fields referring to its subportions
To access the bookmark and flags, you can use as an offset the size of the data, casting the value to the PMdRecInfo pointer type, and then access the proper field of the TMdRecInfo structure via the pointer. The two methods used to set and get the bookmark flags demonstrate this technique:
procedure TMdCustomDataSet.SetBookmarkFlag (Buffer: PChar; Value: TBookmarkFlag); begin PMdRecInfo(Buffer + FRecordSize).BookmarkFlag := Value; end; function TMdCustomDataSet.GetBookmarkFlag (Buffer: PChar): TBookmarkFlag; begin Result := PMdRecInfo(Buffer + FRecordSize).BookmarkFlag; end;
The methods you use to set and get a record's current bookmark are similar to the previous two, but they add complexity because you receive a pointer to the bookmark in the Data parameter. Casting the value referenced by this pointer to an integer, you obtain the bookmark value:
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;
The key bookmark management method is InternalGotoBookmark, which your dataset uses to make a given record the current one. This isn't the standard navigation technique—it's much more common to move to the next or previous record (something you can accomplish using the GetRecord method presented in the next section), or to move to the first or last record (something you'll accomplish using the InternalFirst and InternalLast methods described shortly).
Oddly enough, the InternalGotoBookmark method doesn't expect a bookmark parameter, but a pointer to a bookmark, so you must dereference it to determine the bookmark value. You use the following method, InternalSetToRecord, to jump to a given bookmark, but it must extract the bookmark from the record buffer passed as a parameter. Then, InternalSetToRecord calls InternalGotoBookmark. Here are the two methods:
procedure TMdCustomDataSet.InternalGotoBookmark (Bookmark: Pointer); var ReqBookmark: Integer; begin ReqBookmark := Integer (Bookmark^); if (ReqBookmark >= 0) 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;
In addition to the bookmark management methods just described, you use several other navigation methods to move to specific positions within the dataset, such as the first or last record. These two methods don't really move the current record pointer to the first or last record, but move it to one of two special locations before the first record and after the last one. These are not actual records: Borland calls them cracks. The beginning-of-file crack, or BofCrack, has the value –1 (set in the InternalOpen method), because the position of the first record is zero. The end-of-file crack, or EofCrack, has the value of the number of records, because the last record has the position FRecordCount - 1. I used two local fields, called EofCrack and BofCrack, to make this code easier to read:
procedure TMdCustomDataSet.InternalFirst; begin FCurrentRecord := BofCrack; end; procedure TMdCustomDataSet.InternalLast; begin EofCrack := InternalRecordCount; FCurrentRecord := EofCrack; end;
The InternalRecordCount method is a virtual method introduced in my TMdCustomDataSet class, because different datasets can either have a local field for this value (as in case of the stream-based dataset, which has an FRecordCount field) or compute it on the fly.
Another group of optional methods is used to get the current record number (used by the DBGrid component to show a proportional vertical scroll bar), set the current record number, or determine the number of records. These methods are easy to understand, if you recall that the range of the internal FCurrentRecord field is from 0 to the number of records minus 1. In contrast, the record number reported to the system ranges from 1 to the number of records:
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 CheckBrowseMode; if (Value > 1) and (Value <= FRecordCount) then begin FCurrentRecord := Value - 1; Resync(); end; end;
Notice that the generic custom dataset class implements all the methods of this section. The derived stream-based dataset doesn't need to modify any of them.
Now that we've covered all the support methods, let's examine the core of a custom dataset. In addition to opening and creating records and moving around between them, the component needs to move the data from the stream (the persistent file) to the record buffers, and from the record buffers to the TField objects that are connected to the data-aware controls. The management of record buffers is complex, because each dataset also needs to allocate, empty, and free the memory it requires:
function TMdCustomDataSet.AllocRecordBuffer: PChar; begin GetMem (Result, FRecordBufferSize); end; procedure TMdCustomDataSet.FreeRecordBuffer (var Buffer: PChar); begin FreeMem (Buffer); end;
You allocate memory this way because a dataset generally adds more information to the record buffer, so the system has no way of knowing how much memory to allocate. Notice that in the AllocRecordBuffer method, the component allocates the memory for the record buffer, including both the database data and the record information. In the InternalOpen method, I wrote the following:
FRecordBufferSize := InternalRecordSize + sizeof (TMdRecInfo);
The component also needs to implement a function to reset the buffer (InternalInitRecord), usually filling it with numeric zeros or spaces.
Oddly enough, you must also implement a method that returns the size of each record, but only the data portion—not the entire record buffer. This method is necessary for implementing the read-only RecordSize property, which is used only in a couple of peculiar cases in the entire VCL source code. In the generic custom dataset, the GetRecordSize method returns the value of the FRecordSize field.
Now we've reached the core of the custom dataset component. The methods in this group are GetRecord, which reads data from the file; InternalPost and InternalAddRecord, which update or add new data to the file; and InternalDelete, which removes data and is not implemented in the sample dataset.
The most complex method of this group is GetRecord, which serves multiple purposes. The system uses this method to retrieve the data for the current record, fill a buffer passed as a parameter, and retrieve the data of the next or previous records. The GetMode parameter determines its action:
type TGetMode = (gmCurrent, gmNext, gmPrior);
Of course, a previous or next record might not exist. Even the current record might not exist—for example, when the table is empty (or in case of an internal error). In these cases you don't retrieve the data but return an error code. Therefore, this method's result can be one of the following values:
type TGetResult = (grOK, grBOF, grEOF, grError);
Checking to see if the requested record exists is slightly different than you might expect. You don't have to determine if the current record is in the proper range, only if the requested record is. For example, in the gmCurrent branch of the case statement, you use the standard expression CurrentRecord>= InternalRecourdCount. To fully understand the various cases, you might want to read the code a couple of times.
It took me some trial and error (and system crashes caused by recursive calls) to get the code straight when I wrote my first custom dataset a few years back. To test it, consider that if you use a DBGrid, the system will perform a series of GetRecord calls, until either the grid is full or GetRecord return grEOF. Here's the entire code for the GetRecord method:
// III: Retrieve data for current, previous, or next record // (moving to it if necessary) 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 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;
If there's an error and the DoCheck parameter was True, GetRecord raises an exception. If everything goes fine during record selection, the component loads the data from the stream, moving to the position of the current record (given by the record size multiplied by the record number). In addition, you need to initialize the buffer with the proper bookmark flag and bookmark (or record number) value. This is accomplished by another virtual method I introduced, so that derived classes will only need to implement this portion of the code, while the complex GetRecord method remains unchanged:
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;
You move data to the file in two different cases: when you modify the current record (that is, a post after an edit) or when you add a new record (a post after an insert or append). You use the InternalPost method in both cases, but you can check the dataset's State property to determine which type of post you're performing. In both cases, you don't receive a record buffer as a parameter; so, you must use the ActiveRecord property of TDataSet, which points to the buffer for the current record:
procedure TMdDataSetStream.InternalPost; begin CheckActive; if State = dsEdit then begin // replace data with new data FStream.Position := FDataFileHeaderSize + FRecordSize * FCurrentRecord; FStream.WriteBuffer (ActiveBuffer^, FRecordSize); end else begin // always append InternalLast; FStream.Seek (0, soFromEnd); FStream.WriteBuffer (ActiveBuffer^, FRecordSize); Inc (FRecordCount); end; end;
In addition, there's another related method: InternalAddRecord. This method is called by the AddRecord method, which in turn is called by InsertRecord and AppendRecord. These last two are public methods a user can call. This is an alternative to inserting or appending a new record to the dataset, editing the values of the various fields, and then posting the data, because the InsertRecord and AppendRecord calls receive the values of the fields as parameters. All you must do at that point is replicate the code used to add a new record in the InternalPost method:
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;
I should also have implemented a file operation that removes the current record. This operation is common, but it is complex. If you take a simple approach, such as creating an empty spot in the file, then you'll need to keep track of that spot and make the code for reading or writing a specific record work around that location. An alternate solution is to make a copy of the entire file without the given record and then replace the original file with the copy. Given these choices, I felt that for this example I could forgo supporting record deletion.
In the last few methods, you've seen how datasets move data from the data file to the memory buffer. However, there's little Delphi can do with this record buffer, because it doesn't yet know how to interpret the data in the buffer. You need to provide two more methods: GetData, which copies the data from the record buffer to the field objects of the dataset, and SetData, which moves the data back from the fields to the record buffer. Delphi will automatically move the data from the field objects to the data-aware controls and back.
The code for these two methods isn't difficult, primarily because you saved the field offsets inside the record data in a TList object called FFieldOffset. By incrementing the pointer to the initial position in the record buffer of the current field's offset, you can get the specific data, which takes Field.DataSize bytes.
A confusing element of these two methods is that they both accept a Field parameter and a Buffer parameter. At first, you might think the buffer passed as a parameter is the record buffer. However, I found out that the Buffer is a pointer to the field object's raw data. If you use one of the field object's methods to move that data, it will call the dataset's GetData or SetData method, probably causing an infinite recursion. Instead, you should use the ActiveBuffer pointer to access the record buffer, use the proper offset to get to the data for the current field in the record buffer, and then use the provided Buffer to access the field data. The only difference between the two methods is the direction you move the data:
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 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;
The GetField method should return True or False to indicate whether the field contains data or is empty (a null field, to be more precise). However, unless you use a special marker for blank fields, it's difficult to determine this condition, because you're storing values of different data types. For example, a test such as Ptr^<>#0 makes sense only if you are using a string representation for all the fields. If you use this test, zero integer values and empty strings will show as null values (the data-aware controls will be empty), which may be what you want. The problem is that Boolean False values won't show up. Even worse, floating-point values with no decimals and few digits won't be displayed, because the exponent portion of their representation will be zero. However, to make this example work, I had to consider as empty each date/time field with an initial zero. Without this code, Delphi tries to convert the illegal internal zero date (internally, date fields don't use a TDateTime data type but a different representation), raising an exception. The code used to work with past versions of Delphi.
While trying to fix this problem, I also found out that if you call IsNull for a field, this request is resolved by calling GetFieldData without passing any buffer to fill but looking only for the result of the function call. This is the reason for the if Assigned (Buffer) test within the code.
There's one final method, which doesn't fall into any category: InternalHandleException. Generally, this method silences the exception, because it is activated only at design time.
After all this work, you're ready to test an application example of the custom dataset component, which is installed in the component's package for this chapter. The form displayed by the StreamDSDemo program is simple, as you can see in Figure 17.6. It has a panel with two buttons, a check box, and a navigator component, plus a DBGrid filling its client area.
Figure 17.6: The form of the StreamDSDemo example. The custom dataset has been activated, so you can already see the data at design time.
Figure 17.6 shows the example's form at design time, but I activated the custom dataset so that its data is visible. I already prepared the INI file with the table definition (the file listed earlier when discussing the dataset initialization), and I executed the program to add some data to the file.
You can also modify the form using Delphi's Fields editor and set the properties of the various field objects. Everything works as it does with one of the standard dataset controls. However, to make this work, you must enter the name of the custom dataset's file in the TableName property, using the complete path.
The demo program defines the absolute path of the table file at design time, so you'll need to fix it if you copy the examples to a different drive or directory. In the example, the TableName property is used only at design time. At run time, the program looks for the table in the current directory.
The example code is simple, especially compared to the custom dataset code. If the table doesn't exist yet, you can click the Create New Table button:
procedure TForm1.Button1Click(Sender: TObject); begin MdDataSetStream1.CreateTable; MdDataSetStream1.Open; CheckBox1.Checked := MdDataSetStream1.Active; end;
You create the file first, opening and closing it within the CreateTable call, and then open the table. This is the same behavior as the TTable component (which accomplishes this step using the CreateTable method). To open or close the table, you can click the check box:
procedure TForm1.CheckBox1Click(Sender: TObject); begin MdDataSetStream1.Active := CheckBox1.Checked; end;
Finally, I created a method that tests the custom dataset's bookmark management code (it works).
An important idea related to datasets in Delphi is that they represent a set of data, regardless of where this data comes from. A SQL server and a local file are examples of traditional datasets, but you can use the same technology to show a list of a system's users, a list of a folder's files, the properties of objects, XML-based data, and so on.
As an example, the second dataset presented in this chapter is a list of files. I've built a generic dataset based on a list of objects in memory (using a TObjectList), and then derived a version in which the objects correspond to a folder's files. The example is simplified by the fact that it is a read-only dataset, so you might find it more straightforward than the previous dataset.
Some of the ideas presented here were discussed in an article I wrote for the Borland Community website, published in June 2000 at the URL bdn.borland.com/article/0,1410,20587,00.html.
The generic list-based dataset is called TMdListDataSet and contains the list of objects, a list that is created when you open the dataset and freed when you close it. This dataset doesn't store the record data within the buffer; rather, it saves in the buffer only the position in the list of the entry corresponding to the record's data. This is the class definition:
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;
You can see that by writing a generic custom data class, you can override a few virtual methods of the TDataSet class and of this custom dataset class, and have a working dataset (although this is still an abstract class, which requires extra code from subclasses to work). When the dataset is opened, you have to create the list and set the record size, to indicate you're saving the list index in the buffer:
procedure TMdListDataSet.InternalPreOpen; begin FList := TObjectList.Create (True); // owns the objects FRecordSize := 4; // an integer, the list item id end;
Further derived classes at this point should also fill the list with objects.
Like the ClientDataSet, my list dataset keeps its data in memory. However, using some smart techniques, you can also create a list of fake objects and then load the actual objects only when you are accessing them.
Closing is a matter of freeing the list, which has a record count corresponding to the list size:
function TMdListDataSet.InternalRecordCount: Integer; begin Result := fList.Count; end;
The only other method saves the current record's data in the record buffer, including the bookmark information. The core data is the position of the current record, which matches the list index (and also the bookmark):
procedure TMdListDataSet.InternalLoadCurrentRecord (Buffer: PChar); begin PInteger (Buffer)^ := fCurrentRecord; with PMdRecInfo(Buffer + FRecordSize)^ do begin BookmarkFlag := bfCurrent; Bookmark := fCurrentRecord; end; end;
The derived directory dataset class has to provide a way to load the objects in memory when the dataset is opened, to define the proper fields, and to read and write the value of those fields. It also has a property indicating the directory to work on—or, to be more precise, the directory plus the file mask used for filtering the files (such as 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;
The GetCanModify function is another virtual method of TDataSet, used to determine if the dataset is read-only. In this case, it returns False. You don't have to write any code for the SetFieldData procedure, but you must define it because it is an abstract virtual method.
Because you are dealing with a list of objects, the unit includes a class for those objects. In this case, the file data is extracted from a TSearchRec buffer by the TFileData class constructor:
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;
This constructor is called for each folder while opening the dataset:
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;
The next step is to define the fields of the dataset, which in this case are fixed and depend on the available directory data:
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;
Finally, the component has to move the data from the list object referenced by the current record buffer (the ActiveBuffer value) to each field of the dataset, as requested by the GetFieldData method. This function uses either Move or StrCopy, depending on the data type, and it does some conversions for the attribute codes (H for hidden, R for read-only, and S for system) extracted from the related flags and used to determine whether a file is a folder. Here is the code:
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: // attributes begin strAttr := ' '; if (FileData.Attr and SysUtils.faReadOnly) > 0 then strAttr  := 'R'; if (FileData.Attr and SysUtils.faSysFile) > 0 then strAttr  := 'S'; if (FileData.Attr and SysUtils.faHidden) > 0 then strAttr  := 'H'; StrCopy (Buffer, pchar(strAttr)); end; 4: // folder begin Bool1 := FileData.Attr and SysUtils.faDirectory > 0; Move (Bool1, Buffer^, sizeof (WordBool)); end; end; // case Result := True; end;
The tricky part in writing this code was figuring out the internal format of dates stored in date/time fields. This is not the common TDateTime format used by Delphi, and not even the internal TTimeStamp, but what is internally called the native date and time format. I've written a conversion function by cloning one I found in the VCL code for the date/time fields:
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;
With this dataset available, building the demo program (shown in Figure 17.7) was just a matter of connecting a DBGrid component to the dataset and adding a folder-selection component, the sample ShellTreeView control. This control is set up to work only on files, by setting its Root property to C:. When the user selects a new folder, the OnChange event handler of the ShellTreeView control refreshes the dataset:
procedure TForm1.ShellTreeView1Change(Sender: TObject; Node: TTreeNode); begin MdDirDataset1.Close; MdDirDataset1.Directory := ShellTreeView1.Path + '*.*'; MdDirDataset1.Open; end;
Figure 17.7: The output of the DirDemo example, which uses an unusual dataset that shows directory data
If your version of Windows has problems with the sample shell controls available in Delphi, you can use the DirDemoNoShell version of the example, which uses the old-fashioned Windows 3.1–compatible Delphi file controls.
As you saw in the previous example, a list of objects is conceptually similar to the rows of a table in a dataset. In Delphi, you can build a dataset wrapping a list of objects, as in the case of the TFileData class. It's intriguing to extend this example to build a dataset that supports generic objects, which you can do thanks to the extended RTTI available in Delphi.
This dataset component inherits from TMdListDataSet, as in the previous example. You must provide a single setting: the target class, stored in the ObjClass property (see the complete definition of the TMdObjDataSet class in Listing 17.5).
Listing 17.5: The Complete Definition of the TMdObjDataSet Class
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;
The class is used by the InternalInitFieldDefs method to determine the dataset fields based on the published properties of the target class, which are extracted using RTTI:
procedure TMdObjDataSet.InternalInitFieldDefs; var i: Integer; begin if FObjClass = nil then raise Exception.Create ('TMdObjDataSet: Unassigned class'); // 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;
Similar RTTI-based code is used in the GetFieldData and SetFieldData methods to access the properties of the current object when a dataset field access operation is requested. The huge advantage in using properties to access the dataset data is that read and write operations can be mapped directly to data but also use the corresponding method. This way, you can write the business rules of your application by implementing rules in the read and write methods of the properties—definitely a sounder OOP approach than hooking code to field objects and validating them.
Here is a slightly simplified version of GetFieldData (the other method is symmetric):
function TObjDataSet.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; 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;
This pointer-based code may look terrible, but if you've endured the discussion of the technical details of developing a custom dataset, it won't add much complexity to the picture. It uses some of the data structures defined (and briefly commented) in the TypInfo unit, which should be your reference for any questions about the previous code.
Using this naïve approach of editing the object's data directly, you might wonder what happens if a user cancels the editing operation (something Delphi generally accounts for). My dataset provides two alternative approaches, controlled by the ChangesToClone property and based on the idea of cloning objects by copying their published properties. The core DoClone procedure uses RTTI code similar to what you have already seen to copy all the published data of an object into another object, creating an effective copy (or a clone).
This cloning takes place in both cases. Depending on the value of the ChangesToClone property, either the edit operations are performed on the clone object, which is then copied over the actual object during the Post operation; or the edit operations are performed on the actual object, and the clone is used to get back the original values if editing terminates with a Cancel request. This is the code of the three methods involved:
procedure TObjDataSet.InternalEdit; begin DoClone (fList [FCurrentRecord] as TDbPers, ObjClone); end; procedure TObjDataSet.InternalPost; begin if FChangeToClone and Assigned (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;
In the SetFieldData method, you have to modify either the cloned object or the original instance. To make things more complicated, you must also consider this difference in the GetFieldData method: If you are reading fields from the current object, you might have to use its modified clone (otherwise, the user's changes to other fields will disappear).
As you can see in Listing 17.5, the class also has an Objects array that accesses the data in an OOP way and an Add method that's similar to the Add method of a collection. By calling Add, the code creates a new empty object of the target class and adds it to the internal list:
function TMdObjDataSet.Add: TPersistent; begin if not Active then Open; Result := fObjClass.Create; fList.Add (Result); end;
To demonstrate the use of this component, I wrote the ObjDataSetDemo example. It has a demo target class with a few fields and buttons to create objects automatically, as you can see in Figure 17.8. The most interesting feature of the program, however, is something you have to try for yourself. Run the program and look at the DbGrid columns. Then edit the target class, TDemo, adding a new published property to it. Run the program again, and the grid will include a new column for the property.
Figure 17.8: The ObjDataSet-Demo example showcases a dataset mapped to objects using RTTI.
In this chapter we've delved into Delphi's database architecture by first examining the development of data-aware controls and then studying the internals of the TDataSet class to write a couple of custom dataset components. With this information and the other ideas presented in this part of the book, you should be able to choose the architecture of your database applications, depending on your needs.
Database programming is a core element of Delphi, which is why I've devoted several chapters to this topic. I'll continue to cover it in the next chapter, which is devoted to the new reporting engine available in Delphi 7. We'll get back to databases when focusing on presenting data over the Web in Chapters 20 and 21, and also when discussing XML and SOAP in Chapters 22 and 23.