DBGrid em 3D.

unit DBGrid3D;

interface

uses
SysUtils, Windows, Messages, Classes, Graphics, Controls,
Forms, Dialogs, Grids, DB, DBGrids, ExtCtrls, StdCtrls;

type
TDB3DGrid = class(TCustomDBGrid)
private
FGrid3D: boolean;
FBoolAsCheck: boolean;
FShowMemo: Boolean;
FMemoStream: TMemoryStream;
FMemoStrings: TStrings;
procedure SetGrid3D(Value: Boolean);
procedure SetBoolAsCheck(Value: Boolean);
procedure SetShowMemo(Value: Boolean);
protected
procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
function CanEditShow: Boolean; override;
function IsBoolCheck: Boolean; virtual;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;

X, Y: Integer); override;
procedure KeyPress(var Key: Char); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Canvas;
property SelectedRows;
published
property Align;
property BoolAsCheck: boolean read FBoolAsCheck write SetBoolAsCheck default True;
property BorderStyle;
property Columns stored StoreColumns;
property Color default clBtnFace;
property Ctl3D;
property DataSource;
property DefaultDrawing default False;
property DragCursor;
property DragMode;
property Enabled;
property FixedColor;
property Font;
property Grid3D: boolean read FGrid3D write SetGrid3D default True;
property Options;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly;
property ShowHint;
property ShowMemo: Boolean read FShowMemo write SetShowMemo;
property TabOrder;
property TabStop;
property TitleFont;
property Visible;
property OnColEnter;
property OnColExit;
property OnColumnMoved;
property OnDrawDataCell;
property OnDrawColumnCell;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEditButtonClick;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnStartDrag;
end;

procedure Register;

implementation

function Max(Frst, Sec: LongInt): LongInt;
begin
if Frst >= Sec then
Result := Frst
else
Result := Sec
end;

procedure ReplaceChar(var aStr: string; aOldChar, aNewChar: string);
var
I: Integer;
begin
for I := Length(aStr) downto 1 do
begin
if (UpCase(aStr[I]) = UpCase(aOldChar[1])) and
(Uppercase(Copy(aStr, I, Length(aOldChar))) = Uppercase(aOldChar)) then
begin
Delete(aStr, I, Length(aOldChar));
Insert(aNewChar, aStr, I);
end;
end;
end;

procedure RemoveChar(var aStr: string; aRemove: string);
begin
while Pos(aRemove, aStr) <> 0 do
System.Delete(aStr, Pos(aRemove, aStr), Length(aRemove));
end;

procedure DrawCheck(ACanvas: TCanvas; const ARect: TRect; Checked: Boolean);
var
TempRect: TRect;
OrigRect: TRect;
Dimension: Integer;
OldColor: TColor;
OldPenWidth: Integer;
OldPenColor: TColor;
B: TRect;
DrawBitmap: TBitmap;
begin
OrigRect := ARect;
DrawBitmap := TBitmap.Create;
try
DrawBitmap.Canvas.Brush.Color := ACanvas.Brush.Color;
with DrawBitmap, OrigRect do
begin
Height := Max(Height, Bottom - Top);
Width := Max(Width, Right - Left);
B := Rect(0, 0, Right - Left, Bottom - Top);
end;
with DrawBitmap, OrigRect do ACanvas.CopyRect(OrigRect, Canvas, B);
TempRect := OrigRect;
TempRect.Top := TempRect.Top + 1;
TempRect.Bottom := TempRect.Bottom + 1;
with TempRect do
begin
Dimension := ACanvas.TextHeight('W') - 3;
Top := ((Bottom + Top) - Dimension) shr 1;
Bottom := Top + Dimension;
Left := ((Left + Right) - Dimension) shr 1;
Right := Left + Dimension;
end;
Frame3d(ACanvas, TempRect, clBtnShadow, clBtnHighLight, 1);
Frame3d(ACanvas, TempRect, clBlack, clBlack, 1);
with ACanvas do
begin
OldColor := Brush.Color;
OldPenWidth := Pen.Width;
OldPenColor := Pen.Color;
Brush.Color := clWindow;
FillRect(TempRect);
end;
if Checked then
begin
with ACanvas, TempRect do
begin
Pen.Color := clBlack;
Pen.Width := 1;
MoveTo(Left + 1, Top + 2);
LineTo(Right - 2, Bottom - 1);
MoveTo(Left + 1, Top + 1);
LineTo(Right - 1, Bottom - 1);
MoveTo(Left + 2, Top + 1);
LineTo(Right - 1, Bottom - 2);

MoveTo(Left + 1, Bottom - 3);
LineTo(Right - 2, Top);
MoveTo(Left + 1, Bottom - 2);
LineTo(Right - 1, Top);
MoveTo(Left + 2, Bottom - 2);
LineTo(Right - 1, Top + 1);
end;
end;
ACanvas.Pen.Color := OldPenColor;
ACanvas.Pen.Width := OldPenWidth;
ACanvas.Brush.Color := OldColor;
finally
DrawBitmap.Free;
end;
end;

