Maks150988
Advanced Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
program trackbar;
uses
Windows, Messages, CommCtrl;
const
szClassName = 'Trackbar_Ownerdraw';
WindowWidth = 185;
WindowHeight = 80;
IDC_TRACKBAR = 100;
var
OldWndProc : Pointer;
function IntToStr(I : Integer) : String;
begin
Str(I, Result);
end;
function NewWndProc(Trkb : HWND; uMsg : UINT; wParam : WPARAM; lParam : LPARAM) : LRESULT; stdcall;
begin
Result := 0;
case uMsg of
WM_MOUSELEAVE :
begin
end;
// WM_MOUSEMOVE :
// begin
// end;
else
Result := CallWindowProc(OldWndProc, Trkb, uMsg, wParam, lParam);
end;
end;
procedure PaintItemTrackbar(DC : HDC; RC : Trect; clrBr, clrPen : COLORREF);
var
BrushNew : HBRUSH;
BrushOld : HBRUSH;
PenBrush : HPEN;
begin
BrushNew := CreateSolidBrush(clrBr);
BrushOld := SelectObject(DC, BrushNew);
FillRect(DC, RC, BrushNew);
PenBrush := CreatePen(PS_SOLID, 1, clrPen);
SelectObject(DC, PenBrush);
Rectangle(DC, RC.Left, RC.Top, RC.Right, RC.Bottom);
DeleteObject(PenBrush);
SetBkColor(DC, clrBr);
SetBkMode(DC, TRANSPARENT);
SelectObject(DC, BrushOld);
DeleteObject(BrushNew);
end;
function MainWndProc(hWnd : HWND; uMsg : UINT; wParam : WPARAM; lParam : LPARAM) : LRESULT; stdcall;
var
Value : Integer;
begin
Result := 0;
case uMsg of
WM_CREATE :
begin
CreateWindowEx(0, TRACKBAR_CLASS, '', TBS_HORZ or WS_CHILD or WS_VISIBLE or WS_TABSTOP or WS_CLIPCHILDREN, 15, 15, 150, 20, hWnd, IDC_TRACKBAR, hInstance, nil);
SendMessage(GetDlgItem(hWnd, IDC_TRACKBAR), TBM_SETRANGE, Integer(TRUE), MAKELONG(0, 30));
SendMessage(GetDlgItem(hWnd, IDC_TRACKBAR), TBM_SETPAGESIZE, 0, 5);
SendMessage(GetDlgItem(hWnd, IDC_TRACKBAR), TBM_SETTIC, 0, 5);
SendMessage(GetDlgItem(hWnd, IDC_TRACKBAR), TBM_SETTIC, 0, 10);
SendMessage(GetDlgItem(hWnd, IDC_TRACKBAR), TBM_SETTIC, 0, 15);
SendMessage(GetDlgItem(hWnd, IDC_TRACKBAR), TBM_SETTIC, 0, 20);
SendMessage(GetDlgItem(hWnd, IDC_TRACKBAR), TBM_SETTIC, 0, 25);
OldWndProc := Pointer(SetWindowLong(GetDlgItem(hWnd, IDC_TRACKBAR), GWL_WNDPROC, LongInt(@NewWndProc)));
end;
WM_HSCROLL :
case LoWord(wParam) of
TB_PAGEUP, TB_LINEUP, TB_LINEDOWN, TB_PAGEDOWN, TB_TOP, TB_BOTTOM, TB_ENDTRACK, TB_THUMBPOSITION, TB_THUMBTRACK :
begin
Value := SendMessage(GetDlgItem(hWnd, IDC_TRACKBAR), TBM_GETPOS, 0, 0);
Value := Value - 15;
SendMessage(hWnd, WM_SETTEXT, 0, Integer(PChar(IntToStr(Value))));
end;
end;
WM_NOTIFY :
begin
with PNMHdr(lParam)^ do
if PNMHdr(lParam).idFrom = IDC_TRACKBAR then
begin
case PNMHdr(lParam)^.code of
NM_CUSTOMDRAW :
begin
with PNMLVCUSTOMDRAW(lParam)^ do
begin
case nmcd.dwDrawStage of
CDDS_PREPAINT :
begin
Result := CDRF_NOTIFYITEMDRAW;
SetWindowLong(hWnd, DWL_MSGRESULT, CDRF_NOTIFYITEMDRAW or CDRF_NOTIFYPOSTPAINT);
end;
CDDS_ITEMPREPAINT :
begin
case nmcd.dwItemSpec of
TBCD_CHANNEL :
begin
PaintItemTrackbar(nmcd.HDC, nmcd.rc, RGB(200, 215, 240), RGB(50, 105, 200));
Result := CDRF_SKIPDEFAULT;
end;
TBCD_THUMB :
begin
if (nmcd.uItemState and ODS_SELECTED) <> 0 then
PaintItemTrackbar(nmcd.HDC, nmcd.rc, RGB(150, 150, 230), RGB(50, 105, 200))
else
PaintItemTrackbar(nmcd.HDC, nmcd.rc, RGB(200, 215, 240), RGB(50, 105, 200));
Result := CDRF_SKIPDEFAULT;
end;
TBCD_TICS :
begin
Result := CDRF_DODEFAULT;
end;
end;
end;
else
Result := CDRF_DODEFAULT;
SetWindowLong(hWnd, DWL_MSGRESULT, CDRF_DODEFAULT);
end; // case nmcd.dwDrawStage of
end; // with PNMLVCUSTOMDRAW(pnmh)^ do
end; // NM_CUSTOMDRAW:
end;
end;
end;
WM_DESTROY :
begin
SetWindowLong(GetDlgItem(hWnd, IDC_TRACKBAR), GWL_WNDPROC, LongInt(OldWndProc));
PostQuitMessage(0);
end;
else
Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
end;
end;
var
WndClass : TWndClassEx =
(
cbSize : SizeOf(TWndClassEx);
Style : CS_HREDRAW or CS_VREDRAW;
lpfnWndProc : @MainWndProc;
cbClsExtra : 0;
cbWndExtra : 0;
hbrBackground : COLOR_3DFACE + 1;
lpszMenuName : nil;
lpszClassName : szClassName;
hIconSm : 0
);
uMsg : TMsg;
hwndMain : Cardinal;
begin
InitCommonControls;
WndClass.hInstance := hInstance;
WndClass.hIcon := 0;
WndClass.hCursor := LoadCursor(0, IDC_ARROW);
RegisterClassEx(WndClass);
hwndMain := CreateWindowEx(0, szClassName, szClassName, WS_CAPTION or WS_VISIBLE or WS_SYSMENU, Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), WindowWidth, WindowHeight, 0, 0, hInstance, nil);
while TRUE do
begin
if not GetMessage(uMsg, 0, 0, 0) then
Break;
if not IsDialogMessage(hWndMain, uMsg) then
begin
TranslateMessage(uMsg);
DispatchMessage(uMsg);
end;
end;
ExitCode := uMsg.wParam;
end. |
