Cześć.
Otóż mój plugin .wlx dla Total Commandera po wielu testach działa i przepisany w pełni dla WinAPI. Jednak zanim puszczę jego wersję 0.4 na totalcmd.net to chcę spróbować dopracować jedną rzecz. Mianowicie w swoim pluginie do wyświetlania sampli używam ListBox'a, który tworzę tak:
SamplesLBHandle := CreateWindowEx(WS_EX_CLIENTEDGE, 'ListBox', '',
WS_CHILDWINDOW or WS_VISIBLE or WS_BORDER or WS_VSCROLL or LBS_HASSTRINGS,
SamplesLB_Left, SamplesLB_Top, SamplesLB_Width, SamplesLB_Height,
MainWindowHandle, IDC_SAMPLESLB, HInstance, nil);
Sample wyświetlam tak:
//...
Channel : DWORD;
ChannelInfo : BASS_CHANNELINFO;
procedure TPluginObj.ShowSamplesOrInstrumentsData(GBIndex : Byte);
const
Kinds_Arr_Prefix : array[0..1] of string = ('S', 'I');
Kinds_Arr : array[0..1] of DWORD = (BASS_TAG_MUSIC_SAMPLE, BASS_TAG_MUSIC_INST);
var
SmpNum : WORD;
SmpName : PChar;
begin
SmpNum := 0;
LBClear(SamplesLBHandle);
if GBIndex in [0..1] then
begin
SmpName := PChar(BASS_ChannelGetTags(Channel, Kinds_Arr[GBIndex] + SmpNum));
while SmpName <> nil do
begin
LBAddString(SamplesLBHandle, FormatC(Sample_Names_Format, Kinds_Arr_Prefix[GBIndex], SmpNum + 1, SmpName));
SmpNum := SmpNum + 1;
SmpName := PChar(BASS_ChannelGetTags(Channel, Kinds_Arr[GBIndex] + SmpNum));
end;
end;
end;
Przy ładowaniu kolejnych modułów nie tworzone jest nowe okno, zgodnie z prawidłami użycia eksportowanej przez plugin funkcji ListLoadNext i ListLoadNextW. Dodatkowo poprzedni moduł jest zwalniany przez BASS_MusicFree(Channel). I teraz kiedy tworzę ListBox bez stylu LBS_OWNERDRAWFIXED to wszystko jest ok, mogę odtwarzać w szybkim podglądzie wiele modułów wiele razy i nic się nie zcrashuje.
Crash objawia się tym, że plugin traci tło pod częścią kontrolek, znikają obrazki na staticach i po zamknięciu podglądu i próbie otwarcia kolejnego modułu muzycznego nie widać pluginu w oknie tylko słychać odtwarzany moduł, a czasem i następuje w ogóle zamknięcie samego Total Commandera.
A zależy mi na własnym rysowaniu ListBoxa z jednego prostego względu, chciałbym uzyskać przezroczysty pasek zaznaczenia. Chyba, że da się to osiągnąć inaczej niż przez samodzielne rysowanie. Rysowanie odbywa się poprzez komunikatu WM_DRAWITEM w funkcji obsługi okna głownego. Czyli wygląda to tak:
procedure TPluginObj.OnDrawSamplesLB(DIS : PDrawItemStruct);
var
S : string;
begin
S := LBGetItemText(DIS.hwndItem, DIS.itemID);
if (DIS.itemAction = ODA_FOCUS) and (DIS.itemState and ODS_FOCUS > 0) then
begin
SetTextColor(DIS.hDC, ColorToRGB(ForeColor));
SetBkColor(DIS.hDC, ColorToRGB(BackColor));
FillRect(DIS.hDC, DIS.rcItem, CreateSolidBrush(ColorToRGB(BackColor)));
end
else
begin
SetTextColor(DIS.hDC, ColorToRGB(ForeColor));
SetBkMode(DIS.hDC, TRANSPARENT);
FillRect(DIS.hDC, DIS.rcItem, CreateSolidBrush(ColorToRGB(BackColor)));
end;
DrawTextEx(DIS.hDC, PChar(S), Length(S), DIS.rcItem, DT_LEFT, nil);
if DIS.itemState and ODS_FOCUS > 0 then
begin
DrawFocusRect(DIS.hDC, DIS.rcItem);
end;
end;
procedure TPluginObj.MainWndProc(var AMessage : TMessage);
var
DC : HDC;
R : TRect;
HB : HBRUSH;
DefaultWidth : integer;
WinPos : ^TagWindowPos;
DrawItem : PDrawItemStruct;
PaintStruct : TPaintStruct;
MeasureItem : PMEasureItemStruct;
begin
with AMessage do
begin
Result := 0;
case Msg of
WM_DRAWITEM :
begin
DrawItem := Pointer(LParam);
OnDrawSamplesLB(DrawItem);
end;
WM_MEASUREITEM :
begin
MeasureItem := Pointer(LParam);
MeasureItem.itemHeight := SamplesLB_ItemHeight;
end;
//...
Wszystkie funkcje obsługi okna są przypisane przez MakeObjectInstance, którego kod "wyprułem" sobie ze źródel VCL dla Delphi 7 Enterprise. I dla otwarcia killku plików jest ok, ale próba otwarcia (oczywiście poprzedni jest zwalniany) po sobie kilkudziesięciu lub kilkuset to crash. A docelowo do tego plugin ma służyć. Prosił bym o poradę, jak można usprawnić rysowanie. Moze coś robię nie tak.
Dodam, że gdy początkowo plugin był napisany pod VCL, robiły się identyczne "cyrki". Pokazywał mi się wyjątki. Kodu VCL już nie mam. Ale tam robiłem rysowanie w taki sposób:
procedure TModulesPlayerForm.SamplesLBDrawItem(Control : TWinControl; Index : Integer;
Rect : TRect; State : TOwnerDrawState);
var
MyBrush : TBrush;
begin
MyBrush := TBrush.Create;
with (Control as TListBox).Canvas do
begin
MyBrush.Style := bsSolid;
MyBrush.Color := SamplesLB.Color;
(Control as TListBox).Canvas.Font.Color := SamplesLB.Font.Color;
Windows.FillRect(handle, Rect, MyBrush.Handle);
Brush.Style := bsClear;
TextOut(Rect.Left, Rect.Top, (Control as TListBox).Items[Index]);
MyBrush.Free;
end;
end;
I zdaje się, że powodowalo to wyjątek znajdujący się w kodzie VCL modułu graphics.pas poniżej. Jednak kiedy dodawałem sprawdzenie czy Canvas.Handle > 0 to nic nie dawało. U siebie w kodzie też dla pewności dodałem sprawdzanie czy DC pobrane z WParam jest różne od zera. Oczywiście bez powodzenia.
procedure TCanvas.RequiredState(ReqState: TCanvasState);
var
NeededState: TCanvasState;
begin
NeededState := ReqState - State;
if NeededState <> [] then
begin
if csHandleValid in NeededState then
begin
CreateHandle;
if FHandle = 0 then
raise EInvalidOperation.CreateRes(@SNoCanvasHandle);
end;
if csFontValid in NeededState then CreateFont;
if csPenValid in NeededState then CreatePen;
if csBrushValid in NeededState then CreateBrush;
State := State + NeededState;
end;
end;
Prosil bym o doradzenie mi. Jeżeli z Waszymi radami nie uda się ogarnąć problemu, to trudno. Będę musiał pogodzić się z ListBox'em, ktorego kolor zaznaczenia psuje efekt wizualny. Dodam, że kolory dla tła oraz dla fontu tekstów można zmienić z domyślnych clBlack i clLime na takie, jakie user ma ustawione (jeśli śą) w preferencjach dla Listera. Jednak wtedy efekt, ładnego wyglądu psuje właśnie wypełniona ramka zaznaczenia ListBoxa.