⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.pas

📁 用delphi开发的一个数据表
💻 PAS
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db, DBTables, Grids, DBGrids;

type
  TForm1 = class(TForm)
    DBGrid1: TDBGrid;
    Table1: TTable;
    DataSource1: TDataSource;
    Table1SpeciesNo: TFloatField;
    Table1Category: TStringField;
    Table1Common_Name: TStringField;
    Table1SpeciesName: TStringField;
    Table1Lengthcm: TFloatField;
    Table1Length_In: TFloatField;
    Table1Notes: TMemoField;
    Table1Graphic: TGraphicField;
    procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    procedure Table1NotesSetText(Sender: TField; const Text: String);
    procedure Table1NotesGetText(Sender: TField; var Text: String;
      DisplayText: Boolean);
    procedure DBGrid1CellClick(Column: TColumn);
  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
  outrect:=rect;
  if (column.Field =table1.fields.FieldByName('Common_Name')) then
  begin
    bmp:=tbitmap.Create;
    try
      bmp.Assign(table1.fieldbyname('Graphic'));
      bmpwidth:=(rect.Bottom -rect.Top )*2;
      outrect.Right :=rect.Left +bmpwidth;
      dbgrid1.Canvas.StretchDraw(outrect,bmp);
    except
      bmp.free;
    end;
    if table1.fieldbyname('Length (cm)').asinteger>100 then
    begin
      dbgrid1.Canvas.Font.color:=clred;
      dbgrid1.Canvas.Font.style :=[fsbold];
    end;
    outrect:=rect;
    outrect.left:=outrect.Left +bmpwidth;
  end;
  //dbgrid1.defaultdrawdatacell(rect,column.field,state);
  dbgrid1.DefaultDrawDataCell(outrect,column.field,state);
end;

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

procedure TForm1.Table1NotesGetText(Sender: TField; var Text: String;
  DisplayText: Boolean);
begin
  text:=table1.fieldbyname('Notes').asstring;
end;

procedure TForm1.DBGrid1CellClick(Column: TColumn);
var i:integer;
begin
  for i:=0 to dbgrid1.Columns.Count-1 do
  begin
    if i=dbgrid1.SelectedIndex then
    begin
      dbgrid1.Columns[i].Font.Color :=clblue;
      dbgrid1.Columns[i].font.style:=[fsbold];
      dbgrid1.Columns[i].Color :=clgray;
    end
    else
    begin
      dbgrid1.Columns[i].Font.Color :=clblack;
      dbgrid1.Columns[i].font.style:=dbgrid1.Columns[i].font.style-[fsbold];
      dbgrid1.Columns[i].Color :=clwhite;
    end;
  end;
end;



end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -