unit
Unit2;
interface
uses
Windows, Messages, Graphics, Controls, CommCtrl, ComCtrls;
type
TTrackBar =
class
(ComCtrls
.
TTrackBar)
private
procedure
CNNotify(
var
Message: TWMNotify); message CN_NOTIFY;
end
;
implementation
procedure
TTrackBar
.
CNNotify(
var
Message: TWMNotify);
var
Info: PNMCustomDraw;
can: TCanvas;
begin
if
Message
.
NMHdr^.code = NM_CUSTOMDRAW
then
begin
Info :=
Pointer
(Message
.
NMHdr);
case
Info^.dwDrawStage
of
CDDS_PREPAINT:
Message
.
Result := CDRF_NOTIFYITEMDRAW;
CDDS_ITEMPREPAINT:
begin
case
Info^.dwItemSpec
of
TBCD_CHANNEL:
begin
can := TCanvas
.
Create;
try
can
.
Handle := Info^.hdc;
can
.
Brush
.
Color := clBtnFace;
can
.
FillRect(Info^.rc);
can
.
Pen
.
Color := clBtnHighlight;
can
.
MoveTo(Info^.rc
.
Right, Info^.rc
.
Top);
can
.
LineTo(Info^.rc
.
Right, Info^.rc
.
Bottom);
can
.
LineTo(Info^.rc
.
Left, Info^.rc
.
Bottom);
can
.
Pen
.
Color := clBtnShadow;
can
.
LineTo(Info^.rc
.
Right, Info^.rc
.
Top);
finally
can
.
Free;
end
;
Message
.
Result := CDRF_SKIPDEFAULT;
end
;
TBCD_THUMB:
begin
DrawFrameControl(Info^.hdc, Info^.rc, DFC_BUTTON, DFCS_BUTTONPUSH);
Message
.
Result := CDRF_SKIPDEFAULT;
end
;
else
Message
.
Result := CDRF_DODEFAULT;
end
;
end
;
else
Message
.
Result := CDRF_DODEFAULT;
end
;
end
else
begin
inherited
;
end
;
end
;
end
.