procedure WriteText(ACanvas: TCanvas; ARect: TRect; DX, DY: Integer;
const Text: string; Alignment: TAlignment);
const
AlignFlags: array[TAlignment] of Integer =
(DT_LEFT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
DT_RIGHT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
DT_CENTER or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX);
var
B, R: TRect;
I, Left: Integer;
DrawBitmap: TBitmap;
OrigRect: TRect;
begin
OrigRect := ARect;
DrawBitmap := TBitmap.Create;
try
I := ColorToRGB(ACanvas.Brush.Color);
if GetNearestColor(ACanvas.Handle, I) = I then
begin
case Alignment of
taLeftJustify:
Left := OrigRect.Left + DX;
taRightJustify:
Left := OrigRect.Right - ACanvas.TextWidth(Text) - 3;
else
Left := OrigRect.Left + (OrigRect.Right - OrigRect.Left) shr 1
- (ACanvas.TextWidth(Text) shr 1);
end;
ExtTextOut(ACanvas.Handle, Left, OrigRect.Top + DY, ETO_OPAQUE or
ETO_CLIPPED, @OrigRect, PChar(Text), Length(Text), nil);
end
else begin
with DrawBitmap, OrigRect do
begin
Width := Max(Width, Right - Left);
Height := Max(Height, Bottom - Top);
R := Rect(DX, DY, Right - Left - 1, Bottom - Top - 1);
B := Rect(0, 0, Right - Left, Bottom - Top);
end;
with DrawBitmap.Canvas do
begin
Font := ACanvas.Font;
Font.Color := ACanvas.Font.Color;
Brush := ACanvas.Brush;
Brush.Style := bsSolid;
FillRect(B);
SetBkMode(Handle, TRANSPARENT);
DrawText(Handle, PChar(Text), Length(Text), R, AlignFlags[Alignment]);
end;
ACanvas.CopyRect(OrigRect, DrawBitmap.Canvas, B);
end;
finally
DrawBitmap.Free;
end;
end;

{ DB3DGrid }

constructor TDB3DGrid.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Color := clBtnFace;
Grid3d := True;
FBoolAsCheck := True;
DefaultDrawing := False;
FMemoStream := TMemoryStream.Create;
FMemoStrings := TStringList.Create;
end;

destructor TDB3DGrid.Destroy;
begin
FMemoStream.Free;
FMemoStrings.Free;
inherited Destroy;
end;

procedure TDB3DGrid.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
var
DrawColumn: TColumn;
OldActive: Integer;
Value: Boolean;
ValueStr: string;
begin
if FGrid3D then DefaultDrawing := False;
Canvas.FillRect(ARect);
inherited DrawCell(ACol, ARow, ARect, AState);
if FGrid3D and ([dgRowLines, dgColLines] * Options =
[dgRowLines, dgColLines]) then
begin
if not (gdFixed in AState) then
begin
if (ACol <= Columns.Count) and assigned(Columns[ACol - 1].Field) then begin DrawColumn := Columns[ACol - 1]; if (Columns[ACol - 1].Field.DataType = ftBoolean) and FBoolAsCheck then begin OldActive := DataLink.ActiveRecord; try DataLink.ActiveRecord := ARow - 1; if Assigned(DrawColumn.Field) then begin Value := DrawColumn.Field.AsBoolean; DrawCheck(Canvas, ARect, Value); end; finally DataLink.ActiveRecord := OldActive; end; end else begin OldActive := DataLink.ActiveRecord; try DataLink.ActiveRecord := ARow - 1; if Assigned(DrawColumn.Field) then begin if (Columns[ACol - 1].Field.DataType in [ftMemo, ftFmtMemo]) then begin if FShowMemo then begin FMemoStream.Clear; TBlobField(DrawColumn.Field).SaveToStream(FMemoStream); FMemoStream.Seek(0, soFromBeginning); FMemoStrings.LoadFromStream(FMemoStream); ValueStr := FMemoStrings.Text; ReplaceChar(ValueStr, #13, #32); RemoveChar(ValueStr, #10); end else ValueStr := DrawColumn.Field.DisplayText; end else ValueStr := DrawColumn.Field.DisplayText; WriteText(Canvas, ARect, 2, 2, ValueStr, Columns[ACol - 1].Alignment); end; finally DataLink.ActiveRecord := OldActive; end; end; end; end; with ARect, Canvas do begin if (gdFixed in AState) then Frame3d(Canvas, ARect, clBtnHighLight, clBtnShadow, 2) else begin Pen.Color := clBtnHighLight; PolyLine([Point(Left, Bottom - 1), Point(Left, Top), Point(Right, Top)]); Pen.Color := clBtnShadow; PolyLine([Point(Left, Bottom), Point(Right, Bottom), Point(Right, Top - 1)]); end; end; end; end; procedure TDB3DGrid.SetGrid3D(Value: Boolean); begin if FGrid3D <> Value then
begin
FGrid3D := Value;
DefaultDrawing := not FGrid3d;
FBoolAsCheck := FGrid3d;
Invalidate;
end;
end;

procedure TDB3DGrid.SetBoolAsCheck(Value: Boolean);
begin
if not FGrid3D then
begin
if FBoolAsCheck then
begin
FBoolAsCheck := False;
Invalidate;
end;
Exit;
end;
if FBoolAsCheck <> Value then
begin
FBoolAsCheck := Value;
Invalidate;
end;
end;

procedure TDB3DGrid.SetShowMemo(Value: Boolean);
begin
if not FGrid3D then
begin
if FShowMemo then
begin
FShowMemo := False;
Invalidate;
end;
Exit;
end;
if FShowMemo <> Value then
begin
FShowMemo := Value;
Invalidate;
end;
end;

function TDB3DGrid.IsBoolCheck: Boolean;
begin
Result := False;
if (FGrid3D = true) and ([dgRowLines, dgColLines] * Options =
[dgRowLines, dgColLines]) then
begin
if assigned(Columns[Col - 1].Field) then
begin
if (Columns[Col - 1].Field.DataType = ftBoolean) and FBoolAsCheck then
Result := True;
end;
end;
end;

function TDB3DGrid.CanEditShow: Boolean;
begin
Result := not IsBoolCheck and inherited CanEditShow;
end;

procedure TDB3DGrid.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var
Cell: TGridCoord;
OldCol: Integer;
OldRow: Integer;
State: Boolean;
Rect: TRect;
OldBrush: TBrush;
OldPen: TPen;
begin
OldCol := Col;
OldRow := Row;
inherited MouseDown(Button, Shift, X, Y);
Cell := MouseCoord(X, Y);
if IsBoolCheck then
begin
if DataLink.Active and (Cell.X = OldCol) and (Cell.Y = OldRow) then
begin
if DataLink.DataSet.State = dsBrowse then
DataLink.DataSet.Edit;
if (DataLink.DataSet.State = dsEdit) or (DataLink.DataSet.State = dsInsert) then
begin
Columns[Col - 1].Field.AsBoolean := not Columns[Col - 1].Field.AsBoolean;
State := Columns[Col - 1].Field.AsBoolean;
Rect := BoxRect(Col, Row, Col, Row);
with Canvas, Rect do
begin
OldBrush := Brush;
OldPen := Pen;
Brush.Color := clHighLight;
DrawCheck(Canvas, Rect, State);
Pen.Color := clBtnHighLight;
PolyLine([Point(Left, Bottom - 1), Point(Left, Top), Point(Right, Top)]);
Pen.Color := clBtnShadow;
PolyLine([Point(Left, Bottom), Point(Right, Bottom), Point(Right, Top - 1)]);
Brush := OldBrush;
Pen := OldPen;
end;
end;
end;
end;
end;

procedure TDB3DGrid.KeyPress(var Key: Char);
var
OldBrush: TBrush;
OldPen: TPen;
State: Boolean;
Rect: TRect;
begin
if not (dgAlwaysShowEditor in Options) and (Key = #32) and IsBoolCheck and
(Columns[Col - 1].Field.DataType = ftBoolean) then
begin
Key := #13;
if DataLink.Active and (DataLink.DataSet.State = dsBrowse) then
DataLink.DataSet.Edit;
end;
if not (dgAlwaysShowEditor in Options) and (Key = #13) and IsBoolCheck then
begin
if DataLink.Active then
begin
if DataLink.DataSet.State = dsBrowse then
DataLink.DataSet.Edit;
if (DataLink.DataSet.State = dsEdit) or (DataLink.DataSet.State = dsInsert) then
begin
Columns[Col - 1].Field.AsBoolean := not Columns[Col - 1].Field.AsBoolean;
State := Columns[Col - 1].Field.AsBoolean;
Rect := BoxRect(Col, Row, Col, Row);
with Canvas, Rect do
begin
OldBrush := Brush;
OldPen := Pen;
Brush.Color := clHighLight;
DrawCheck(Canvas, Rect, State);
Pen.Color := clBtnHighLight;
PolyLine([Point(Left, Bottom - 1), Point(Left, Top), Point(Right, Top)]);
Pen.Color := clBtnShadow;
PolyLine([Point(Left, Bottom), Point(Right, Bottom), Point(Right, Top - 1)]);
Brush := OldBrush;
Pen := OldPen;
end;
end;
end;
end;
inherited KeyPress(Key);
end;

procedure Register;
begin
RegisterComponents('WEADB', [TDB3DGrid]);
end;

end.