MdDbGrid.pas
资源名称:delphi.rar [点击查看]
上传用户:fh681027
上传日期:2022-07-23
资源大小:1959k
文件大小:3k
源码类别:
Delphi控件源码
开发平台:
Delphi
- unit MdDbGrid;
- interface
- uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- Grids, DBGrids, Db;
- type
- TMdDbGrid = class(TDbGrid)
- private
- FLinesPerRow: Integer;
- procedure SetLinesPerRow (Value: Integer);
- protected
- procedure DrawColumnCell(const Rect: TRect; DataCol: Integer;
- Column: TColumn; State: TGridDrawState); override;
- procedure LayoutChanged; override;
- public
- constructor Create (AOwner: TComponent); override;
- published
- property LinesPerRow: Integer
- read FLinesPerRow write SetLinesPerRow
- default 1;
- end;
- procedure Register;
- implementation
- constructor TMdDbGrid.Create(AOwner: TComponent);
- begin
- inherited Create(AOwner);
- FLinesPerRow := 1;
- 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;
- 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);
- // 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 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;
- procedure TMdDbGrid.SetLinesPerRow(Value: Integer);
- begin
- if Value <> FLinesPerRow then
- begin
- FLinesPerRow := Value;
- LayoutChanged;
- end;
- end;
- procedure Register;
- begin
- RegisterComponents('Md', [TMdDbGrid]);
- end;
- end.