cocoa: TTrackBar implementation

git-svn-id: trunk@46264 -
This commit is contained in:
sekelsenmat 2014-09-20 12:30:50 +00:00
parent 8cea4118ab
commit 256196bcd2
3 changed files with 324 additions and 65 deletions

View File

@ -683,12 +683,47 @@ type
function lclIsHandle: Boolean; override; function lclIsHandle: Boolean; override;
end; 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); procedure SetViewDefaults(AView: NSView);
function CheckMainThread: Boolean; function CheckMainThread: Boolean;
function GetNSViewSuperViewHeight(view: NSView): CGFloat; function GetNSViewSuperViewHeight(view: NSView): CGFloat;
implementation implementation
{$I mackeycodes.inc}
procedure SetViewDefaults(AView: NSView); procedure SetViewDefaults(AView: NSView);
begin begin
if not Assigned(AView) then Exit; if not Assigned(AView) then Exit;
@ -1681,7 +1716,7 @@ end;
procedure TCocoaCustomControl.drawRect(dirtyRect: NSRect); procedure TCocoaCustomControl.drawRect(dirtyRect: NSRect);
begin begin
inherited drawRect(dirtyRect); inherited drawRect(dirtyRect);
if CheckMainThread and ASsigned(callback) then if CheckMainThread and Assigned(callback) then
callback.Draw(NSGraphicsContext.currentContext, bounds, dirtyRect); callback.Draw(NSGraphicsContext.currentContext, bounds, dirtyRect);
end; end;
@ -2921,5 +2956,122 @@ begin
result:=menuItemCallback; result:=menuItemCallback;
end; 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. end.

View File

@ -13,6 +13,7 @@ uses
MacOSAll, CocoaAll, MacOSAll, CocoaAll,
Classes, LCLType, SysUtils, Contnrs, LCLMessageGlue, LMessages, Classes, LCLType, SysUtils, Contnrs, LCLMessageGlue, LMessages,
Controls, ComCtrls, Types, StdCtrls, LCLProc, Graphics, ImgList, Controls, ComCtrls, Types, StdCtrls, LCLProc, Graphics, ImgList,
Math,
// WS // WS
WSComCtrls, WSComCtrls,
// Cocoa WS // Cocoa WS
@ -149,6 +150,55 @@ type
class procedure SetStyle(const AProgressBar: TCustomProgressBar; const NewStyle: TProgressBarStyle); override; class procedure SetStyle(const AProgressBar: TCustomProgressBar; const NewStyle: TProgressBarStyle); override;
end; 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 }
TLCLListViewCallback = class(TLCLCommonCallback, IListViewCallback) TLCLListViewCallback = class(TLCLCommonCallback, IListViewCallback)
@ -159,32 +209,6 @@ type
implementation 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 } { TCocoaWSCustomPage }
class function TCocoaWSCustomPage.CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; class function TCocoaWSCustomPage.CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle;
@ -858,8 +882,18 @@ end;
class function TCocoaWSProgressBar.CreateHandle(const AWinControl: TWinControl; class function TCocoaWSProgressBar.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): TLCLIntfHandle; const AParams: TCreateParams): TLCLIntfHandle;
var
lResult: TCocoaProgressIndicator;
begin 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; end;
class procedure TCocoaWSProgressBar.ApplyChanges( class procedure TCocoaWSProgressBar.ApplyChanges(
@ -913,41 +947,6 @@ begin
callback:=nil; callback:=nil;
end; *) 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 } { TLCLListViewCallback }
procedure TLCLListViewCallback.delayedSelectionDidChange_OnTimer( procedure TLCLListViewCallback.delayedSelectionDidChange_OnTimer(
@ -957,4 +956,111 @@ begin
TCocoaTableListView(Owner).tableViewSelectionDidChange(nil); TCocoaTableListView(Owner).tableViewSelectionDidChange(nil);
end; 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. end.

View File

@ -197,7 +197,8 @@ end;
function RegisterCustomTrackBar: Boolean; alias : 'WSRegisterCustomTrackBar'; function RegisterCustomTrackBar: Boolean; alias : 'WSRegisterCustomTrackBar';
begin begin
Result := False; RegisterWSComponent(TCustomTrackBar, TCocoaWSTrackBar);
Result := True;
end; end;
function RegisterCustomTreeView: Boolean; alias : 'WSRegisterCustomTreeView'; function RegisterCustomTreeView: Boolean; alias : 'WSRegisterCustomTreeView';