Производная TOutline Delphi , Компоненты и Классы , TOutline
Производная TOutline
Автор: Craig Osterloh
Я пытаюсь создать компонент, производный от TOutline и хотел бы
использовать несколько иконок для изображения папок, документов и т.п. Только не
знаю как.
Если установлен стиль otOwnerDraw, вы можете сами отрисовывать компонент. В
этом режиме вы можете вывести какие угодно изображения. Примечание: чтобы
получить OwnerDraw для работы, вы должны установить свойство Scrollbar в
vsVertical.
Затем обрабатывайте событие OnDrawItem для рисования каждой строчки OutLine.
Для получения правильного индекса узла используйте GetItem(Rect.Left,
Rect.Top). Индекс в drawItem неверен.
Вот пример из моего приложения. Надеюсь это вам поможет.
procedure TfrmMain.Outline2DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
Node: TOutlineNode;
NodeIdx: Integer;
Offset: Integer;
NowBitmap: TBitmap;
NowAstValue: string ;
begin
NodeIdx := Outline2.GetItem(Rect.Left, Rect.Top);
Node := Outline2.Items[NodeIdx];
NowAstValue := PAstRec(Outline2.Items[NodeIdx].Data)^.AstValue;
with Outline2.Canvas do
begin
Font.Name := 'MS Sans Serif';
Font.Size := 8;
Offset := MulDiv(Font.Size, 150, 100);
fillRect(Rect);
Rect.Left := Rect.Left + ((Node.Level - 1) * Offset + 2);
if Node.HasItems then
begin
if Node.Expanded then
NowBitmap := Outline2.PictureMinus
else
NowBitmap := Outline2.PicturePlus;
{рисуем иконку}
BrushCopy(Rect, NowBitmap,
Bounds(0, 0, Rect.Right - Rect.Left, Rect.Bottom -
Rect.Top),
NowBitmap.TransparentColor);
end ;
Rect.Left := Rect.Left + Offset + 2;
{выводим текст}
TextOut(Rect.left, Rect.Top, Node.Text);
{создаем суммирующую колонку с правым выравниванием}
Rect.Left := Rect.Right - TextWidth(NowAstValue) - 2;
TextOut(Rect.Left, Rect.Top, NowAstValue);
end ;
end ;
А как работает функция PAstRec() и как получить указатель на
данные?
function TfrmMain.LoadAssetNodes(fName: string ; header: string ): Double;
var
headerIdx: Integer;
NowClientID: string ;
TotAssetValue: Double;
AstRecPtr: PAstRec;
sqlText: string ;
HeadPtr: PAstRec;
begin
with qryAssets do
begin
NowClientID := dtbClients.Fields[0].AsString;
sqlText := 'Select * from ' + fName + ' where ClientID = ' +
NowClientID;
SQL.Clear;
SQL.Add(sqlText);
Open;
First;
TotAssetValue := 0;
new(HeadPtr);
headerIdx := outAssets.AddObject(0, header, HeadPtr);
while not EOF do
begin
new(AstRecPtr);
AstRecPtr^.AstValue := format('%8.0n',
[FieldByName('AssetValue').AsFloat]);
TotAssetValue :=
TotAssetValue + FieldByName('AssetValue').AsFloat;
outAssets.AddChildObject(headerIdx,
FieldByName('AssetName').AsString,
AstRecPtr);
Next;
end ;
HeadPtr^.AstValue := format('%8.0n', [TotAssetValue]);
Result := TotAssetValue;
end ;
end ;
Статья Производная TOutline раздела Компоненты и Классы TOutline может быть полезна для разработчиков на Delphi и FreePascal.
Комментарии и вопросы
Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.
:: Главная :: TOutline ::
