mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-22 01:39:42 +02:00
cocoa: TTrackBar implementation
git-svn-id: trunk@46264 -
This commit is contained in:
sekelsenmat
parent
8cea4118ab
commit
256196bcd2
@ -683,12 +683,47 @@ type
|
||||
function lclIsHandle: Boolean; override;
|
||||
end;
|
||||
|
||||
{ TCocoaProgressIndicator }
|
||||
|
||||
TCocoaProgressIndicator = objcclass(NSProgressIndicator)
|
||||
callback: ICommonCallback;
|
||||
function acceptsFirstResponder: Boolean; override;
|
||||
function becomeFirstResponder: Boolean; override;
|
||||
function resignFirstResponder: Boolean; override;
|
||||
function lclGetCallback: ICommonCallback; override;
|
||||
procedure lclClearCallback; override;
|
||||
procedure resetCursorRects; override;
|
||||
end;
|
||||
|
||||
{ TCocoaSlider }
|
||||
|
||||
TCocoaSlider = objcclass(NSSlider)
|
||||
callback: ICommonCallback;
|
||||
function acceptsFirstResponder: Boolean; override;
|
||||
function becomeFirstResponder: Boolean; override;
|
||||
function resignFirstResponder: Boolean; override;
|
||||
function lclGetCallback: ICommonCallback; override;
|
||||
procedure lclClearCallback; override;
|
||||
procedure resetCursorRects; override;
|
||||
//
|
||||
procedure keyDown(event: NSEvent); override;
|
||||
procedure keyUp(event: NSEvent); override;
|
||||
//
|
||||
procedure SnapToInteger(AExtraFactor: Integer = 0); message 'SnapToInteger:';
|
||||
procedure sliderAction(sender: id); message 'sliderAction:';
|
||||
end;
|
||||
|
||||
TCocoaSliderCell = objcclass(NSSliderCell)
|
||||
end;
|
||||
|
||||
procedure SetViewDefaults(AView: NSView);
|
||||
function CheckMainThread: Boolean;
|
||||
function GetNSViewSuperViewHeight(view: NSView): CGFloat;
|
||||
|
||||
implementation
|
||||
|
||||
{$I mackeycodes.inc}
|
||||
|
||||
procedure SetViewDefaults(AView: NSView);
|
||||
begin
|
||||
if not Assigned(AView) then Exit;
|
||||
@ -1681,7 +1716,7 @@ end;
|
||||
procedure TCocoaCustomControl.drawRect(dirtyRect: NSRect);
|
||||
begin
|
||||
inherited drawRect(dirtyRect);
|
||||
if CheckMainThread and ASsigned(callback) then
|
||||
if CheckMainThread and Assigned(callback) then
|
||||
callback.Draw(NSGraphicsContext.currentContext, bounds, dirtyRect);
|
||||
end;
|
||||
|
||||
@ -2655,7 +2690,7 @@ end;
|
||||
|
||||
procedure TCocoaTableListView.mouseDragged(event: NSEvent);
|
||||
begin
|
||||
if not Assigned(callback) or not callback.MouseMove(event) then
|
||||
if not Assigned(callback) or not callback.MouseMove(event) then
|
||||
inherited mouseDragged(event);
|
||||
end;
|
||||
|
||||
@ -2921,5 +2956,122 @@ begin
|
||||
result:=menuItemCallback;
|
||||
end;
|
||||
|
||||
{ TCocoaProgressIndicator }
|
||||
|
||||
function TCocoaProgressIndicator.acceptsFirstResponder: Boolean;
|
||||
begin
|
||||
Result:=True;
|
||||
end;
|
||||
|
||||
function TCocoaProgressIndicator.becomeFirstResponder: Boolean;
|
||||
begin
|
||||
Result := inherited becomeFirstResponder;
|
||||
callback.BecomeFirstResponder;
|
||||
end;
|
||||
|
||||
function TCocoaProgressIndicator.resignFirstResponder: Boolean;
|
||||
begin
|
||||
Result := inherited resignFirstResponder;
|
||||
callback.ResignFirstResponder;
|
||||
end;
|
||||
|
||||
function TCocoaProgressIndicator.lclGetCallback: ICommonCallback;
|
||||
begin
|
||||
Result:=callback;
|
||||
end;
|
||||
|
||||
procedure TCocoaProgressIndicator.lclClearCallback;
|
||||
begin
|
||||
callback:=nil;
|
||||
end;
|
||||
|
||||
procedure TCocoaProgressIndicator.resetCursorRects;
|
||||
begin
|
||||
if not callback.resetCursorRects then
|
||||
inherited resetCursorRects;
|
||||
end;
|
||||
|
||||
{ TCocoaSlider }
|
||||
|
||||
function TCocoaSlider.acceptsFirstResponder: Boolean;
|
||||
begin
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
function TCocoaSlider.becomeFirstResponder: Boolean;
|
||||
begin
|
||||
Result := inherited becomeFirstResponder;
|
||||
callback.BecomeFirstResponder;
|
||||
end;
|
||||
|
||||
function TCocoaSlider.resignFirstResponder: Boolean;
|
||||
begin
|
||||
Result := inherited resignFirstResponder;
|
||||
callback.ResignFirstResponder;
|
||||
end;
|
||||
|
||||
function TCocoaSlider.lclGetCallback: ICommonCallback;
|
||||
begin
|
||||
Result:=callback;
|
||||
end;
|
||||
|
||||
procedure TCocoaSlider.lclClearCallback;
|
||||
begin
|
||||
callback := nil;
|
||||
end;
|
||||
|
||||
procedure TCocoaSlider.resetCursorRects;
|
||||
begin
|
||||
if not callback.resetCursorRects then
|
||||
inherited resetCursorRects;
|
||||
end;
|
||||
|
||||
procedure TCocoaSlider.keyDown(event: NSEvent);
|
||||
var
|
||||
KeyCode: word;
|
||||
begin
|
||||
KeyCode := Event.keyCode;
|
||||
case KeyCode of
|
||||
MK_UP : SnapToInteger(1);
|
||||
MK_DOWN : SnapToInteger(-1);
|
||||
MK_LEFT : SnapToInteger(-1);
|
||||
MK_RIGHT : SnapToInteger(1);
|
||||
else
|
||||
// If this isn't done callback.KeyEvent will cause arrow left/right to change control
|
||||
if Assigned(callback) then callback.KeyEvent(event)
|
||||
else inherited keyDown(event);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCocoaSlider.keyUp(event: NSEvent);
|
||||
var
|
||||
KeyCode: word;
|
||||
begin
|
||||
KeyCode := Event.keyCode;
|
||||
case KeyCode of
|
||||
MK_UP, MK_DOWN, MK_LEFT, MK_RIGHT: inherited keyUp(event);
|
||||
else
|
||||
// If this isn't done callback.KeyEvent will cause arrow left/right to change control
|
||||
if Assigned(callback) then callback.KeyEvent(event)
|
||||
else inherited keyUp(event);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCocoaSlider.SnapToInteger(AExtraFactor: Integer);
|
||||
begin
|
||||
setIntValue(Round(doubleValue() + AExtraFactor));
|
||||
end;
|
||||
|
||||
procedure TCocoaSlider.sliderAction(sender: id);
|
||||
var
|
||||
Msg: TLMessage;
|
||||
begin
|
||||
SnapToInteger();
|
||||
// OnChange event
|
||||
FillChar(Msg, SizeOf(Msg), #0);
|
||||
Msg.Msg := LM_CHANGED;
|
||||
DeliverMessage(Msg);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -13,6 +13,7 @@ uses
|
||||
MacOSAll, CocoaAll,
|
||||
Classes, LCLType, SysUtils, Contnrs, LCLMessageGlue, LMessages,
|
||||
Controls, ComCtrls, Types, StdCtrls, LCLProc, Graphics, ImgList,
|
||||
Math,
|
||||
// WS
|
||||
WSComCtrls,
|
||||
// Cocoa WS
|
||||
@ -149,6 +150,55 @@ type
|
||||
class procedure SetStyle(const AProgressBar: TCustomProgressBar; const NewStyle: TProgressBarStyle); override;
|
||||
end;
|
||||
|
||||
{ TCocoaWSCustomUpDown }
|
||||
|
||||
TCocoaWSCustomUpDown = class(TWSCustomUpDown)
|
||||
published
|
||||
end;
|
||||
|
||||
{ TCarbonWSUpDown }
|
||||
|
||||
TCarbonWSUpDown = class(TWSUpDown)
|
||||
published
|
||||
end;
|
||||
|
||||
{ TCocoaWSToolButton }
|
||||
|
||||
TCocoaWSToolButton = class(TWSToolButton)
|
||||
published
|
||||
end;
|
||||
|
||||
{ TCarbonWSToolBar }
|
||||
|
||||
TCarbonWSToolBar = class(TWSToolBar)
|
||||
published
|
||||
//class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
|
||||
end;
|
||||
|
||||
{ TCocoaWSTrackBar }
|
||||
|
||||
TCocoaWSTrackBar = class(TWSTrackBar)
|
||||
published
|
||||
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
|
||||
class procedure ApplyChanges(const ATrackBar: TCustomTrackBar); override;
|
||||
class function GetPosition(const ATrackBar: TCustomTrackBar): integer; override;
|
||||
class procedure SetPosition(const ATrackBar: TCustomTrackBar; const {%H-}NewPosition: integer); override;
|
||||
class procedure SetOrientation(const ATrackBar: TCustomTrackBar; const AOrientation: TTrackBarOrientation); override;
|
||||
//class procedure SetTick(const ATrackBar: TCustomTrackBar; const ATick: integer); virtual;
|
||||
end;
|
||||
|
||||
{ TCocoaWSCustomTreeView }
|
||||
|
||||
TCocoaWSCustomTreeView = class(TWSCustomTreeView)
|
||||
published
|
||||
end;
|
||||
|
||||
{ TCocoaWSTreeView }
|
||||
|
||||
TCocoaWSTreeView = class(TWSTreeView)
|
||||
published
|
||||
end;
|
||||
|
||||
{ TLCLListViewCallback }
|
||||
|
||||
TLCLListViewCallback = class(TLCLCommonCallback, IListViewCallback)
|
||||
@ -159,32 +209,6 @@ type
|
||||
|
||||
implementation
|
||||
|
||||
type
|
||||
{ TCocoaProgressIndicator }
|
||||
|
||||
TCocoaProgressIndicator = objcclass(NSProgressIndicator)
|
||||
callback: ICommonCallback;
|
||||
function acceptsFirstResponder: Boolean; override;
|
||||
function becomeFirstResponder: Boolean; override;
|
||||
function resignFirstResponder: Boolean; override;
|
||||
function lclGetCallback: ICommonCallback; override;
|
||||
procedure lclClearCallback; override;
|
||||
procedure resetCursorRects; override;
|
||||
end;
|
||||
|
||||
|
||||
function AllocProgressIndicator(ATarget: TWinControl; const AParams: TCreateParams): TCocoaProgressIndicator;
|
||||
begin
|
||||
Result := TCocoaProgressIndicator.alloc.lclInitWithCreateParams(AParams);
|
||||
if Assigned(Result) then
|
||||
begin
|
||||
Result.callback := TLCLCommonCallback.Create(Result, ATarget);
|
||||
Result.startAnimation(nil);
|
||||
//small constrol size looks like carbon
|
||||
//Result.setControlSize(NSSmallControlSize);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TCocoaWSCustomPage }
|
||||
|
||||
class function TCocoaWSCustomPage.CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle;
|
||||
@ -858,8 +882,18 @@ end;
|
||||
|
||||
class function TCocoaWSProgressBar.CreateHandle(const AWinControl: TWinControl;
|
||||
const AParams: TCreateParams): TLCLIntfHandle;
|
||||
var
|
||||
lResult: TCocoaProgressIndicator;
|
||||
begin
|
||||
Result:=TLCLIntfHandle(AllocProgressIndicator(AWinControl, AParams));
|
||||
lResult := TCocoaProgressIndicator.alloc.lclInitWithCreateParams(AParams);
|
||||
if Assigned(lResult) then
|
||||
begin
|
||||
lResult.callback := TLCLCommonCallback.Create(lResult, AWinControl);
|
||||
lResult.startAnimation(nil);
|
||||
//small constrol size looks like carbon
|
||||
//lResult.setControlSize(NSSmallControlSize);
|
||||
end;
|
||||
Result := TLCLIntfHandle(lResult);
|
||||
end;
|
||||
|
||||
class procedure TCocoaWSProgressBar.ApplyChanges(
|
||||
@ -913,41 +947,6 @@ begin
|
||||
callback:=nil;
|
||||
end; *)
|
||||
|
||||
{ TCocoaProgressIndicator }
|
||||
|
||||
function TCocoaProgressIndicator.acceptsFirstResponder: Boolean;
|
||||
begin
|
||||
Result:=True;
|
||||
end;
|
||||
|
||||
function TCocoaProgressIndicator.becomeFirstResponder: Boolean;
|
||||
begin
|
||||
Result := inherited becomeFirstResponder;
|
||||
callback.BecomeFirstResponder;
|
||||
end;
|
||||
|
||||
function TCocoaProgressIndicator.resignFirstResponder: Boolean;
|
||||
begin
|
||||
Result := inherited resignFirstResponder;
|
||||
callback.ResignFirstResponder;
|
||||
end;
|
||||
|
||||
function TCocoaProgressIndicator.lclGetCallback: ICommonCallback;
|
||||
begin
|
||||
Result:=callback;
|
||||
end;
|
||||
|
||||
procedure TCocoaProgressIndicator.lclClearCallback;
|
||||
begin
|
||||
callback:=nil;
|
||||
end;
|
||||
|
||||
procedure TCocoaProgressIndicator.resetCursorRects;
|
||||
begin
|
||||
if not callback.resetCursorRects then
|
||||
inherited resetCursorRects;
|
||||
end;
|
||||
|
||||
{ TLCLListViewCallback }
|
||||
|
||||
procedure TLCLListViewCallback.delayedSelectionDidChange_OnTimer(
|
||||
@ -957,4 +956,111 @@ begin
|
||||
TCocoaTableListView(Owner).tableViewSelectionDidChange(nil);
|
||||
end;
|
||||
|
||||
{ TCocoaWSTrackBar }
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCocoaWSTrackBar.CreateHandle
|
||||
Params: AWinControl - LCL control
|
||||
AParams - Creation parameters
|
||||
Returns: Handle to the control in Carbon interface
|
||||
|
||||
Creates new track bar with the specified parameters
|
||||
------------------------------------------------------------------------------}
|
||||
class function TCocoaWSTrackBar.CreateHandle(const AWinControl: TWinControl;
|
||||
const AParams: TCreateParams): TLCLIntfHandle;
|
||||
var
|
||||
lResult: TCocoaSlider;
|
||||
begin
|
||||
lResult := TCocoaSlider.alloc.lclInitWithCreateParams(AParams);
|
||||
if Assigned(lResult) then
|
||||
begin
|
||||
lResult.callback := TLCLCommonCallback.Create(lResult, AWinControl);
|
||||
lResult.setTarget(lResult);
|
||||
lResult.setAction(objcselector('sliderAction:'));
|
||||
end;
|
||||
Result := TLCLIntfHandle(lResult);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCocoaWSTrackBar.ApplyChanges
|
||||
Params: ATrackBar - LCL custom track bar
|
||||
|
||||
Sets the parameters (Min, Max, Position, Ticks) of slider
|
||||
------------------------------------------------------------------------------}
|
||||
class procedure TCocoaWSTrackBar.ApplyChanges(const ATrackBar: TCustomTrackBar);
|
||||
var
|
||||
lSlider: TCocoaSlider;
|
||||
lTickCount, lTrackBarLength: Integer;
|
||||
begin
|
||||
if not Assigned(ATrackBar) or not ATrackBar.HandleAllocated then Exit;
|
||||
lSlider := TCocoaSlider(ATrackBar.Handle);
|
||||
lSlider.setMaxValue(ATrackBar.Max);
|
||||
lSlider.setMinValue(ATrackBar.Min);
|
||||
lSlider.setIntValue(ATrackBar.Position);
|
||||
|
||||
if ATrackBar.Orientation = trHorizontal then
|
||||
lTrackBarLength := ATrackBar.Width
|
||||
else
|
||||
lTrackBarLength := ATrackBar.Height;
|
||||
|
||||
// Ticks
|
||||
if ATrackBar.TickStyle = tsNone then
|
||||
begin
|
||||
lTickCount := 0;
|
||||
end
|
||||
else
|
||||
begin
|
||||
lTickCount := lTrackBarLength div 5;
|
||||
lTickCount := Min(lTickCount, ATrackBar.Max-ATrackBar.Min);
|
||||
end;
|
||||
lSlider.setNumberOfTickMarks(lTickCount);
|
||||
|
||||
//procedure setAltIncrementValue(incValue: double); message 'setAltIncrementValue:';
|
||||
//procedure setTitle(aString: NSString); message 'setTitle:';
|
||||
//procedure setKnobThickness(aFloat: CGFloat); message 'setKnobThickness:';
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCocoaWSTrackBar.GetPosition
|
||||
Params: ATrackBar - LCL custom track bar
|
||||
Returns: Position of slider
|
||||
------------------------------------------------------------------------------}
|
||||
class function TCocoaWSTrackBar.GetPosition(const ATrackBar: TCustomTrackBar
|
||||
): integer;
|
||||
var
|
||||
lSlider: TCocoaSlider;
|
||||
begin
|
||||
if not Assigned(ATrackBar) or not ATrackBar.HandleAllocated then Exit;
|
||||
lSlider := TCocoaSlider(ATrackBar.Handle);
|
||||
Result := lSlider.intValue();
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCocoaWSTrackBar.SetPosition
|
||||
Params: ATrackBar - LCL custom track bar
|
||||
NewPosition - New position
|
||||
|
||||
Sets the position of slider
|
||||
------------------------------------------------------------------------------}
|
||||
class procedure TCocoaWSTrackBar.SetPosition(const ATrackBar: TCustomTrackBar;
|
||||
const NewPosition: integer);
|
||||
var
|
||||
lSlider: TCocoaSlider;
|
||||
begin
|
||||
if not Assigned(ATrackBar) or not ATrackBar.HandleAllocated then Exit;
|
||||
lSlider := TCocoaSlider(ATrackBar.Handle);
|
||||
lSlider.setIntValue(ATrackBar.Position);
|
||||
end;
|
||||
|
||||
// Cocoa auto-detects the orientation based on width/height and there seams
|
||||
// to be no way to force it
|
||||
class procedure TCocoaWSTrackBar.SetOrientation(
|
||||
const ATrackBar: TCustomTrackBar; const AOrientation: TTrackBarOrientation);
|
||||
begin
|
||||
if (AOrientation = trHorizontal) and (ATrackBar.Height > ATrackBar.Width) then
|
||||
ATrackBar.Width := ATrackBar.Height + 1
|
||||
else if (AOrientation = trVertical) and (ATrackBar.Width > ATrackBar.Height then
|
||||
ATrackBar.Height := ATrackBar.Width + 1;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -197,7 +197,8 @@ end;
|
||||
|
||||
function RegisterCustomTrackBar: Boolean; alias : 'WSRegisterCustomTrackBar';
|
||||
begin
|
||||
Result := False;
|
||||
RegisterWSComponent(TCustomTrackBar, TCocoaWSTrackBar);
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
function RegisterCustomTreeView: Boolean; alias : 'WSRegisterCustomTreeView';
|
||||
|
||||
Loading…
Reference in New Issue
Block a user