Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2005.10.16;
Скачать: CL | DM;

Вниз

Помогите с наследником 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;
Скачать: CL | DM;

Наверх




Память: 0.48 MB
Время: 0.036 c
4-1124229187
SuperMatser
2005-08-17 01:53
2005.10.16
Проблема с цветом!!!!!!!!!!!!!!! WinAPi


2-1125984829
voyage_rost
2005-09-06 09:33
2005.10.16
базы данных


2-1126686038
JTAG
2005-09-14 12:20
2005.10.16
Про tray


6-1111927099
Nes
2005-03-27 16:38
2005.10.16
IdUDPClient &amp; IdUDPServer ==> Вешаться или подскажите?


4-1124115667
NikNet
2005-08-15 18:21
2005.10.16
ListBox с иконками слева?