david
3b29f73ece
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.DevExpressVCL@8 05c56307-c608-d34a-929d-697000501d7a
1350 lines
38 KiB
ObjectPascal
1350 lines
38 KiB
ObjectPascal
|
|
{********************************************************************}
|
|
{ }
|
|
{ Developer Express Visual Component Library }
|
|
{ ExpressCommonLibrary }
|
|
{ }
|
|
{ Copyright (c) 1998-2007 Developer Express Inc. }
|
|
{ ALL RIGHTS RESERVED }
|
|
{ }
|
|
{ The entire contents of this file is protected by U.S. and }
|
|
{ International Copyright Laws. Unauthorized reproduction, }
|
|
{ reverse-engineering, and distribution of all or any portion of }
|
|
{ the code contained in this file is strictly prohibited and may }
|
|
{ result in severe civil and criminal penalties and will be }
|
|
{ prosecuted to the maximum extent possible under the law. }
|
|
{ }
|
|
{ RESTRICTIONS }
|
|
{ }
|
|
{ THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES }
|
|
{ (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE }
|
|
{ SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS }
|
|
{ LICENSED TO DISTRIBUTE THE EXPRESSCOMMONLIBRARY AND ALL }
|
|
{ ACCOMPANYING VCL CONTROLS AS PART OF AN EXECUTABLE PROGRAM ONLY. }
|
|
{ }
|
|
{ THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED }
|
|
{ FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE }
|
|
{ COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE }
|
|
{ AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT }
|
|
{ AND PERMISSION FROM DEVELOPER EXPRESS INC. }
|
|
{ }
|
|
{ CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON }
|
|
{ ADDITIONAL RESTRICTIONS. }
|
|
{ }
|
|
{********************************************************************}
|
|
|
|
unit cxScrollBar;
|
|
|
|
{$I cxVer.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF VCL}
|
|
Windows, Messages, dxThemeManager,
|
|
{$ELSE}
|
|
Qt, QTypes,
|
|
{$ENDIF}
|
|
{$IFDEF DELPHI6}
|
|
Types,
|
|
{$ENDIF}
|
|
{$IFNDEF DELPHI5}
|
|
cxClasses,
|
|
{$ENDIF}
|
|
SysUtils, Classes, Controls, StdCtrls,
|
|
Graphics, cxGraphics, Forms, cxLookAndFeels, cxLookAndFeelPainters;
|
|
|
|
type
|
|
TcxScrollBarState = record
|
|
PressedPart: TcxScrollBarPart;
|
|
HotPart: TcxScrollBarPart;
|
|
end;
|
|
|
|
TcxScrollBar = class(TCustomControl, {$IFNDEF DELPHI6}IUnknown,{$ENDIF} IdxSkinSupport)
|
|
private
|
|
FBitmap: TBitmap;
|
|
FState: TcxScrollBarState;
|
|
FTimer: TComponent;
|
|
FCanvas: TcxCanvas;
|
|
FLookAndFeel: TcxLookAndFeel;
|
|
{$IFDEF VCL}
|
|
FThemeChangedNotificator: TdxThemeChangedNotificator;
|
|
{$ELSE}
|
|
FUseSaveScrollCode: Boolean;
|
|
FSaveScrollCode: TScrollCode;
|
|
FParamsChanging: Boolean;
|
|
FRangeControl: QRangeControlH;
|
|
{$ENDIF}
|
|
FThumbnailSize: Integer;
|
|
FTopLeftArrow: TRect;
|
|
FBottomRightArrow: TRect;
|
|
FThumbnail: TRect;
|
|
FPageUp: TRect;
|
|
FPageDown: TRect;
|
|
FKind: TScrollBarKind;
|
|
FPosition: Integer;
|
|
FSavePosition: Integer;
|
|
FSaveThumbnailPos: TPoint;
|
|
FDownMousePos: TPoint;
|
|
FMin: Integer;
|
|
FMax: Integer;
|
|
FPageSize: Integer;
|
|
FSmallChange: TScrollBarInc;
|
|
FLargeChange: TScrollBarInc;
|
|
FUnlimitedTracking: Boolean;
|
|
FOnChange: TNotifyEvent;
|
|
FOnScroll: TScrollEvent;
|
|
procedure AdjustPagesRects;
|
|
procedure CalcMinThumnailSize;
|
|
procedure CalculateRects;
|
|
procedure CalculateThumbnailRect;
|
|
procedure CancelScroll;
|
|
procedure DoScroll(APart: TcxScrollBarPart);
|
|
function GetPositionFromThumbnail: Integer;
|
|
function GetScrollBarPart(P: TPoint): TcxScrollBarPart;
|
|
procedure InternalScroll(AScrollCode: TScrollCode);
|
|
procedure OnTimer(Sender: TObject);
|
|
procedure SetKind(Value: TScrollBarKind);
|
|
procedure SetLookAndFeel(Value: TcxLookAndFeel);
|
|
procedure SetMax(Value: Integer);
|
|
procedure SetMin(Value: Integer);
|
|
procedure SetPageSize(Value: Integer);
|
|
procedure SetPosition(Value: Integer);
|
|
{$IFDEF VCL}
|
|
procedure ThemeChanged;
|
|
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
|
|
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
|
|
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
|
|
procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE;
|
|
procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED;
|
|
procedure CNHScroll(var Message: TWMHScroll); message CN_HSCROLL;
|
|
procedure CNVScroll(var Message: TWMVScroll); message CN_VSCROLL;
|
|
procedure CNCtlColorScrollBar(var Message: TMessage); message CN_CTLCOLORSCROLLBAR;
|
|
procedure WMCancelMode(var Message: TWMCancelMode); message WM_CANCELMODE;
|
|
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
|
|
{$ELSE}
|
|
function GetHandle: QScrollBarH;
|
|
function GetLargeChange: TScrollBarInc;
|
|
function GetMax: Integer;
|
|
function GetMin: Integer;
|
|
function GetPosition: Integer;
|
|
function GetSmallChange: TScrollBarInc;
|
|
procedure NextLineHook; cdecl;
|
|
procedure NextPageHook; cdecl;
|
|
procedure PrevLineHook; cdecl;
|
|
procedure PrevPageHook; cdecl;
|
|
procedure SetLargeChange(const Value: TScrollBarInc);
|
|
procedure SetSmallChange(const Value: TScrollBarInc);
|
|
procedure SliderPressedHook; cdecl;
|
|
procedure SliderReleasedHook; cdecl;
|
|
procedure ValueChangedHook(Value: Integer); cdecl;
|
|
function RangeControl: QRangeControlH;
|
|
{$ENDIF}
|
|
protected
|
|
procedure Change; virtual;
|
|
{$IFNDEF VCL}
|
|
procedure CreateWidget; override;
|
|
procedure HookEvents; override;
|
|
procedure InitWidget; override;
|
|
procedure DestroyWidget; override;
|
|
procedure Loaded; override;
|
|
procedure Painting(Sender: QObjectH; EventRegion: QRegionH); override;
|
|
{$ENDIF}
|
|
function GetPainter: TcxCustomLookAndFeelPainterClass;
|
|
procedure LookAndFeelChanged(Sender: TcxLookAndFeel;
|
|
AChangedValues: TcxLookAndFeelValues);
|
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer); override;
|
|
procedure MouseEnter(AControl: TControl); {$IFDEF VCL}dynamic{$ELSE}override{$ENDIF};
|
|
procedure MouseLeave(AControl: TControl); {$IFDEF VCL}dynamic{$ELSE}override{$ENDIF};
|
|
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
|
|
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer); override;
|
|
|
|
procedure Paint; override;
|
|
procedure Scroll(ScrollCode: TScrollCode; var ScrollPos: Integer); virtual;
|
|
property Painter: TcxCustomLookAndFeelPainterClass read GetPainter;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
|
|
procedure SetScrollParams(AMin, AMax, APosition, APageSize: Integer; ARedraw: Boolean = True);
|
|
procedure SetParams(APosition, AMin, AMax: Integer);
|
|
{$IFNDEF VCL}
|
|
property Handle: QScrollBarH read GetHandle;
|
|
{$ENDIF}
|
|
published
|
|
property Align;
|
|
property Anchors;
|
|
property Constraints;
|
|
{$IFDEF VCL}
|
|
property Ctl3D;
|
|
property DragCursor;
|
|
property DragKind;
|
|
{$ENDIF}
|
|
property DragMode;
|
|
property Enabled;
|
|
property Kind: TScrollBarKind read FKind write SetKind default sbHorizontal;
|
|
property LargeChange: TScrollBarInc
|
|
{$IFDEF VCL}
|
|
read FLargeChange write FLargeChange
|
|
{$ELSE}
|
|
read GetLargeChange write SetLargeChange
|
|
{$ENDIF}
|
|
default 1;
|
|
property LookAndFeel: TcxLookAndFeel read FLookAndFeel write SetLookAndFeel;
|
|
property Max: Integer
|
|
read {$IFDEF VCL}FMax{$ELSE}GetMax{$ENDIF} write SetMax default 100;
|
|
property Min: Integer
|
|
read {$IFDEF VCL}FMin{$ELSE}GetMin{$ENDIF} write SetMin default 0;
|
|
property PageSize: Integer read FPageSize write SetPageSize;
|
|
{$IFDEF VCL}
|
|
property ParentCtl3D;
|
|
{$ENDIF}
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property Position: Integer
|
|
read {$IFDEF VCL}FPosition{$ELSE}GetPosition{$ENDIF} write SetPosition
|
|
default 0;
|
|
property ShowHint;
|
|
property SmallChange: TScrollBarInc
|
|
{$IFDEF VCL}
|
|
read FSmallChange write FSmallChange
|
|
{$ELSE}
|
|
read GetSmallChange write SetSmallChange
|
|
{$ENDIF}
|
|
default 1;
|
|
property UnlimitedTracking: Boolean read FUnlimitedTracking write FUnlimitedTracking default False;
|
|
property Visible;
|
|
{$IFDEF DELPHI5}
|
|
property OnContextPopup;
|
|
{$ENDIF}
|
|
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
{$IFDEF VCL}
|
|
property OnEndDock;
|
|
{$ENDIF}
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnKeyDown;
|
|
property OnKeyPress;
|
|
property OnKeyUp;
|
|
property OnScroll: TScrollEvent read FOnScroll write FOnScroll;
|
|
{$IFDEF VCL}
|
|
property OnStartDock;
|
|
{$ENDIF}
|
|
property OnStartDrag;
|
|
end;
|
|
|
|
function GetScrollBarSize: TSize;
|
|
|
|
implementation
|
|
|
|
uses
|
|
{$IFDEF VCL}
|
|
dxuxTheme,
|
|
dxThemeConsts,
|
|
{$ENDIF}
|
|
Consts, cxControls;
|
|
|
|
const
|
|
EmptyRect: TRect = (Left: 0; Top: 0; Right: 0; Bottom: 0);
|
|
cxScrollInitialInterval = 400;
|
|
cxScrollInterval = 60;
|
|
cxScrollMinDistance: Integer = 34;
|
|
cxScrollMaxDistance: Integer = 136;
|
|
cxMinStdThumbnailSize = 8;
|
|
cxTimerParts = [sbpLineUp, sbpLineDown, sbpPageUp, sbpPageDown];
|
|
|
|
function GetScrollBarSize: TSize;
|
|
begin
|
|
{$IFDEF VCL}
|
|
Result.cx := GetSystemMetrics(SM_CXVSCROLL);
|
|
Result.cy := GetSystemMetrics(SM_CYHSCROLL);
|
|
{$ELSE}
|
|
QStyle_scrollBarExtent(QApplication_style, @Result);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function MaxInt(A, B: Integer): Integer;
|
|
begin
|
|
if A > B then Result := A else Result := B;
|
|
end;
|
|
|
|
function MinInt(A, B: Integer): Integer;
|
|
begin
|
|
if A < B then Result := A else Result := B;
|
|
end;
|
|
|
|
{$IFNDEF DELPHI6}
|
|
|
|
function Bounds(ALeft, ATop, AWidth, AHeight: Integer): TRect;
|
|
begin
|
|
with Result do
|
|
begin
|
|
Left := ALeft;
|
|
Top := ATop;
|
|
Right := ALeft + AWidth;
|
|
Bottom := ATop + AHeight;
|
|
end;
|
|
end;
|
|
|
|
{$ENDIF}
|
|
|
|
{ TcxScrollBar }
|
|
|
|
constructor TcxScrollBar.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FBitmap := TBitmap.Create;
|
|
{$IFDEF VCL}
|
|
FBitmap.PixelFormat := pfDevice;
|
|
{$ELSE}
|
|
Palette.ColorRole := crButton;
|
|
Palette.TextColorRole := crButtonText;
|
|
{$ENDIF}
|
|
FCanvas := TcxCanvas.Create(FBitmap.Canvas);
|
|
FLookAndFeel := TcxLookAndFeel.Create(Self);
|
|
FLookAndFeel.OnChanged := LookAndFeelChanged;
|
|
Width := 121;
|
|
ControlStyle := [csFramed, csOpaque, csCaptureMouse];
|
|
FKind := sbHorizontal;
|
|
Height := GetScrollBarSize.cy;
|
|
{$IFDEF VCL}
|
|
FThemeChangedNotificator := TdxThemeChangedNotificator.Create;
|
|
FThemeChangedNotificator.OnThemeChanged := ThemeChanged;
|
|
{$ENDIF}
|
|
FPosition := 0;
|
|
FMin := 0;
|
|
FMax := 100;
|
|
FSmallChange := 1;
|
|
FLargeChange := 1;
|
|
|
|
FTimer := TcxTimer.Create(nil);
|
|
TcxTimer(FTimer).Enabled := False;
|
|
TcxTimer(FTimer).Interval:= cxScrollInitialInterval;
|
|
TcxTimer(FTimer).OnTimer := OnTimer;
|
|
CalcMinThumnailSize;
|
|
CalculateRects;
|
|
end;
|
|
|
|
destructor TcxScrollBar.Destroy;
|
|
begin
|
|
FreeAndNil(FTimer);
|
|
{$IFDEF VCL}
|
|
FreeAndNil(FThemeChangedNotificator);
|
|
{$ENDIF}
|
|
FreeAndNil(FLookAndFeel);
|
|
FreeAndNil(FCanvas);
|
|
FreeAndNil(FBitmap);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TcxScrollBar.OnTimer(Sender: TObject);
|
|
|
|
function CheckHotPart: Boolean;
|
|
var
|
|
P: TPoint;
|
|
begin
|
|
GetCursorPos(P);
|
|
Result := GetScrollBarPart(ScreenToClient(P)) = FState.PressedPart;
|
|
end;
|
|
|
|
begin
|
|
if (GetCaptureControl = Self) and (FState.PressedPart in cxTimerParts) then
|
|
begin
|
|
if TcxTimer(FTimer).Interval = cxScrollInitialInterval then
|
|
TcxTimer(FTimer).Interval := cxScrollInterval;
|
|
DoScroll(FState.PressedPart);
|
|
TcxTimer(FTimer).Enabled := CheckHotPart;
|
|
end
|
|
else
|
|
CancelScroll;
|
|
end;
|
|
|
|
procedure TcxScrollBar.SetKind(Value: TScrollBarKind);
|
|
begin
|
|
if FKind <> Value then
|
|
begin
|
|
FKind := Value;
|
|
{$IFNDEF VCL}
|
|
if FLookAndFeel.NativeStyle then
|
|
QScrollBar_setOrientation(Handle, Orientation(FKind));
|
|
{$ENDIF}
|
|
if not (csLoading in ComponentState) then
|
|
SetBounds(Left, Top, Height, Width)
|
|
else
|
|
CalculateRects;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TcxScrollBar.SetLookAndFeel(Value: TcxLookAndFeel);
|
|
begin
|
|
FLookAndFeel.Assign(Value);
|
|
end;
|
|
|
|
procedure TcxScrollBar.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
|
|
var
|
|
ABoundsChanged: Boolean;
|
|
begin
|
|
ABoundsChanged := (ALeft <> Left) or (ATop <> Top) or
|
|
(AWidth <> Width) or (AHeight <> Height);
|
|
inherited SetBounds(ALeft, ATop, AWidth, AHeight);
|
|
if ABoundsChanged and (AWidth > 0) and (AHeight > 0) then
|
|
begin
|
|
FBitmap.Width := AWidth;
|
|
FBitmap.Height := AHeight;
|
|
CalculateRects;
|
|
end;
|
|
end;
|
|
|
|
procedure TcxScrollBar.SetScrollParams(AMin, AMax, APosition,
|
|
APageSize: Integer; ARedraw: Boolean = True);
|
|
begin
|
|
if (AMax < AMin) or (AMax < APageSize) then
|
|
raise EInvalidOperation.Create(SScrollBarRange);
|
|
ARedraw := ARedraw and HandleAllocated;
|
|
|
|
if APosition < AMin then APosition := AMin;
|
|
if APosition > AMax then APosition := AMax;
|
|
|
|
{$IFNDEF VCL}
|
|
FParamsChanging := True;
|
|
try
|
|
{$ENDIF}
|
|
if (Min <> AMin) or (Max <> AMax) or (FPageSize <> APageSize) or
|
|
(Position <> APosition) then
|
|
begin
|
|
FMin := AMin;
|
|
FMax := AMax;
|
|
{$IFNDEF VCL}
|
|
if FLookAndFeel.NativeStyle then
|
|
QRangeControl_setRange(RangeControl, AMin, AMax);
|
|
{$ENDIF}
|
|
FPageSize := APageSize;
|
|
end
|
|
else
|
|
ARedraw := False;
|
|
if Position <> APosition then
|
|
begin
|
|
Enabled := True;
|
|
{$IFNDEF VCL}
|
|
if FLookAndFeel.NativeStyle then
|
|
begin
|
|
QRangeControl_setValue(RangeControl, APosition);
|
|
FPosition := Position;
|
|
end
|
|
else
|
|
begin
|
|
FPosition := APosition;
|
|
CalculateThumbnailRect;
|
|
if ARedraw then {$IFDEF LINUX}Invalidate{$ELSE}Repaint{$ENDIF};
|
|
end;
|
|
InternalScroll(scPosition);
|
|
{$ELSE}
|
|
FPosition := APosition;
|
|
CalculateThumbnailRect;
|
|
if ARedraw then Repaint;
|
|
Change;
|
|
{$ENDIF}
|
|
end
|
|
else
|
|
begin
|
|
CalculateThumbnailRect;
|
|
if ARedraw then {$IFDEF LINUX}Invalidate{$ELSE}Repaint{$ENDIF};
|
|
end;
|
|
{$IFNDEF VCL}
|
|
finally
|
|
FParamsChanging := False;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TcxScrollBar.SetParams(APosition, AMin, AMax: Integer);
|
|
begin
|
|
SetScrollParams(AMin, AMax, APosition, {$IFDEF VCL}FPageSize{$ELSE}0{$ENDIF});
|
|
end;
|
|
|
|
procedure TcxScrollBar.SetMax(Value: Integer);
|
|
begin
|
|
SetScrollParams(FMin, Value, FPosition, FPageSize);
|
|
end;
|
|
|
|
procedure TcxScrollBar.SetMin(Value: Integer);
|
|
begin
|
|
SetScrollParams(Value, FMax, FPosition, FPageSize);
|
|
end;
|
|
|
|
procedure TcxScrollBar.SetPageSize(Value: Integer);
|
|
begin
|
|
SetScrollParams(FMin, FMax, FPosition, Value);
|
|
end;
|
|
|
|
procedure TcxScrollBar.SetPosition(Value: Integer);
|
|
begin
|
|
SetScrollParams(FMin, FMax, Value, FPageSize);
|
|
end;
|
|
|
|
procedure TcxScrollBar.Change;
|
|
begin
|
|
{$IFDEF VCL}
|
|
inherited Changed;
|
|
{$ENDIF}
|
|
if Assigned(FOnChange) then FOnChange(Self);
|
|
end;
|
|
|
|
{$IFNDEF VCL}
|
|
|
|
procedure TcxScrollBar.CreateWidget;
|
|
begin
|
|
if FLookAndFeel.NativeStyle then
|
|
begin
|
|
FHandle := QScrollBar_create(ParentWidget, nil);
|
|
Hooks := QScrollBar_hook_create(FHandle);
|
|
end
|
|
else
|
|
inherited CreateWidget;
|
|
end;
|
|
|
|
procedure TcxScrollBar.HookEvents;
|
|
var
|
|
Method: TMethod;
|
|
begin
|
|
if FLookAndFeel.NativeStyle then
|
|
begin
|
|
QScrollBar_valueChanged_Event(Method) := ValueChangedHook;
|
|
QScrollBar_hook_hook_valueChanged(QScrollBar_hookH(Hooks), Method);
|
|
QScrollBar_sliderPressed_Event(Method) := SliderPressedHook;
|
|
QScrollBar_hook_hook_sliderPressed(QScrollBar_hookH(Hooks), Method);
|
|
QScrollBar_sliderReleased_Event(Method) := SliderReleasedHook;
|
|
QScrollBar_hook_hook_sliderReleased(QScrollBar_hookH(Hooks), Method);
|
|
QScrollBar_nextLine_Event(Method) := NextLineHook;
|
|
QScrollBar_hook_hook_nextLine(QScrollBar_hookH(Hooks), Method);
|
|
QScrollBar_prevLine_Event(Method) := PrevLineHook;
|
|
QScrollBar_hook_hook_prevLine(QScrollBar_hookH(Hooks), Method);
|
|
QScrollBar_nextPage_Event(Method) := NextPageHook;
|
|
QScrollBar_hook_hook_nextPage(QScrollBar_hookH(Hooks), Method);
|
|
QScrollBar_prevPage_Event(Method) := PrevPageHook;
|
|
QScrollBar_hook_hook_prevPage(QScrollBar_hookH(Hooks), Method);
|
|
end;
|
|
inherited HookEvents;
|
|
end;
|
|
|
|
procedure TcxScrollBar.InitWidget;
|
|
begin
|
|
inherited InitWidget;
|
|
if FLookAndFeel.NativeStyle then
|
|
begin
|
|
Max := FMax;
|
|
Min := FMin;
|
|
SmallChange := FSmallChange;
|
|
LargeChange := FLargeChange;
|
|
Position:= FPosition;
|
|
//!!! lcm
|
|
//if FUnlimitedTracking then Style.MaxSliderDragDistance := -1;
|
|
QScrollBar_setTracking(Handle, True);
|
|
QScrollBar_setOrientation(Handle, Orientation(FKind));
|
|
end
|
|
else
|
|
QWidget_setBackgroundMode(Handle, QWidgetBackgroundMode_NoBackground);
|
|
QWidget_setFocusPolicy(Handle, QWidgetFocusPolicy_NoFocus);
|
|
end;
|
|
|
|
procedure TcxScrollBar.DestroyWidget;
|
|
begin
|
|
FRangeControl := nil;
|
|
Style := nil;
|
|
inherited DestroyWidget;
|
|
end;
|
|
|
|
procedure TcxScrollBar.Loaded;
|
|
begin
|
|
inherited Loaded;
|
|
if FLookAndFeel.NativeStyle then
|
|
QScrollBar_setOrientation(Handle, Orientation(FKind));
|
|
end;
|
|
|
|
procedure TcxScrollBar.Painting(Sender: QObjectH; EventRegion: QRegionH);
|
|
var
|
|
ForcedPaintEvent: QPaintEventH;
|
|
begin
|
|
if not FLookAndFeel.NativeStyle then
|
|
inherited
|
|
else
|
|
begin
|
|
ForcedPaintEvent := QPaintEvent_create(EventRegion, False);
|
|
try
|
|
ControlState := ControlState + [csWidgetPainting];
|
|
try
|
|
QObject_event(Sender, ForcedPaintEvent);
|
|
finally
|
|
ControlState := ControlState - [csWidgetPainting];
|
|
end;
|
|
finally
|
|
QPaintEvent_destroy(ForcedPaintEvent);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{$ENDIF}
|
|
|
|
function TcxScrollBar.GetPainter: TcxCustomLookAndFeelPainterClass;
|
|
begin
|
|
Result := LookAndFeel.GetAvailablePainter(totScrollBar);
|
|
end;
|
|
|
|
procedure TcxScrollBar.LookAndFeelChanged(Sender: TcxLookAndFeel;
|
|
AChangedValues: TcxLookAndFeelValues);
|
|
begin
|
|
{$IFDEF VCL}
|
|
CalcMinThumnailSize;
|
|
CalculateRects;
|
|
{$ELSE}
|
|
RecreateWidget;
|
|
if not Sender.NativeStyle then
|
|
begin
|
|
CalcMinThumnailSize;
|
|
CalculateRects;
|
|
end;
|
|
{$ENDIF}
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TcxScrollBar.MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
var
|
|
APart: TcxScrollBarPart;
|
|
begin
|
|
inherited;
|
|
if (Button <> mbLeft){$IFNDEF VCL} or FLookAndFeel.NativeStyle{$ENDIF} then Exit;
|
|
APart := GetScrollBarPart(Point(X, Y));
|
|
if APart <> sbpNone then
|
|
begin
|
|
if APart = sbpThumbnail then
|
|
begin
|
|
FDownMousePos := Point(X, Y);
|
|
FSavePosition := FPosition;
|
|
FSaveThumbnailPos := FThumbnail.TopLeft;
|
|
InternalScroll(scTrack);
|
|
end;
|
|
FState.PressedPart := APart;
|
|
FState.HotPart := APart;
|
|
if APart in cxTimerParts then
|
|
begin
|
|
DoScroll(APart);
|
|
TcxTimer(FTimer).Interval := cxScrollInitialInterval;
|
|
TcxTimer(FTimer).Enabled := True;
|
|
end;
|
|
Repaint;
|
|
end;
|
|
end;
|
|
|
|
procedure TcxScrollBar.MouseEnter(AControl: TControl);
|
|
begin
|
|
{$IFNDEF VCL}
|
|
inherited MouseEnter(AControl);
|
|
if FLookAndFeel.NativeStyle then Exit;
|
|
{$ENDIF}
|
|
if Painter.IsButtonHotTrack or (FState.PressedPart in cxTimerParts) then
|
|
Repaint;
|
|
end;
|
|
|
|
procedure TcxScrollBar.MouseLeave(AControl: TControl);
|
|
begin
|
|
{$IFNDEF VCL}
|
|
inherited MouseLeave(AControl);
|
|
if FLookAndFeel.NativeStyle then Exit;
|
|
{$ENDIF}
|
|
if FState.PressedPart <> sbpThumbnail then
|
|
FState.HotPart := sbpNone;
|
|
if Painter.IsButtonHotTrack or (FState.PressedPart in cxTimerParts) then
|
|
Invalidate;
|
|
end;
|
|
|
|
|
|
procedure TcxScrollBar.MouseMove(Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
APart: TcxScrollBarPart;
|
|
R: TRect;
|
|
ADelta, ANewPos, ASize: Integer;
|
|
|
|
procedure UpdateThumbnail(ADeltaX, ADeltaY: Integer);
|
|
begin
|
|
if FKind = sbHorizontal then
|
|
FThumbnail := Bounds(FSaveThumbnailPos.X, 0, ASize, Height)
|
|
else
|
|
FThumbnail := Bounds(0, FSaveThumbnailPos.Y, Width, ASize);
|
|
OffsetRect(FThumbnail, ADeltaX, ADeltaY);
|
|
AdjustPagesRects;
|
|
Repaint;
|
|
end;
|
|
|
|
begin
|
|
inherited MouseMove(Shift, X, Y);
|
|
{$IFNDEF VCL}
|
|
if FLookAndFeel.NativeStyle then Exit;
|
|
{$ENDIF}
|
|
APart := GetScrollBarPart(Point(X, Y));
|
|
if FState.PressedPart = sbpThumbnail then
|
|
begin
|
|
if FKind = sbHorizontal then
|
|
begin
|
|
ASize := FThumbnail.Right - FThumbnail.Left;
|
|
R := Rect(-cxScrollMinDistance, -cxScrollMaxDistance,
|
|
Width + cxScrollMinDistance, Height + cxScrollMaxDistance);
|
|
end
|
|
else
|
|
begin
|
|
ASize := FThumbnail.Bottom - FThumbnail.Top;
|
|
R := Rect(-cxScrollMaxDistance, -cxScrollMinDistance,
|
|
Width + cxScrollMaxDistance, Height + cxScrollMinDistance);
|
|
end;
|
|
if not (FUnlimitedTracking or PtInRect(R, Point(X, Y))) then
|
|
begin
|
|
if Position <> FSavePosition then
|
|
begin
|
|
Position := FSavePosition;
|
|
DoScroll(sbpThumbnail);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if FKind = sbHorizontal then
|
|
begin
|
|
ADelta := X - FDownMousePos.X;
|
|
if ADelta = 0 then Exit;
|
|
if (ADelta < 0) and (FSaveThumbnailPos.X + ADelta < FTopLeftArrow.Right) then
|
|
ADelta := FTopLeftArrow.Right - FSaveThumbnailPos.X
|
|
else
|
|
if (ADelta > 0) and (FSaveThumbnailPos.X + ASize + ADelta > FBottomRightArrow.Left) then
|
|
ADelta := FBottomRightArrow.Left - (FSaveThumbnailPos.X + ASize);
|
|
UpdateThumbnail(ADelta, 0);
|
|
end
|
|
else
|
|
begin
|
|
ADelta := Y - FDownMousePos.Y;
|
|
if ADelta = 0 then Exit;
|
|
if (ADelta < 0) and (FSaveThumbnailPos.Y + ADelta < FTopLeftArrow.Bottom) then
|
|
ADelta := FTopLeftArrow.Bottom - FSaveThumbnailPos.Y
|
|
else
|
|
if (ADelta > 0) and (FSaveThumbnailPos.Y + ASize + ADelta > FBottomRightArrow.Top) then
|
|
ADelta := FBottomRightArrow.Top - (FSaveThumbnailPos.Y + ASize);
|
|
UpdateThumbnail(0, ADelta);
|
|
end;
|
|
ANewPos := GetPositionFromThumbnail;
|
|
if ANewPos <> FPosition then
|
|
begin
|
|
FPosition := ANewPos;
|
|
DoScroll(sbpThumbnail);
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if FState.PressedPart <> sbpNone then
|
|
TcxTimer(FTimer).Enabled := FState.PressedPart = APart;
|
|
if (FState.HotPart <> APart) and Painter.IsButtonHotTrack then
|
|
begin
|
|
FState.HotPart := APart;
|
|
Repaint;
|
|
end
|
|
else
|
|
FState.HotPart := APart;
|
|
end;
|
|
end;
|
|
|
|
procedure TcxScrollBar.MouseUp(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
begin
|
|
inherited;
|
|
{$IFNDEF VCL}
|
|
// FUseSaveScrollCode := False;
|
|
if FLookAndFeel.NativeStyle then
|
|
begin
|
|
if Enabled and Visible then InternalScroll(scEndScroll);
|
|
FUseSaveScrollCode := False;
|
|
end
|
|
else
|
|
{$ENDIF}
|
|
begin
|
|
CancelScroll;
|
|
FState.HotPart := GetScrollBarPart(Point(X, Y));
|
|
end;
|
|
end;
|
|
|
|
procedure TcxScrollBar.Paint;
|
|
|
|
function GetButtonStateFromPartState(APart: TcxScrollBarPart): TcxButtonState;
|
|
begin
|
|
if not Enabled then
|
|
Result := cxbsDisabled
|
|
else
|
|
if (APart <> sbpThumbnail) or ((APart = sbpThumbnail) and
|
|
Painter.IsButtonHotTrack) then
|
|
begin
|
|
if FState.PressedPart <> sbpNone then
|
|
if (APart = FState.PressedPart) and (APart = FState.HotPart) then
|
|
Result := cxbsPressed
|
|
else
|
|
Result := cxbsNormal
|
|
else
|
|
if (APart = FState.HotPart) and not (csDesigning in ComponentState) then
|
|
Result := cxbsHot
|
|
else
|
|
Result := cxbsNormal
|
|
end
|
|
else
|
|
Result := cxbsNormal;
|
|
end;
|
|
|
|
var
|
|
AHorz: Boolean;
|
|
{$IFNDEF VCL}
|
|
R: TRect;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFNDEF VCL}
|
|
if FLookAndFeel.NativeStyle then
|
|
Exit;
|
|
{$ENDIF}
|
|
AHorz := FKind = sbHorizontal;
|
|
with Painter do
|
|
begin
|
|
if not IsRectEmpty(FThumbnail) then
|
|
DrawScrollBarPart(FCanvas, AHorz, FThumbnail, sbpThumbnail,
|
|
GetButtonStateFromPartState(sbpThumbnail))
|
|
else
|
|
begin
|
|
DrawScrollBarPart(FCanvas, AHorz, Bounds(0, 0, Width, Height),
|
|
sbpPageUp, cxbsNormal);
|
|
end;
|
|
DrawScrollBarPart(FCanvas, AHorz, FTopLeftArrow, sbpLineUp,
|
|
GetButtonStateFromPartState(sbpLineUp));
|
|
DrawScrollBarPart(FCanvas, AHorz, FBottomRightArrow, sbpLineDown,
|
|
GetButtonStateFromPartState(sbpLineDown));
|
|
if not IsRectEmpty(FPageUp) then
|
|
DrawScrollBarPart(FCanvas, AHorz, FPageUp, sbpPageUp,
|
|
GetButtonStateFromPartState(sbpPageUp));
|
|
if not IsRectEmpty(FPageDown) then
|
|
DrawScrollBarPart(FCanvas, AHorz, FPageDown, sbpPageDown,
|
|
GetButtonStateFromPartState(sbpPageDown));
|
|
end;
|
|
{$IFDEF VCL}
|
|
BitBlt(Canvas.Handle, 0, 0, FBitmap.Width, FBitmap.Height,
|
|
FCanvas.Handle, 0, 0, SRCCOPY);
|
|
{$ELSE}
|
|
R := Rect(0, 0, FBitmap.Width, FBitmap.Height);
|
|
Canvas.CopyRect(R, FCanvas.Canvas, R);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TcxScrollBar.Scroll(ScrollCode: TScrollCode; var ScrollPos: Integer);
|
|
begin
|
|
if Assigned(FOnScroll) then FOnScroll(Self, ScrollCode, ScrollPos);
|
|
end;
|
|
|
|
procedure TcxScrollBar.AdjustPagesRects;
|
|
begin
|
|
if not IsRectEmpty(FThumbnail) then
|
|
begin
|
|
if FKind = sbHorizontal then
|
|
begin
|
|
FPageUp := Rect(FTopLeftArrow.Right, 0, FThumbnail.Left, Height);
|
|
FPageDown := Rect(FThumbnail.Right, 0, FBottomRightArrow.Left, Height);
|
|
end
|
|
else
|
|
begin
|
|
FPageUp := Rect(0, FTopLeftArrow.Bottom, Width, FThumbnail.Top);
|
|
FPageDown := Rect(0, FThumbnail.Bottom, Width, FBottomRightArrow.Top);
|
|
end
|
|
end
|
|
else
|
|
begin
|
|
FPageUp := EmptyRect;
|
|
FPageDown := EmptyRect;
|
|
end;
|
|
end;
|
|
|
|
procedure TcxScrollBar.CalcMinThumnailSize;
|
|
begin
|
|
FThumbnailSize := Painter.ScrollBarMinimalThumbSize(FKind = sbVertical);
|
|
end;
|
|
|
|
procedure TcxScrollBar.CalculateRects;
|
|
var
|
|
W, H, ASize: Integer;
|
|
begin
|
|
if FKind = sbHorizontal then
|
|
begin
|
|
ASize := GetScrollBarSize.cy;
|
|
if (Width div 2) < ASize then W := Width div 2 else W := ASize;
|
|
FTopLeftArrow := Bounds(0, 0, W, Height);
|
|
FBottomRightArrow := Bounds(Width - W, 0, W, Height);
|
|
end
|
|
else
|
|
begin
|
|
ASize := GetScrollBarSize.cx;
|
|
if (Height div 2) < ASize then H := Height div 2 else H := ASize;
|
|
FTopLeftArrow := Bounds(0, 0, Width, H);
|
|
FBottomRightArrow := Bounds(0, Height - H, Width, H);
|
|
end;
|
|
CalculateThumbnailRect;
|
|
end;
|
|
|
|
procedure TcxScrollBar.CalculateThumbnailRect;
|
|
var
|
|
ADelta, ASize: Integer;
|
|
begin
|
|
FThumbnail := EmptyRect;
|
|
AdjustPagesRects;
|
|
if not Enabled then
|
|
Exit;
|
|
if FKind = sbHorizontal then
|
|
begin
|
|
ADelta := FBottomRightArrow.Left - FTopLeftArrow.Right;
|
|
if FPageSize = 0 then
|
|
begin
|
|
{$IFDEF VCL}
|
|
ASize := GetSystemMetrics(SM_CXHTHUMB);
|
|
{$ELSE}
|
|
ASize := FTopLeftArrow.Right - FTopLeftArrow.Left;
|
|
{$ENDIF}
|
|
if ASize > ADelta then Exit;
|
|
Dec(ADelta, ASize);
|
|
if (ADelta <= 0) or (FMax = FMin) then
|
|
FThumbnail := Bounds(FTopLeftArrow.Right, 0, ASize, Height)
|
|
else
|
|
FThumbnail := Bounds(FTopLeftArrow.Right +
|
|
MulDiv(ADelta, FPosition - FMin, FMax - FMin), 0, ASize, Height);
|
|
end
|
|
else
|
|
begin
|
|
ASize := MinInt(ADelta, MulDiv(FPageSize, ADelta, FMax - FMin + 1));
|
|
if (ADelta < FThumbnailSize) or (FMax = FMin) then Exit;
|
|
if ASize < FThumbnailSize then ASize := FThumbnailSize;
|
|
Dec(ADelta, ASize);
|
|
FThumbnail := Bounds(FTopLeftArrow.Right, 0, ASize, Height);
|
|
ASize := (FMax - FMin) - (FPageSize - 1);
|
|
OffsetRect(FThumbnail, MulDiv(ADelta, MinInt(FPosition - FMin, ASize), ASize), 0);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
ADelta := FBottomRightArrow.Top - FTopLeftArrow.Bottom;
|
|
if FPageSize = 0 then
|
|
begin
|
|
{$IFDEF VCL}
|
|
ASize := GetSystemMetrics(SM_CYVTHUMB);
|
|
{$ELSE}
|
|
ASize := FTopLeftArrow.Bottom - FTopLeftArrow.Top;
|
|
{$ENDIF}
|
|
if ASize > ADelta then Exit;
|
|
Dec(ADelta, ASize);
|
|
if (ADelta <= 0) or (FMax = FMin) then
|
|
FThumbnail := Bounds(0, FTopLeftArrow.Bottom, Width, ASize)
|
|
else
|
|
FThumbnail := Bounds(0, FTopLeftArrow.Bottom +
|
|
MulDiv(ADelta, FPosition - FMin, FMax - FMin), Width, ASize);
|
|
end
|
|
else
|
|
begin
|
|
ASize := MinInt(ADelta, MulDiv(FPageSize, ADelta, FMax - FMin + 1));
|
|
if (ADelta < FThumbnailSize) or (FMax = FMin) then Exit;
|
|
if ASize < FThumbnailSize then ASize := FThumbnailSize;
|
|
Dec(ADelta, ASize);
|
|
FThumbnail := Bounds(0, FTopLeftArrow.Bottom, Width, ASize);
|
|
ASize := (FMax - FMin) - (FPageSize - 1);
|
|
OffsetRect(FThumbnail, 0, MulDiv(ADelta, MinInt(FPosition - FMin, ASize), ASize));
|
|
end;
|
|
end;
|
|
AdjustPagesRects;
|
|
end;
|
|
|
|
procedure TcxScrollBar.CancelScroll;
|
|
begin
|
|
if FState.PressedPart <> sbpNone then
|
|
begin
|
|
if FState.PressedPart = sbpThumbnail then
|
|
begin
|
|
{$IFDEF VCL}
|
|
FPosition := GetPositionFromThumbnail;
|
|
{$ENDIF}
|
|
InternalScroll(scPosition);
|
|
end;
|
|
TcxTimer(FTimer).Enabled := False;
|
|
FState.PressedPart := sbpNone;
|
|
FState.HotPart := sbpNone;
|
|
InternalScroll(scEndScroll);
|
|
CalculateThumbnailRect;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TcxScrollBar.DoScroll(APart: TcxScrollBarPart);
|
|
begin
|
|
case APart of
|
|
sbpLineUp: InternalScroll(scLineUp);
|
|
sbpLineDown: InternalScroll(scLineDown);
|
|
sbpPageUp: InternalScroll(scPageUp);
|
|
sbpPageDown: InternalScroll(scPageDown);
|
|
sbpThumbnail: InternalScroll(scTrack);
|
|
end;
|
|
end;
|
|
|
|
function TcxScrollBar.GetPositionFromThumbnail: Integer;
|
|
var
|
|
ATotal, AThumbnailSize, ADistance: Integer;
|
|
begin
|
|
ATotal := FMax - FMin;
|
|
if FPageSize > 0 then Dec(ATotal, FPageSize - 1);
|
|
if FKind = sbHorizontal then
|
|
begin
|
|
AThumbnailSize := FThumbnail.Right - FThumbnail.Left;
|
|
ADistance := FBottomRightArrow.Left - FTopLeftArrow.Right - AThumbnailSize;
|
|
Result := FMin + MulDiv(ATotal, FThumbnail.Left - FTopLeftArrow.Right,
|
|
ADistance);
|
|
end
|
|
else
|
|
begin
|
|
AThumbnailSize := FThumbnail.Bottom - FThumbnail.Top;
|
|
ADistance := FBottomRightArrow.Top - FTopLeftArrow.Bottom - AThumbnailSize;
|
|
Result := FMin + MulDiv(ATotal, FThumbnail.Top - FTopLeftArrow.Bottom,
|
|
ADistance);
|
|
end;
|
|
end;
|
|
|
|
function TcxScrollBar.GetScrollBarPart(P: TPoint): TcxScrollBarPart;
|
|
begin
|
|
Result := sbpNone;
|
|
if not PtInRect(ClientRect, P) then
|
|
Exit;
|
|
if PtInRect(FTopLeftArrow, P) then
|
|
Result := sbpLineUp
|
|
else if PtInRect(FBottomRightArrow, P) then
|
|
Result := sbpLineDown
|
|
else if IsRectEmpty(FThumbnail) then
|
|
Exit
|
|
else if PtInRect(FThumbnail, P) then
|
|
Result := sbpThumbnail
|
|
else if PtInRect(FPageUp, P) then
|
|
Result := sbpPageUp
|
|
else if PtInRect(FPageDown, P) then
|
|
Result := sbpPageDown
|
|
end;
|
|
|
|
procedure TcxScrollBar.InternalScroll(AScrollCode: TScrollCode);
|
|
var
|
|
ScrollPos: Integer;
|
|
NewPos: Longint;
|
|
|
|
procedure CorrectPos(var APos: Integer);
|
|
begin
|
|
if APos < Min then APos := Min;
|
|
if APos > Max then APos := Max;
|
|
end;
|
|
|
|
begin
|
|
{$IFNDEF VCL}
|
|
if FParamsChanging then Exit;
|
|
{$ENDIF}
|
|
NewPos := Position;
|
|
{$IFNDEF VCL}
|
|
if not FUseSaveScrollCode then
|
|
{$ENDIF}
|
|
case AScrollCode of
|
|
scLineUp:
|
|
Dec(NewPos, SmallChange);
|
|
scLineDown:
|
|
Inc(NewPos, SmallChange);
|
|
scPageUp:
|
|
Dec(NewPos, LargeChange);
|
|
scPageDown:
|
|
Inc(NewPos, LargeChange);
|
|
scTop:
|
|
{$IFNDEF VCL}
|
|
if not FLookAndFeel.NativeStyle then
|
|
{$ENDIF}
|
|
NewPos := FMin;
|
|
scBottom:
|
|
{$IFNDEF VCL}
|
|
if not FLookAndFeel.NativeStyle then
|
|
{$ENDIF}
|
|
NewPos := FMax;
|
|
end;
|
|
CorrectPos(NewPos);
|
|
ScrollPos := NewPos;
|
|
{$IFNDEF VCL}
|
|
if FUseSaveScrollCode then AScrollCode := FSaveScrollCode;
|
|
Scroll(AScrollCode, ScrollPos);
|
|
if FLookAndFeel.NativeStyle then
|
|
begin
|
|
if ScrollPos <> NewPos then
|
|
begin
|
|
case AScrollCode of
|
|
scPageDown:
|
|
Dec(ScrollPos, LargeChange);
|
|
scPageUp:
|
|
Inc(ScrollPos, LargeChange);
|
|
scLineDown:
|
|
Dec(ScrollPos, SmallChange);
|
|
scLineUp:
|
|
Inc(ScrollPos, SmallChange);
|
|
end;
|
|
Position := ScrollPos;
|
|
end;
|
|
FPosition := Position;
|
|
end
|
|
else
|
|
{$ELSE}
|
|
Scroll(AScrollCode, ScrollPos);
|
|
{$ENDIF}
|
|
begin
|
|
CorrectPos(ScrollPos);
|
|
if ScrollPos <> FPosition then
|
|
begin
|
|
if AScrollCode <> scTrack then
|
|
SetPosition(ScrollPos)
|
|
else
|
|
begin
|
|
FPosition := ScrollPos;
|
|
Repaint;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF VCL}
|
|
|
|
procedure TcxScrollBar.ThemeChanged;
|
|
begin
|
|
CalcMinThumnailSize;
|
|
CalculateRects;
|
|
UpdateScrollBarBitmaps;
|
|
Invalidate;
|
|
if Parent <> nil then
|
|
Parent.Realign;
|
|
end;
|
|
|
|
procedure TcxScrollBar.CMEnabledChanged(var Message: TMessage);
|
|
begin
|
|
inherited;
|
|
CalculateRects;
|
|
if not Enabled then
|
|
CancelScroll;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TcxScrollBar.CNHScroll(var Message: TWMHScroll);
|
|
begin
|
|
InternalScroll(TScrollCode(Message.ScrollCode));
|
|
end;
|
|
|
|
procedure TcxScrollBar.CMMouseEnter(var Message: TMessage);
|
|
begin
|
|
inherited;
|
|
if Message.lParam = 0 then
|
|
MouseEnter(Self)
|
|
else
|
|
{$IFNDEF CLR}
|
|
MouseEnter(TControl(Message.lParam));
|
|
{$ELSE}
|
|
//TODO CLR check it out
|
|
if (Parent <> nil) and (Message.lParam < Parent.ControlCount)
|
|
and (Message.lParam >= 0) then
|
|
MouseEnter(Parent.Controls[Message.lParam]);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TcxScrollBar.CMMouseLeave(var Message: TMessage);
|
|
begin
|
|
inherited;
|
|
if Message.lParam = 0 then
|
|
MouseLeave(Self)
|
|
else
|
|
{$IFNDEF CLR}
|
|
MouseLeave(TControl(Message.lParam));
|
|
{$ELSE}
|
|
//TODO CLR check it out
|
|
if (Parent <> nil) and (Message.lParam < Parent.ControlCount)
|
|
and (Message.lParam >= 0) then
|
|
MouseLeave(Parent.Controls[Message.lParam]);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TcxScrollBar.CMSysColorChange(var Message: TMessage);
|
|
begin
|
|
UpdateScrollBarBitmaps;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TcxScrollBar.CMVisibleChanged(var Message: TMessage);
|
|
begin
|
|
if not Visible then CancelScroll;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TcxScrollBar.CNVScroll(var Message: TWMVScroll);
|
|
begin
|
|
InternalScroll(TScrollCode(Message.ScrollCode));
|
|
end;
|
|
|
|
procedure TcxScrollBar.CNCtlColorScrollBar(var Message: TMessage);
|
|
begin
|
|
UpdateScrollBarBitmaps;
|
|
with Message do
|
|
CallWindowProc(DefWndProc, Handle, Msg, WParam, LParam);
|
|
end;
|
|
|
|
procedure TcxScrollBar.WMEraseBkgnd(var Message: TWMEraseBkgnd);
|
|
begin
|
|
Message.Result := 1;
|
|
end;
|
|
|
|
procedure TcxScrollBar.WMCancelMode(var Message: TWMCancelMode);
|
|
begin
|
|
CancelScroll;
|
|
inherited;
|
|
end;
|
|
|
|
{$ELSE}
|
|
|
|
function TcxScrollBar.GetHandle: QScrollBarH;
|
|
begin
|
|
HandleNeeded;
|
|
Result := QScrollBarH(FHandle);
|
|
end;
|
|
|
|
function TcxScrollBar.GetLargeChange: TScrollBarInc;
|
|
begin
|
|
if FLookAndFeel.NativeStyle then
|
|
Result := QRangeControl_pageStep(RangeControl)
|
|
else
|
|
Result := FLargeChange;
|
|
end;
|
|
|
|
function TcxScrollBar.GetMax: Integer;
|
|
begin
|
|
if FLookAndFeel.NativeStyle then
|
|
Result := QRangeControl_maxValue(RangeControl)
|
|
else
|
|
Result := FMax;
|
|
end;
|
|
|
|
function TcxScrollBar.GetMin: Integer;
|
|
begin
|
|
if FLookAndFeel.NativeStyle then
|
|
Result := QRangeControl_minValue(RangeControl)
|
|
else
|
|
Result := FMin;
|
|
end;
|
|
|
|
function TcxScrollBar.GetPosition: Integer;
|
|
begin
|
|
if FLookAndFeel.NativeStyle then
|
|
Result := QRangeControl_value(RangeControl)
|
|
else
|
|
Result := FPosition;
|
|
end;
|
|
|
|
function TcxScrollBar.GetSmallChange: TScrollBarInc;
|
|
begin
|
|
if FLookAndFeel.NativeStyle then
|
|
Result := QRangeControl_lineStep(RangeControl)
|
|
else
|
|
Result := FSmallChange;
|
|
end;
|
|
|
|
procedure TcxScrollBar.NextLineHook;
|
|
begin
|
|
FSaveScrollCode := scLineDown;
|
|
FUseSaveScrollCode := True;
|
|
end;
|
|
|
|
procedure TcxScrollBar.NextPageHook;
|
|
begin
|
|
FSaveScrollCode := scPageDown;
|
|
FUseSaveScrollCode := True;
|
|
end;
|
|
|
|
procedure TcxScrollBar.PrevLineHook;
|
|
begin
|
|
FSaveScrollCode := scLineUp;
|
|
FUseSaveScrollCode := True;
|
|
end;
|
|
|
|
procedure TcxScrollBar.PrevPageHook;
|
|
begin
|
|
FSaveScrollCode := scPageUp;
|
|
FUseSaveScrollCode := True;
|
|
end;
|
|
|
|
procedure TcxScrollBar.SetLargeChange(const Value: TScrollBarInc);
|
|
begin
|
|
if Value <> LargeChange then
|
|
if FLookAndFeel.NativeStyle then
|
|
begin
|
|
QRangeControl_setSteps(RangeControl, SmallChange, Value);
|
|
FLargeChange := LargeChange;
|
|
end
|
|
else
|
|
FLargeChange := Value;
|
|
end;
|
|
|
|
procedure TcxScrollBar.SetSmallChange(const Value: TScrollBarInc);
|
|
begin
|
|
if Value <> SmallChange then
|
|
if FLookAndFeel.NativeStyle then
|
|
begin
|
|
QRangeControl_SetSteps(RangeControl, Value, LargeChange);
|
|
FSmallChange := SmallChange;
|
|
end
|
|
else
|
|
FSmallChange := Value;
|
|
end;
|
|
|
|
procedure TcxScrollBar.SliderPressedHook;
|
|
begin
|
|
FUseSaveScrollCode := False;
|
|
try
|
|
InternalScroll(scTrack);
|
|
except
|
|
Application.HandleException(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TcxScrollBar.SliderReleasedHook;
|
|
begin
|
|
try
|
|
InternalScroll(scPosition);
|
|
except
|
|
Application.HandleException(Self);
|
|
end;
|
|
end;
|
|
|
|
function TcxScrollBar.RangeControl: QRangeControlH;
|
|
begin
|
|
if not Assigned(FRangeControl) then
|
|
FRangeControl := QScrollBar_to_QRangeControl(Handle);
|
|
Result := FRangeControl;
|
|
end;
|
|
|
|
procedure TcxScrollBar.ValueChangedHook(Value: Integer);
|
|
begin
|
|
try
|
|
InternalScroll(scTrack);
|
|
FUseSaveScrollCode := False;
|
|
if Position = Min then InternalScroll(scTop)
|
|
else if Position = Max then InternalScroll(scBottom);
|
|
Change;
|
|
except
|
|
Application.HandleException(Self);
|
|
end;
|
|
end;
|
|
|
|
{$ENDIF}
|
|
|
|
end.
|