paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-11 18:59:19 +02:00
Code Issues Packages Projects Releases Wiki Activity

Carbon intf:

Browse Source 
- removed inline
- fixed MenuItem.Enabled, disabling main menu on show modal
- fixed fsStayOnTop form style

git-svn-id: trunk@10975 -
This commit is contained in:
tombo 2007-04-19 12:40:10 +00:00
parent f73e81e3de
commit d62398550f
22 changed files with 900 additions and 509 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lcl/interfaces/carbon/carbondbgconsts.pp
View File

@ -30,10 +30,10 @@ const
SDestroyWidget = 'DestroyWidget';
SInvalidate = 'Invalidate';
SEnable = 'Enable';
SSetFocus = 'SetFocus';
SSetColor = 'SetColor';
SGetText = 'GetText';
SSetText = 'SetText';
SSetReadOnly = 'SetReadOnly';
SShowModal = 'ShowModal';
@ -44,6 +44,7 @@ const
SShowHideProc = 'ShowHideProcess';
SGetKeyboardFocus = 'GetKeyboardFocus';
SSetUserFocusWindow = 'SetUserFocusWindow';
SSetControlProp = 'SetControlProperty';
@ -71,6 +72,8 @@ const
SChangeMenuItemAttrs = 'ChangeMenuItemAttributes';
SChangeMenuAttrs = 'ChangeMenuAttributes';
SSetMenuTitle = 'SetMenuTitleWithCFString';
SChangeWindowAttrs = 'ChangeWindowAttributes';
SSetModality = 'SetWindowModality';

28
lcl/interfaces/carbon/carbondef.pp
View File

