XProfan

###########################
Thema : Subclassing
###########################
Listbox mit Hintergrundbild
###########################
Andreas Miethe
Oktober 2003
###########################
 $H windows.ph
 $H structs.ph
 $H messages.ph
set(FastMode,1)

PROC SetColor

    Parameters wParam&,col&

    IF Brush&

        ~DeleteObject(Brush&)

    endif

    Brush& = ~CreateSolidBrush(Col&)
    RETURN Brush&

endproc

Struct PS = ~PAINTSTRUCT
Struct Rect = ~RECT
Declare Ende&,ListBox&,OldLbProc&,Brush&
Declare hdc&, mDC&, m2DC&, width&, height&, Painting&
Declare Image&,mOldObject&,m2OldObject&,hmBitmap&
Declare PS#,Rect#
DIM PS#,PS
Dim Rect#,Rect

Proc LbProc

    Declare result&
    Parameters Wnd&, Msg&, wParam&, lParam&
    Result& = 0

    If Msg& = ~WM_ERASEBKGND

        Result& = 1

    Elseif Msg& = ~WM_PAINT

        If Painting& = 0

            Painting& = 1
            Result& = ~CallWindowProc(OldLbProc&, wnd&, Msg&, m2dc&,lParam&)
            ~BeginPaint(wnd&, PS#)
            ~GetClientRect(Listbox&,Rect#)
            ~BitBlt(m2dc&, Rect#.Left&,Rect#.Top&,Rect#.right&,Rect#.Bottom&, mDC&,Rect#.Left&,Rect#.Top&, ~SRCAND)
            ~BitBlt(m2dc&, 0, 0, width&, height&, mDC&, 0, 0, ~SRCAND)
            hdc& = ~GetDC(wnd&)
            ~BitBlt(hdc&, Rect#.Left&,Rect#.Top&,Rect#.right&,Rect#.Bottom&, m2DC&,Rect#.Left&,Rect#.Top&, ~SRCCOPY)
            ~BitBlt(hdc&, 0, 0, width&, height&, m2DC&, 0, 0, ~SRCCOPY)
            ~ReleaseDC(wnd&, hdc&)
            ~EndPaint(wnd&, ps#)
            Painting& = 0

        EndIf

    Else

        Result& = ~CallWindowProc(OldLbProc&,Wnd&, Msg&, WParam&, LParam&)

    Endif

    Return Result&

EndProc

CLS ~GetSysColor(~COLOR_BTNFACE)
Image& = ~LoadImage(0,tile.bmp,0,640,480,$10)
width& = 640
height& = 480
hdc& = ~GetDC(%hwnd)
mDC& = ~CreateCompatibleDC(%hdc)
mOldObject& = ~SelectObject(mDC&, hmBitmap&)
mOldObject& = ~SelectObject(mDC&, Image&)
m2DC& = ~CreateCompatibleDC(hdc&)
hmBitmap& = ~CreateCompatibleBitmap(%hdc,width&,height&)
m2OldObject& = ~SelectObject(m2DC&, hmBitmap&)
~ReleaseDC(%hwnd,hdc&)
ClearList
AddFiles *.*
ListBox& = CreateListBox(%hwnd,,0,0,0,0)
~SetWindowPos(ListBox&,0,10,10,300,292,~SWP_SHOWWINDOW)
MoveListToList(ListBox&)
~SendMessage(ListBox&,~WM_SETFONT,~GetStockObject(~DEFAULT_GUI_FONT),0)
OldLbProc& = ~SetWindowLong(ListBox&,~GWL_WNDPROC, ProcAddr(LBProc,4))
RePaint
Usermessages ~WM_CLOSE

Whilenot Ende&

    Waitinput

    If GetFocus(ListBox&)

        SendMessage(Listbox&,~WM_PAINT,0,0)

    Endif

    If %UMessage = ~WM_CLOSE

        ~DeleteObject(Image&)
        Ende& = 1

    Endif

Wend