Marco's Web Center

Menu for Development

Site Menu
Object Pascal Handbook
Delphi Handbooks Collection
Mastering Borland Delphi 2005
(Old) White Papers
(Old)Tools
(Old) Conferences

My Other Sites
Italian Site (www.marcocantu.it)
the delphi search

Spirit of delphi

Advertising
Home My Blog Books Object Pascal Marco

Home: Code Repository: Mastering Delphi 6

Chapter 13 - Project DrawData

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);
    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.
DrawForm.dfm
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