delphi - TTrackBar 具有自定义位置？

Question

我试图在 Win 7 缩放跟踪栏中复制 PAINT 应用程序的行为:(我知道这是一个常见的轨迹栏控件)

100% 位于中心。它有 11 个可用位置:

等等...

12.5%、25%、50%、100%、200%、300%、400%、500%、600%、700%、800%

所以我的缩放值 (ZoomArray) 是:
0.125、0.25、0.5、1、2、3、4、5、6、7、8

这很简单，我可以将 Min 设置为 1，将 Max 设置为 11 并获取我需要的值:
ZoomArray[TrackBar1.Position]

问题是如何保持 100% 处于中心并且唯一可用的位置就是上面的位置？

我尝试在数组中使用虚拟值来将 1 保持在中心，例如:
0.125、0.25、0.5、-1、-1、-1、-1、1、2、3、4、5、6、7、8
并在更改事件上重新定位轨迹栏，但我的逻辑似乎无法正常工作。

有什么想法吗？

Answer 1

这是一种从 TTrackbar 派生新控件的替代方案，删除自动抽动并处理滚动消息中的滑动，其行为与 Paint 中的控件几乎相同。用D2007编译，尝试评论一下:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, Forms, ComCtrls, StdCtrls;

type
  TCNHScroll = TWMHScroll;

  TTrackBar = class(comctrls.TTrackBar)  // interposer class for quick test
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure CNHScroll(var Message: TCNHScroll); message CN_HSCROLL;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TForm1 = class(TForm)
    Label1: TLabel;
    TrackBar1: TTrackBar;
    procedure TrackBar1Change(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

uses
  commctrl;

{$R *.dfm}

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
  // account for non-linear scaling for a sensible value
  if TrackBar1.Position <= 8 then
    Label1.Caption := IntToStr(TrackBar1.Position * 125)
  else
    Label1.Caption := IntToStr(TrackBar1.Position * 1000 - 7000)
end;

{ TTrackBar }

constructor TTrackBar.Create(AOwner: TComponent);
begin
  inherited;

  // We'll have 15 positions which should account for the following values 
  // 125 250 - 500 - - - 1000 2000 3000 4000 5000 6000 7000 8000
  // positions 3, 5..7 will be skipped when tracking
  Min := 1;
  Max := 15;
  LineSize := 1;
  PageSize := 1;
end;

procedure TTrackBar.CreateParams(var Params: TCreateParams);
begin
  inherited;
  // remove automatic ticks so that we don't have ticks at 3 and 5..7
  Params.Style := Params.Style and not TBS_AUTOTICKS;
end;

procedure TTrackBar.CreateWnd;
begin
  inherited;
  // first and last tick not required
  SetTick(2);  //  250
  SetTick(4);  //  500
  SetTick(8);  // 1000
  SetTick(9);  // 2000
  SetTick(10); 
  SetTick(11);
  SetTick(12);
  SetTick(13);
  SetTick(14); // 7000
end;

procedure TTrackBar.CNHscroll(var Message: TCNHScroll);
var
  Pos: Integer;
begin
  // prevent jumping back and forth while thumb tracking, do not slide to the
  // next tick until a threshold is passed
  if Message.ScrollCode = SB_THUMBTRACK then begin
    case Message.Pos of            
      5: SendMessage(Handle, TBM_SETPOS, 1, 4);
      6, 7: SendMessage(Handle, TBM_SETPOS, 1, 8);
    end;
  end;

  // for line and page and rest of the scrolling, skip certain ticks
  Pos := SendMessage(Handle, TBM_GETPOS, 0, 0);
  if Pos > Position then      // compare with previous position
    case Pos of
      3: SendMessage(Handle, TBM_SETPOS, 1, 4);
      5..7: SendMessage(Handle, TBM_SETPOS, 1, 8);
    end;
  if Pos < Position then
    case Pos of
      3: SendMessage(Handle, TBM_SETPOS, 1, 2);
      5..7: SendMessage(Handle, TBM_SETPOS, 1, 4);
    end;

  inherited;
end;

end.

如果需要的话，垂直实现将是类似的。这并不是真正的成品，只是模仿上述控件行为的尝试。