TTrackBar with custom positions?

Question

I am trying to duplicate the behaviour of PAINT application in Win 7 zoom track bar: (I know it's a common track bar control)

The 100% is located in the center. and it has 11 available positions:

etc...

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

So my zoom values (ZoomArray) are:
0.125, 0.25, 0.5, 1, 2, 3, 4, 5, 6, 7, 8

That's easy I could set Min to 1 and Max to 11 and get the values I need:
ZoomArray[TrackBar1.Position]

The question is how to keep 100% in the center and the only positions that are available are the one above?

I have tried to use dummy values in the array to keep the 1 in the center e.g.:
0.125, 0.25, 0.5, -1, -1, -1, -1, 1, 2, 3, 4, 5, 6, 7, 8
And reposition the trackbar on Change event, but my logic doesnt seem to work right.

Any ideas?

Ioab

My solution would be to have enough zoom values so that 100% was in the middle. Anything else will just be horrible to use. – Reinhardt

@David, what Paint does makes sense, it allows for simpler (and more meaningful) zooming of bitmaps. Below 100% you get 50, 25 and 12.5; One on-screen pixel is render based on a (2x2), (4x4) or (8x8) area of the original. Zoom levels over 100 go from hundred to hundred: one pixel is zoomed to (2x2), (3x3) ... (8x8). Sure it's horrible, but 33% zoom might not look good in a pixel-painting application. – Gymkhana

@CosminPrund It depends on the resize algorithm used. A good resampler can do a good job at non power of 2 scales. – Reinhardt

Answer 1

Here is one alternative that derives a new control from TTrackbar, removing the automatic tics and handling sliding in the scroll message, behaves nearly identical to the control in Paint. Compiled with D2007, tried to comment a little:

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.

Vertical implementation would be similar, if needed. This is not really a finished product, just a trial to mimic the behavior of the mentioned control.

Elainaelaine

@Ioab - You're welcome! Just one thing I later noticed: the VCL already has support for custom ticks. Putting TickStyle:=tsManual; in the constructor, there will be no need to override CreateParams. I can edit the code if you like. – Elainaelaine

@SertacAkyuz, I'm adding and not TBS_ENABLESELRANGE in CreateParams so I'm using it anywahy. – Ioab

How can I inc or dec the position via [-] or [+] button? do I need to send CN_HSCROLL? it seems like setting TrackBar.Position := TrackBar.Position + 1 does not work as expected. – Ioab

@Ioab - I think the easiest solution would be to mutate the key. E.g. in an OnKeyDown handler: if Key = VK_ADD then Key := VK_RIGHT; – Elainaelaine

It's not what I meant: I have a TButton ("Zoon In") and when I click it: procedure TForm1.ZoomInButtonClick(Sender: TObject); begin ZoomTrackBar.Position := ZoomTrackBar.Position + 1; end; – Ioab

@Ioab - A scroll message would do. Or setting the position conditionally (depending on the current position). Or since I'm obsessed with keys right now :), send a key message: TrackBar1.Perform(WM_KEYDOWN, VK_RIGHT, 0); – Elainaelaine

Answer 2

Set TrackBar.Max to 14, and implement the OnChange and OnKeyDown handlers, as well as maybe some button OnClick handlers for zooming in and out. Also, set TrackBar.PageSize = 4 to get the PageUp and PageDown keys correctly working.

const
  ZoomTickCount = 15;

function ZoomLevelPos(Position: Integer; GoneUp: Boolean): Integer;
const
  Ticks: array[0..ZoomTickCount - 1] of Integer =
    (0, 1, 1, 2, 2, 2, 2, 9, 10, 11, 12, 13, 14, 15, 16);
begin
  Result := Position;
  if GoneUp then
    while (Result < High(Ticks)) and (Ticks[Result] = Ticks[Position - 1]) do
      Inc(Result)
  else
    while (Result > Low(Ticks)) and (Ticks[Result - 1] = Ticks[Position]) do
      Dec(Result);
end;

procedure TForm1.ZoomTrackBarChange(Sender: TObject);
const
  Zooms: array[0..ZoomTickCount - 1] of Single =
    (0.125, 0.25, 0.25, 0.5, 0.5, 0.5, 0.5, 1, 2, 3, 4, 5, 6, 7, 8);
begin
  ZoomTrackBar.Position := ZoomLevelPos(ZoomTrackBar.Position, False);
  Label1.Caption := Format('%.1n%%', [Zooms[ZoomTrackBar.Position] * 100]);
end;

procedure TForm1.ZoomTrackBarKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key in [VK_DOWN, VK_RIGHT] then
  begin
    ZoomTrackBar.Position := ZoomLevelPos(ZoomTrackBar.Position + 1, True);
    Key := 0;
  end;
end;

procedure TForm1.ZoomInButtonClick(Sender: TObject);
begin
  ZoomTrackBar.Position := ZoomLevelPos(ZoomTrackBar.Position + 1, True);
end;

procedure TForm1.ZoomOutButtonClick(Sender: TObject);
begin
  ZoomTrackBar.Position := ZoomTrackBar.Position - 1;
end;

Dodecasyllable

It's almost perfect (but having the same problems I do). if the position is 0 and you click the far right it wont go over position 3. also try the arrow keys. it is stack in position 2 or 3. – Ioab

But now 100% is not in the center. – Ioab

Seems like PageSize has a main role here. If I set it to 1 (just like in PAINT) and try to click on the most right position it get stack again. I think that Sertac's solution is a bit more elegant since it does not involve key down code, works and looks exactly like PAINT. Thanks for the effort and your time! – Ioab