10.02.2014, 00:53
|
|
Профессионал
|
|
Регистрация: 06.08.2012
Адрес: Кривой Рог
Сообщения: 1,791
Версия Delphi: Delphi 7, XE2
Репутация: 4415
|
|
Посмотрел исходники Media Player Classic - Home Cinema, немного поколдовал и получилось у меня такое:
Код:
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
{ TTrackBar }
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.
|