Mega Code Archive
Güzel bir dbgrid componenti
<![CDATA[
//SplitRow ile iki farklı satır rengi tanımlama özelliği (Bu Özelliği Kullanıyorsanız BitmapDrawing özelliğini true yapın)
//EnterAsTab ile enter tuşunu tab olarak kullanma özelliği.
//RowCount ColCount değerlerinin alınabilmesi.
unit ORDBGrid;
interface
uses
ShellAPI, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Grids, DBGrids, DB, StdCtrls, ClipBrd, Menus, dbctrls, Jpeg,
extctrls, Registry, Comctrls;
type
TORDBGrid = class(TDBGrid)
private
splitcolor1,splitcolor2:Tcolor;
issplitrows:Boolean;
isenterastab:boolean;
procedure setissplitrows(newvalue:Boolean);
procedure setcolor1(newvalue:Tcolor);
procedure setcolor2(newvalue:Tcolor);
{ Private declarations }
protected
procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
procedure Scroll(Distance: Integer);override;
procedure SetUseBitmapDrawing(Value: Boolean);
procedure WMPaint(var Message: TWMPaint); message WM_Paint;
procedure KeyPress(var Key: Char);override;
procedure KeyDown( var Key: Word; Shift: TShiftState); override;
procedure KeyUp( var Key: Word; Shift: TShiftState); override;
procedure DrawColumnCell( const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); override;
{ Protected declarations }
public
usebitmapdrawing:boolean;
property row;
property col;
property ColCount;
property RowCount;
property GridLineWidth;
constructor create(AOwner: Tcomponent);override;
destructor Destroy;override;
{ Public declarations }
published
property SplitRows:Boolean read issplitrows write setissplitrows;
property SplitRowColor1:Tcolor read splitcolor1 write setcolor1;
property SplitRowColor2:Tcolor read splitcolor2 write setcolor2;
property EnterAsTab:Boolean read isenterastab write isenterastab;
property BitmapDrawing: Boolean read UseBitmapDrawing write SetUseBitmapDrawing;
{ Published declarations }
end;
type
TMyBookmarks = class(TBookmarkList);
procedure Register;
implementation
constructor Tordbgrid.create(AOwner: Tcomponent);
begin
inherited create(AOwner);
splitcolor1:=clwhite;
splitcolor2:=clwhite;
issplitrows:=false;
isenterastab:=false;
usebitmapdrawing:=false;
end;
destructor Tordbgrid.Destroy;
begin
usebitmapdrawing:=false;
inherited destroy;
end;
procedure TorDBGrid.Scroll(Distance: Integer);
begin
if issplitrows then
Invalidate;
inherited scroll(distance);
end;
procedure TORDBGrid.setissplitrows(newvalue:Boolean);
begin
issplitrows:=newvalue;
repaint;
end;
procedure TORDBGrid.setcolor1(newvalue:Tcolor);
begin
splitcolor1:=newvalue;
repaint;
end;
procedure TORDBGrid.setcolor2(newvalue:Tcolor);
begin
splitcolor2:=newvalue;
repaint;
end;
procedure TORDBGrid.SetUseBitmapDrawing(Value: Boolean);
begin
if UseBitmapDrawing <> Value then
begin
UseBitmapDrawing := Value;
Invalidate;
end;
end;
procedure TorDBGrid.WMPaint(var Message: TWMPaint);
var
WinDC, MemDC: HDC;
Bitmap, OldBitmap: HBITMAP;
PS: TPaintStruct;
BegunPaint: Boolean;
begin
if usebitmapdrawing= true then begin
BegunPaint := False;
WinDC := Message.DC;
if WinDC = 0 then
begin
WinDC := BeginPaint(Handle, PS);
BegunPaint := True;
end;
MemDC := CreateCompatibleDC(Canvas.Handle);
Bitmap := CreateCompatibleBitmap(Canvas.Handle, Width, Height);
OldBitmap := SelectObject(MemDC, Bitmap);
try
Message.DC := MemDC;
inherited;
with Canvas.ClipRect do
BitBlt(WinDC, Left, Top, Right - Left, Bottom - Top, MemDC, Left, Top, SRCCOPY);
finally
SelectObject(MemDC, OldBitmap);
DeleteObject(Bitmap);
DeleteDC(MemDC);
if BegunPaint then
EndPaint(Handle, PS);
end;
end
else
begin
inherited;
end;
end;
procedure TorDBGrid.KeyPress(var Key: Char);
begin
if not EditorMode then
if isenterastab and (Key = #13) then
Key := #9;
inherited KeyPress(Key);
end;
procedure Tordbgrid.KeyDown(var Key: Word; Shift: TShiftState);
begin
if isenterastab=true then
if key=VK_RETURN then
key:=VK_TAB;
inherited KeyDown(key,shift);
end;
procedure Tordbgrid.KeyUp(var Key: Word; Shift: TShiftState);
begin
if isenterastab=true then
if key=VK_RETURN then
key:=VK_TAB;
inherited keyup(key,shift);
end;
procedure Tordbgrid.DrawColumnCell(const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
beginupdate;
canvas.Lock;
if issplitrows=true then begin
if (not (gdSelected in State)) and (not (gdFixed in State)) then begin
if (canvas.Brush.Color=clwhite) or (canvas.Brush.Color=clwindow) or (canvas.Brush.Color=clnone) then begin
Canvas.Brush.Style := bsSolid;
if ((Rect.Top div (Rect.Bottom - Rect.Top + 1)) mod 2) = 0 then
canvas.brush.Color:=splitcolor2
else
canvas.brush.Color:=splitcolor1;
canvas.FillRect(rect);
end;
end;
end;
if (gdSelected in State) and (not (gdFixed in State)) then begin
canvas.Brush.Color := clNavy;
canvas.Font.Color := clWhite;
canvas.FillRect(Rect);
end;
if (dgAlwaysShowSelection in Options) then begin
if (gdSelected in State) then
if not (dgRowSelect in Options) then
Canvas.DrawFocusRect(Rect);
end else begin
if (gdFocused in State) then begin
if not (dgRowSelect in Options) then
Canvas.DrawFocusRect(Rect);
end else begin
if (not (gdFocused in State)) and (gdSelected in State) then
if not (dgRowSelect in Options) then begin
Canvas.Brush.Color := clBlue;
Canvas.FillRect(Rect);
end;
end;
end;
canvas.unlock;
inherited DrawColumnCell(Rect, DataCol, Column, State);
DefaultDrawColumnCell(rect,datacol,column,state);
endupdate;
end;
procedure Tordbgrid.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
begin
inherited DrawCell(ACol, ARow, ARect,AState);
if ((ARow=0) and (dgTitles in options)) or ((Acol=0) and (dgindicator in options)) then begin
with arect do begin
Canvas.Pen.Color := TorDBGrid(Self).FixedColor;
Canvas.PolyLine([Point(Left + 1, Bottom - 1), Point(Right - 1, Bottom - 1), Point(Right - 1, Top)]);
Canvas.Pen.Color := clBtnShadow;
Canvas.PolyLine([Point(Left - 1, Bottom), Point(Right, Bottom), Point(Right, Top - 1)]);
end;
end;
end;
procedure Register;
begin
RegisterComponents('OR Tools', [TORDBGrid]);
end;
end.
]]>