Текущий архив: 2002.10.28;
Скачать: CL | DM;

Вниз

DBGrid - несколько строк в заголовке   Найти похожие ветки 

← →
theEnter   (2002-10-18 10:26) [0]

Можно ли в DBGrid сделать в заголовке несколько строк, чтобы в заголовке каждого столбца было несколько строчек(не умещаются их названия)?

---

← →
Игорь Шевченко ©   (2002-10-18 10:40) [1]


{
Демонстрация возможности рисования многострочных заголовков в стандартном
TDBGrid.
Программа была написана на скорую руку, для демонстрации рисования средствами
Windows в той области стандартных компонент, которая обычно недоступна
для рисования из стандартных событий компонента.
В качестве DataSet используется таблица clients.dbf из алиаса DBDEMOS, с
исправленными DisplayLabels для части полей.

Ограничения: Нельзя устанавливать опцию DBGrid dgColSizing, так как при
изменении ширины колонок изменения вертикального размера колонок пропадают.

Автор: Игорь Шевченко.
}
unit Main;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
DBGrids, Grids, ExtCtrls, ImgList, Db, DBTables;

type
TForm1 = class(TForm)
DBGrid1: TDBGrid;
ds: TDataSource;
Table: TTable;
TableLAST_NAME: TStringField;
TableFIRST_NAME: TStringField;
TableACCT_NBR: TFloatField;
TableADDRESS_1: TStringField;
TableCITY: TStringField;
TableSTATE: TStringField;
TableZIP: TStringField;
TableTELEPHONE: TStringField;
TableDATE_OPEN: TDateField;
TableSS_NUMBER: TFloatField;
TablePICTURE: TStringField;
TableBIRTH_DATE: TDateField;
TableRISK_LEVEL: TStringField;
TableOCCUPATION: TStringField;
TableOBJECTIVES: TStringField;
TableINTERESTS: TStringField;
TableIMAGE: TBlobField;
procedure FormShow(Sender: TObject);
procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
procedure FormActivate(Sender: TObject);
private
GridWnd : HWND; // handle окна DBGrid
OldWndProc : Pointer; // старая оконная процедура DBGrid"а
GridTitles : array of Boolean; // массив необходимости перерисовки заголовков.
procedure InvalidateGridTitles; // Принудительная перерисовка всех заголовков
procedure GridWndProc (var Message : TMessage); // Новая оконная процедура
// для DBGrid"а
end;

var
Form1: TForm1;

const
RowCount = 2; { Количество строк в заголовках DBGrid.
Для примера заголовки будут двухстрочными. }



Продолжение следует...

---

← →
Игорь Шевченко ©   (2002-10-18 10:41) [2]

implementation

{$R *.DFM}

function RectHeight (R : TRect) : Integer;
begin
Result := R.Bottom - R.Top;
end;

{ Объявление фиктивного класса для доступа к protected-полям DBGrid }
type
THackGrid = class(TCustomGrid)
public
property RowHeights;
end;

procedure TForm1.FormShow(Sender: TObject);
var I : Integer;
H : Integer;
begin
SetLength(GridTitles, DBGrid1.Columns.Count);
for I:=0 to Pred(DBGrid1.Columns.Count) do begin
DBGrid1.Columns[I].Title.Alignment := taCenter;
GridTitles[I] := false; //Все заголовки надо перерисовывать
end;
{ Определение необходимой высоты первой строки для многострочных заголовков }
H := DbGrid1.Canvas.TextHeight("gW");
THackGrid(DBGrid1).RowHeights[0] := (H + 2) * RowCount;
{ Для того, чтобы при изменении размеров DBGrid"а творчество с заголовками
не пропадало, надо обрабатывать момент, когда DBGrid будет перерисовываться}
GridWnd := DBGrid1.Handle;
OldWndProc := Pointer(GetWindowLong(GridWnd, GWL_WNDPROC));
SetWindowLong(GridWnd, GWL_WNDPROC, Integer(MakeObjectInstance(GridWndProc)));
end;

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);

procedure DrawGridTitle(ColIndex : Integer);
var Titles : array[1..RowCount] of String;
{ Глупое предположение, что в заголовке может быть
только две строки. Исправив здесь, надо исправить
в присваивании высоты колонок заголовка }
ARect : TRect;
RH : Integer; { Высота прямоугольника }
BlankPos : Integer; { Позиция разбиения заголовка }
begin
BlankPos := Pos(" ", Column.Title.Caption);
if BlankPos <> 0 then begin { Рисуем многострочный заголовок только для тех
колонок, у которых есть пробел в названии.
Заголовки остальных колонки DBGrid
нарисует сам. }
Titles[1] := Copy(Column.Title.Caption, 1, BlankPos-1);
Titles[2] := Copy(Column.Title.Caption, BlankPos+1,
Length(Column.Title.Caption) - BlankPos);
RH := RectHeight(Rect);
{ Область для рисования части заголовка. Перемещаем ее в область
заголовков DBGrid, указывая в качестве вертикальных координат 0 }
SetRect(ARect, Rect.Left, 0, Rect.Right, RH);
InflateRect(ARect, -2, -2); { Поправка на окантовку Titles }
Dec(RH, 2);
with DBGrid1.Canvas do begin
Brush.Color := DBGrid1.FixedColor;
FillRect(ARect); { Залить область заголовка, стерев все, что там
нарисовано DBGrid"ом }
{ Рисование первой строки в заголовке }
ARect.Bottom := RH;
DrawText(Handle, PChar(Titles[1]), -1, ARect, DT_CENTER OR DT_SINGLELINE);
{ Рисование второй строки в заголовке }
OffsetRect(ARect, 0, RH-2);
DrawText(Handle, PChar(Titles[2]), -1, ARect,DT_CENTER OR DT_SINGLELINE);
end;
end;
GridTitles[ColIndex] := true; //Нарисовали заголовок для этой колонки
end;

begin
if NOT GridTitles[Column.Index] then
DrawGridTitle(Column.Index);
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
InvalidateGridTitles();
end;

procedure TForm1.InvalidateGridTitles;
var I : Integer;
begin
for I:=0 to Pred(DBGrid1.Columns.Count) do
GridTitles[I] := false;
end;

procedure TForm1.GridWndProc(var Message: TMessage);
begin
case Message.Msg of
WM_ERASEBKGND, WM_VSCROLL:
InvalidateGridTitles();
WM_HSCROLL:
begin
InvalidateGridTitles();
// сожалению, приходится мириться с необходимостью перерисовки всего
// DBGrid"а при горизонтальном скроллинге, иначе, все усилия по рисованию
// многострочных заголовков пропадают :-(
InvalidateRect(GridWnd, nil, true);
end;
end;
with Message do
Result := CallWindowProc(OldWndProc, GridWnd, Msg, wParam, lParam);
end;

end.


---

Страницы: 1 вся ветка

Текущий архив: 2002.10.28;
Скачать: CL | DM;

Наверх

Память: 0.49 MB
Время: 0.013 c