Marco Cantù 1998, Mastering Delphi 4
Project: DRAWDATA.DPR
Project Structure
DRAWDATA.DPR
program DrawData;
uses
Forms,
DrawForm in 'DrawForm.pas' {Form1};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
DRAWFORM.PAS
unit DrawForm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
DBTables, DB, Grids, DBGrids, ExtCtrls, StdCtrls, DBCtrls;
type
TForm1 = class(TForm)
DataSource1: TDataSource;
DBGrid1: TDBGrid;
Table1: TTable;
Table1SpeciesNo: TFloatField;
Table1Category: TStringField;
Table1Common_Name: TStringField;
Table1Lengthcm: TFloatField;
Table1Notes: TMemoField;
Table1Graphic: TGraphicField;
procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
var
Code: Integer;
Bmp: TBitmap;
begin
// erase existing output
DBGrid1.Canvas.FillRect (Rect);
if Column.Field = Table1Graphic then
begin
// draw the image
Bmp := TBitmap.Create;
try
Bmp.Assign (Table1Graphic);
DBGrid1.Canvas.StretchDraw (Rect, Bmp);
finally
Bmp.Free;
end;
end
else
begin
// choose the font color
if (Column.Field = Table1Lengthcm) and
(Table1Lengthcm.AsInteger > 100) then
DBGrid1.Canvas.Font.Color := clRed
else if gdSelected in State then
DBGrid1.Canvas.Font.Color := clHighlightText
else
DBGrid1.Canvas.Font.Color := Column.Font.Color;
// draw the standard text
DBGrid1.Canvas.TextRect (
Rect, Rect.Left, Rect.Top,
Column.Field.AsString);
end;
// optionally draw the focus rectangle
if gdFocused in State then
DBGrid1.Canvas.DrawFocusRect (Rect);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Table1.Active := True;
end;
end.
DRAWFORM.DFM
object Form1: TForm1
Left = 4
Top = 143
Width = 790
Height = 309
Caption = 'Draw Data Grid'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = True
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object DBGrid1: TDBGrid
Left = 0
Top = 0
Width = 782
Height = 282
Align = alClient
BorderStyle = bsNone
DataSource = DataSource1
DefaultDrawing = False
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 0
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'MS Sans Serif'
TitleFont.Style = []
OnDrawColumnCell = DBGrid1DrawColumnCell
end
object DataSource1: TDataSource
DataSet = Table1
Left = 24
Top = 16
end
object Table1: TTable
DatabaseName = 'DBDEMOS'
FieldDefs = <
item
Name = 'Species No'
DataType = ftFloat
end
item
Name = 'Category'
DataType = ftString
Size = 15
end
item
Name = 'Common_Name'
DataType = ftString
Size = 30
end
item
Name = 'Species Name'
DataType = ftString
Size = 40
end
item
Name = 'Length (cm)'
DataType = ftFloat
end
item
Name = 'Length_In'
DataType = ftFloat
end
item
Name = 'Notes'
DataType = ftMemo
Size = 50
end
item
Name = 'Graphic'
DataType = ftGraphic
end>
IndexDefs = <
item
Name = 'Table1Index1'
Fields = 'Species No'
Options = [ixPrimary, ixUnique]
end>
StoreDefs = True
TableName = 'biolife.db'
Left = 24
Top = 72
object Table1SpeciesNo: TFloatField
FieldName = 'Species No'
Visible = False
end
object Table1Category: TStringField
DisplayWidth = 12
FieldName = 'Category'
Size = 15
end
object Table1Common_Name: TStringField
DisplayWidth = 23
FieldName = 'Common_Name'
Size = 30
end
object Table1Lengthcm: TFloatField
DisplayWidth = 9
FieldName = 'Length (cm)'
end
object Table1Notes: TMemoField
DisplayWidth = 36
FieldName = 'Notes'
ReadOnly = True
BlobType = ftMemo
Size = 50
end
object Table1Graphic: TGraphicField
DisplayWidth = 9
FieldName = 'Graphic'
ReadOnly = True
BlobType = ftGraphic
end
end
end
Copyright Marco Cantù 1998