Beim Klick auf eine TrackBar zur Klickposition springen

[Matze]

bitsetter zeigt in diesem Thema, wie man bei einem Klick auf eine TTrackBar direkt zur Klickposition springen kann. Standardmäßig wird der Wert nur um eine Einheit verändert, was manchmal störend sein kann, wenn man beispielsweise einen MediaPlayer programmiert.

Delphi-Quellcode:

uses
  ComCtrls;

type
  TTrackBar = class(ComCtrls.TTrackBar)
  private
    procedure WMLBUTTONDOWN(var Msg: TMessage); message WM_LBUTTONDOWN;
  end;

// ...

implementation

{$R *.dfm}

// ...

uses
  CommCtrl;

procedure TTrackBar.WMLBUTTONDOWN(var Msg: TMessage);
var
  ChannelRect, SliderRect: TRect;
  SliderWidth: Word;
  Pt: TPoint;
begin
  ZeroMemory(@SliderRect, SizeOf(SliderRect));
  SendMessage(Handle, TBM_GETTHUMBRECT, 0, DWord(@SliderRect));
  ZeroMemory(@ChannelRect, SizeOf(ChannelRect));
  SendMessage(Handle, TBM_GETCHANNELRECT, 0, DWord(@ChannelRect));
  if Orientation = trHorizontal then
  begin
    Pt:= Point(msg.LParamLo, msg.LParamHi);
    SliderWidth := (SliderRect.Right - SliderRect.Left) div 2;
    ChannelRect.Top := SliderRect.Top;
    ChannelRect.Bottom := SliderRect.Bottom;
  end else
  begin
    Pt:= Point(msg.LParamHi, msg.LParamLo);
    SliderWidth := (SliderRect.Bottom - SliderRect.Top) div 2;
    ChannelRect.Top := SliderRect.Left;
    ChannelRect.Bottom := SliderRect.Right;
  end;
  if PtInRect(SliderRect, Point(msg.LParamLo, msg.LParamHi)) then
    inherited
  else
    if Windows.PtInRect(ChannelRect, Pt) then
    begin
      inc(ChannelRect.Left, SliderWidth);
      dec(ChannelRect.Right, SliderWidth);
      self.Position := round((Pt.X - ChannelRect.Left) * self.Max /
                             (ChannelRect.Right - ChannelRect.Left));
    end;
  inherited; 
end;

Suchbegriffe: TrackBar Position

[edit=fkerber]Ein "inherited" spendiert - Danke an Flips. Mfg, fkerber[/edit]