diff --git a/lcl/interfaces/carbon/carbondbgconsts.pp b/lcl/interfaces/carbon/carbondbgconsts.pp index 7b76350c2b..5e81db537c 100644 --- a/lcl/interfaces/carbon/carbondbgconsts.pp +++ b/lcl/interfaces/carbon/carbondbgconsts.pp @@ -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'; diff --git a/lcl/interfaces/carbon/carbondef.pp b/lcl/interfaces/carbon/carbondef.pp index 9760cb9c31..1d1e0883bc 100644 --- a/lcl/interfaces/carbon/carbondef.pp +++ b/lcl/interfaces/carbon/carbondef.pp @@ -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 diff --git a/lcl/interfaces/carbon/carbonedits.pp b/lcl/interfaces/carbon/carbonedits.pp index 7bc70bc734..07c4956db4 100644 --- a/lcl/interfaces/carbon/carbonedits.pp +++ b/lcl/interfaces/carbon/carbonedits.pp @@ -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. diff --git a/lcl/interfaces/carbon/carbonint.pas b/lcl/interfaces/carbon/carbonint.pas index f2656f9ecb..188adfb036 100644 --- a/lcl/interfaces/carbon/carbonint.pas +++ b/lcl/interfaces/carbon/carbonint.pas @@ -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 diff --git a/lcl/interfaces/carbon/carbonlclintf.inc b/lcl/interfaces/carbon/carbonlclintf.inc index 70147b74ab..3c5e5a6d9d 100644 --- a/lcl/interfaces/carbon/carbonlclintf.inc +++ b/lcl/interfaces/carbon/carbonlclintf.inc @@ -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 diff --git a/lcl/interfaces/carbon/carbonmenus.pp b/lcl/interfaces/carbon/carbonmenus.pp index 019099a67d..910f14a9ee 100644 --- a/lcl/interfaces/carbon/carbonmenus.pp +++ b/lcl/interfaces/carbon/carbonmenus.pp @@ -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; diff --git a/lcl/interfaces/carbon/carbonobject.inc b/lcl/interfaces/carbon/carbonobject.inc index 778c416580..7ca700db51 100644 --- a/lcl/interfaces/carbon/carbonobject.inc +++ b/lcl/interfaces/carbon/carbonobject.inc @@ -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 diff --git a/lcl/interfaces/carbon/carbonprivate.pp b/lcl/interfaces/carbon/carbonprivate.pp index fd57526661..d9c039180d 100644 --- a/lcl/interfaces/carbon/carbonprivate.pp +++ b/lcl/interfaces/carbon/carbonprivate.pp @@ -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. diff --git a/lcl/interfaces/carbon/carbonprivatecommon.inc b/lcl/interfaces/carbon/carbonprivatecommon.inc index 38f70e6547..59cc7d029e 100644 --- a/lcl/interfaces/carbon/carbonprivatecommon.inc +++ b/lcl/interfaces/carbon/carbonprivatecommon.inc @@ -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; diff --git a/lcl/interfaces/carbon/carbonprivatecontrol.inc b/lcl/interfaces/carbon/carbonprivatecontrol.inc index a206ab5ceb..0f7cb141d4 100644 --- a/lcl/interfaces/carbon/carbonprivatecontrol.inc +++ b/lcl/interfaces/carbon/carbonprivatecontrol.inc @@ -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; diff --git a/lcl/interfaces/carbon/carbonprivatewindow.inc b/lcl/interfaces/carbon/carbonprivatewindow.inc index f3b4a85e1f..cdf520277d 100644 --- a/lcl/interfaces/carbon/carbonprivatewindow.inc +++ b/lcl/interfaces/carbon/carbonprivatewindow.inc @@ -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; diff --git a/lcl/interfaces/carbon/carbonproc.pp b/lcl/interfaces/carbon/carbonproc.pp index a04015b373..578806da52 100644 --- a/lcl/interfaces/carbon/carbonproc.pp +++ b/lcl/interfaces/carbon/carbonproc.pp @@ -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 diff --git a/lcl/interfaces/carbon/carbontabs.pp b/lcl/interfaces/carbon/carbontabs.pp index d0f669a36e..e81d7e740c 100644 --- a/lcl/interfaces/carbon/carbontabs.pp +++ b/lcl/interfaces/carbon/carbontabs.pp @@ -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. diff --git a/lcl/interfaces/carbon/carbonutils.pas b/lcl/interfaces/carbon/carbonutils.pas index 65d443975b..f7de5490fd 100644 --- a/lcl/interfaces/carbon/carbonutils.pas +++ b/lcl/interfaces/carbon/carbonutils.pas @@ -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; diff --git a/lcl/interfaces/carbon/carbonwinapi.inc b/lcl/interfaces/carbon/carbonwinapi.inc index 15f2979e44..cd6fecdd93 100644 --- a/lcl/interfaces/carbon/carbonwinapi.inc +++ b/lcl/interfaces/carbon/carbonwinapi.inc @@ -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; diff --git a/lcl/interfaces/carbon/carbonwsbuttons.pp b/lcl/interfaces/carbon/carbonwsbuttons.pp index 5cc5827596..3276303bac 100644 --- a/lcl/interfaces/carbon/carbonwsbuttons.pp +++ b/lcl/interfaces/carbon/carbonwsbuttons.pp @@ -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 diff --git a/lcl/interfaces/carbon/carbonwscomctrls.pp b/lcl/interfaces/carbon/carbonwscomctrls.pp index f903a4ba5c..2a8d6aa6a7 100644 --- a/lcl/interfaces/carbon/carbonwscomctrls.pp +++ b/lcl/interfaces/carbon/carbonwscomctrls.pp @@ -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; diff --git a/lcl/interfaces/carbon/carbonwscontrols.pp b/lcl/interfaces/carbon/carbonwscontrols.pp index 8de00064b0..af4890fd9b 100644 --- a/lcl/interfaces/carbon/carbonwscontrols.pp +++ b/lcl/interfaces/carbon/carbonwscontrols.pp @@ -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; {------------------------------------------------------------------------------ diff --git a/lcl/interfaces/carbon/carbonwsextctrls.pp b/lcl/interfaces/carbon/carbonwsextctrls.pp index 509366e6ce..1ab87e15e8 100644 --- a/lcl/interfaces/carbon/carbonwsextctrls.pp +++ b/lcl/interfaces/carbon/carbonwsextctrls.pp @@ -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; {------------------------------------------------------------------------------ diff --git a/lcl/interfaces/carbon/carbonwsforms.pp b/lcl/interfaces/carbon/carbonwsforms.pp index d4be4bf1d9..c0bb52effb 100644 --- a/lcl/interfaces/carbon/carbonwsforms.pp +++ b/lcl/interfaces/carbon/carbonwsforms.pp @@ -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; diff --git a/lcl/interfaces/carbon/carbonwsmenus.pp b/lcl/interfaces/carbon/carbonwsmenus.pp index c6560f12c8..e78c7d059a 100644 --- a/lcl/interfaces/carbon/carbonwsmenus.pp +++ b/lcl/interfaces/carbon/carbonwsmenus.pp @@ -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; diff --git a/lcl/interfaces/carbon/carbonwsstdctrls.pp b/lcl/interfaces/carbon/carbonwsstdctrls.pp index 0def181ac8..19de1f12f7 100644 --- a/lcl/interfaces/carbon/carbonwsstdctrls.pp +++ b/lcl/interfaces/carbon/carbonwsstdctrls.pp @@ -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