Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2002.10.28;
Скачать: [xml.tar.bz2];

Вниз

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;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.57 MB
Время: 0.036 c
1-92609
acorus
2002-10-17 12:37
2002.10.28
Неужели все мастера жмут Ctrl-K-I/U ?


1-92528
Semion
2002-10-16 08:28
2002.10.28
прог


7-92751
CkuB
2002-08-19 00:07
2002.10.28
разрешение принтера


1-92569
SiJack
2002-10-16 12:47
2002.10.28
таблица в QReport без базы данных


1-92601
brestmarket
2002-10-15 12:44
2002.10.28
Как в WebBrowser1 программно переходить от одного якоря (anchor)





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский