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下调试通过。
2003-11-19 11:27:19 在DBGrid控件中显示图形如果在数据库中设置了一个为BLOB类型的字段用于保存图形,在使用DBGrid控件显示时,在表格中显示的是BLOB,而无法显示出图形,当然,有一些第三方控件可以显示出图形,但是要去找第三方控件不是一件容易的事,而且