@ -92,7 +92,9 @@ type
function GetBounds(var ARect: TRect): Boolean; virtual; abstract;
function GetScreenBounds(var ARect: TRect): Boolean; virtual; abstract;
function SetBounds(const ARect: TRect): Boolean; virtual; abstract;
procedure SetChildZPosition(AChild: TCarbonWidget; const AOldPos, ANewPos: Integer; const AChildren: TFPList); virtual; abstract;
procedure SetFocus; virtual; abstract;
procedure SetColor(const AColor: TColor); virtual; abstract;
procedure SetFont(const AFont: TFont); virtual; abstract;
procedure ShowHide(AVisible: Boolean); virtual; abstract;
@ -127,10 +129,6 @@ const
LCLCarbonEventKindWake = 'Wake';
LCLCarbonEventKindMain = 'Main';
function AsControlRef(Handle: HWND): ControlRef; inline;
function AsWindowRef(Handle: HWND): WindowRef; inline;
function CheckHandle(const AWinControl: TWinControl; const AClass: TClass; const DbgText: String): Boolean;
function CheckWidget(const Handle: HWND; const AMethodName: String; AParamName: String = ''): Boolean;
@ -140,27 +138,7 @@ procedure UnRegisterEventHandler(AHandler: TCarbonEventHandlerProc);
implementation
uses
CarbonProc, CarbonCanvas, CarbonDbgConsts, CarbonUtils;
{------------------------------------------------------------------------------
Name: AsControlRef
Params: Handle - Handle of window control
Returns: Carbon control
------------------------------------------------------------------------------}
function AsControlRef(Handle: HWND): ControlRef;
begin
Result := ControlRef(TCarbonWidget(Handle).Widget);
end;
{------------------------------------------------------------------------------
Name: AsWindowRef
Params: Handle - Handle of window
Returns: Carbon window
------------------------------------------------------------------------------}
function AsWindowRef(Handle: HWND): WindowRef;
begin
Result := WindowRef(TCarbonWidget(Handle).Widget);
end;
CarbonProc, CarbonDbgConsts, CarbonUtils;
{------------------------------------------------------------------------------
Name: CheckHandle

131
lcl/interfaces/carbon/carbonedits.pp
View File

@ -61,6 +61,7 @@ type
function SetText(const S: String): Boolean; override;
public
property MaxLength: Integer read FMaxLength write FMaxLength;
procedure SetReadOnly(AReadOnly: Boolean); virtual;
end;
{ TCarbonComboBox }
@ -80,11 +81,20 @@ type
procedure Insert(AIndex: Integer; const S: String);
procedure Remove(AIndex: Integer);
function DropDown(ADropDown: Boolean): Boolean;
end;
{ TCarbonCustomEdit }
TCarbonCustomEdit = class(TCarbonControlWithEdit)
public
procedure SetPasswordChar(AChar: Char); virtual; abstract;
end;
{ TCarbonEdit }
TCarbonEdit = class(TCarbonControlWithEdit)
TCarbonEdit = class(TCarbonCustomEdit)
private
FIsPassword: Boolean;
protected
@ -92,13 +102,12 @@ type
public
function GetText(var S: String): Boolean; override;
function SetText(const S: String): Boolean; override;
public
property IsPassword: Boolean read FIsPassword;
procedure SetPasswordChar(AChar: Char); override;
end;
{ TCarbonMemo }
TCarbonMemo = class(TCarbonControlWithEdit)
TCarbonMemo = class(TCarbonCustomEdit)
private
FScrollView: HIViewRef;
FScrollBars: TScrollStyle;
@ -112,6 +121,9 @@ type
public
procedure SetColor(const AColor: TColor); override;
procedure SetFont(const AFont: TFont); override;
procedure SetPasswordChar(AChar: Char); override;
procedure SetReadOnly(AReadOnly: Boolean); override;
procedure SetWordWrap(AWordWrap: Boolean); virtual;
public
property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars;
end;
@ -362,6 +374,19 @@ begin
end;
end;
{------------------------------------------------------------------------------
Method: TCarbonControlWithEdit.SetReadOnly
Params: AReadOnly - Read only behavior
Sets the read only behavior of edit control
------------------------------------------------------------------------------}
procedure TCarbonControlWithEdit.SetReadOnly(AReadOnly: Boolean);
begin
OSError(SetControlData(ControlRef(Widget), GetEditPart,
kControlEditTextLockedTag, SizeOf(Boolean), @AReadOnly),
Self, 'SetReadOnly', SSetData);
end;
{ TCarbonComboBox }
{------------------------------------------------------------------------------
@ -488,6 +513,23 @@ begin
Self, 'Remove', 'HIComboBoxRemoveItemAtIndex');
end;
{------------------------------------------------------------------------------
Method: TCarbonComboBox.DropDown
Params: ADropDown - Drop down
Returns: If the function succeeds
Shows or hides drop down list
------------------------------------------------------------------------------}
function TCarbonComboBox.DropDown(ADropDown: Boolean): Boolean;
begin
Result := False;
if OSError(HIComboBoxSetListVisible(ControlRef(Widget), ADropDown), Self,
'DropDown', 'HIComboBoxSetListVisible') then Exit;
Result := True;
end;
{ TCarbonEdit }
{------------------------------------------------------------------------------
@ -540,7 +582,7 @@ function TCarbonEdit.GetText(var S: String): Boolean;
var
CFString: CFStringRef;
begin
if not IsPassword then
if not FIsPassword then
Result := inherited GetText(S)
else
begin
@ -571,7 +613,7 @@ function TCarbonEdit.SetText(const S: String): Boolean;
var
CFString: CFStringRef;
begin
if not IsPassword then
if not FIsPassword then
Result := inherited SetText(S)
else
begin
@ -591,6 +633,17 @@ begin
end;
end;
{------------------------------------------------------------------------------
Method: TCarbonEdit.SetPasswordChar
Params: AChar - New password char
Sets the new password char of Carbon edit
------------------------------------------------------------------------------}
procedure TCarbonEdit.SetPasswordChar(AChar: Char);
begin
if FIsPassword <> (AChar <> #0) then RecreateWnd(LCLObject);
end;
{ TCarbonMemo }
{------------------------------------------------------------------------------
@ -786,5 +839,71 @@ begin
Invalidate;
end;
{------------------------------------------------------------------------------
Method: TCarbonMemo.SetPasswordChar
Params: AChar - New password char
Sets the new password char of Carbon memo
------------------------------------------------------------------------------}
procedure TCarbonMemo.SetPasswordChar(AChar: Char);
begin
OSError(
TXNEchoMode(HITextViewGetTXNObject(ControlRef(Widget)),
UniChar(AChar), CreateTextEncoding(kTextEncodingUnicodeDefault,
kUnicodeNoSubset, kUnicodeUTF8Format), AChar <> #0),
Self, 'SetPasswordChar', 'TXNEchoMode');
Invalidate;
end;
{------------------------------------------------------------------------------
Method: TCarbonMemo.SetReadOnly
Params: AReadOnly - Read only behavior
Sets the read only behavior of Carbon memo
------------------------------------------------------------------------------}
procedure TCarbonMemo.SetReadOnly(AReadOnly: Boolean);
var
Tag: TXNControlTag;
Data: TXNControlData;
begin
Tag := kTXNNoUserIOTag;
if AReadOnly then
Data.uValue := UInt32(kTXNReadOnly)
else
Data.uValue := UInt32(kTXNReadWrite);
OSError(
TXNSetTXNObjectControls(HITextViewGetTXNObject(ControlRef(Widget)),
False, 1, @Tag, @Data),
Self, 'SetReadOnly', SSetTXNControls);
end;
{------------------------------------------------------------------------------
Method: TCarbonMemo.SetWordWrap
Params: AWordWrap - New word wrap
Sets the word wrap of Carbon memo
------------------------------------------------------------------------------}
procedure TCarbonMemo.SetWordWrap(AWordWrap: Boolean);
var
Tag: TXNControlTag;
Data: TXNControlData;
begin
Tag := kTXNWordWrapStateTag;
if AWordWrap then
Data.uValue := UInt32(kTXNAutoWrap)
else
Data.uValue := UInt32(kTXNNoAutoWrap);
OSError(
TXNSetTXNObjectControls(HITextViewGetTXNObject(ControlRef(Widget)),
False, 1, @Tag, @Data),
Self, 'SetWordWrap', SSetTXNControls);
Invalidate;
end;
end.

3
lcl/interfaces/carbon/carbonint.pas
View File

@ -77,6 +77,8 @@ type
procedure AppMinimize; override;
procedure AppRestore; override;
procedure AppBringToFront; override;
procedure AppSetTitle(const ATitle: string); override;
function WidgetSetName: string; override;
procedure AttachMenuToWindow(AMenuObject: TComponent); Override;
@ -96,6 +98,7 @@ type
{$I carbonlclintfh.inc}
public
procedure SetMainMenuEnabled(AEnabled: Boolean);
end;
var

21
lcl/interfaces/carbon/carbonlclintf.inc
View File

@ -327,6 +327,27 @@ begin
Result:=inherited ReplaceBitmapMask(Image, Mask, NewMask);
end;
{------------------------------------------------------------------------------
Method: SetMainMenuEnabled
Params: AEnabled
Enables/disables main menu
------------------------------------------------------------------------------}
procedure TCarbonWidgetSet.SetMainMenuEnabled(AEnabled: Boolean);
begin
{$IFDEF VerboseLCLIntf}
DebugLn('TCarbonWidgetSet.SetMainMenuEnabled AEnabled: ' + DbgS(AEnabled));
{$ENDIF}
if FMainMenu <> nil then
begin
if FMainMenu.Items.HandleAllocated then
begin
TCarbonMenu(FMainMenu.Items.Handle).SetEnable(AEnabled);
end;
end;
end;
//##apiwiz##eps## // Do not remove, no wizard declaration after this line
// included by carbonint.pas

64
lcl/interfaces/carbon/carbonmenus.pp
View File

@ -72,24 +72,12 @@ type
procedure SetStyle;
end;
function AsMenuRef(Handle: HMENU): MenuRef; inline;
function CheckMenu(const Menu: HMENU; const AMethodName: String; AParamName: String = ''): Boolean;
implementation
uses
CarbonProc, CarbonDbgConsts;
{------------------------------------------------------------------------------
Name: AsMenuRef
Params: Handle - Handle of menu
Returns: Carbon menu
------------------------------------------------------------------------------}
function AsMenuRef(Handle: HMENU): MenuRef;
begin
Result := TCarbonMenu(Handle).Menu;
end;
{------------------------------------------------------------------------------
Name: CheckMenu
@ -310,7 +298,7 @@ begin
if Menu <> nil then
OSError(SetMenuTitleWithCFString(Menu, CFString), Self, SName,
'SetMenuTitleWithCFString');
SSetMenuTitle);
finally
FreeCFString(CFString);
end;
@ -332,7 +320,7 @@ end;
{------------------------------------------------------------------------------
Method: TCarbonMenu.AttachToMenuBar
Attaches Carbon menu to root menu bar
Attaches Carbon menu to the menu bar
------------------------------------------------------------------------------}
procedure TCarbonMenu.AttachToMenuBar;
var
@ -385,8 +373,7 @@ begin
Self, SName, 'SetMenuItemTextWithCFString');
if Menu <> nil then
OSError(SetMenuTitleWithCFString(Menu, CFString), Self, SName,
'SetMenuTitleWithCFString');
OSError(SetMenuTitleWithCFString(Menu, CFString), Self, SName, SSetMenuTitle);
finally
FreeCFString(CFString);
end;
@ -436,30 +423,41 @@ end;
procedure TCarbonMenu.SetEnable(AEnabled: Boolean);
var
I: Integer;
const
SName = 'SetEnable';
begin
if FParentMenu = nil then Exit;
if AEnabled and FParentMenu.LCLMenuItem.Enabled then
if FParentMenu = nil then
begin
OSError(
ChangeMenuItemAttributes(FParentMenu.Menu, GetIndex + 1, 0, kMenuItemAttrDisabled),
Self, SName, SChangeMenuItemAttrs, 'enable');
// update sub menus enabled
// diable sub items for top most menus
if FItems <> nil then
for I := 0 to FItems.Count - 1 do
TCarbonMenu(FItems[I]).SetEnable(TCarbonMenu(FItems[I]).LCLMenuItem.Enabled);
begin
if AEnabled then
TCarbonMenu(FItems[I]).SetEnable(TCarbonMenu(FItems[I]).LCLMenuItem.Enabled)
else
TCarbonMenu(FItems[I]).SetEnable(False);
end;
Exit;
end;
if AEnabled then
begin
EnableMenuItem(FParentMenu.Menu, GetIndex + 1);
// enable sub menu
if Menu <> nil then
begin
EnableMenuItem(Menu, 0);
end;
end
else
begin
OSError(
ChangeMenuItemAttributes(FParentMenu.Menu, GetIndex + 1, kMenuItemAttrDisabled, 0),
Self, SName, SChangeMenuItemAttrs, 'disable');
// disable sub menus
if Menu <> nil then DisableAllMenuItems(Menu);
DisableMenuItem(FParentMenu.Menu, GetIndex + 1);
// disable sub menu
if Menu <> nil then
begin
DisableMenuItem(Menu, 0);
end;
end;
end;

11
lcl/interfaces/carbon/carbonobject.inc
View File

@ -632,6 +632,17 @@ begin
OSError(SetFrontProcess(Proc), Self, SName, 'SetFrontProcess');
end;
{------------------------------------------------------------------------------
Method: TCarbonWidgetSet.AppSetTitle
Params: ATitle - New application title
Changes the application title
------------------------------------------------------------------------------}
procedure TCarbonWidgetSet.AppSetTitle(const ATitle: string);
begin
// TODO
end;
{------------------------------------------------------------------------------
Method: TCarbonWidgetSet.WidgetSetName
Returns: Name of Carbon widget set

372
lcl/interfaces/carbon/carbonprivate.pp
View File

@ -39,7 +39,7 @@ uses
CarbonDef,
// LCL
LMessages, LCLMessageGlue, LCLProc, LCLType, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, ExtCtrls, Menus;
Dialogs, StdCtrls, Buttons, ComCtrls, ExtCtrls, Menus;
type
TCarbonControlEvent = (cceValueChanged, cceIndicatorMoved,
@ -80,7 +80,9 @@ type
function GetBounds(var ARect: TRect): Boolean; override;
function GetScreenBounds(var ARect: TRect): Boolean; override;
function SetBounds(const ARect: TRect): Boolean; override;
procedure SetChildZPosition(AChild: TCarbonWidget; const AOldPos, ANewPos: Integer; const AChildren: TFPList); override;
procedure SetFocus; override;
procedure SetColor(const AColor: TColor); override;
procedure SetFont(const AFont: TFont); override;
procedure ShowHide(AVisible: Boolean); override;
@ -89,6 +91,12 @@ type
function SetText(const S: String): Boolean; override;
function Update: Boolean; override;
public
function GetValue: Integer;
procedure SetValue(AValue: Integer);
procedure SetMinimum(AValue: Integer);
procedure SetMaximum(AValue: Integer);
procedure SetViewSize(AValue: Integer);
public
{ Frame:
= widget in controls without special frame control
@ -101,6 +109,8 @@ type
{ TCarbonWindow }
TCarbonWindow = class(TCarbonWidget)
private
FBorderStyle: TFormBorderStyle;
protected
procedure RegisterEvents; override;
procedure UnregisterEvents; override;
@ -120,7 +130,9 @@ type
function GetBounds(var ARect: TRect): Boolean; override;
function GetScreenBounds(var ARect: TRect): Boolean; override;
function SetBounds(const ARect: TRect): Boolean; override;
procedure SetChildZPosition(AChild: TCarbonWidget; const AOldPos, ANewPos: Integer; const AChildren: TFPList); override;
procedure SetFocus; override;
procedure SetColor(const AColor: TColor); override;
procedure SetFont(const AFont: TFont); override;
procedure ShowHide(AVisible: Boolean); override;
@ -129,6 +141,16 @@ type
function SetText(const S: String): Boolean; override;
function Update: Boolean; override;
public
function Activate: Boolean; virtual;
procedure CloseModal; virtual;
procedure ShowModal; virtual;
function Show(AShow: Integer): Boolean; virtual;
procedure SetBorderIcons(ABorderIcons: TBorderIcons); virtual;
procedure SetFormBorderStyle(AFormBorderStyle: TFormBorderStyle); virtual;
end;
{ TCarbonHintWindow }
@ -195,6 +217,9 @@ type
class function GetValidEvents: TCarbonControlEvents; override;
procedure Hit(AControlPart: ControlPartCode); override;
procedure ValueChanged; override;
function RetrieveState: TCheckBoxState; virtual;
procedure SetState(AState: TCheckBoxState); virtual;
end;
{ TCarbonCheckBox }
@ -233,6 +258,8 @@ type
TCarbonButton = class(TCarbonCustomButton)
protected
procedure CreateWidget(const AParams: TCreateParams); override;
public
procedure SetDefault(ADefault: Boolean); virtual;
end;
{ TCarbonBitBtn }
@ -240,6 +267,9 @@ type
TCarbonBitBtn = class(TCarbonCustomButton)
protected
procedure CreateWidget(const AParams: TCreateParams); override;
public
procedure SetGlyph(AGlyph: TBitmap); virtual;
procedure SetLayout(ALayout: TButtonLayout); virtual;
end;
{ TCarbonStaticText }
@ -247,16 +277,16 @@ type
TCarbonStaticText = class(TCarbonControl)
protected
procedure CreateWidget(const AParams: TCreateParams); override;
public
procedure SetAlignment(AAlignment: TAlignment); virtual;
end;
{ TCarbonCustomBar }
TCarbonCustomBar = class(TCarbonControl)
public
procedure SetData(APos: Integer);
procedure SetData(APos, AMin, AMax: Integer);
procedure SetData(APos, AMin, AMax, APage: Integer);
function GetPos: Integer;
function GetPosition: Integer; virtual;
procedure SetPosition(APosition: Integer); virtual;
end;
{ TCarbonProgressBar }
@ -264,34 +294,41 @@ type
TCarbonProgressBar = class(TCarbonCustomBar)
protected
procedure CreateWidget(const AParams: TCreateParams); override;
public
procedure ApplyChanges; virtual;
end;
{ TCarbonMovableBar }
TCarbonMovableBar = class(TCarbonCustomBar)
protected
class function GetValidEvents: TCarbonControlEvents; override;
procedure IndicatorMoved; override;
procedure ValueChanged; override;
end;
{ TCarbonTrackBar }
TCarbonTrackBar = class(TCarbonCustomBar)
TCarbonTrackBar = class(TCarbonMovableBar)
private
FTicks: LongWord;
public
class function GetValidEvents: TCarbonControlEvents; override;
procedure ValueChanged; override;
procedure IndicatorMoved; override;
function GetTicks: LongWord;
protected
procedure CreateWidget(const AParams: TCreateParams); override;
public
function GetTicks: LongWord;
property Ticks: LongWord read FTicks;
procedure ApplyChanges; virtual;
end;
{ TCarbonScrollBar }
TCarbonScrollBar = class(TCarbonCustomBar)
TCarbonScrollBar = class(TCarbonMovableBar)
protected
procedure CreateWidget(const AParams: TCreateParams); override;
public
class function GetValidEvents: TCarbonControlEvents; override;
procedure ValueChanged; override;
procedure IndicatorMoved; override;
procedure DoAction(AControlPart: ControlPartCode); override;
procedure SetParams; virtual;
end;
procedure RaiseCreateWidgetError(AControl: TWinControl);
@ -302,8 +339,8 @@ function GetCarbonControl(AWidget: ControlRef): TCarbonControl;
implementation
uses InterfaceBase, CarbonProc, CarbonDbgConsts, CarbonUtils, CarbonWSStdCtrls,
CarbonStrings, CarbonCanvas, CarbonGDIObjects;
uses InterfaceBase, CarbonInt, CarbonProc, CarbonDbgConsts, CarbonUtils,
CarbonWSStdCtrls, CarbonStrings, CarbonCanvas, CarbonGDIObjects;
{------------------------------------------------------------------------------
Name: RaiseCreateWidgetError
@ -740,6 +777,40 @@ begin
LCLSendChangedMsg(LCLObject);
end;
{------------------------------------------------------------------------------
Method: TCarbonCustomCheckBox.RetrieveState
Returns: State of Carbon custom check box
------------------------------------------------------------------------------}
function TCarbonCustomCheckBox.RetrieveState: TCheckBoxState;
begin
case GetControl32BitValue(ControlRef(Widget)) of
kControlCheckBoxCheckedValue : Result := cbChecked;
kControlCheckBoxUncheckedValue : Result := cbUnchecked;
kControlCheckBoxMixedValue : Result := cbGrayed;
else
Result := cbUnchecked;
end;
end;
{------------------------------------------------------------------------------
Method: TCarbonCustomCheckBox.SetState
Params: AState - New state
Sets the new state of Carbon custom check box
------------------------------------------------------------------------------}
procedure TCarbonCustomCheckBox.SetState(AState: TCheckBoxState);
var
Value: UInt32;
begin
case AState of
cbChecked : Value := kControlCheckBoxCheckedValue;
cbUnChecked: Value := kControlCheckBoxUncheckedValue;
cbGrayed : Value := kControlCheckBoxMixedValue;
end;
SetControl32BitValue(ControlRef(Widget), Value);
end;
{ TCarbonCheckBox }
{------------------------------------------------------------------------------
@ -913,6 +984,20 @@ begin
SetText(AParams.Caption);
end;
{------------------------------------------------------------------------------
Method: TCarbonButton.SetDefault
Params: ADefault - Is default
Sets the default indication
------------------------------------------------------------------------------}
procedure TCarbonButton.SetDefault(ADefault: Boolean);
begin
OSError(
SetControlData(ControlRef(Widget), kControlEntireControl,
kControlPushButtonDefaultTag, SizeOf(Boolean), @ADefault),
Self, 'SetDefault', SSetData);
end;
{ TCarbonBitBtn }
{------------------------------------------------------------------------------
@ -945,6 +1030,50 @@ begin
Self, SCreateWidget, SSetData, 'kControlBevelButtonKindTag');
end;
{------------------------------------------------------------------------------
Method: TCarbonBitBtn.SetGlyph
Params: AGlyph - New glyph bitmap
Sets the glyph bitmap
------------------------------------------------------------------------------}
procedure TCarbonBitBtn.SetGlyph(AGlyph: TBitmap);
var
ContentInfo: ControlButtonContentInfo;
begin
ContentInfo.contentType := kControlContentCGImageRef;
if AGlyph = nil then
ContentInfo.imageRef := nil
else
ContentInfo.imageRef := TCarbonBitmap(AGlyph.Handle).CGImage;
OSError(SetBevelButtonContentInfo(ControlRef(Widget), @ContentInfo),
Self, 'SetGlyph', 'SetBevelButtonContentInfo');
end;
{------------------------------------------------------------------------------
Method: TCarbonBitBtn.SetLayout
Params: ALayout - Bitmap and caption layout
Sets the bitmap and caption layout
------------------------------------------------------------------------------}
procedure TCarbonBitBtn.SetLayout(ALayout: TButtonLayout);
var
Placement: ControlButtonTextPlacement;
begin
case ALayout of
blGlyphLeft : Placement := kControlBevelButtonPlaceToRightOfGraphic;
blGlyphRight : Placement := kControlBevelButtonPlaceToLeftOfGraphic;
blGlyphTop : Placement := kControlBevelButtonPlaceBelowGraphic;
blGlyphBottom: Placement := kControlBevelButtonPlaceAboveGraphic;
end;
OSError(SetBevelButtonTextPlacement(ControlRef(Widget), Placement),
Self, 'SetLayout', 'SetBevelButtonTextPlacement');
Invalidate;
end;
{ TCarbonStaticText }
@ -985,58 +1114,60 @@ begin
Self, SCreateWidget, SSetData, 'kControlStaticTextIsMultilineTag');
end;
{------------------------------------------------------------------------------
Method: TCarbonStaticText.SetAlignment
Params: AAlignment - New caption alignment
Sets the new caption alignment of Carbon static text
------------------------------------------------------------------------------}
procedure TCarbonStaticText.SetAlignment(AAlignment: TAlignment);
var
FontStyle: ControlFontStyleRec;
const
SName = 'SetAlignment';
begin
// get static text font style and change only justification
OSError(
GetControlData(ControlRef(Widget), kControlEntireControl,
kControlStaticTextStyleTag, SizeOf(FontStyle), @FontStyle, nil),
Self, SName, SGetData);
FontStyle.flags := FontStyle.flags or kControlUseJustMask;
case AAlignment of
taLeftJustify : FontStyle.just := teFlushLeft;
taRightJustify: FontStyle.just := teFlushRight;
taCenter : FontStyle.just := teCenter;
end;
OSError(
SetControlData(ControlRef(Widget), kControlEntireControl,
kControlStaticTextStyleTag, SizeOf(FontStyle), @FontStyle),
Self, SName, SSetData);
Invalidate;
end;
{ TCarbonCustomBar }
{------------------------------------------------------------------------------
Method: TCarbonCustomBar.SetData
Params: APos - New position
Sets the position of custom bar
Method: TCarbonCustomBar.GetPosition
Returns: The positon of Carbon bar
------------------------------------------------------------------------------}
procedure TCarbonCustomBar.SetData(APos: Integer);
function TCarbonCustomBar.GetPosition: Integer;
begin
SetControl32BitValue(ControlRef(Widget), APos);
Result := GetValue;
end;
{------------------------------------------------------------------------------
Method: TCarbonCustomBar.SetData
Params: APos - New position
AMin - New minimum
AMax - New maximum
Method: TCarbonCustomBar.SetPosition
Params: APosition - New position
Sets the position, minimum and maximum of custom bar
Sets the position of Carbon bar
------------------------------------------------------------------------------}
procedure TCarbonCustomBar.SetData(APos, AMin, AMax: Integer);
procedure TCarbonCustomBar.SetPosition(APosition: Integer);
begin
SetControl32BitMinimum(ControlRef(Widget), AMin);
SetControl32BitMaximum(ControlRef(Widget), AMax);
SetControl32BitValue(ControlRef(Widget), APos);
end;
{------------------------------------------------------------------------------
Method: TCarbonCustomBar.SetData
Params: APos - New position
AMin - New minimum
AMax - New maximum
APage - New page size
Sets the position, minimum, maximum and page size of custom bar
------------------------------------------------------------------------------}
procedure TCarbonCustomBar.SetData(APos, AMin, AMax, APage: Integer);
begin
SetControl32BitMinimum(ControlRef(Widget), AMin);
SetControl32BitMaximum(ControlRef(Widget), AMax);
SetControl32BitValue(ControlRef(Widget), APos);
SetControlViewSize(ControlRef(Widget), APage);
end;
{------------------------------------------------------------------------------
Method: TCarbonCustomBar.GetPos
Returns: The position of custom bar
------------------------------------------------------------------------------}
function TCarbonCustomBar.GetPos: Integer;
begin
Result := GetControl32BitValue(ControlRef(Widget));
SetValue(APosition);
end;
{ TCarbonProgressBar }
@ -1065,6 +1196,53 @@ begin
inherited;
end;
{------------------------------------------------------------------------------
Method: TCarbonProgressBar.ApplyChanges
Sets the parameters (Min, Max, Position) of Carbon progress bar
------------------------------------------------------------------------------}
procedure TCarbonProgressBar.ApplyChanges;
var
ProgressBar: TCustomProgressBar;
begin
ProgressBar := LCLObject as TCustomProgressBar;
SetValue(ProgressBar.Position);
SetMinimum(ProgressBar.Min);
SetMaximum(ProgressBar.Max);
end;
{ TCarbonMovableBar }
{------------------------------------------------------------------------------
Method: TCarbonMovableBar.GetValidEvents
Returns: Set of events with installed handlers
------------------------------------------------------------------------------}
class function TCarbonMovableBar.GetValidEvents: TCarbonControlEvents;
begin
Result := [cceValueChanged, cceIndicatorMoved];
end;
{------------------------------------------------------------------------------
Method: TCarbonMovableBar.IndicatorMoved
Indicator moved event handler
------------------------------------------------------------------------------}
procedure TCarbonMovableBar.IndicatorMoved;
begin
ValueChanged;
end;
{------------------------------------------------------------------------------
Method: TCarbonMovableBar.ValueChanged
Value changed event handler
------------------------------------------------------------------------------}
procedure TCarbonMovableBar.ValueChanged;
begin
LCLSendChangedMsg(LCLObject);
end;
{ TCarbonTrackBar }
{------------------------------------------------------------------------------
@ -1088,35 +1266,6 @@ begin
Result := 2;
end;
{------------------------------------------------------------------------------
Method: TCarbonTrackBar.GetValidEvents
Returns: Set of events with installed handlers
------------------------------------------------------------------------------}
class function TCarbonTrackBar.GetValidEvents: TCarbonControlEvents;
begin
Result := [cceValueChanged, cceIndicatorMoved];
end;
{------------------------------------------------------------------------------
Method: TCarbonTrackBar.ValueChanged
Value changed event handler
------------------------------------------------------------------------------}
procedure TCarbonTrackBar.ValueChanged;
begin
LCLSendChangedMsg(LCLObject);
end;
{------------------------------------------------------------------------------
Method: TCarbonTrackBar.IndicatorMoved
Indicator moved event handler
------------------------------------------------------------------------------}
procedure TCarbonTrackBar.IndicatorMoved;
begin
ValueChanged;
end;
{------------------------------------------------------------------------------
Method: TCarbonTrackBar.CreateWidget
Params: AParams - Creation parameters
@ -1143,6 +1292,27 @@ begin
inherited;
end;
{------------------------------------------------------------------------------
Method: TCarbonTrackBar.ApplyChanges
Sets the parameters (Min, Max, Position, Ticks) of Carbon track bar
------------------------------------------------------------------------------}
procedure TCarbonTrackBar.ApplyChanges;
var
TrackBar: TCustomTrackBar;
begin
if FTicks <> GetTicks then
RecreateWnd(LCLObject) // recreate track bar if ticks have changed
else
begin
TrackBar := LCLObject as TCustomTrackBar;
SetValue(TrackBar.Position);
SetMinimum(TrackBar.Min);
SetMaximum(TrackBar.Max);
end;
end;
{ TCarbonScrollBar }
{------------------------------------------------------------------------------
@ -1175,7 +1345,7 @@ end;
------------------------------------------------------------------------------}
class function TCarbonScrollBar.GetValidEvents: TCarbonControlEvents;
begin
Result := [cceValueChanged, cceIndicatorMoved, cceDoAction];
Result := inherited GetValidEvents + [cceDoAction];
end;
{------------------------------------------------------------------------------
@ -1197,16 +1367,6 @@ begin
DeliverMessage(LCLObject, ScrollMsg);
end;
{------------------------------------------------------------------------------
Method: TCarbonScrollBar.IndicatorMoved
Indicator moved event handler
------------------------------------------------------------------------------}
procedure TCarbonScrollBar.IndicatorMoved;
begin
ValueChanged;
end;
{------------------------------------------------------------------------------
Method: TCarbonScrollBar.DoAction
Params: AControlPart - Control part to perform the action
@ -1243,6 +1403,22 @@ begin
end;
end;
{------------------------------------------------------------------------------
Method: TCarbonScrollBar.SetParams
Sets the parameters (Min, Max, Position, PageSize) of Carbon scroll bar
------------------------------------------------------------------------------}
procedure TCarbonScrollBar.SetParams;
var
ScrollBar: TCustomScrollBar;
begin
ScrollBar := LCLObject as TCustomScrollBar;
SetMinimum(ScrollBar.Min);
SetMaximum(ScrollBar.Max);
SetValue(ScrollBar.Position);
SetViewSize(ScrollBar.PageSize);
end;
end.

2
lcl/interfaces/carbon/carbonprivatecommon.inc
View File

@ -372,7 +372,7 @@ begin
end;
if TabIndex < TabList.Count then
NextControl := AsControlRef(TWinControl(TabList[TabIndex]).Handle)
NextControl := TCarbonControl(TWinControl(TabList[TabIndex]).Handle).Widget
else
NextControl := nil;

132
lcl/interfaces/carbon/carbonprivatecontrol.inc
View File

@ -418,6 +418,59 @@ begin
Result := ControlRef(Widget);
end;
{------------------------------------------------------------------------------
Method: TCarbonControl.GetValue
Returns: The value of Carbon control
------------------------------------------------------------------------------}
function TCarbonControl.GetValue: Integer;
begin
Result := GetControl32BitValue(ControlRef(Widget));
end;
{------------------------------------------------------------------------------
Method: TCarbonControl.SetValue
Params: AValue - New control value
Sets the Carbon control value
------------------------------------------------------------------------------}
procedure TCarbonControl.SetValue(AValue: Integer);
begin
SetControl32BitValue(ControlRef(Widget), AValue);
end;
{------------------------------------------------------------------------------
Method: TCarbonControl.SetMinimum
Params: AValue - New control minimum
Sets the Carbon control minimum
------------------------------------------------------------------------------}
procedure TCarbonControl.SetMinimum(AValue: Integer);
begin
SetControl32BitMinimum(ControlRef(Widget), AValue);
end;
{------------------------------------------------------------------------------
Method: TCarbonControl.SetMaximum
Params: AValue - New control maximum
Sets the Carbon control maximum
------------------------------------------------------------------------------}
procedure TCarbonControl.SetMaximum(AValue: Integer);
begin
SetControl32BitMaximum(ControlRef(Widget), AValue);
end;
{------------------------------------------------------------------------------
Method: TCarbonControl.SetViewSize
Params: AValue - New control view size
Sets the Carbon control view size
------------------------------------------------------------------------------}
procedure TCarbonControl.SetViewSize(AValue: Integer);
begin
SetControlViewSize(ControlRef(Widget), AValue);
end;
{------------------------------------------------------------------------------
Method: TCarbonControl.Invalidate
Params: Rect - Pointer to rect (optional)
@ -547,6 +600,82 @@ begin
Result := True;
end;
{------------------------------------------------------------------------------
Method: TCarbonControl.SetChildZPosition
Params: AChild - Child widget
AOldPos - Old z position
ANewPos - New z position
AChildren - List of all child controls
Sets the child z position of Carbon widget
------------------------------------------------------------------------------}
procedure TCarbonControl.SetChildZPosition(AChild: TCarbonWidget;
const AOldPos, ANewPos: Integer; const AChildren: TFPList);
var
RefView: HIViewRef;
Order: HIViewZOrderOp;
I, StopPos: Integer;
Child: TWinControl;
begin
RefView := nil;
if ANewPos <= 0 then // send behind all
Order := kHIViewZOrderBelow
else
if ANewPos >= Pred(AChildren.Count) then // bring to front of all
Order := kHIViewZOrderAbove
else // custom position
begin
// Search for the first child above us with a handle.
// The child list is reversed form the windows order.
// If we don't find an allocated handle then exit.
if AOldPos > ANewPos then
StopPos := AOldPos // the child is moved to the bottom
else
StopPos := Pred(AChildren.Count); // the child is moved to the top
for I := Succ(ANewPos) to StopPos do
begin
Child := TWinControl(AChildren[I]);
if Child.HandleAllocated then
begin
RefView := ControlRef(TCarbonWidget(Child.Handle).Widget);
Order := kHIViewZOrderBelow;
Break;
end;
end;
if RefView = nil then Exit;
end;
OSError(HIViewSetZOrder(ControlRef(AChild.Widget), Order, RefView),
Self, 'SetChildZPosition', 'HIViewSetZOrder');
end;
{------------------------------------------------------------------------------
Method: TCarbonControl.SetFocus
Sets the focus to control
------------------------------------------------------------------------------}
procedure TCarbonControl.SetFocus;
var
Window: WindowRef;
Control: ControlRef;
begin
Window := GetTopParentWindow;
OSError(
SetUserFocusWindow(Window), Self, SSetFocus, SSetUserFocusWindow);
OSError(GetKeyboardFocus(Window, Control), Self, SSetFocus, SGetKeyboardFocus);
if Control <> ControlRef(Widget) then
OSError(SetKeyboardFocus(Window, ControlRef(Widget), kControlFocusNextPart),
Self, SSetFocus, 'SetKeyboardFocus');
end;
{------------------------------------------------------------------------------
Method: TCarbonControl.SetColor
Params: AColor - New color
@ -688,7 +817,8 @@ var
begin
Window := LCLObject.GetTopParent;
if Window is TCustomForm then Result := AsWindowRef((Window as TWinControl).Handle)
if Window is TCustomForm then
Result := TCarbonWindow((Window as TWinControl).Handle).Widget
else Result := nil;
end;

192
lcl/interfaces/carbon/carbonprivatewindow.inc
View File

@ -956,32 +956,37 @@ var
begin
// apply appropriate form border style and form style
case (LCLObject as TCustomForm).FormStyle of
fsStayOnTop, fsSplash: NewWindowClass := kUtilityWindowClass;
fsStayOnTop, fsSplash:
begin
NewWindowClass := kFloatingWindowClass;
Attributes := 0;
end;
else
NewWindowClass := kDocumentWindowClass;
Attributes := kWindowInWindowMenuAttribute;
end;
case (LCLObject as TCustomForm).BorderStyle of
bsNone:
Attributes := kWindowNoTitleBarAttribute;
Attributes := Attributes or kWindowNoTitleBarAttribute;
bsToolWindow, bsSingle:
Attributes := kWindowCloseBoxAttribute or kWindowCollapseBoxAttribute;
Attributes := Attributes or kWindowCloseBoxAttribute or
kWindowCollapseBoxAttribute;
bsSizeable:
Attributes := kWindowCloseBoxAttribute or kWindowCollapseBoxAttribute
Attributes := Attributes or kWindowCloseBoxAttribute or kWindowCollapseBoxAttribute
or kWindowFullZoomAttribute or kWindowResizableAttribute;
bsDialog:
Attributes := kWindowCloseBoxAttribute;
Attributes := Attributes or kWindowCloseBoxAttribute;
bsSizeToolWin:
Attributes := kWindowCloseBoxAttribute or kWindowResizableAttribute;
Attributes := Attributes or kWindowCloseBoxAttribute or kWindowResizableAttribute;
end;
//DebugLn('TCarbonWindow.CreateWidget ' + DbgS(ParamsToCarbonRect(AParams)));
if OSError(
CreateNewWindow(NewWindowClass,
Attributes or kWindowCompositingAttribute or
kWindowStandardHandlerAttribute or kWindowLiveResizeAttribute or
kWindowInWindowMenuAttribute, GetCarbonRect(0, 0, 0, 0), Window),
Attributes or kWindowCompositingAttribute or kWindowStandardHandlerAttribute
or kWindowLiveResizeAttribute, GetCarbonRect(0, 0, 0, 0), Window),
Self, SCreateWidget, 'CreateNewWindow') then RaiseCreateWidgetError(LCLObject);
Widget := Window;
@ -992,6 +997,8 @@ begin
OSError(
SetControlProperty(Content, LAZARUS_FOURCC, WIDGETINFO_FOURCC, SizeOf(Self), @Self),
Self, SCreateWidget, SSetControlProp);
FBorderStyle := (LCLObject as TCustomForm).BorderStyle;
SetBounds(Bounds(AParams.X, AParams.Y, AParams.Width, AParams.Height));
SetText(AParams.Caption);
@ -1235,6 +1242,32 @@ begin
Result := True;
end;
{------------------------------------------------------------------------------
Method: TCarbonWindow.SetChildZPosition
Params: AChild - Child widget
AOldPos - Old z position
ANewPos - New z position
AChildren - List of all child controls
Sets the child z position of Carbon widget
------------------------------------------------------------------------------}
procedure TCarbonWindow.SetChildZPosition(AChild: TCarbonWidget; const AOldPos,
ANewPos: Integer; const AChildren: TFPList);
begin
// not supported
end;
{------------------------------------------------------------------------------
Method: TCarbonWindow.SetFocus
Sets the focus to window
------------------------------------------------------------------------------}
procedure TCarbonWindow.SetFocus;
begin
OSError(
SetUserFocusWindow(WindowRef(Widget)), Self, SSetFocus, SSetUserFocusWindow);
end;
{------------------------------------------------------------------------------
Method: TCarbonWindow.SetColor
Params: AColor - New color
@ -1318,3 +1351,144 @@ begin
if OSError(HIViewRender(Content), Self, 'Update', SViewRender) then Exit;
Result := True;
end;
{------------------------------------------------------------------------------
Method: TCarbonWindow.Activate
Returns: If the function suceeds
Activates Carbon window
------------------------------------------------------------------------------}
function TCarbonWindow.Activate: Boolean;
begin
Result := False;
if OSError(ActivateWindow(WindowRef(Widget), True), Self, 'Activate',
'ActivateWindow') then Exit;
Result := True;
end;
{------------------------------------------------------------------------------
Method: TCarbonWindow.CloseModal
Closes modal Carbon window
------------------------------------------------------------------------------}
procedure TCarbonWindow.CloseModal;
begin
CarbonWidgetSet.SetMainMenuEnabled(True);
OSError(
SetWindowModality(WindowRef(Widget), kWindowModalityNone, nil),
Self, 'CloseModal', SSetModality);
end;
{------------------------------------------------------------------------------
Method: TCarbonWindow.ShowModal
Shows modal Carbon window
------------------------------------------------------------------------------}
procedure TCarbonWindow.ShowModal;
begin
OSError(
SetWindowModality(WindowRef(Widget), kWindowModalityAppModal, nil),
Self, 'ShowModal', SSetModality);
CarbonWidgetSet.SetMainMenuEnabled(False);
SelectWindow(WindowRef(Widget));
end;
{------------------------------------------------------------------------------
Method: TCarbonWindow.Show
Params: AShow - (SW_SHOWNORMAL, SW_MINIMIZE, SW_SHOWMAXIMIZED)
Returns: If the function succeeds
Shows the Carbon window normal, minimized or maximized
------------------------------------------------------------------------------}
function TCarbonWindow.Show(AShow: Integer): Boolean;
var
P: FPCMacOSAll.Point;
Maximized: Boolean;
const
SName = 'Show';
SCollapse = 'CollapseWindow';
SZoomIdeal = 'ZoomWindowIdeal';
begin
Result := False;
case AShow of
SW_SHOWNORMAL, SW_SHOWMAXIMIZED:
begin
if IsWindowCollapsed(WindowRef(Widget)) then
if OSError(CollapseWindow(WindowRef(Widget), False),
Self, SName, SCollapse) then Exit;
// for checking if any change is necessary
Maximized := IsWindowInStandardState(WindowRef(Widget), nil, nil);
if AShow = SW_SHOWNORMAL then
begin
if Maximized then
if OSError(ZoomWindowIdeal(WindowRef(Widget), inZoomIn, P),
Self, SName, SZoomIdeal, 'inZoomIn') then Exit;
end
else
if not Maximized then
begin
P.v := $3FFF;
P.h := $3FFF;
if OSError(ZoomWindowIdeal(WindowRef(Widget), inZoomOut, P),
Self, SName, SZoomIdeal, 'inZoomOut') then Exit;
end;
end;
SW_MINIMIZE:
begin
if OSError(CollapseWindow(WindowRef(Widget), True),
Self, SName, SCollapse) then Exit;
end;
end;
Result := True;
end;
{------------------------------------------------------------------------------
Method: TCarbonWSCustomForm.SetBorderIcons
Params: ABorderIcons - Border icons
Sets the border icons of Carbon window
------------------------------------------------------------------------------}
procedure TCarbonWindow.SetBorderIcons(ABorderIcons: TBorderIcons);
var
AttrsSet, AttrsClear: WindowAttributes;
begin
AttrsSet := 0;
AttrsClear := 0;
if (biMinimize in ABorderIcons) and (biSystemMenu in ABorderIcons) then
AttrsSet := AttrsSet or kWindowCollapseBoxAttribute
else
AttrsClear := AttrsClear or kWindowCollapseBoxAttribute;
if (biMaximize in ABorderIcons) and (biSystemMenu in ABorderIcons) then
AttrsSet := AttrsSet or kWindowFullZoomAttribute
else
AttrsClear := AttrsClear or kWindowFullZoomAttribute;
if biSystemMenu in ABorderIcons then
AttrsSet := AttrsSet or kWindowCloseBoxAttribute
else
AttrsClear := AttrsClear or kWindowCloseBoxAttribute;
OSError(ChangeWindowAttributes(WindowRef(Widget), AttrsSet, AttrsClear),
Self, 'SetBorderIcons', SChangeWindowAttrs);
end;
{------------------------------------------------------------------------------
Method: TCarbonWSCustomForm.SetFormBorderStyle
Params: AFormBorderStyle - Form border style
Sets the form border style of Carbon window
------------------------------------------------------------------------------}
procedure TCarbonWindow.SetFormBorderStyle(AFormBorderStyle: TFormBorderStyle);
begin
if AFormBorderStyle <> FBorderStyle then RecreateWnd(LCLObject);
end;

8
lcl/interfaces/carbon/carbonproc.pp
View File

@ -67,8 +67,8 @@ procedure FillStandardDescription(var Desc: TRawImageDescription);
const
DEFAULT_CFSTRING_ENCODING = kCFStringEncodingUTF8;
procedure CreateCFString(const S: String; out AString: CFStringRef); inline;
procedure FreeCFString(var AString: CFStringRef); inline;
procedure CreateCFString(const S: String; out AString: CFStringRef);
procedure FreeCFString(var AString: CFStringRef);
function CFStringToStr(AString: CFStringRef): String;
function GetCarbonRect(Left, Top, Width, Height: Integer): FPCMacOSAll.Rect;
@ -89,7 +89,7 @@ function ParamsToHIRect(const AParams: TCreateParams): HIRect;
function CarbonRectToRect(const ARect: FPCMacOSAll.Rect): TRect;
function ColorToRGBColor(const AColor: TColor): RGBColor;
function RGBColorToColor(const AColor: RGBColor): TColor; inline;
function RGBColorToColor(const AColor: RGBColor): TColor;
function CreateCGColor(const AColor: TColor): CGColorRef;
function DbgS(const ASize: TSize): string; overload;
@ -393,7 +393,7 @@ begin
Desc.GreenShift := 16;
Desc.BlueShift := 08;
Desc.AlphaShift := 00;
end;
end;
{------------------------------------------------------------------------------
Name: CreateCFString

23
lcl/interfaces/carbon/carbontabs.pp
View File

@ -59,7 +59,7 @@ type
TCarbonTabsControl = class(TCarbonControl)
private
FUserPane: ControlRef;
FTabPositon: TTabPosition;
FTabPosition: TTabPosition;
FTabs: TObjectList; // of TCarbonTab
protected
procedure CreateWidget(const AParams: TCreateParams); override;
@ -78,8 +78,7 @@ type
procedure Remove(AIndex: Integer);
procedure SetTabIndex(AIndex: Integer);
procedure ShowTabs(AShow: Boolean);
public
property TabPosition: TTabPosition read FTabPositon;
procedure SetTabPosition(ATabPosition: TTabPosition);
end;
@ -200,7 +199,7 @@ begin
inherited;
FTabPositon := (LCLObject as TCustomNotebook).TabPosition;
FTabPosition := (LCLObject as TCustomNotebook).TabPosition;
FTabs := TObjectList.Create(False);
end;
@ -394,7 +393,8 @@ end;
procedure TCarbonTabsControl.Add(ATab: TCarbonTab; AIndex: Integer);
begin
//DebugLn('TCarbonTabsControl.Add ' + DbgS(AIndex));
FTabs.Insert(AIndex, ATab);
if FTabs.IndexOf(ATab) < 0 then
FTabs.Insert(AIndex, ATab);
ATab.Attach(Self);
UpdateTabs(AIndex, True);
@ -461,7 +461,7 @@ begin
if Page.TabVisible or (csDesigning in Page.ComponentState) then
begin
if FTabs.IndexOf(Page) < 0 then
if FTabs.IndexOf(TCarbonTab(Page.Handle)) < 0 then
begin
FTabs.Insert(Page.VisibleIndex, TCarbonTab(Page.Handle));
TCarbonTab(Page.Handle).Attach(Self);
@ -474,5 +474,16 @@ begin
UpdateTabs(0, True);
end;
{------------------------------------------------------------------------------
Method: TCarbonTabsControl.SetTabPosition
Params: ATabPosition - New position of tabs
Changes position of the tabs
------------------------------------------------------------------------------}
procedure TCarbonTabsControl.SetTabPosition(ATabPosition: TTabPosition);
begin
if FTabPosition <> ATabPosition then RecreateWnd(LCLObject);
end;
end.

16
lcl/interfaces/carbon/carbonutils.pas
View File

@ -41,11 +41,11 @@ type
TFourCC = packed array[0..3] of Char;
// in eventhandlers UInt32 and FourCCs are mixed, so we provide here some fixup wrappers
function MakeEventSpec(AClass: TFourCC; AKind: UInt32): EventTypeSpec; inline;
function MakeEventSpec(AClass, AKind: TFourCC): EventTypeSpec; inline;
function MakeEventSpec(AClass, AKind: UInt32): EventTypeSpec; inline;
function MakeEventSpec(AClass: TFourCC; AKind: UInt32): EventTypeSpec; //inline;
function MakeEventSpec(AClass, AKind: TFourCC): EventTypeSpec; //inline;
function MakeEventSpec(AClass, AKind: UInt32): EventTypeSpec; //inline;
function MakeFourCC(AFourCC: TFourCC): FourCharCode; inline;
function MakeFourCC(AFourCC: TFourCC): FourCharCode; //inline;
// Some missing macros (params differ)
function InstallControlEventHandler(inControl: ControlRef;
@ -70,7 +70,7 @@ uses
AKind - Event kind
Returns: Event type specification
------------------------------------------------------------------------------}
function MakeEventSpec(AClass, AKind: TFourCC): EventTypeSpec; inline;
function MakeEventSpec(AClass, AKind: TFourCC): EventTypeSpec;
begin
Result.eventClass := FourCharCode(AClass);
Result.eventKind := FourCharCode(AKind);
@ -82,7 +82,7 @@ end;
AKind - Event kind
Returns: Event type specification
------------------------------------------------------------------------------}
function MakeEventSpec(AClass, AKind: UInt32): EventTypeSpec; inline;
function MakeEventSpec(AClass, AKind: UInt32): EventTypeSpec;
begin
Result.eventClass := AClass;
Result.eventKind := AKind;
@ -94,7 +94,7 @@ end;
AKind - Event kind
Returns: Event type specification
------------------------------------------------------------------------------}
function MakeEventSpec(AClass: TFourCC; AKind: UInt32): EventTypeSpec; inline;
function MakeEventSpec(AClass: TFourCC; AKind: UInt32): EventTypeSpec;
begin
Result.eventClass := FourCharCode(AClass);
Result.eventKind := AKind;
@ -105,7 +105,7 @@ end;
Params: AFourCC - Four char code
Returns: Four char code
------------------------------------------------------------------------------}
function MakeFourCC(AFourCC: TFourCC): FourCharCode; inline;
function MakeFourCC(AFourCC: TFourCC): FourCharCode;
begin
Result := FourCharCode(AFourCC);
end;

122
lcl/interfaces/carbon/carbonwinapi.inc
View File

@ -146,12 +146,11 @@ end;
Method: ComboBoxDropDown
Params: Handle - Handle to combo box
DropDown - Show list
Returns: If hte function succeeds
Returns: If the function succeeds
Shows or hides the combo box list
------------------------------------------------------------------------------}
function TCarbonWidgetSet.ComboBoxDropDown(Handle: HWND; DropDown: boolean
): boolean;
function TCarbonWidgetSet.ComboBoxDropDown(Handle: HWND; DropDown: boolean): boolean;
begin
Result := False;
@ -160,11 +159,14 @@ begin
{$ENDIF}
if not CheckWidget(Handle, 'ComboBoxDropDown') then Exit;
if OSError(HIComboBoxSetListVisible(AsControlRef(Handle), DropDown), Self,
'ComboBoxDropDown', 'HIComboBoxSetListVisible') then Exit;
Result := True;
if not (TCarbonWidget(Handle) is TCarbonComboBox) then
begin
DebugLn('TCarbonWidgetSet.ComboBoxDropDown failed - passed widget ' +
TCarbonWidget(Handle).ClassName + ' is not TCarbonComboBox!');
Exit;
end;
Result := TCarbonComboBox(Handle).DropDown(DropDown);
end;
{------------------------------------------------------------------------------
@ -1430,7 +1432,8 @@ begin
if not CheckWidget(Handle, 'GetParent') then Exit;
if TCarbonWidget(Handle) is TCarbonControl then
Result := HWnd(GetCarbonWidget(HIViewGetSuperview(AsControlRef(Handle))));
Result :=
HWnd(GetCarbonWidget(HIViewGetSuperview(TCarbonControl(Handle).Widget)));
// Carbon windows has no parent
{$IFDEF VerboseWinAPI}
@ -2683,9 +2686,15 @@ begin
{$ENDIF}
if not CheckWidget(Handle, SName) then Exit;
if not (TCarbonWidget(Handle) is TCarbonWindow) then
begin
DebugLn('TCarbonWidgetSet.SetActiveWindow failed - widget ' +
TCarbonWidget(Handle).ClassName + ' is not TCarbonWindow!');
Exit;
end;
Result := GetActiveWindow;
if OSError(ActivateWindow(AsWindowRef(Handle), True), Self, SName,
SActivateWindow) then Result := 0;
if not TCarbonWindow(Handle).Activate then Result := 0;
end;
{------------------------------------------------------------------------------
@ -2794,11 +2803,6 @@ end;
Sets the keyboard focus to the specified window
------------------------------------------------------------------------------}
function TCarbonWidgetSet.SetFocus(HWnd: HWND): HWND;
var
Window: WindowRef;
Control: ControlRef;
const
SName = 'SetFocus';
begin
{$IFDEF VerboseWinAPI}
DebugLn('TCarbonWidgetSet.SetFocus HWnd: ' + DbgS(HWnd));
@ -2807,21 +2811,9 @@ begin
Result := GetFocus;
if HWnd = 0 then Exit;
if HWnd = Result then Exit; // if window is already focused exit
if not CheckWidget(HWnd, 'SetFocus') then Exit;
if not CheckWidget(HWnd, SSetFocus) then Exit;
Window := TCarbonWidget(HWnd).GetTopParentWindow;
OSError(
SetUserFocusWindow(Window), Self, SName, 'SetUserFocusWindow');
if HWnd <> THandle(GetCarbonWindow(Window)) then
begin
OSError(GetKeyboardFocus(Window, Control), Self, SName, SGetKeyboardFocus);
if Control <> AsControlRef(HWnd) then
OSError(SetKeyboardFocus(Window, AsControlRef(HWnd), kControlFocusNextPart),
Self, SName, 'SetKeyboardFocus');
end;
TCarbonWidget(HWnd).SetFocus;
end;
{------------------------------------------------------------------------------
@ -2842,10 +2834,14 @@ begin
{$ENDIF}
if not CheckWidget(HWnd, SName) then Exit;
if OSError(ActivateWindow(AsWindowRef(HWnd), True), Self, SName,
SActivateWindow) then Exit;
if not (TCarbonWidget(HWnd) is TCarbonWindow) then
begin
DebugLn('TCarbonWidgetSet.SetForegroundWindow failed - widget ' +
TCarbonWidget(HWnd).ClassName + ' is not TCarbonWindow!');
Exit;
end;
Result := True;
Result := TCarbonWindow(HWnd).Activate;
end;
{------------------------------------------------------------------------------
@ -2909,6 +2905,8 @@ end;
------------------------------------------------------------------------------}
function TCarbonWidgetSet.SetScrollInfo(Handle: HWND; SBStyle: Integer;
ScrollInfo: TScrollInfo; bRedraw: Boolean): Integer;
var
CarbonControl: TCarbonControl;
begin
Result := 0;
@ -2921,17 +2919,18 @@ begin
if SBStyle = SB_CTL then
begin
Result := GetControl32BitValue(AsControlRef(Handle));
CarbonControl := TCarbonControl(Handle);
Result := CarbonControl.GetValue;
if (SIF_RANGE and ScrollInfo.fMask) > 0 then
begin
SetControl32BitMinimum(AsControlRef(Handle), ScrollInfo.nMin);
SetControl32BitMaximum(AsControlRef(Handle), ScrollInfo.nMax);
CarbonControl.SetMinimum(ScrollInfo.nMin);
CarbonControl.SetMaximum(ScrollInfo.nMax);
end;
if (SIF_POS and ScrollInfo.fMask) > 0 then
SetControl32BitValue(AsControlRef(Handle), ScrollInfo.nPos);
CarbonControl.SetValue(ScrollInfo.nPos);
if (SIF_PAGE and ScrollInfo.fMask) > 0 then
SetControlViewSize(AsControlRef(Handle), ScrollInfo.nPage);
CarbonControl.SetViewSize(ScrollInfo.nPage);
end
else
// TODO: SB_VERT, SB_HORZ
@ -3010,13 +3009,6 @@ end;
Shows the window normal, minimized or maximized
------------------------------------------------------------------------------}
function TCarbonWidgetSet.ShowWindow(hWnd: HWND; nCmdShow: Integer): Boolean;
var
P: FPCMacOSAll.Point;
Maximized: Boolean;
const
SName = 'ShowWindow';
SCollapse = 'CollapseWindow';
SZoomIdeal = 'ZoomWindowIdeal';
begin
Result := False;
@ -3025,41 +3017,15 @@ begin
DbgS(nCmdShow));
{$ENDIF}
if not CheckWidget(HWnd, SName) then Exit;
case nCmdShow of
SW_SHOWNORMAL, SW_SHOWMAXIMIZED:
if not CheckWidget(HWnd, 'ShowWindow') then Exit;
if not (TCarbonWidget(HWnd) is TCarbonWindow) then
begin
if IsWindowCollapsed(AsWindowRef(HWnd)) then
if OSError(CollapseWindow(AsWindowRef(HWnd), False),
Self, SName, SCollapse) then Exit;
DebugLn('TCarbonWidgetSet.ShowWindow failed - widget ' +
TCarbonWidget(HWnd).ClassName + ' is not TCarbonWindow!');
Exit;
end;
// for checking if any change is necessary
Maximized := IsWindowInStandardState(AsWindowRef(HWnd), nil, nil);
if nCmdShow = SW_SHOWNORMAL then
begin
if Maximized then
if OSError(ZoomWindowIdeal(AsWindowRef(HWnd), inZoomIn, P),
Self, SName, SZoomIdeal, 'inZoomIn') then Exit;
end
else
if not Maximized then
begin
P.v := $3FFF;
P.h := $3FFF;
if OSError(ZoomWindowIdeal(AsWindowRef(HWnd), inZoomOut, P),
Self, SName, SZoomIdeal, 'inZoomOut') then Exit;
end;
end;
SW_MINIMIZE:
begin
if OSError(CollapseWindow(AsWindowRef(HWnd), True),
Self, SName, SCollapse) then Exit;
end;
end;
Result := True;
Result := TCarbonWindow(HWnd).Show(nCmdShow);
end;
function TCarbonWidgetSet.StretchBlt(DestDC: HDC; X, Y, Width, Height: Integer;

34
lcl/interfaces/carbon/carbonwsbuttons.pp
View File

@ -105,10 +105,7 @@ class procedure TCarbonWSButton.SetDefault(const AButton: TCustomButton;
begin
if not CheckHandle(AButton, Self, 'SetDefault') then Exit;
OSError(
SetControlData(AsControlRef(AButton.Handle), kControlEntireControl,
kControlPushButtonDefaultTag, SizeOf(Boolean), @ADefault),
Self, 'SetDefault', SSetData);
TCarbonButton(AButton.Handle).SetDefault(ADefault);
end;
{ TCarbonWSBitBtn }
@ -137,19 +134,10 @@ end;
------------------------------------------------------------------------------}
class procedure TCarbonWSBitBtn.SetGlyph(const ABitBtn: TCustomBitBtn;
const AValue: TBitmap);
var
ContentInfo: ControlButtonContentInfo;
begin
if not CheckHandle(ABitBtn, Self, 'SetGlyph') then Exit;
ContentInfo.contentType := kControlContentCGImageRef;
if AValue = nil then
ContentInfo.imageRef := nil
else
ContentInfo.imageRef := TCarbonBitmap(AValue.Handle).CGImage;
OSError(SetBevelButtonContentInfo(AsControlRef(ABitBtn.Handle), @ContentInfo),
Self, 'SetGlyph', 'SetBevelButtonContentInfo');
TCarbonBitBtn(ABitBtn.Handle).SetGlyph(AValue);
end;
{------------------------------------------------------------------------------
@ -157,26 +145,14 @@ end;
Params: ABitBtn - LCL custom bitmap button
AValue - Bitmap and caption layout
Sets the bitmap nad caption layout of bevel button in Carbon interface
Sets the bitmap and caption layout of bevel button in Carbon interface
------------------------------------------------------------------------------}
class procedure TCarbonWSBitBtn.SetLayout(const ABitBtn: TCustomBitBtn;
const AValue: TButtonLayout);
var
Placement: ControlButtonTextPlacement;
begin
if not CheckHandle(ABitBtn, Self, 'SetLayout') then Exit;
case AValue of
blGlyphLeft : Placement := kControlBevelButtonPlaceToRightOfGraphic;
blGlyphRight : Placement := kControlBevelButtonPlaceToLeftOfGraphic;
blGlyphTop : Placement := kControlBevelButtonPlaceBelowGraphic;
blGlyphBottom: Placement := kControlBevelButtonPlaceAboveGraphic;
end;
OSError(SetBevelButtonTextPlacement(AsControlRef(ABitBtn.Handle), Placement),
Self, 'SetLayout', 'SetBevelButtonTextPlacement');
TCarbonWidget(ABitBtn.Handle).Invalidate;
TCarbonBitBtn(ABitBtn.Handle).SetLayout(AValue);
end;
initialization

18
lcl/interfaces/carbon/carbonwscomctrls.pp
View File

@ -248,8 +248,7 @@ class procedure TCarbonWSProgressBar.ApplyChanges(
begin
if not CheckHandle(AProgressBar, Self, 'ApplyChanges') then Exit;
TCarbonCustomBar(AProgressBar.Handle).SetData(AProgressBar.Position,
AProgressBar.Min, AProgressBar.Max);
TCarbonProgressBar(AProgressBar.Handle).ApplyChanges;
end;
{------------------------------------------------------------------------------
@ -264,7 +263,7 @@ class procedure TCarbonWSProgressBar.SetPosition(
begin
if not CheckHandle(AProgressBar, Self, 'SetPosition') then Exit;
TCarbonCustomBar(AProgressBar.Handle).SetData(AProgressBar.Position);
TCarbonCustomBar(AProgressBar.Handle).SetPosition(AProgressBar.Position);
end;
{ TCarbonWSTrackBar }
@ -290,17 +289,10 @@ end;
Sets the parameters (Min, Max, Position, Ticks) of slider in Carbon interface
------------------------------------------------------------------------------}
class procedure TCarbonWSTrackBar.ApplyChanges(const ATrackBar: TCustomTrackBar);
var
CarbonTrackBar: TCarbonTrackBar;
begin
if not CheckHandle(ATrackBar, Self, 'ApplyChanges') then Exit;
CarbonTrackBar := TCarbonTrackBar(ATrackBar.Handle);
if CarbonTrackBar.Ticks <> CarbonTrackBar.GetTicks then
RecreateWnd(ATrackBar) // recreate track bar if ticks have changed
else
CarbonTrackBar.SetData(ATrackBar.Position, ATrackBar.Min, ATrackBar.Max);
TCarbonTrackBar(ATrackBar.Handle).ApplyChanges;
end;
{------------------------------------------------------------------------------
@ -314,7 +306,7 @@ begin
Result := 0;
if not CheckHandle(ATrackBar, Self, 'GetPosition') then Exit;
Result := TCarbonTrackBar(ATrackBar.Handle).GetPos;
Result := TCarbonTrackBar(ATrackBar.Handle).GetPosition;
end;
{------------------------------------------------------------------------------
@ -329,7 +321,7 @@ class procedure TCarbonWSTrackBar.SetPosition(const ATrackBar: TCustomTrackBar;
begin
if not CheckHandle(ATrackBar, Self, 'SetPosition') then Exit;
TCarbonTrackBar(ATrackBar.Handle).SetData(ATrackBar.Position);
TCarbonTrackBar(ATrackBar.Handle).SetPosition(ATrackBar.Position);
end;

40
lcl/interfaces/carbon/carbonwscontrols.pp
View File

@ -180,48 +180,12 @@ end;
------------------------------------------------------------------------------}
class procedure TCarbonWSWinControl.SetChildZPosition(const AWinControl,
AChild: TWinControl; const AOldPos, ANewPos: Integer; const AChildren: TFPList);
var
RefView: HIViewRef;
Order: HIViewZOrderOp;
I, StopPos: Integer;
Child: TWinControl;
begin
if not CheckHandle(AWinControl, Self, 'SetChildZPosition') then Exit;
if not CheckHandle(AChild, Self, 'SetChildZPosition AChild') then Exit;
RefView := nil;
if ANewPos <= 0 then // send behind all
Order := kHIViewZOrderBelow
else
if ANewPos >= Pred(AChildren.Count) then // bring to front of all
Order := kHIViewZOrderAbove
else // custom position
begin
// Search for the first child above us with a handle.
// The child list is reversed form the windows order.
// If we don't find an allocated handle then exit.
if AOldPos > ANewPos then
StopPos := AOldPos // the child is moved to the bottom
else
StopPos := Pred(AChildren.Count); // the child is moved to the top
for I := Succ(ANewPos) to StopPos do
begin
Child := TWinControl(AChildren[I]);
if Child.HandleAllocated then
begin
RefView := AsControlRef(Child.Handle);
Order := kHIViewZOrderBelow;
Break;
end;
end;
if RefView = nil then Exit;
end;
OSError(HIViewSetZOrder(AsControlRef(AChild.Handle), Order, RefView),
Self, 'SetChildZPosition', 'HIViewSetZOrder');
TCarbonWidget(AWinControl.Handle).SetChildZPosition(TCarbonWidget(AChild.Handle),
AOldPos, ANewPos, AChildren);
end;
{------------------------------------------------------------------------------

3
lcl/interfaces/carbon/carbonwsextctrls.pp
View File

@ -336,8 +336,7 @@ class procedure TCarbonWSCustomNotebook.SetTabPosition(const ANotebook: TCustomN
begin
if not CheckHandle(ANotebook, Self, 'SetTabPosition') then Exit;
if TCarbonTabsControl(ANotebook.Handle).TabPosition <> ATabPosition then
RecreateWnd(ANotebook);
TCarbonTabsControl(ANotebook.Handle).SetTabPosition(ATabPosition);
end;
{------------------------------------------------------------------------------

51
lcl/interfaces/carbon/carbonwsforms.pp
View File

@ -150,14 +150,10 @@ end;
Closes modal window in Carbon interface
------------------------------------------------------------------------------}
class procedure TCarbonWSCustomForm.CloseModal(const ACustomForm: TCustomForm);
const
SName = 'CloseModal';
begin
if not CheckHandle(ACustomForm, Self, SName) then Exit;
if not CheckHandle(ACustomForm, Self, 'CloseModal') then Exit;
OSError(
SetWindowModality(AsWindowRef(ACustomForm.Handle), kWindowModalityNone, nil),
Self, SName, SSetModality);
TCarbonWindow(ACustomForm.Handle).CloseModal;
end;
{------------------------------------------------------------------------------
@ -170,11 +166,7 @@ class procedure TCarbonWSCustomForm.ShowModal(const ACustomForm: TCustomForm);
begin
if not CheckHandle(ACustomForm, Self, SShowModal) then Exit;
OSError(
SetWindowModality(AsWindowRef(ACustomForm.Handle), kWindowModalityAppModal, nil),
Self, SShowModal, SSetModality);
SelectWindow(AsWindowRef(ACustomForm.Handle));
TCarbonWindow(ACustomForm.Handle).ShowModal;
end;
{------------------------------------------------------------------------------
@ -186,46 +178,25 @@ end;
------------------------------------------------------------------------------}
class procedure TCarbonWSCustomForm.SetBorderIcons(const AForm: TCustomForm;
const ABorderIcons: TBorderIcons);
var
AttrsSet, AttrsClear: WindowAttributes;
const
SName = 'SetBorderIcons';
begin
if not CheckHandle(AForm, Self, SName) then Exit;
if not CheckHandle(AForm, Self, 'SetBorderIcons') then Exit;
AttrsSet := 0;
AttrsClear := 0;
if (biMinimize in ABorderIcons) and (biSystemMenu in ABorderIcons) then
AttrsSet := AttrsSet or kWindowCollapseBoxAttribute
else
AttrsClear := AttrsClear or kWindowCollapseBoxAttribute;
if (biMaximize in ABorderIcons) and (biSystemMenu in ABorderIcons) then
AttrsSet := AttrsSet or kWindowFullZoomAttribute
else
AttrsClear := AttrsClear or kWindowFullZoomAttribute;
if biSystemMenu in ABorderIcons then
AttrsSet := AttrsSet or kWindowCloseBoxAttribute
else
AttrsClear := AttrsClear or kWindowCloseBoxAttribute;
OSError(ChangeWindowAttributes(AsWindowRef(AForm.Handle), AttrsSet, AttrsClear),
Self, SName, SChangeWindowAttrs);
TCarbonWindow(AForm.Handle).SetBorderIcons(ABorderIcons);
end;
{------------------------------------------------------------------------------
Method: TCarbonWSCustomForm.SetFormBorderStyle
Params: AForm - LCL custom form
AFormBorderStyle - Border style
Params: AForm - LCL custom form
AFormBorderStyle - Form border style
Sets the border style of window in Carbon interface
Sets the form border style of window in Carbon interface
------------------------------------------------------------------------------}
class procedure TCarbonWSCustomForm.SetFormBorderStyle(const AForm: TCustomForm;
const AFormBorderStyle: TFormBorderStyle);
begin
RecreateWnd(AForm);
if not CheckHandle(AForm, Self, 'SetFormBorderStyle') then Exit;
TCarbonWindow(AForm.Handle).SetFormBorderStyle(AFormBorderStyle);
end;

4
lcl/interfaces/carbon/carbonwsmenus.pp
View File

@ -245,6 +245,7 @@ class function TCarbonWSMenuItem.SetCheck(const AMenuItem: TMenuItem;
const Checked: boolean): boolean;
begin
Result := False;
if not CheckMenuItem(AMenuItem, 'SetCheck') then Exit;
if not CheckMenuItem(AMenuItem.Parent, 'SetCheck', 'Parent') then Exit;
@ -266,6 +267,7 @@ class function TCarbonWSMenuItem.SetEnable(const AMenuItem: TMenuItem;
const Enabled: boolean): boolean;
begin
Result := False;
if not CheckMenuItem(AMenuItem, 'SetEnable') then Exit;
if not CheckMenuItem(AMenuItem.Parent, 'SetEnable', 'Parent') then Exit;
@ -302,7 +304,7 @@ class procedure TCarbonWSPopupMenu.Popup(const APopupMenu: TPopupMenu; const X,
begin
if not CheckMenu(APopupMenu.Handle, 'TCarbonWSPopupMenu.Popup') then Exit;
PopUpMenuSelect(AsMenuRef(APopupMenu.Handle), Y, X, 0);
PopUpMenuSelect(TCarbonMenu(APopupMenu.Handle).Menu, Y, X, 0);
// ^- order top, left is correct!
APopupMenu.Close; // notify LCL popup menu
end;

129
lcl/interfaces/carbon/carbonwsstdctrls.pp
View File

@ -156,9 +156,7 @@ type
class function GetStrings(const ACustomMemo: TCustomMemo): TStrings; override;
class procedure AppendText(const ACustomMemo: TCustomMemo; const AText: string); override;
class procedure SetPasswordChar(const ACustomEdit: TCustomEdit; NewChar: char); override;
class procedure SetScrollbars(const ACustomMemo: TCustomMemo; const NewScrollbars: TScrollStyle); override;
class procedure SetReadOnly(const ACustomEdit: TCustomEdit; NewReadOnly: boolean); override;
class procedure SetWordWrap(const ACustomMemo: TCustomMemo; const NewWordWrap: boolean); override;
end;
@ -290,8 +288,7 @@ class procedure TCarbonWSScrollBar.SetParams(const AScrollBar: TCustomScrollBar)
begin
if not CheckHandle(AScrollBar, Self, 'SetParams') then Exit;
TCarbonCustomBar(AScrollBar.Handle).SetData(AScrollBar.Position,
AScrollBar.Min, AScrollBar.Max, AScrollBar.PageSize);
TCarbonScrollBar(AScrollBar.Handle).SetParams;
end;
{ TCarbonWSCustomGroupBox }
@ -407,7 +404,7 @@ end;
class procedure TCarbonWSCustomComboBox.SetSelLength(
const ACustomComboBox: TCustomComboBox; NewLength: integer);
begin
if not CheckHandle(ACustomComboBox, Self, 'SetSelLength') then Exit;
if not CheckHandle(ACustomComboBox, Self, 'SetSelLength') then Exit;
TCarbonComboBox(ACustomComboBox.Handle).SetSelLength(NewLength);
end;
@ -745,8 +742,7 @@ class procedure TCarbonWSCustomEdit.SetPasswordChar(const ACustomEdit: TCustomEd
begin
if not CheckHandle(ACustomEdit, Self, 'SetPasswordChar') then Exit;
if TCarbonEdit(ACustomEdit.Handle).IsPassword <> (NewChar <> #0) then
RecreateWnd(ACustomEdit);
TCarbonCustomEdit(ACustomEdit.Handle).SetPasswordChar(NewChar);
end;
{------------------------------------------------------------------------------
@ -759,11 +755,9 @@ end;
class procedure TCarbonWSCustomEdit.SetReadOnly(const ACustomEdit: TCustomEdit;
NewReadOnly: boolean);
begin
if not CheckHandle(ACustomEdit, Self, SSetReadOnly) then Exit;
if not CheckHandle(ACustomEdit, Self, 'SetReadOnly') then Exit;
OSError(SetControlData(AsControlRef(ACustomEdit.Handle), kControlEntireControl,
kControlEditTextLockedTag, SizeOf(Boolean), @NewReadOnly),
Self, SSetReadOnly, SSetData);
TCarbonEdit(ACustomEdit.Handle).SetReadOnly(NewReadOnly);
end;
{------------------------------------------------------------------------------
@ -847,29 +841,6 @@ begin
end;
end;
{------------------------------------------------------------------------------
Method: TCarbonWSCustomMemo.SetPasswordChar
Params: ACustomEdit - LCL custom edit
NewChar - New password char
Sets the new password char of memo in Carbon interface
------------------------------------------------------------------------------}
class procedure TCarbonWSCustomMemo.SetPasswordChar(
const ACustomEdit: TCustomEdit; NewChar: char);
const
SName = 'SetPasswordChar';
begin
if not CheckHandle(ACustomEdit, Self, SName) then Exit;
OSError(
TXNEchoMode(HITextViewGetTXNObject(AsControlRef(ACustomEdit.Handle)),
UniChar(NewChar), CreateTextEncoding(kTextEncodingUnicodeDefault,
kUnicodeNoSubset, kUnicodeUTF8Format), NewChar <> #0),
Self, SName, 'TXNEchoMode');
TCarbonWidget(ACustomEdit.Handle).Invalidate;
end;
{------------------------------------------------------------------------------
Method: TCarbonWSCustomMemo.SetScrollbars
Params: ACustomEdit - LCL custom memo
@ -885,33 +856,6 @@ begin
TCarbonMemo(ACustomMemo.Handle).ScrollBars := NewScrollbars;
end;
{------------------------------------------------------------------------------
Method: TCarbonWSCustomMemo.SetReadOnly
Params: ACustomEdit - LCL custom edit
NewReadOnly - Read only behavior
Sets the read only behavior of memo in Carbon interface
------------------------------------------------------------------------------}
class procedure TCarbonWSCustomMemo.SetReadOnly(const ACustomEdit: TCustomEdit;
NewReadOnly: boolean);
var
Tag: TXNControlTag;
Data: TXNControlData;
begin
if not CheckHandle(ACustomEdit, Self, SSetReadOnly) then Exit;
Tag := kTXNNoUserIOTag;
if NewReadOnly then
Data.uValue := UInt32(kTXNReadOnly)
else
Data.uValue := UInt32(kTXNReadWrite);
OSError(
TXNSetTXNObjectControls(HITextViewGetTXNObject(AsControlRef(ACustomEdit.Handle)),
False, 1, @Tag, @Data),
sELF, SSetReadOnly, SSetTXNControls);
end;
{------------------------------------------------------------------------------
Method: TCarbonWSCustomMemo.SetWordWrap
Params: ACustomMemo - LCL custom memo
@ -921,26 +865,11 @@ end;
------------------------------------------------------------------------------}
class procedure TCarbonWSCustomMemo.SetWordWrap(const ACustomMemo: TCustomMemo;
const NewWordWrap: boolean);
var
Tag: TXNControlTag;
Data: TXNControlData;
const
SName = 'SetWordWrap';
begin
if not CheckHandle(ACustomMemo, Self, SName) then Exit;
if not CheckHandle(ACustomMemo, Self, 'SetWordWrap') then Exit;
Tag := kTXNWordWrapStateTag;
if NewWordWrap then
Data.uValue := UInt32(kTXNAutoWrap)
else
Data.uValue := UInt32(kTXNNoAutoWrap);
OSError(
TXNSetTXNObjectControls(HITextViewGetTXNObject(AsControlRef(ACustomMemo.Handle)),
False, 1, @Tag, @Data),
Self, SName, SSetTXNControls);
TCarbonWidget(ACustomMemo.Handle).Invalidate;
TCarbonMemo(ACustomMemo.Handle).SetWordWrap(NewWordWrap);
end;
{ TCarbonWSCustomCheckBox }
@ -970,13 +899,10 @@ class function TCarbonWSCustomCheckBox.RetrieveState(
const ACustomCheckBox: TCustomCheckBox): TCheckBoxState;
begin
Result := cbUnchecked;
if not CheckHandle(ACustomCheckBox, Self, 'RetrieveState') then Exit;
case GetControl32BitValue(AsControlRef(ACustomCheckBox.Handle)) of
kControlCheckBoxCheckedValue : Result := cbChecked;
kControlCheckBoxUncheckedValue : Result := cbUnchecked;
kControlCheckBoxMixedValue : Result := cbGrayed;
end;
Result := TCarbonCustomCheckBox(ACustomCheckBox.Handle).RetrieveState;
end;
{------------------------------------------------------------------------------
@ -988,17 +914,10 @@ end;
------------------------------------------------------------------------------}
class procedure TCarbonWSCustomCheckBox.SetState(
const ACustomCheckBox: TCustomCheckBox; const NewState: TCheckBoxState);
var
Value: UInt32;
begin
if not CheckHandle(ACustomCheckBox, Self, 'SetState') then Exit;
case NewState of
cbChecked : Value := kControlCheckBoxCheckedValue;
cbUnChecked: Value := kControlCheckBoxUncheckedValue;
cbGrayed : Value := kControlCheckBoxMixedValue;
end;
SetControl32BitValue(AsControlRef(ACustomCheckBox.Handle), Value);
TCarbonCustomCheckBox(ACustomCheckBox.Handle).SetState(NewState);
end;
@ -1056,36 +975,14 @@ end;
Params: ACustomStaticText - LCL custom static text
NewAlignment - New caption alignment
Sets the new cpation alignment of static text in Carbon interface
Sets the new caption alignment of static text in Carbon interface
------------------------------------------------------------------------------}
class procedure TCarbonWSCustomStaticText.SetAlignment(
const ACustomStaticText: TCustomStaticText; const NewAlignment: TAlignment);
var
FontStyle: ControlFontStyleRec;
const
SName = 'SetAlignment';
begin
if not CheckHandle(ACustomStaticText, Self, SName) then Exit;
if not CheckHandle(ACustomStaticText, Self, 'SetAlignment') then Exit;
// get static text font style and change only justification
OSError(
GetControlData(AsControlRef(ACustomStaticText.Handle), kControlEntireControl,
kControlStaticTextStyleTag, SizeOf(FontStyle), @FontStyle, nil),
Self, SName, SGetData);
FontStyle.flags := FontStyle.flags or kControlUseJustMask;
case NewAlignment of
taLeftJustify : FontStyle.just := teFlushLeft;
taRightJustify: FontStyle.just := teFlushRight;
taCenter : FontStyle.just := teCenter;
end;
OSError(
SetControlData(AsControlRef(ACustomStaticText.Handle), kControlEntireControl,
kControlStaticTextStyleTag, SizeOf(FontStyle), @FontStyle),
Self, SName, SSetData);
// invalidate static text
TCarbonWidget(ACustomStaticText.Handle).Invalidate;
TCarbonStaticText(ACustomStaticText.Handle).SetAlignment(NewAlignment);
end;
initialization