[VahaC]

Пример оттуда же

Code:

{Предотвратить изменение ширины колонки для TListView}

private
FListViewOldWndProc: TWndMethod;
procedure ListViewNewWndProc(var Msg: TMessage);
end;

{….}

implementation

uses
CommCtrl;

procedure TForm1.FormCreate(Sender: TObject);
begin
//Sichern der ursprunglichen WindowProc der Listview
FListViewOldWndProc := ListView1.WindowProc;

//Subclassing: Umleiten der WindowProc auf unsere eigene Procedur
Listview1.WindowProc := ListViewNewWndProc;
end;

procedure TForm1.ListViewNewWndProc(var Msg: TMessage);
var
hdn: ^THDNotify;
begin
if Msg.Msg = WM_NOTIFY then
begin
hdn := Pointer(Msg.lParam);
//Abfangen und loschen der HDN_BeginTrack Botschaft
if (hdn.hdr.code = HDN_BeginTrackW) or (hdn.hdr.code = HDN_BeginTrackA) then
Msg.Result := 1
else
FListViewOldWndProc(Msg);
end
// ansonsten Botschaft an die ursprungliche WindowProc weiterreichen
else
FListViewOldWndProc(Msg);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
//vor dem Beenden Original WindowProc wiederherstellen
ListView1.WindowProc := FlistViewOldWndProc;
FListViewOldWndProc := nil;
end;

[VahaC]

пример из DRKB

Code:

{
Question:
How do I capture a column resize event in TListView, the OnResize
only works when the ListView is changed?

Answer:
The event can be added with a bit of work. See the custom TListview derivative
below. It has 3 new events:
OnColumnResize, OnBeginColumnResize, OnEndColumnResize
}

unit PBExListview;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls;

type
TLVColumnResizeEvent = procedure(Sender: TCustomListview;
columnindex: Integer;
columnwidth: Integer) of object;
TPBExListview = class(TListview)
private
FBeginColumnResizeEvent: TLVColumnResizeEvent;
FEndColumnResizeEvent: TLVColumnResizeEvent;
FColumnResizeEvent: TLVColumnResizeEvent;

protected
procedure DoBeginColumnResize(columnindex, columnwidth: Integer);
virtual;
procedure DoEndColumnResize(columnindex, columnwidth: Integer);
virtual;
procedure DoColumnResize(columnindex, columnwidth: Integer);
virtual;
procedure WMNotify(var Msg: TWMNotify); message WM_NOTIFY;
function FindColumnIndex(pHeader: pNMHdr): Integer;
function FindColumnWidth(pHeader: pNMHdr): Integer;
procedure CreateWnd; override;
published
property OnBeginColumnResize: TLVColumnResizeEvent
read FBeginColumnResizeEvent write FBeginColumnResizeEvent;
property OnEndColumnResize: TLVColumnResizeEvent
read FEndColumnResizeEvent write FEndColumnResizeEvent;
property OnColumnResize: TLVColumnResizeEvent
read FColumnResizeEvent write FColumnResizeEvent;
end;

procedure Register;

implementation

uses CommCtrl;

procedure Register;
begin
RegisterComponents('PBGoodies', [TPBExListview]);
end;

procedure TPBExListview.DoBeginColumnResize(columnindex, columnwidth: Integer);
begin
if Assigned(FBeginColumnResizeEvent) then
FBeginColumnResizeEvent(Self, columnindex, columnwidth);
end;

procedure TPBExListview.DoEndColumnResize(columnindex, columnwidth: Integer);
begin
if Assigned(FEndColumnResizeEvent) then
FEndColumnResizeEvent(Self, columnindex, columnwidth);
end;

procedure TPBExListview.DoColumnResize(columnindex, columnwidth: Integer);
begin
if Assigned(FColumnResizeEvent) then
FColumnResizeEvent(Self, columnindex, columnwidth);
end;

function TPBExListview.FindColumnIndex(pHeader: pNMHdr): Integer;
var
hwndHeader: HWND;
iteminfo: THdItem;
ItemIndex: Integer;
buf: array [0..128] of Char;
begin
Result := -1;
hwndHeader := pHeader^.hwndFrom;
ItemIndex := pHDNotify(pHeader)^.Item;
FillChar(iteminfo, SizeOf(iteminfo), 0);
iteminfo.Mask := HDI_TEXT;
iteminfo.pszText := buf;
iteminfo.cchTextMax := SizeOf(buf) – 1;
Header_GetItem(hwndHeader, ItemIndex, iteminfo);
if CompareStr(Columns[ItemIndex].Caption, iteminfo.pszText) = 0 then
Result := ItemIndex
else
begin
for ItemIndex := 0 to Columns.Count – 1 do
if CompareStr(Columns[ItemIndex].Caption, iteminfo.pszText) = 0 then
begin
Result := ItemIndex;
Break;
end;
end;
end;

procedure TPBExListview.WMNotify(var Msg: TWMNotify);
begin
inherited;
case Msg.NMHdr^.code of
HDN_ENDTRACK:
DoEndColumnResize(FindColumnIndex(Msg.NMHdr),
FindColumnWidth(Msg.NMHdr));
HDN_BEGINTRACK:
DoBeginColumnResize(FindColumnIndex(Msg.NMHdr),
FindColumnWidth(Msg.NMHdr));
HDN_TRACK:
DoColumnResize(FindColumnIndex(Msg.NMHdr),
FindColumnWidth(Msg.NMHdr));
end;
end;

