开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
DrawForm.pas
资源名称：delphi.rar　[点击查看]
上传用户：fh681027
上传日期：2022-07-23
资源大小：1959k
文件大小：2k
源码类别：

Delphi控件源码

开发平台：

Delphi

DrawForm.pas：源码内容
  1. unit DrawForm;
  3. interface
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   DBTables, DB, Grids, DBGrids, ExtCtrls, StdCtrls, DBCtrls;
  9. type
  10.   TForm1 = class(TForm)
  11.     DataSource1: TDataSource;
  12.     DBGrid1: TDBGrid;
  13.     Table1: TTable;
  14.     Table1SpeciesNo: TFloatField;
  15.     Table1Category: TStringField;
  16.     Table1Common_Name: TStringField;
  17.     Table1Lengthcm: TFloatField;
  18.     Table1Notes: TMemoField;
  19.     Table1Graphic: TGraphicField;
  20.     procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
  21.       DataCol: Integer; Column: TColumn; State: TGridDrawState);
  22.     procedure FormCreate(Sender: TObject);
  23.     procedure Table1NotesGetText(Sender: TField; var Text: String;
  24.       DisplayText: Boolean);
  25.     procedure Table1NotesSetText(Sender: TField; const Text: String);
  26.   private
  27.     { Private declarations }
  28.   public
  29.     { Public declarations }
  30.   end;
  32. var
  33.   Form1: TForm1;
  35. implementation
  37. {$R *.DFM}
  39. procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
  40.   DataCol: Integer; Column: TColumn; State: TGridDrawState);
  41. var
  42.   Bmp: TBitmap;
  43.   OutRect: TRect;
  44.   BmpWidth: Integer;
  45. begin
  46.   // default output rectangle
  47.   OutRect := Rect;
  49.   if Column.Field = Table1Common_Name then
  50.   begin
  51.     // draw the image
  52.     Bmp := TBitmap.Create;
  53.     try
  54.       Bmp.Assign (Table1Graphic);
  55.       BmpWidth := (Rect.Bottom - Rect.Top) * 2;
  56.       OutRect.Right := Rect.Left + BmpWidth;
  57.       DBGrid1.Canvas.StretchDraw (OutRect, Bmp);
  58.     finally
  59.       Bmp.Free;
  60.     end;
  61.     // reset output rectangle, leaving space for the graphic
  62.     OutRect := Rect;
  63.     OutRect.Left := OutRect.Left + BmpWidth;
  64.   end;
  66.   // red font color if length > 100
  67.   if (Column.Field = Table1Lengthcm) and
  68.       (Table1Lengthcm.AsInteger > 100) then
  69.     DBGrid1.Canvas.Font.Color := clRed;
  71.   // default drawing
  72.   DBGrid1.DefaultDrawDataCell (OutRect, Column.Field, State);
  73. end;
  75. procedure TForm1.FormCreate(Sender: TObject);
  76. begin
  77.   Table1.Active := True;
  78. end;
  80. procedure TForm1.Table1NotesGetText(Sender: TField; var Text: String;
  81.   DisplayText: Boolean);
  82. begin
  83.   Text := Trim (Sender.AsString);
  84. end;
  86. procedure TForm1.Table1NotesSetText(Sender: TField; const Text: String);
  87. begin
  88.   Sender.AsString := Text;
  89. end;
  91. end.