我正在尝试在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
并在Change事件上重新定位轨迹栏,但我的逻辑似乎没有正常工作。
有什么想法吗?
答案 0 :(得分:10)
将TrackBar.Max
设置为14
,并实施OnChange
和OnKeyDown
处理程序,以及一些按钮OnClick处理程序,用于放大和缩小。另外,设置TrackBar.PageSize = 4
以使PageUp和PageDown键正常工作。
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;
答案 1 :(得分:10)
这是从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.
如果需要,垂直实施将类似。这不是一个真正的成品,只是模仿上述控制行为的试验。