Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Компоненты";
Текущий архив: 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.036 c
14-1127468953
Игорь Шевченко
2005-09-23 13:49
2005.10.16
Мы на горе всем буржуям мировой пожар раздуем...


1-1127723749
Leonid
2005-09-26 12:35
2005.10.16
Delphi обнаружила, что она ворованая ?


14-1127846871
syte_ser78
2005-09-27 22:47
2005.10.16
Посоветуйте программу.


2-1127134150
Fantasy
2005-09-19 16:49
2005.10.16
Сервис HELP


5-1103007155
liver
2004-12-14 09:52
2005.10.16
"Создание компонентов"





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский