unit uListBox;
interface
uses Windows, Classes, Messages, uGlobal, uGDIUnit, uSkin, uDrawText,
uBass, uBassVis, BassVis, SysUtils, StrUtils;
type
TListBox =
class
private
FHOwner : HWND;
LStyle: DWORD;
hFDefault: HWND;
procedure SubClass(WinHandle: HWND);
procedure UnSubClass(WinHandle: HWND);
function DefaultFont: hFont;
procedure SetCTLFont(hCtL: HWND; Font: hFont);
public
constructor Create(hOwner: HWND; FullpathImageName:
string; x, y, xW, yH,
PlayListID: integer; BackColor: COLORREF);
destructor Destroy;
override;
end;
type
LBTYPE =
Record
Forecolor : COLORREF;
Backcolor : COLORREF;
ForeColorSelected : COLORREF;
BackColorSelected : COLORREF;
BorderStyle : Integer;
DrawStyle : Integer;
ItemHeight : Integer;
hWnd : HWND;
Left : Integer;
Top : Integer;
Width : Integer;
Height : Integer;
hFont : HFONT;
end;
var
TMListBox: LBTYPE;
TempFont: GpFont;
Img: cardinal;
function ListBoxProc(WinHandle: HWND; Msg: UINT; wP: WParam; lP: LParam): LRESULT;
stdcall;
procedure DrawItem(lP: Integer);
implementation
uses uMainApp;
var
PrevWndProc, PrevWndProcLB: Integer;
// Erstelle den Default Font.
function TListBox.DefaultFont: hFont;
begin
if hFDefault = 0
then
hFDefault := GetStockObject(ANSI_VAR_FONT);
Result := hFDefault;
end;
// Setze den verwendeten Font zum ausgewählten Control.
procedure TListBox.SetCTLFont(hCtL: HWND; Font: hFont);
begin
SendMessage(hCtL, WM_SETFONT, Font, 0);
end;
constructor TListBox.Create(hOwner: HWND; FullpathImageName:
string; x, y, xW, yH,
PlayListID: integer; BackColor: COLORREF);
begin
with SkinEngine
do
begin
// Erstelle das GDIPLUS image von Datei
Img := AddResource(PAnsiChar(FullpathImageName));
if Img <> 0
then
begin
// Hole die Thumb GDIPLUS image größe
GetImageSize(Img, imgW, imgH);
// LBS_NOTIFY übergeben ohne wird kein Event
// auf LBN_DBLCLK ausgelößt
// LBS_OWNERDRAWFIXED verursacht ärger keine ahnung warum
LStyle := LBS_HASSTRINGS
{Or LBS_OWNERDRAWFIXED} Or
LBS_NOINTEGRALHEIGHT
Or LBS_NOTIFY
or WS_CHILD
Or WS_BORDER
Or WS_VSCROLL;
// Propertys der Listbox festlegen
TMListBox.Forecolor := GetSysColor(COLOR_BTNTEXT);
TMListBox.Backcolor :=
RGB(255, 255, 255);
TMListBox.ForeColorSelected := GetSysColor(COLOR_HIGHLIGHTTEXT);
TMListBox.BackColorSelected := GetSysColor(COLOR_HIGHLIGHT);
TMListBox.BorderStyle := EDGE_RAISED;
TMListBox.Left := x;
TMListBox.Top := y;
TMListBox.Width := xW;
TMListBox.Height := yH;
// ListBox erstellen
TMListBox.hWnd := CreateWindowEx(WS_EX_CLIENTEDGE
or WS_EX_TRANSPARENT,
SKLISTBOX,
nil, LStyle, TMListBox.Left, TMListBox.Top, TMListBox.Width, TMListBox.Height,
hOwner, PlayListID, skInstance,
nil);
if TMListBox.hWnd <> 0
then
begin
// HinterGrundBitmap ListBox
SetImageProperty(TMListBox.hWnd, PROP_IMAGE_BACK, Img);
// Font erstellen
TMListBox.hFont := DefaultFont;
SetCTLFont(TMListBox.hWnd, TMListBox.hFont);
// Font Object entfernen
DeleteObject(TMListBox.hFont);
// Itemhöhe zuweisen
TMListBox.ItemHeight := 16;
SendMessage(TMListBox.hWnd, LB_SETITEMHEIGHT, 0, TMListBox.ItemHeight);
// DrawStyle zuweisen
TMListBox.DrawStyle := CreateSolidBrush(TMListBox.Backcolor);
FHOwner := hOwner;
SubClass(FHOwner);
end else
// Image löschen wenn Fehler
DeleteResource(Img);
end;
end;
end;
destructor TListBox.Destroy;
begin
UnSubClass(FHOwner);
inherited Destroy;
end;
procedure DrawItem(lP: Integer);
var
PDis: PDrawItemStruct;
DTP: TDRAWTEXTPARAMS;
BColor,
FColor: COLORREF;
hBrush: Integer;
ItemText: PChar;
l: Integer;
begin
CopyMemory(@PDis, @lP, SizeOf(@PDis));
ItemText :=
nil;
If PDis.itemState <> 0
And ODS_SELECTED
Then
begin
BColor := SetBkColor(PDis.hDC, TMListBox.BackColorSelected);
hBrush := CreateSolidBrush(TMListBox.BackColorSelected);
FColor := SetTextColor(PDis.hDC, TMListBox.ForeColorSelected);
end else
begin
BColor := SetBkColor(PDis.hDC, TMListBox.Backcolor);
hBrush := CreateSolidBrush(TMListBox.Backcolor);
FColor := SetTextColor(PDis.hDC, TMListBox.Forecolor);
end;
//Img := SkinEngine.GetProperty(TMListBox.hWnd, PROP_IMAGE_BACK);
//SkinEngine.GetImageSize(Img, ImgW, ImgH);
//BitBlt(PDis.hDC, PDis.rcItem.Left + 4, PDis.rcItem.Top + 1, 13, 11,
// GetDc(Img.Handle), 0, 0, SRCCopy);
PDis.rcItem.Left := PDis.rcItem.Left + 20;
FillRect(PDis.hDC, PDis.rcItem, hBrush);
l := SendMessage(TMListBox.hWnd, LB_GETTEXTLEN, PDis.itemID, 0);
if l > 0
Then
begin
GetMem(ItemText, l + 1);
SendMessage(TMListBox.hWnd, LB_GETTEXT, PDis.itemID, integer(ItemText));
end;
DTP.cbSize := SizeOf(DTP);
DrawTextEx(PDis.hDC, ItemText, l, PDis.rcItem, DT_LEFT
Or DT_VCENTER
Or DT_SINGLELINE, @DTP);
SetTextColor(PDis.hDC, FColor);
SetBkColor(PDis.hDC, BColor);
DeleteObject(hBrush);
CopyMemory(@lP, @PDis, SizeOf(@PDis));
end;
function WndProc(WinHandle: HWND; Msg: UINT; wP: WParam; lP: LParam): LRESULT;
stdcall;
var
hList : HWND;
nItem: Integer;
begin
with SkinEngine
do
begin
case msg
of
WM_COMMAND:
begin
case HiWord(wP)
of
LBN_DBLCLK:
begin
nItem := ListGetCurSel(TMListBox.hWnd);
hList := GetMainItem(ID_PLAYLISTBOX);
ListSelectPlus(hList, nItem);
if nItem > 0
then
begin
hList := GetMainItem(ID_PLAYLISTBOX);
getAudioFile := ListGetText(hList, nItem);
BassChannelPlay;
end;
end;
end;
case LoWord(wP)
of
IDM_PlayList:
begin
hList := GetMainItem(ID_PLAYLIST);
if isWindowVisible(hList)
then
begin
VisBassVis.StartVis(PAnsiChar(PlgFilename));
ShowWindow(hList, SW_HIDE)
end else
begin
VisBassVis.StopVis;
SetAnchorMode(hList, ANCHOR_HEIGHT_WIDTH);
SetZorder(hList, HWND_TOP);
ShowWindow(hList, SW_SHOW);
end;
nItem := LastPlayListTitle;
ListSelectPlus(hList,nItem);
end;
end;
end;
WM_MOUSEWHEEL:
begin
hList := GetMainItem(ID_PLAYLIST);
if isWindowVisible(hList)
then
SendMessage(hList, Msg, wP, lP);
end;
WM_CTLCOLORLISTBOX:
begin
Result := TMListBox.DrawStyle;
exit;
end;
WM_ERASEBKGND:
begin
Result := 1;
exit;
end;
WM_DRAWITEM:
begin
DrawItem(lP);
//Problem geht auf Main WinProc
Result := CallWindowProc(Pointer(PrevWndProc), WinHandle, Msg, wP, lP);
exit;
end;
end;
Result := CallWindowProc(Pointer(PrevWndProc), WinHandle, Msg, wP, lP);
end;
end;
procedure TListBox.SubClass(WinHandle: HWND);
begin
PrevWndProc := SetWindowLong(WinHandle, GWL_WNDPROC, integer(@WndProc));
PrevWndProcLB := SetWindowLong(TMListBox.hWnd, GWL_WNDPROC, integer(@ListBoxProc));
end;
procedure TListBox.UnSubClass(WinHandle: HWND);
begin
SetWindowLong(WinHandle, GWL_WNDPROC, PrevWndProc);
SetWindowLong(TMListBox.hWnd, GWL_WNDPROC, integer(@ListBoxProc));
end;
function ListBoxProc(WinHandle: HWND; Msg: UINT; wP: WParam; lP: LParam): LRESULT;
stdcall;
begin
Result := CallWindowProc(Pointer(PrevWndProcLB), WinHandle, Msg, wP, lP);
end;
end.