Dziękuję jeszcze raz za cierpliwość i odpowiedzi. Oczywiście tak to jest jak się pisze wątek na szybko przed wyjściem do pracy, a później z pracy już nie ma się dostepu do swojego kodu w łatwy sposób. Problem rozwiązany, a sprawę dodatkowo komplikowało to - o czym zupełnie zapomniałem, iż mam ustawiony ItemHeight
na 18. Co nie zmienia faktu, że najfajnie to będzie ogarnąc sukcesywnie w WinAPI. Ponieważ pod XP na przykład wtedy wszystko się w ListBoxie pokazuje tak samo jak pod siódemką. A pod VCL, Delphi sobie coś tam modzi i pomimo ustawienia Font.Handle czcionka różni się szerokością. Teraz test wypadł ok:
A wprawka WinAPI pod XP również pokazuje wszystko jak należy, dla próby wczytane nazwy sampli z modułu z małym ASCII logo, żeby mieć pewnośc, że wszystkoo jest ogarnięte, tak jak chcę. A stąd te kombinację, bo chcę aby plugin wyświetlał listę sampli/instrumentów w miarę wyraźnym fontem, dlatego tak kombinowałem.
Podsumowując najbardziej naprowadził mnie kod @abrakadaber'a. Poniżej podaję zastosowane rozwiązania wycięte z kodu:
//...
const
Test_FileName = 'C:\PROGRAMY\MODULY\sound_h.mod';
Plugin_Ver = '0.1';
IDC_MAINDLG = 1000;
IDC_SAMPLESLB = 100;
IDC_CONTROLSGB = 101;
IDC_TITLEEDIT = 102;
IDC_SHOWKINDGB = 103;
IDC_SHOWKINDGB_ITEM_1 = 104;
IDC_SHOWKINDGB_ITEM_2 = 105;
IDC_LOOPCBX = 106;
IDC_PLAYBTN = 301;
IDC_PAUSEBTN = 302;
IDC_STOPBTN = 303;
type
TColor = -$7FFFFFFF - 1..$7FFFFFFF;
const
GFX_BASE = 500;
Error_Text = 'Error';
Buttons_Icon_Size = 32;
clLime = TColor($00FF00);
clBlack = TColor($000000);
WM_CHANGEMSGBOX = WM_USER + 555;
Bass_Resource_Name = 'library_bass';
var
Channel : DWORD;
PNewMsgBoxProc, POldMsgBoxProc, POldStaticssProc : Pointer;
ActiveWindowHandle, MainDialogHandle, PlayBtnHandle, SamplesLBHandle : HWND;
procedure OnDrawSamplesLB(DIS : PDrawItemStruct);
var
S : string;
HB : HBRUSH;
Rect : TRect;
begin
S := LBGetItemText(DIS.hwndItem, DIS.itemID);
SetTextColor(DIS.hDC, ColorToRGB(clLime));
HB := CreateSolidBrush(ColorToRGB(clBlack));
SetBkMode(DIS.hDC, TRANSPARENT);
Windows.FillRect(DIS.hDC, DIS.rcItem, HB);
CopyMemory(@Rect, @DIS.rcItem, SizeOf(TRECT));
Windows.TextOut(DIS.hDC, Rect.Left, Rect.Top, PChar(S), Length(S));
end;
function LoadResourceDllAndInit(AHandle : HWND) : boolean;
begin
Result := LoadBassDllFromResource(Bass_Resource_Name);
if not Result then
begin
MessageBox(AHandle, PChar('Resource named "' +
Bass_Resource_Name + '" with bass.dll - invalid! Plugin will be closed.'),
PChar(Error_Text), MB_ICONERROR or MB_OK);
end
else
begin
Result := BASS_Init(-1, 44100, 0, 0, nil);
if not Result then
begin
MessageBox(AHandle, 'Audio initialization error! Plugin will be closed.',
PChar(Error_Text), MB_ICONERROR or MB_OK);
end;
end;
end;
function MainDlgProc(AHWnd : HWND; Msg : UINT; AWParam : WParam; ALParam : LParam) : LRESULT; stdcall;
var
H : HWND;
DC : HDC;
I : integer;
LBFontH : HFONT;
DlgStyles : DWORD;
DrawItem : PDrawItemStruct;
MeasItem : PMEasureItemStruct;
begin
//...
WM_DRAWITEM :
begin
DrawItem := Pointer(ALParam);
case LoWord(AWParam) of
IDC_PLAYBTN, IDC_PAUSEBTN, IDC_STOPBTN :
begin
OnDrawStatics(DrawItem);
end;
IDC_SAMPLESLB :
begin
DrawItem := Pointer(ALParam);
OnDrawSamplesLB(DrawItem);
end;
end;
end;
WM_MEASUREITEM :
begin
MeasItem := Pointer(ALParam);
MeasItem.itemHeight := 18;
end;
//...
WM_INITDIALOG :
begin
LoadSettings;
MainDialogHandle := AHWnd;
SamplesLBHandle := GetDlgItem(AHWnd, IDC_SAMPLESLB);
LBFontH := CreateFont(Round(-12 * 111 / 72), 0, 0, 0, FW_NORMAL, 0, 0, 0,
OEM_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS,
DEFAULT_QUALITY, DEFAULT_PITCH, 'Terminal');
SendMessage(SamplesLBHandle, WM_SETFONT, LBFontH, 1);
if not LoadResourceDllAndInit(AHWnd) then
begin
Halt(5);
end;
Channel := BASS_MusicLoad(False, PChar(Test_FileName), 0, 0, BASS_MUSIC_PRESCAN, 0);
ShowSamplesOrInstrumentsData(0);
LBSetItemIndex(SamplesLBHandle, 0);
//...
Tylko właśnie ważne było to ustawianie ItemIndexu na końcu na zero, bo inaczej pojawiała
się ramka na zerowym elemencie i trzeba było by kliknąc na nią, a później na inny element aby uniknąć zaznaczenia.
Niestety póki co wydając wersję VCL 0.3 pluginu, muszę w niej implementować taki lamerski trick, co będzie jak wspomniałem zbędne raczej w wersji WinAPI. Ale niestety były cyrki z dopasowaniem na szerokość tekstu w ListBoxie pod XP, względem wyglądu na przykład w Windows 7. Nie umiejąc wpaść na inne rozwiązanie zrobiłem tak jak poniżej.
//...
const
SamplesLB_Width_Chars_Count = 32;
//...
function GetTextWidth(TextToCheck : string; GivenTextFont : HFONT) : integer;
var
DC : HDC;
PStr : PChar;
Size : TSize;
begin
Result := 0;
if TextToCheck <> '' then
begin
GetMem(PStr, Length(TextToCheck));
CopyMemory(PStr, PChar(TextToCheck), Length(TextToCheck));
DC := GetDC(0);
SelectObject(DC, GivenTextFont);
GetTextExtentPoint32(DC, PStr, Length(TextToCheck), Size);
ReleaseDC(0, DC);
FreeMem(PStr);
Result := Size.cx;
end;
end;
//...
SamplesLBFontH := CreateFont(Round(-12 * 111 / 72), 0, 0, 0, FW_NORMAL, 0, 0, 0,
OEM_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS,
DEFAULT_QUALITY, DEFAULT_PITCH, 'Terminal');
SamplesLB.Font.Handle := SamplesLBFontH;
TempStr := '';
for I := 1 to SamplesLB_Width_Chars_Count do
begin
TempStr := TempStr + 'C';
end;
SamplesLB.Width := GetTextWidth(AnsiUpperCase(TempStr), SamplesLBFontH);
//...
Także kończąc rozpiskę jak to ja ;P jeszcze raz dziękuję Wam za pomoc i co złego to nie ja ;)