procedure TPBExListview.CreateWnd;
var
wnd: HWND;
begin
inherited;
wnd := GetWindow(Handle, GW_CHILD);
SetWindowLong(wnd, GWL_STYLE,
GetWindowLong(wnd, GWL_STYLE) and not HDS_FULLDRAG);
end;

function TPBExListview.FindColumnWidth(pHeader: pNMHdr): Integer;
begin
Result := -1;
if Assigned(PHDNotify(pHeader)^.pItem) and
((PHDNotify(pHeader)^.pItem^.mask and HDI_WIDTH) <> 0) then
Result := PHDNotify(pHeader)^.pItem^.cxy;
end;

end.

[VahaC]

MaxWidth, MinWidth ??

или вам перехватывать события?? Если да то точно так как и в стандартном контроле примеры есть в интернете.

[VahaC]

Почему вот в тоталкомандере все очень даже заметно, там выделение делается красным цветом. Мне надо сделать нечто подобное только с учетом того что в скине может быть установлен красный цвет шрифта.

Конечно же есть вариант дать пользователю самому выбрать цвет выделения, но чайники могут с этим не справится.

[VahaC]

ChangeSaturation и ChangeHUE не работает если цвет шрифта черный.

ChangeBrightness работает но выделение как то не очень заметно.

Так что получается что нормально решение нет?

[VahaC]

'Torbins' wrote:

Совсем ничего из Get***Color не подходит?

совсем ничего :(. Выбор то достаточно маленький.

'Torbins' wrote:

Тогда как временным решением можно воспользоваться ChangeHue.

Как ее использовать а то пробую вот так

Code:

Sender.Canvas.Font.Color := ChangeHue(50, TsListView(Sender).SkinData.SkinManager.GetHighLightFontColor(False))

но ничего не получается

[VahaC]

Спасибо ав больше нет.

Но выделения не видно, как я понимаю из-за того что GetHighLightFontColor(False) = GetGlobalFontColor.

так что вопрос остается открытым 🙁

[VahaC]

вот так прога валится при запуске с AV

Code:

if Item.Checked then
Sender.Canvas.Font.Color := TsListView(Sender).SkinData.FSkinManager.GetHighLightFontColor(False)
else
Sender.Canvas.Font.Color := TsListView(Sender).SkinData.FSkinManager.GetGlobalFontColor;

[VahaC]

Спасибо за комментарии, будет время поковыряю

[VahaC]

стало только хуже

теперь неверно рисуется даже при включенных скинах [attachment=4751:mainmenu1.PNG]

[attachment=4752:mainmenu2.PNG]

ПС

правда в design time все рисуется нормально

[VahaC]

Спасибо. Жду с нетерпением.

[VahaC]

1 можно фрагмент кода а то ничего не получается. Вернее получается но пиксели стали белыми и выделение не полу прозразчное

2 действительно

3 можно более детально а то не пойму никак о чем именно речь

[VahaC]

2 KSS

А как на счет OnCompare?

[VahaC]

у меня точно такая ситуация

[VahaC]

'Support' wrote:

Спасибо

Когда он будет доделан, я могу выложить его в пакете ACExtra для общего пользования (по желанию 🙂 ).

Да не за что. Хотелось бы услышать ваши мысли как избавится от выше приведенных багов.

[VahaC]

Короче посидел я поковырял этот компонент и кое чего даже получилось.

Вот архив с тем что получилось [attachment=4698:acVistaPathEdit.zip] (пароль к архиву в личке)

Баги которые мне известны и которые я не знаю как правильно исправить:

• при рисовании выделенного айтема по углах рисуются розовые пиксели (то есть неверно рисуется прозрачность)[*]при быстром переходе от одного таба к другому иногда заметны тормоза при отрисовке выпавшего меню[*]реагирует на смену скинов или их включение только после того как наведешь на него мышь (не знаю как это правильно сделать)

ПС

Прошу прощение у других пользователей за то что архив с паролем, просто не хочу выкладывать недоделанный компонент. Как только завершу работу над ним сразу здесь выложу. Кстати, автор компонента дал разрешение на изменение исходников и дальнейшую их публикацию.

[VahaC]

Quote:

Откомпилить не получилось

Блин я же забыл что у меня исходники компонента изменены (надо было их тоже прикрепить)

Quote:

Програмка, кстати очень симпатичная получилась.

спасибо на добром слове

Quote:

вместо acLV.Items.BeginUpdate нужно использовать acLV.BeginUpdate

еще раз спасибо, все заработало как надо.

[VahaC]

Насколько я понял исправление ожидается в версии 7,40

И кажись она уже в работе

[VahaC]

Ок, буду в асе сегодня где то с часов 12 (по Киеву), там и договиримся.

[VahaC]

Обе.

Quote:

Если отключить скины то у формы пропадает иконка и неверно рисуется меню

касательно меню вы более верно сформулировали проблему

[Author]

Posts