ListView

← →
Сема_ (2007-09-15 11:33) [0]

Уважаемые мастера.
Имеется ListView. Хочется самому прорисовать текс в ячейках, не получается.

procedure TPers_f.GeneralListAdvancedCustomDrawSubItem(
Sender: TCustomListView; Item: TListItem; SubItem: Integer;
State: TCustomDrawState; Stage: TCustomDrawStage;
var DefaultDraw: Boolean);
var
dbitmap:TBitmap;
begin
if (SubItem = 1) then
begin
DBitmap:=TBitmap.Create;
DBitmap.Assign(Image1.Picture.Bitmap);
DBitmap.TransparentColor:=$00000000;
DBitmap.Transparent:=True;
Sender.Canvas.Draw(Item.Left+8,Item.Top-1,Image1.Picture.Bitmap);
DBitmap.Free;
end else
if (SubItem > 1) then
begin
Не знаю, как получить параметр TRect и текст соответ. ячейки
DrawText();
end;
end;

Заранее спасибо.

← →
Lacmus © (2007-09-15 11:54) [1]

Использовать сообщение LVM_GETSUBITEMRECT

← →
Сема_ (2007-09-15 12:11) [2]

Попробывал, что-то не так:
var
prc: PRect;
s:String;
if (SubItem > 1) then
begin
New(prc);
s:="jjjj";
SendMessage(Sender.Canvas.Handle, LVM_GETSUBITEMRECT, SubItem, Longint(Prc));
DrawText(Sender.Canvas.Handle,PChar(s),Length(s),prc^,dt_Center);
Dispose(prc);
end;

← →
Lacmus © (2007-09-15 12:24) [3]

prc необходимо инициализировать

Parameters iItem Index of the subitem"s parent item. lpRect Pointer to a RECT structure that will receive the subitem bounding rectangle information. Its members must be initialized according to the following member/value relationships: top The one-based index of the subitem. left Flag value (see remarks). Indicates the portion of the list-view subitem for which to retrieve the bounding rectangle.

← →
Сема_ (2007-09-15 12:33) [4]

А как в данном случае проинициализировать prc, если он указатель на TRect.
А там явно таких параметров нет.
Что нужно изменить в моем коде ?

← →
Lacmus © (2007-09-15 12:39) [5]

procedure TForm57.Button3Click(Sender: TObject); var Rect: TRect; begin Rect.Left := LVIR_BOUNDS; Rect.Top := 1; SendMessage(ListView1.Handle, LVM_GETSUBITEMRECT, 1, LParam(@Rect)); with Rect do ShowMessage(Format("%d-%d-%d-%d", [Left, Top, Right, Bottom])) end;

← →
Сема_ (2007-09-15 12:53) [6]

Этот код только для одной строчки (в Rect.Top вставляется SubItem).
А как его использовать на остальные строки.

← →
Lacmus © (2007-09-15 13:20) [7]

procedure TForm57.Button3Click(Sender: TObject); var i, j: Integer; Item: TListItem; Rect: TRect; begin Memo1.Lines.Clear; for i := 0 to ListView1.Items.Count - 1 do begin Item := ListView1.Items[i]; for j := 0 to Item.SubItems.Count - 1 do begin Rect.Left := LVIR_BOUNDS; Rect.Top := j + 1; SendMessage(ListView1.Handle, LVM_GETSUBITEMRECT, i, LParam(@Rect)); with Rect do Memo1.Lines.Add(Item.SubItems[j] + ": " + Format("%d-%d-%d-%d", [Left, Top, Right, Bottom])) end end end;

> [6] Сема_ (15.09.07 12:53)

function ListView_GetSubItemRect(hwndLV: HWND; iItem, iSubItem: Integer; code: DWORD; prc: PRect): BOOL; begin if prc <> nil then begin prc^.Top := iSubItem; prc^.Left := code; end; Result := BOOL(SendMessage(hwndLV, LVM_GETSUBITEMRECT, iItem, Longint(prc))); end;

ListView_GetSubItemRect - это уже написано в commctrl.pas
использование:
var R: TRect; begin ListView_GetSubItemRect(<ListView>.Handle, Item.Index, SubItem, LVIR_BOUNDS, @R);

← →
Сема_ (2007-09-15 13:55) [9]

Большое спасибо.
Только возникла еще проблема:
если ставишь OwnerData:=True - данные исчезают,но шрифт нормальный;
если OwnerData:=False - системный шрифт, который не нужен.
Как от него избавиться?

> [9] Сема_ (15.09.07 13:55)
> Как от него избавиться?

Поставь в конец своего обработчика(хххDrawXxx) вот эту "штуку":
with Sender.Canvas.Font do
if Assigned(OnChange) then OnChange(Sender.Canvas.Font);

ListView Найти похожие ветки