Форум: "Компоненты";
Текущий архив: 2005.10.16;
Скачать: [xml.tar.bz2];
ВнизПомогите с наследником DBGrid Найти похожие ветки
← →
diabolik_krsk (2004-11-25 09:08) [0]Пишу следующий наследник компонента DBGrid:
procedure THSDBGrid.DrawCell(ACol, ARow: Integer; ARect: TRect;
State: TGridDrawState);
var
TitleText : String; { Полный заголовок }
Titles : array of String; { Части заголовка }
{ Разбиение полного заголовка на части с возвращением числа получившихся
частей }
function SplitTitle : Integer;
const
TitleSeparator = " "; { Можно этот символ вынести в published property }
var
CurPos, J: Integer;
CurStr: string;
begin
SetLength(Titles, FTitleLines);
{ Определяем, сколько реально строк присутсвует в заголовке.
Просто считается количество символов TitleSeparator }
J := 0;
CurStr:= TitleText;
repeat
CurPos:= Pos(TitleSeparator, CurStr);
if (CurPos > 0) and (J < Pred(FTitleLines)) then begin
Titles[J] := Copy(CurStr, 1, Pred(CurPos));
CurStr:= Copy(CurStr, CurPos+Length(TitleSeparator),
Length(CurStr)-CurPos-Length(TitleSeparator)+1);
Inc(J);
end else begin
Titles[J] := CurStr;
if J >= Pred(FTitleLines) then { Не надо копировать больше, чем может
вместить заголовок }
Break;
end;
until CurPos=0;
Result := J+1;
end;
var
DataCol, I, TitleParts : Integer;
TextRect : TRect;
LineHeight : Integer;
begin
if (dgTitles in Options) AND (gdFixed in State) AND (ARow = 0) AND
(ACol <> 0) then begin
{ Должна быть нарисована ячейка заголовка }
{ Стандартное действие DBGrid }
if csLoading in ComponentState then begin
Canvas.Brush.Color := Color;
Canvas.FillRect(ARect);
Exit;
end;
DataCol := ACol;
if dgIndicator in Options then
Dec(DataCol);
{ Изменение размеров области заголовка под окантовку, если хочется сделать
плоские заголовки, то InflateRect надо пропустить }
if [dgRowLines, dgColLines] * Options = [dgRowLines, dgColLines] then
InflateRect(ARect, -1, -1);
TitleText := Columns[DataCol].Title.Caption;
Canvas.Brush.Color := FixedColor;
{ Если захочется сделать прозрачный заголовок, то вызов FillRect надо будет
пропустить }
{ Если будет желание рисовать фоновую картинку в области заголовка, то
нарисовать ее можно здесь }
Canvas.FillRect(ARect);
{ Теперь можно нарисовать собственно текст }
Canvas.Font := Font;
if FTitleLines = 1 then begin
WriteText (Canvas, ARect, 1, 1, TitleText,
Columns[DataCol].Title.Alignment);
end else begin
TitleParts := SplitTitle();
TextRect := ARect;
LineHeight := RectHeight(ARect) DIV TitleParts;
TextRect.Bottom := TextRect.Top + LineHeight;
for I:=0 to Pred(TitleParts) do begin
WriteText (Canvas, TextRect, 1, 0, Titles[I],
Columns[DataCol].Title.Alignment);
OffsetRect(TextRect, 0, LineHeight);
end;
end;
{ Окантовка ячейки заголовка, если хочется сделать плоские заголовки,
то DrawEdge надо пропустить }
if [dgRowLines, dgColLines] * Options = [dgRowLines, dgColLines] then begin
InflateRect(ARect, 1, 1);
DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_BOTTOMRIGHT);
DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_TOPLEFT);
end;
DoDrawTitleCell (DataCol, Columns[DataCol], ARect);
end else
inherited;
end;
Однако при компиляции возникают ошибки!!
Undeklared Identifier WriteText
Undeklared Identifier DoDrawTitleCell
Undeklared Identifier RectHeight
Подскажите как их описать чтобы не возникало ошибок компиляции и был рабочий код.
← →
Pentium133 © (2004-11-25 13:11) [1]Раз этот код написал ТЫ, то тебе должно быть виднее где у тебя находятся эти процедуры...
← →
diabolik_krsk (2004-11-26 04:50) [2]Вдохновляющий ответ.
Но если в общем, то код писал не я лично. А вот рабочий экземпляр я нашел.
Спасибо за внимание.
← →
Игорь Шевченко © (2004-12-13 09:58) [3]А что, в статье рабочего примера нету ? :)))
Страницы: 1 вся ветка
Форум: "Компоненты";
Текущий архив: 2005.10.16;
Скачать: [xml.tar.bz2];
Память: 0.46 MB
Время: 0.04 c