For certain reasons I can't use additional components such as EhLib or DevExpress QuantumGrid, so I'm trying to make my own component, derivative from standard DBGrid.
But I don't have enough in-depth knowledge of Delphi, and thus tried to use example from http://etutorials.org/Programming/mastering+delphi+7/Part+III+Delphi+Database-Oriented+Architectures/Chapter+17+Writing+Database+Components/Customizing+the+DBGrid+Component/ ("Mastering Delphi" by Marco Cantu)
But... It acts like a standard DBgrid, no word wrap happening.
Edit: okay, looks like I've found the source of the problem. Don't know what to do with it, though. Though Canvas draws on the form, it draws under it's elements. It seems to does draw what I want, but I can't see it! I checked it by drawing a simple rectangle in OnDrawColumn event and moved PageControl up and down to check.
Edit2: sorry for testing your patience, Tom Brunberg, and here is the code (also I have uploaded the files at https://www.dropbox.com/sh/971w8r3wz62zcfg/AAD5knqO5FJg-a9SGqCtY8mPa?dl=0).
Edit3: thank you so much Tom Brunberg for your help! Unsetting DefaultDrawing and adding additional fields TWideStringField and TWideMemoField helped!
unit MdDbGrid;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, DB, StdCtrls, ExtCtrls, Grids, DBGrids;
type
TMdDbGrid = class(TDBGrid)
private
{ Private declarations }
FLinesPerRow: Integer;
procedure SetLinesPerRow (Value: Integer);
protected
{ Protected declarations }
procedure DrawColumnCell(const Rect: TRect; DataCol: Integer;
Column: TColumn; State: TGridDrawState); override;
procedure LayoutChanged; override;
public
{ Public declarations }
constructor Create (AOwner: TComponent); override;
published
{ Published declarations }
property LinesPerRow: Integer
read FLinesPerRow write SetLinesPerRow default 1;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('MyComponents', [TMdDbGrid]);
end;
constructor TMdDbGrid.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FLinesPerRow:=1;
end;
procedure TMdDbGrid.SetLinesPerRow(Value: Integer);
begin
if Value <> FLinesPerRow then
begin
FLinesPerRow := Value;
LayoutChanged;
end;
end;
procedure TMdDbGrid.LayOutChanged;
var
PixelsPerRow, PixelsTitle, I: Integer;
begin
inherited LayOutChanged;
Canvas.Font := Font;
PixelsPerRow := Canvas.TextHeight('Wg') + 3;
if dgRowLines in Options then
Inc (PixelsPerRow, GridLineWidth);
Canvas.Font := TitleFont;
PixelsTitle := Canvas.TextHeight('Wg') + 4;
if dgRowLines in Options then
Inc (PixelsTitle, GridLineWidth);
// set number of rows
RowCount := 1 + (Height - PixelsTitle) div (PixelsPerRow * FLinesPerRow);
// set the height of each row
DefaultRowHeight := PixelsPerRow * FLinesPerRow;
RowHeights [0] := PixelsTitle;
for I := 1 to RowCount - 1 do
RowHeights [I] := PixelsPerRow * FLinesPerRow;
// send a WM_SIZE message to let the base component recompute
// the visible rows in the private UpdateRowCount method
PostMessage (Handle, WM_SIZE, 0, MakeLong(Width, Height));
end;
procedure TMdDbGrid.DrawColumnCell (const Rect: TRect; DataCol: Integer;
Column: TColumn; State: TGridDrawState);
var
Bmp: TBitmap;
OutRect: TRect;
begin
if FLinesPerRow = 1 then
inherited DrawColumnCell(Rect, DataCol, Column, State)
else
begin
// clear area
//Canvas.FillRect (Rect);
Self.Canvas.FillRect (Rect);
// Annd... This is where I discovered that the program is already not working as it should.
// Canvas.FillRect was supposed to draw filled squares over data cells, over which new text would be drawn
// I commented out the executable code that was supposed to draw the text.
//The result should have been empty cells on the new grid. But the grid was still drawn as a single line with the same text.
// copy the rectangle
OutRect := Rect;
// restrict output
InflateRect (OutRect, -2, -2);
// output field data
if Column.Field is TGraphicField then
begin
Bmp := TBitmap.Create;
try
Bmp.Assign (Column.Field);
Canvas.StretchDraw (OutRect, Bmp);
finally
Bmp.Free;
end;
end
else if (Column.Field is TMemoField) or (Column.Field is TWideStringField) or (Column.Field is TWideMemoField) then
begin
DrawText (Canvas.Handle, PChar (Column.Field.AsString),
Length (Column.Field.AsString), OutRect, dt_WordBreak or dt_NoPrefix)
end
else // draw single line vertically centered
DrawText (Canvas.Handle, PChar (Column.Field.DisplayText),
Length (Column.Field.DisplayText), OutRect,
dt_vcenter or dt_SingleLine or dt_NoPrefix);
end;
end;
end.