MdDbGrid.pas
上传用户:fh681027
上传日期:2022-07-23
资源大小:1959k
文件大小:3k
源码类别:

Delphi控件源码

开发平台:

Delphi

  1. unit MdDbGrid;
  2. interface
  3. uses
  4.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  5.   Grids, DBGrids, Db;
  6. type
  7.   TMdDbGrid = class(TDbGrid)
  8.   private
  9.     FLinesPerRow: Integer;
  10.     procedure SetLinesPerRow (Value: Integer);
  11.   protected
  12.     procedure DrawColumnCell(const Rect: TRect; DataCol: Integer;
  13.       Column: TColumn; State: TGridDrawState); override;
  14.     procedure LayoutChanged; override;
  15.   public
  16.     constructor Create (AOwner: TComponent); override;
  17.   published
  18.     property LinesPerRow: Integer
  19.       read FLinesPerRow write SetLinesPerRow
  20.       default 1;
  21.   end;
  22. procedure Register;
  23. implementation
  24. constructor TMdDbGrid.Create(AOwner: TComponent);
  25. begin
  26.   inherited Create(AOwner);
  27.   FLinesPerRow := 1;
  28. end;
  29. procedure TMdDbGrid.LayOutChanged;
  30. var
  31.   PixelsPerRow, PixelsTitle, I: Integer;
  32. begin
  33.   inherited LayOutChanged;
  34.   Canvas.Font := Font;
  35.   PixelsPerRow := Canvas.TextHeight('Wg') + 3;
  36.   if dgRowLines in Options then
  37.       Inc (PixelsPerRow, GridLineWidth);
  38.   Canvas.Font := TitleFont;
  39.   PixelsTitle := Canvas.TextHeight('Wg') + 4;
  40.   if dgRowLines in Options then
  41.     Inc (PixelsTitle, GridLineWidth);
  42.   // set number of rows
  43.   RowCount := 1 + (Height - PixelsTitle) div
  44.     (PixelsPerRow * FLinesPerRow);
  45.   // set the height of each row
  46.   DefaultRowHeight := PixelsPerRow * FLinesPerRow;
  47.   RowHeights [0] := PixelsTitle;
  48.   for I := 1 to RowCount - 1 do
  49.     RowHeights [I] := PixelsPerRow * FLinesPerRow;
  50. end;
  51. procedure TMdDbGrid.DrawColumnCell(const Rect: TRect;
  52.   DataCol: Integer; Column: TColumn; State: TGridDrawState);
  53. var
  54.   Bmp: TBitmap;
  55.   OutRect: TRect;
  56. begin
  57.   if FLinesPerRow = 1 then
  58.     inherited DrawColumnCell(Rect, DataCol, Column, State)
  59.   else
  60.   begin
  61.     // clear area
  62.     Canvas.FillRect (Rect);
  63.     // copy the rectangle
  64.     OutRect := Rect;
  65.     // restrict output
  66.     InflateRect (OutRect, -2, -2);
  67.     // output field data
  68.     if Column.Field is TGraphicField then
  69.     begin
  70.       Bmp := TBitmap.Create;
  71.       try
  72.         Bmp.Assign (Column.Field);
  73.         Canvas.StretchDraw (OutRect, Bmp);
  74.       finally
  75.         Bmp.Free;
  76.       end;
  77.     end
  78.     else if Column.Field is TMemoField then
  79.     begin
  80.       DrawText (Canvas.Handle,
  81.         PChar (Column.Field.AsString),
  82.         Length (Column.Field.AsString),
  83.         OutRect, dt_WordBreak or dt_NoPrefix)
  84.     end
  85.     else // draw single line vertically centered
  86.       DrawText (Canvas.Handle,
  87.         PChar (Column.Field.DisplayText),
  88.         Length (Column.Field.DisplayText),
  89.         OutRect, dt_vcenter or dt_SingleLine or dt_NoPrefix);
  90.   end;
  91. end;
  92. procedure TMdDbGrid.SetLinesPerRow(Value: Integer);
  93. begin
  94.   if Value <> FLinesPerRow then
  95.   begin
  96.     FLinesPerRow := Value;
  97.     LayoutChanged;
  98.   end;
  99. end;
  100. procedure Register;
  101. begin
  102.   RegisterComponents('Md', [TMdDbGrid]);
  103. end;
  104. end.