(Delphi) Trying to make derivative DBGrid, can't make it work

150 views Asked by At

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.
0

There are 0 answers