The DBGrid control in Delphi

Source: Internet
Author: User

In Delphi, DBGrid Control is a development database software can not use the control, it is very powerful, with SQL statements to achieve almost all the data report display, operation is very simple, properties, procedures, events, etc. are very intuitive, but in use, sometimes still need some other functions, For example, print, zebra display, transfer data from DBGrid to EXCEL97, and so on. This requires us to customize the DBGrid to better adapt to our actual needs. I based on the use of Delphi experience, customized DBGrid, to achieve the above enumerated functions, for the printing function is on the basis of DBGrid joint quickreport function, direct DBGrid printing and preview, the user does not feel the existence of Quickreport , just call the method Wpaperpreview, and the same is true for dump data to excel, but it's using the Automation variable Excel. Because the program is too long, can not be listed in detail, here is a complete implementation of zebra pattern display DBGrid, the name is Newdbgrid. According to this applet, the reader can add other better, more and more useful functions.

The principle of Newdbgrid is to inherit all the functions of DBGrid, while adding new properties: Wzebra,wfirstcolor, Wsecondcolor. When the value of Wzebra is true, the zebra effect is displayed with the effect that the singular row color is wfirstcolor, and the even-numbered row color is wsecondcolor. See the following list of procedures:

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;
New data controls are inherited by TDBGrid
Tnewdbgrid = Class (TDBGrid)
Private
Private variables
Fwzebra:boolean; Whether to show zebra color
Fwfirstcolor:tcolor; Singular line Color
Fwsecondcolor:tcolor; Even-numbered row color
Fdrawfieldcellevent:tdrawfieldcellevent;
Procedure Autoinitialize; The automatic initial process
Procedure Autodestroy;
function Getwfirstcolor:tcolor;
Reading and writing function and process of 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
The key process of this control
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);
{You can add the additional controls you need and the initial parameter} at the same time}
End
Procedure Tnewdbgrid.autodestroy;
Begin
{This frees up system resources such as adding parameters and so on.}
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

Achieve zebra effects
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 you are in the control's load state, the color is directly filled out}
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
{for column headings, without any adornments}
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
{Reduce arect to fill in data}
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//If the property wzebra true displays zebra stripes
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
Displays the current cursor at the blue bottom of the yellow word, while bold display
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
If you move the cursor and so on, you need to refresh the display DBGrid
Procedure Tnewdbgrid.scroll (Distance:integer);
Begin
Inherited Scroll (Distance);
Refresh
End
End.

The above procedures in Win98 + Delphi 5 debugging through.

The DBGrid control in Delphi

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.