Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Многострочный DBGrid

Автор: Chris Hall

Жена заявляет программисту:
Ж: Дорогой, у меня задержка...
П (не отрываясь от монитора): Хммммм.. ЭТО - БАГ 2000!!!

...я тоже на днях пытался сделать себе такую сеточку. Вначале я думал что можно будет ушибиться, делая такую штуку, но это оказалось совсем простым. Ничего сложного. В TDBGrid необходимо изменять высоту строки и переносить текст, если для его показа нужно более одной строки. Я не стал корежить исходники VCL, а написал своего наследника TDBGrid.

Я добавил дополнительное свойство LinesPerRow. Установка значений данного свойства соответственно изменяет высоту строки, в зависимости от текущего шрифта. Текст в ячейках будет переноситься, если значение LinesPerRow больше чем единица. Все это произведение искусств оказалось чрезвычайно полезным и удивительно простым, так что я публикую его здесь в надежде, что оно пригодится кому-нибудь еще. Код простой, но для его понимания необходимо изучение исходного кода VCL.

Я протестировал данный код и он отлично работал. Небольшая доводка все-же нужна (обработка blob-полей, обработка ошибок и пр.), но это не сложно.


unit Dbmygrid;

interface

uses

  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, DB, DBTables, StdCtrls, ExtCtrls, Grids, DBGrids;

type

  TMultiLineDBGrid = class(TDBGrid)
  private
    FLinesPerRow: Integer;
    procedure DrawDataCell(Sender: TObject; const Rect: TRect; Field: TField;
      State: TGridDrawState);
    procedure LayoutChanged; override;
    procedure SetLinesPerRow(ALinesPerRow: Integer);
  public
    property LinesPerRow: Integer read FLinesPerRow write SetLinesPerRow default
      1;
    constructor Create(AOwner: TComponent); override;
  end;

implementation

constructor TMultiLineDBGrid.Create(AOwner: TComponent);
begin

  inherited Create(AOwner);
  FLinesPerRow := 1;
  OnDrawDataCell := DrawDataCell;
end;

procedure TMultiLineDBGrid.LayOutChanged;
begin

  inherited LayOutChanged;
  DefaultRowHeight := DefaultRowHeight * LinesPerRow;
end;

procedure TMultiLineDBGrid.DrawDataCell(Sender: TObject; const Rect: TRect;
  Field: TField; State: TGridDrawState);
var

  Format: Word;
  C: array[0..255] of Char;
begin

  if LinesPerRow = 1 then
    Format := DT_SINGLELINE or DT_LEFT
  else
    Format := DT_LEFT or DT_WORDBREAK;

  Canvas.FillRect(Rect);

  StrPCopy(C, Field.AsString);
  WinProcs.DrawText(Canvas.Handle, C, StrLen(C), Rect, Format);
end;

procedure TMultiLineDBGrid.SetLinesPerRow(ALinesPerRow: Integer);
begin

  if ALinesPerRow <> FLinesPerRow then
  begin
    FLinesPerRow := ALinesPerRow;
    LayoutChanged;
  end;
end;

end.

Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.