Home: Code Repository: Mastering Delphi 5

Project DRAWDATA

Project Structure

DRAWDATA.DPR
DRAWFORM.PAS
DRAWFORM.DFM

program DrawData;

uses
  Forms,
  DrawForm in 'DrawForm.pas' {Form1};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

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);
    procedure Table1NotesGetText(Sender: TField; var Text: String;
      DisplayText: Boolean);
    procedure Table1NotesSetText(Sender: TField; const Text: String);
  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
  Bmp: TBitmap;
  OutRect: TRect;
  BmpWidth: Integer;
begin
  // default output rectangle
  OutRect := Rect;

  if Column.Field = Table1Common_Name then
  begin
    // draw the image
    Bmp := TBitmap.Create;
    try
      Bmp.Assign (Table1Graphic);
      BmpWidth := (Rect.Bottom - Rect.Top) * 2;
      OutRect.Right := Rect.Left + BmpWidth;
      DBGrid1.Canvas.StretchDraw (OutRect, Bmp);
    finally
      Bmp.Free;
    end;
    // reset output rectangle, leaving space for the graphic
    OutRect := Rect;
    OutRect.Left := OutRect.Left + BmpWidth;
  end;

  // red font color if length > 100
  if (Column.Field = Table1Lengthcm) and
      (Table1Lengthcm.AsInteger > 100) then
    DBGrid1.Canvas.Font.Color := clRed;

  // default drawing
  DBGrid1.DefaultDrawDataCell (OutRect, Column.Field, State);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Table1.Active := True;
end;

procedure TForm1.Table1NotesGetText(Sender: TField; var Text: String;
  DisplayText: Boolean);
begin
  Text := Trim (Sender.AsString);
end;

procedure TForm1.Table1NotesSetText(Sender: TField; const Text: String);
begin
  Sender.AsString := Text;
end;

end.

object Form1: TForm1
  Left = 181
  Top = 119
  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]
    Options = [dgEditing, dgAlwaysShowEditor, dgTitles, dgIndicator, dgColumnResize, dgColLines, dgRowLines, dgTabs, dgConfirmDelete, dgCancelOnExit]
    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'
    UpdateMode = upWhereChanged
    Left = 24
    Top = 72
    object Table1SpeciesNo: TFloatField
      FieldName = 'Species No'
      Visible = False
    end
    object Table1Category: TStringField
      DisplayWidth = 12
      FieldName = 'Category'
      FixedChar = False
      Size = 15
    end
    object Table1Common_Name: TStringField
      DisplayWidth = 23
      FieldName = 'Common_Name'
      FixedChar = False
      Size = 30
    end
    object Table1Lengthcm: TFloatField
      DisplayWidth = 9
      FieldName = 'Length (cm)'
    end
    object Table1Notes: TMemoField
      DisplayWidth = 36
      FieldName = 'Notes'
      OnGetText = Table1NotesGetText
      OnSetText = Table1NotesSetText
      BlobType = ftMemo
      Size = 50
    end
    object Table1Graphic: TGraphicField
      DisplayWidth = 9
      FieldName = 'Graphic'
      Visible = False
      BlobType = ftGraphic
    end
  end
end