Maks150988
Advanced Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Код: unit F_DblBuf;
interface
uses
Windows, Messages;
procedure CreateDoubleBufferControlW(hWnd: HWND);
procedure RemoveDoubleBufferControlW(hWnd: HWND);
implementation
type
TCtrlWndProc = function(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
P_CTRL_PRO = ^T_CTRL_PRO;
T_CTRL_PRO = packed record
CtrlProc : TCtrlWndProc;
rcClient : TRect;
hdcMem : HDC;
hbmMem : HBITMAP;
hbmOld : HBITMAP;
end;
var
pcp: P_CTRL_PRO;
//
function CtrlWndProc_WmSize(pcp: P_CTRL_PRO; hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
var
hdcIn: HDC;
begin
GetClientRect(hWnd, pcp.rcClient);
if (pcp.hdcMem <> 0) then
begin
SelectObject(pcp.hdcMem, pcp.hbmOld);
DeleteObject(pcp.hbmMem);
DeleteDC(pcp.hdcMem);
end;
hdcIn := GetDC(hWnd);
pcp.hdcMem := CreateCompatibleDC(hdcIn);
pcp.hbmMem := CreateCompatibleBitmap(
hdcIn,
pcp.rcClient.Right - pcp.rcClient.Left,
pcp.rcClient.Bottom - pcp.rcClient.Top
);
pcp.hbmOld := SelectObject(pcp.hdcMem, pcp.hbmMem);
ReleaseDC(hWnd, hdcIn);
Result := CallWindowProcW(@pcp.CtrlProc, hWnd, uMsg, wParam, lParam);
RedrawWindow(hWnd, nil, 0, RDW_INVALIDATE or RDW_UPDATENOW or RDW_NOERASE);
end;
//
function CtrlWndProc_WmPaint(pcp: P_CTRL_PRO; hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
hdcIn: HDC;
ps : TPaintStruct;
begin
if (wParam = 0) then
hdcIn := BeginPaint(hWnd, ps)
else
hdcIn := wParam;
CallWindowProcW(@pcp.CtrlProc, hWnd, WM_ERASEBKGND, pcp.hdcMem, 0);
CallWindowProcW(@pcp.CtrlProc, hWnd, WM_PRINTCLIENT, pcp.hdcMem, PRF_CLIENT);
BitBlt(
hdcIn,
0,
0,
pcp.rcClient.Right - pcp.rcClient.Left,
pcp.rcClient.Bottom - pcp.rcClient.Top,
pcp.hdcMem,
0,
0,
SRCCOPY
);
if (wParam = 0) then
EndPaint(hWnd, ps);
Result := CallWindowProcW(@pcp.CtrlProc, hWnd, uMsg, wParam, lParam);
end;
//
function CtrlWndProc_WmEraseBkgnd(pcp: P_CTRL_PRO; hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
begin
Result := 1;
end;
//
function CtrlWndProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
pcp := P_CTRL_PRO(GetWindowLongW(hWnd, GWL_USERDATA));
if (pcp = nil) then
begin
Result := DefWindowProcW(hWnd, uMsg, wParam, lParam);
Exit;
end;
case uMsg of
//
WM_DESTROY:
begin
RemoveDoubleBufferControlW(hWnd);
end;
//
WM_SIZE:
begin
Result := CtrlWndProc_WmSize(pcp, hWnd, uMsg, wParam, lParam);
end;
//
WM_PRINTCLIENT,
WM_PAINT:
begin
Result := CtrlWndProc_WmPaint(pcp, hWnd, uMsg, wParam, lParam);
end;
//
WM_ERASEBKGND:
begin
Result := CtrlWndProc_WmEraseBkgnd(pcp, hWnd, uMsg, wParam, lParam);
end;
else
Result := CallWindowProcW(@pcp.CtrlProc, hWnd, uMsg, wParam, lParam);
end;
end;
//
procedure CreateDoubleBufferControlW(hWnd: HWND);
begin
RemoveDoubleBufferControlW(hWnd);
pcp := P_CTRL_PRO(HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, SizeOf(T_CTRL_PRO)));
ZeroMemory(pcp, SizeOf(T_CTRL_PRO));
pcp.CtrlProc := TCtrlWndProc(Pointer(GetWindowLongW(hWnd, GWL_WNDPROC)));
SetWindowLongW(hWnd, GWL_USERDATA, Longint(pcp));
SetWindowLongW(hWnd, GWL_WNDPROC, Longint(@CtrlWndProc));
SendMessageW(hWnd, WM_SIZE, 0, 0);
end;
//
procedure RemoveDoubleBufferControlW(hWnd: HWND);
begin
pcp := P_CTRL_PRO(GetWindowLongW(hWnd, GWL_USERDATA));
if (pcp <> nil) then
begin
if (pcp.hdcMem <> 0) then
begin
SelectObject(pcp.hdcMem, pcp.hbmOld);
DeleteObject(pcp.hbmMem);
DeleteDC(pcp.hdcMem);
end;
SetWindowLongW(hWnd, GWL_WNDPROC, Longint(@pcp.CtrlProc));
RedrawWindow(hWnd, nil, 0, RDW_FRAME or RDW_INVALIDATE or RDW_ERASE);
SetWindowLongW(hWnd, GWL_USERDATA, 0);
HeapFree(GetProcessHeap, 0, pcp);
end;
end;
end. |
|
