paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-23 01:59:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

lcl: add TTrackBar.SelStart, TTrackBar.SelEnd, TTrackBar.ShowSelRange based on patch of Justin Smyth (issue #0016299)

Browse Source 
git-svn-id: trunk@24728 -
This commit is contained in:
paul 2010-04-20 04:39:09 +00:00
parent efe222d30e
commit 229564f15d
4 changed files with 85 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
lcl/comctrls.pp
View File

@ -1805,6 +1805,9 @@ type
TCustomTrackBar = class(TWinControl)
private
FOrientation: TTrackBarOrientation;
FSelEnd: Integer;
FSelStart: Integer;
FShowSelRange: Boolean;
FTickMarks: TTickMark;
FTickStyle: TTickStyle;
FLineSize: Integer;
@ -1813,8 +1816,8 @@ type
FMax: Integer;
FFrequency: Integer;
FPosition: Integer;
FScalePos : TTrackBarScalePos;
FScaleDigits : integer;
FScalePos: TTrackBarScalePos;
FScaleDigits: integer;
FOnChange: TNotifyEvent;
procedure SetFrequency(Value: Integer);
procedure SetLineSize(Value: Integer);
@ -1825,6 +1828,9 @@ type
procedure SetParams(APosition, AMin, AMax: Integer);
procedure SetPosition(Value: Integer);
procedure SetScalePos(Value: TTrackBarScalePos);
procedure SetSelEnd(const AValue: Integer);
procedure SetSelStart(const AValue: Integer);
procedure SetShowSelRange(const AValue: Boolean);
procedure SetTickMarks(Value: TTickMark);
procedure SetTickStyle(Value: TTickStyle);
procedure UpdateSelection;
@ -1849,6 +1855,9 @@ type
property PageSize: Integer read FPageSize write SetPageSize default 2;
property Position: Integer read FPosition write SetPosition;
property ScalePos: TTrackBarScalePos read FScalePos write SetScalePos default trTop;
property SelEnd: Integer read FSelEnd write SetSelEnd default 0;
property SelStart: Integer read FSelStart write SetSelStart default 0;
property ShowSelRange: Boolean read FShowSelRange write SetShowSelRange default True;
property TabStop default True;
property TickMarks: TTickMark read FTickMarks write SetTickMarks default tmBottomRight;
property TickStyle: TTickStyle read FTickStyle write SetTickStyle default tsAuto;
@ -1900,7 +1909,10 @@ type
property PopupMenu;
property Position;
property ScalePos;
property SelEnd;
property SelStart;
property ShowHint;
property ShowSelRange;
property TabOrder;
property TabStop;
property TickMarks;

50
lcl/include/trackbar.inc
View File

@ -58,19 +58,22 @@ begin
inherited Create (aOwner);
fCompStyle := csTrackbar;
ControlStyle := ControlStyle - [csCaptureMouse];
FLineSize := 1;
FMax := 10;
FMin := 0;
FPosition := 0;
FPageSize := 2;
FLineSize := 1;
FMax := 10;
FMin := 0;
FPosition := 0;
FPageSize := 2;
FFrequency := 1;
FOrientation := trHorizontal;
FScalePos := trTop;
FScalePos := trTop;
FScaleDigits := 0;
FTickMarks := tmBottomRight;
FTickStyle := tsAuto;
FSelStart := 0;
FSelEnd := 0;
FShowSelRange := True;
TabStop := True;
SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
SetInitialBounds(0, 0, GetControlClassDefaultSize.X, GetControlClassDefaultSize.Y);
end;
{------------------------------------------------------------------------------
@ -101,7 +104,8 @@ end;
------------------------------------------------------------------------------}
procedure TCustomTrackBar.SetTick(Value: Integer);
begin
{ := Value; }
if HandleAllocated then
TWSTrackBarClass(WidgetSetClass).SetTick(Self, Value);
end;
{------------------------------------------------------------------------------
@ -290,8 +294,6 @@ end;
class procedure TCustomTrackBar.WSRegisterClass;
begin
inherited WSRegisterClass;
RegisterPropertyToSkip(TCustomTrackBar, 'SelStart', 'VCL compatibility property', '');
RegisterPropertyToSkip(TCustomTrackBar, 'SelEnd', 'VCL compatibility property', '');
RegisterPropertyToSkip(TCustomTrackBar, 'ThumbLength', 'VCL compatibility property', '');
RegisterCustomTrackBar;
end;
@ -354,3 +356,31 @@ begin
ApplyChanges;
end;
end;
procedure TCustomTrackBar.SetSelEnd(const AValue: Integer);
begin
if FSelEnd <> AValue then
begin
FSelEnd := AValue;
ApplyChanges;
end;
end;
procedure TCustomTrackBar.SetSelStart(const AValue: Integer);
begin
if FSelStart <> AValue then
begin
FSelStart := AValue;
ApplyChanges;
end;
end;
procedure TCustomTrackBar.SetShowSelRange(const AValue: Boolean);
begin
if FShowSelRange <> AValue then
begin
FShowSelRange := AValue;
ApplyChanges;
end;
end;

37
lcl/interfaces/win32/win32wscomctrls.pp
View File

@ -207,8 +207,9 @@ type
class procedure DefaultWndHandler(const AWinControl: TWinControl;
var AMessage); override;
class procedure ApplyChanges(const ATrackBar: TCustomTrackBar); override;
class function GetPosition(const ATrackBar: TCustomTrackBar): integer; override;
class function GetPosition(const ATrackBar: TCustomTrackBar): integer; override;
class procedure SetPosition(const ATrackBar: TCustomTrackBar; const NewPosition: integer); override;
class procedure SetTick(const ATrackBar: TCustomTrackBar; const ATick: integer); override;
end;
{ TWin32WSCustomTreeView }
@ -872,27 +873,33 @@ var
wHandle: HWND;
NewStyle: integer;
const
StyleMask = TBS_AUTOTICKS or TBS_NOTICKS or TBS_VERT or TBS_TOP or TBS_BOTH;
TickStyleStyle : array[TTickStyle] of integer =
(TBS_NOTICKS, TBS_AUTOTICKS, 0);
OrientationStyle : array[TTrackBarOrientation] of integer =
(TBS_HORZ, TBS_VERT);
TickMarksStyle : array[TTickMark] of integer =
(TBS_BOTTOM, TBS_TOP, TBS_BOTH);
StyleMask = TBS_AUTOTICKS or TBS_NOTICKS or TBS_VERT or TBS_TOP or TBS_BOTH or
TBS_ENABLESELRANGE;
TickStyleStyle: array[TTickStyle] of DWORD = (TBS_NOTICKS, TBS_AUTOTICKS, 0);
OrientationStyle: array[TTrackBarOrientation] of DWORD = (TBS_HORZ, TBS_VERT);
TickMarksStyle: array[TTickMark] of DWORD = (TBS_BOTTOM, TBS_TOP, TBS_BOTH);
SelRangeStyle: array[Boolean] of DWORD = (0, TBS_ENABLESELRANGE);
begin
with ATrackBar do
begin
{ cache handle }
wHandle := Handle;
NewStyle := TickStyleStyle[TickStyle] or OrientationStyle[Orientation] or
TickMarksStyle[TickMarks];
TickMarksStyle[TickMarks] or SelRangeStyle[ShowSelRange];
UpdateWindowStyle(wHandle, NewStyle, StyleMask);
Windows.SendMessage(wHandle, TBM_SETRANGEMAX, Windows.WPARAM(true), Max);
Windows.SendMessage(wHandle, TBM_SETRANGEMIN, Windows.WPARAM(true), Min);
Windows.SendMessage(wHandle, TBM_SETPOS, Windows.WPARAM(true), Position);
Windows.SendMessage(wHandle, TBM_SETRANGEMAX, Windows.WPARAM(True), Max);
Windows.SendMessage(wHandle, TBM_SETRANGEMIN, Windows.WPARAM(True), Min);
Windows.SendMessage(wHandle, TBM_SETPOS, Windows.WPARAM(True), Position);
Windows.SendMessage(wHandle, TBM_SETLINESIZE, 0, LineSize);
Windows.SendMessage(wHandle, TBM_SETPAGESIZE, 0, PageSize);
Windows.SendMessage(wHandle, TBM_SETTICFREQ, Frequency, 0);
if ((SelStart = 0) and (SelEnd = 0)) or not ShowSelRange then
Windows.SendMessage(wHandle, TBM_CLEARSEL, Windows.WPARAM(True), 0)
else
begin
Windows.SendMessage(wHandle, TBM_SETSELSTART, Windows.WParam(False), SelStart);
Windows.SendMessage(wHandle, TBM_SETSELEND, Windows.WParam(True), SelEnd)
end;
end;
end;
@ -906,4 +913,10 @@ begin
Windows.SendMessage(ATrackBar.Handle, TBM_SETPOS, Windows.WPARAM(true), Windows.LPARAM(NewPosition));
end;
class procedure TWin32WSTrackBar.SetTick(const ATrackBar: TCustomTrackBar;
const ATick: integer);
begin
Windows.SendMessage(ATrackBar.Handle, TBM_SETTIC, 0, Windows.LPARAM(ATick));
end;
end.

7
lcl/widgetset/wscomctrls.pp
View File

@ -194,8 +194,9 @@ type
TWSTrackBar = class(TWSWinControl)
published
class procedure ApplyChanges(const ATrackBar: TCustomTrackBar); virtual;
class function GetPosition(const ATrackBar: TCustomTrackBar): integer; virtual;
class function GetPosition(const ATrackBar: TCustomTrackBar): integer; virtual;
class procedure SetPosition(const ATrackBar: TCustomTrackBar; const NewPosition: integer); virtual;
class procedure SetTick(const ATrackBar: TCustomTrackBar; const ATick: integer); virtual;
end;
{ TWSCustomTreeView }
@ -558,6 +559,10 @@ class procedure TWSTrackBar.SetPosition(const ATrackBar: TCustomTrackBar; const
begin
end;
class procedure TWSTrackBar.SetTick(const ATrackBar: TCustomTrackBar; const ATick: integer);
begin
end;
{ WidgetSetRegistration }
procedure RegisterStatusBar;