Delphi中的DBGrid控件
在Delphi中,DBGrid控件是一个开发数据库软件不能不使用的控件,其功能非常强大,可以配合SQL语句实现几乎所有数据报表的显示,操作也非常简单,属性、过程、事件等都非常直观,但是使用中,有时侯还是需要一些其他功能,例如打印、斑马纹显示、将DBGrid中的数据转存到Excel97中等等。这就需要我们定制DBGrid,以更好的适应我们的实际需要。本人根据使用Delphi的体会,定制了DBGrid,实现了以上列举的功能,对于打印功能则是在DBGrid的基础上联合QuickReport的功能,直接进行DBGrid的打印及预览,用户感觉不到QuickReport的存在,只需调用方法WpaperPreview即可;对于转存数据到Excel也是一样,不过这里使用的是自动化变量Excel而已。由于程序太长,不能详细列举,这里介绍一个完整的实现斑马纹显示的DBGrid,名字是NewDBGrid。根据这个小程序,读者可以添加其他更好、更多、更实用的功能。
NewDBGrid的实现原理就是继承DBGrid的所有功能,同时添加新的属性:Wzebra,WfirstColor ,WsecondColor。当Wzebra的值为True时,显示斑马纹效果,其显示的效果是单数行颜色为WfirstColor,双数行颜色为WsecondColor。具体的见下面程序清单:
unit NewDBGrid;
interface
uses
Windows, Messages, SysUtils, Classes,
Graphics, Controls, Forms, Dialogs,
DB, Grids, DBGrids,Excel97;
type
TDrawFieldCellEvent = procedure(Sender: TObject; Field: TField;
var Color: TCOlor;Var Font: TFont;Row:Longint) of object;
//新的数据控件由 TDBGrid 继承而来
TNewDBGrid = class(TDBGrid)
private
//私有变量
FWZebra: Boolean; //是否显示斑马颜色
FWFirstColor : TColor; //单数行颜色
FWSecondColor : TCOlor; //双数行颜色
FDrawFieldCellEvent : TDrawFieldCellEvent;
procedure AutoInitialize; //自动初使化过程
procedure AutoDestroy;
function GetWFirstColor : TColor;
//FirstColor 的读写函数及过程
procedure SetWFirstColor(Value : TColor);
function GetWSecondColor : TCOlor;
procedure SetWSecondColor(Value : TColor);
function GetWZebra : Boolean;
procedure SetWZebra(Value : Boolean);
protected
procedure Scroll(Distance: Integer); override;
//本控件的重点过程
procedure DrawCell(Acol,ARow: Longint;ARect:
TRect;AState: TGridDrawState); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property WZebra: Boolean read GetWZebra write SetWZebra;
property OnDblClick;
property OnDragDrop;
property OnKeyUp;
property OnKeyDown;
property OnKeyPress;
property OnEnter;
property OnExit;
property OnDrawDataCell;
property WFirstColor : TColor
read GetWFirstColor write SetWFirstColor ;
property WSecondColor : TColor
read GetWSecondColor write SetWSecondColor ;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents(?Data Controls?, [TNewDBGrid]);
end;
procedure TNewDBGrid.AutoInitialize;
begin
FWFirstColor := RGB(239,254,247);
FWSecondColor := RGB(249,244,245);
{可以在次添加需要的其它控件及初使化参数}
end;
procedure TNewDBGrid.AutoDestroy;
begin
{在这里释放自己添加参数等占用的系统资源}
end;
procedure TNewDBGrid.SetWZebra(Value : Boolean);
begin
FWZebra := Value;
Refresh;
end;
function TNewDBGrid.GetWZebra: Boolean;
begin
Result :=FWZebra;
end;
function TNewDBGrid.GetWFirstColor : TColor;
begin
Result := FWFirstColor;
end;
procedure TNewDBGrid.SetWFirstColor(Value : TColor);
begin
FWFirstColor := Value;
Refresh;
end;
function TNewDBGrid.GetWSecondColor : TColor;
begin
Result := FWSecondColor;
end;
procedure TNewDBGrid.SetWSecondColor(Value : TColor);
begin
FWSecondColor := Value;
Refresh;
end;
constructor TNewDBGrid.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
AutoInitialize;
end;
destructor TNewDBGrid.Destroy;
begin
AutoDestroy;
inherited Destroy;
end;
//实现斑马效果
procedure TNewDBGrid.DrawCell(ACol,ARow:
Longint;ARect: TRect;AState: TGridDrawState);
var
OldActive: Integer;
Highlight: Boolean;
Value: string;
DrawColumn: Tcolumn;
cl: TColor;
fn: TFont;
begin
{如果处于控件装载状态,则直接填充颜色后退出}
if csLoading in ComponentState then
begin
Canvas.Brush.Color := Color;
Canvas.FillRect(ARect);
Exit;
end;
if (gdFixed in AState) and (ACol - IndicatorOffset 〈 0 ) then
begin
inherited DrawCell(ACol,ARow,ARect,AState);
Exit;
end;
{对于列标题,不用任何修饰}
if (dgTitles in Options) and (ARow = 0) then
begin
inherited DrawCell(ACol,ARow,ARect,AState);
Exit;
end;
if (dgTitles in Options) then Dec(ARow);
Dec(ACol,IndicatorOffset);
if (gdFixed in AState) and ([dgRowLines,dgColLines] * Options =
[dgRowLines,dgColLines]) then
begin
{缩减ARect,以便填写数据}
InflateRect(ARect,-1,-1);
end
else
with Canvas do
begin
DrawColumn := Columns[ACol];
Font := DrawColumn.Font;
Brush.Color := DrawColumn.Color;
Font.Color := DrawColumn.Font.Color;
if FWZebra then //如果属性WZebra为True则显示斑马纹
if Odd(ARow) then
Brush.Color := FWSecondColor
else
Brush.Color := FWFirstColor;
if (DataLink = nil) or not DataLink.Active then
FillRect(ARect)
else
begin
Value := ??;
OldActive := DataLink.ActiveRecord;
try
DataLink.ActiveRecord := ARow;
if Assigned(DrawColumn.Field) then
begin
Value := DrawColumn.Field.DisplayText;
if Assigned(FDrawFieldCellEvent) then
begin
cl := Brush.Color;
fn := Font;
FDrawFieldCellEvent(self,DrawColumn.Field,cl,fn,ARow);
Brush.Color := cl;
Font := fn;
end;
end;
Highlight := HighlightCell(ACol,ARow,Value,AState);
if Highlight and (not FWZebra) then
begin
Brush.Color := clHighlight;
Font.Color := clHighlightText;
end;
if DefaultDrawing then
DefaultDrawColumnCell(ARect,ACol,DrawColumn,AState);
if Columns.State = csDefault then
DrawDataCell(ARect,DrawColumn.Field,AState);
DrawColumnCell(ARect,ACol,DrawColumn,AState);
finally
DataLink.Activerecord := OldActive;
end;
if DefaultDrawing and (gdSelected in AState) and
((dgAlwaysShowSelection in Options) or Focused)
and not (csDesigning in Componentstate)
and not (dgRowSelect in Options)
and (ValidParentForm(self).ActiveControl = self) then
begin
//显示当前光标处为蓝底黄字,同时加粗显示
Windows.DrawFocusRect(Handle,ARect);
Canvas.Brush.COlor := clBlue;
Canvas.FillRect(ARect);
Canvas.Font.Color := clYellow;
Canvas.Font.Style := [fsBold];
DefaultDrawColumnCell(ARect,ACol,DrawColumn,AState);
end;
end;
end;
if (gdFixed in AState) and ([dgRowLines,dgColLines] * Options =
[dgRowLines,dgColLines]) then
begin
InflateRect(ARect,-2,-2);
DrawEdge(Canvas.Handle,ARect,BDR_RAISEDINNER,BF_BOTTOMRIGHT);
DrawEdge(Canvas.Handle,ARect,BDR_SUNKENINNER,BF_TOPLEFT);
end;
end;
//如果移动光标等,则需要刷新显示DBGrid
procedure TNewDBGrid.Scroll(Distance: Integer);
begin
inherited Scroll(Distance);
refresh;
end;
end.
以上程序在Win98 + Delphi 5下调试通过。
Delphi中的DBGrid控件的更多相关文章
- Delphi中使用TXMLDocument控件应注意的问题 转
Delphi中使用TXMLDocument控件应注意的问题 delphiconstructorxmlclass今天写了一个类,其中用到了TXMLDocument控件.这个控件我是要动态生成的. 但是却 ...
- Delphi中,indy控件实现收发邮件的几点学习记录( 可以考虑加入多线程,用多个邮箱做一个邮箱群发器) 转
关于用Delphi中的Indy控件实现收发邮件的几点学习记录 这几天心里颇不宁静,不是因为项目延期,而是因为自己几个月前做的邮件发送程序至今无任何进展,虽然一向谦虚的人在网上发 ...
- Delphi中代替WebBrowser控件的第三方控件
这几天,接触到在delphi中内嵌网页,用delphi7自带的TWebBrowser控件,显示的内容与本机IE8显示的不一样,但是跟装IE8之前的IE6显示一个效果.现在赶脚是下面两个原因中的一个: ...
- delphi中通过http控件上载文件的问题(紧急) 整理的CSDN 帖子
http控件能不能实现post文件?要求效果就像普通的html中通过表单(form中<INPUT TYPE="FILE" NAME="FILE1" SIZ ...
- Delphi中使用TXMLDocument控件应注意的问题
今天写了一个类,其中用到了TXMLDocument控件.这个控件我是要动态生成的. 但是却遇到了非常奇怪的问题,下面分享一下 procedure TMainForm.Button1Click(Send ...
- 在DELPHI中动态创建控件以及控件的事件
在DELPHI中我们经常要动态的创建控件以及控件的事件.例如,我们可能想根据程序需要动态的创建一些Tshape组件来创建某个图形,并使得在鼠标移动上去之后可以完成某些操作.这一般需要需要三步: 生成一 ...
- delphi中的Label控件背景透明
Label1.Transparent:=true;你在它的属性窗口把它的Transparent属性改成TRUE就行了 来自为知笔记(Wiz)
- delphi中使用mediaplayer控件播放音乐
新建一个名字为media的文件夹,把要播放的音乐文件放在这个文件夹里. ExtractFilePath是用来获得产生的可执行程式所在的路径,因为我们把要播放的音乐文件放在了可执行程式的那个根目录下. ...
- delphi如何按照控件的左右顺序来遍历窗体中的每个控件 [问题点数:20 http://bbs.csdn.net/topics/380216822
delphi如何按照控件的左右顺序来遍历窗体中的每个控件delphi默认是按照控件添加进窗体的顺序来遍历的,有没有哪个属性能控制这个/?? 更多0分享到: 对我有用[0] 丢个板砖[0] 引用 | ...
随机推荐
- day1 post验证登录
用post方式模拟 1.登录抽屉网 2.登录代码 ,URL,Form Data 中的信息写入 # coding=utf-8 #post 登录验证 import requests form_data = ...
- 【CF813D】Two Melodies
[CF813D]Two Melodies 题面 洛谷 题解 $dp$: 设$f[i][j]$表示第一个集合以$i$结尾.第二个集合以$j$结尾的合法长度之和最大是多少 明显有$f[i][j]=f[j] ...
- springboot-vue-JWT使用
springboot-vue-JWT使用 后端引入依赖: <dependency> <groupId>io.jsonwebtoken</groupId> <a ...
- 【MYSQL备份】利用mysqldump将一个数据库复制到另一个数据库
假设要将服务器A上的数据库test备份到服务器B 1.在服务器B上新建数据库cp_test mysql> create database cp_test; Query OK, row affec ...
- docker基本的常用命令
- VIN码识别/车架号识别独家支持云识别
VIN码(车架号)对于懂车的人来说并不陌生,不要小看这一串字符,从VIN码中可以读懂车辆的生产厂家.年代.车型.车身型式及代码.发动机代码及组装地点等信息. 一辆汽车的VIN码也是车辆的唯一身份证明, ...
- oracle的分号和斜杠/
;是执行语句必须的/是执行语句块必须的 比如执行一个触发器 CREATE OR REPLACE TRIGGER "TRG_1" BEFORE INSERT ON "CAT ...
- 《疯狂前端开发讲义jQuery+Angular+Bootstrap前端开发实践》学习笔记
<疯狂前端开发讲义jQuery+Angular+Bootstrap前端开发实践>学习笔记 二〇一九年二月十三日星期三2时28分54秒 前提:本书适合有初步HTML.CSS.JavaScri ...
- Python基础入门(模块和包)
1 模块 1.1 什么是模块 在 Python 中,一个 .py 文件就称之为一个模块(Module). 我们学习过函数,知道函数是实现一项或多项功能的一段程序 .其实模块就是函数功能的扩展.为什么这 ...
- Vyatta 网络操作系统
原文发表于:2010-09-19 转载至cu于:2012-07-21 以下是"开源中国社区"写到的: http://www.oschina.net/news/11423/vyatt ...