paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-22 16:39:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

* patch from Tom Gregorovic

Browse Source 
git-svn-id: trunk@10732 -
This commit is contained in:
marc 2007-03-10 00:05:51 +00:00
parent 076523638b
commit c9f940ca40
14 changed files with 263 additions and 111 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -243,6 +243,7 @@ type
function GetCGContext: CGContextRef; virtual; abstract;
function GetSize: TPoint; virtual; abstract;
public
constructor Create;
destructor Destroy; override;
procedure Reset; virtual;
@ -622,6 +623,12 @@ begin
end;
end;
constructor TCarbonDeviceContext.Create;
begin
FBkBrush := TCarbonBrush.Create;
FTextPen := TCarbonPen.Create;
end;
destructor TCarbonDeviceContext.Destroy;
begin
BkBrush.Free;
@ -638,26 +645,18 @@ begin
PenPos.y := 0;
// create brush for bk color and mode
FBkColor := clWhite;
FBkColor := clNone;
FBkMode := TRANSPARENT;
FBkBrush := TCarbonBrush.Create;
// create pen for text color
FTextColor := clBlack;
FTextPen := TCarbonPen.Create;
FTextColor := clNone;
// set raster operation to copy
FROP2 := R2_COPYPEN;
// set initial pen and brush
FCurrentPen := TextPen;
FCurrentBrush := BkBrush;
if CGContext <> nil then
begin
CurrentPen.Apply(Self);
CurrentBrush.Apply(Self);
end;
FCurrentPen := nil;
FCurrentBrush := nil;
Update;
end;
@ -666,10 +665,9 @@ procedure TCarbonDeviceContext.Update;
begin
if CGContext <> nil then
begin
{$IFDEF VerbosePaint}
DebugLn('TCarbonDeviceContext.Update');
// change origin of coordination system (botom-left to top-left)
// note that the coordination system is upside-down
CGContextTranslateCTM(CGContext, 0, Size.Y);
{$ENDIF}
// disable anti-aliasing
CGContextSetShouldAntialias(CGContext, 0);
end;

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

@ -116,7 +116,7 @@ uses
CarbonWSControls,
// CarbonWSDbCtrls,
// CarbonWSDBGrids,
// CarbonWSDialogs,
CarbonWSDialogs,
// CarbonWSDirSel,
// CarbonWSEditBtn,
// CarbonWSExtCtrls,

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

@ -445,14 +445,21 @@ end;
------------------------------------------------------------------------------}
procedure TCarbonWidgetSet.AppBringToFront;
var
I: Integer;
//I: Integer;
Proc: ProcessSerialNumber;
begin
CollapseAllWindows(False);
{CollapseAllWindows(False);
for I := 0 to Pred(Screen.CustomFormZOrderCount) do
begin
BringToFront(WindowRef(Screen.CustomFormsZOrdered[I].Handle));
end;
end;}
(*
According to Carbon Development Tips & Tricks:
34. How do I bring all my windows to the front?
*)
if GetCurrentProcess(Proc) = noErr then SetFrontProcess(Proc);
end;
{------------------------------------------------------------------------------

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

@ -41,7 +41,9 @@ var
EraseMsg: TLMEraseBkgnd;
AStruct: PPaintStruct;
begin
{$IFDEF VerbosePaint}
Debugln('CarbonPrivateCommon_Draw ', DbgSName(AInfo.LCLObject));
{$ENDIF}
{
// send erase background messsage
@ -56,7 +58,7 @@ begin
GetEventParameter(AEvent, kEventParamCGContextRef, typeCGContextRef, nil,
SizeOf(CGContextRef), nil, @(AInfo.CGContext));
AInfo.Context.Update;
AInfo.Context.Reset;
// TODO: save DC
@ -64,7 +66,9 @@ begin
FillChar(AStruct^, SizeOf(TPaintStruct), 0);
AStruct^.hdc := HDC(AInfo.Context);
try
{$IFDEF VerbosePaint}
DebugLn('CarbonPrivateCommon_Draw LM_PAINT to ', DbgSName(AInfo.LCLObject));
{$ENDIF}
LCLSendPaintMsg(AInfo.LCLObject as TControl, HDC(AInfo.Context), AStruct);
finally
Dispose(AStruct);
@ -111,32 +115,44 @@ function CarbonPrivateCommon_ValueChanged(ANextHandler: EventHandlerCallRef;
AEvent: EventRef;
AInfo: TCarbonWidgetInfo): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
var
I: Integer;
RadioButton: TRadioButton;
ScrollMsg: TLMScroll;
RadioButton: TRadioButton;
I: Integer;
begin
DebugLn('CarbonPrivateCommon_ValueChanged ', DbgSName(AInfo.LCLObject));
Result := CallNextEventHandler(ANextHandler, AEvent);
if AInfo.LCLObject is TRadioButton then
if AInfo.LCLObject is TCustomCheckBox then
begin
if GetControl32BitValue(ControlRef(AInfo.Widget)) = kControlCheckBoxCheckedValue then
(*// toggle custom check box state before on click event is proceed
case GetControl32BitValue(ControlRef(AInfo.Widget)) of
kControlCheckBoxCheckedValue : Value := cbUnchecked;
kControlCheckBoxUncheckedValue: Value := cbChecked;
kControlCheckBoxMixedValue : Value := cbGrayed; // Is this right?
end;
SetControl32BitValue(ControlRef(AInfo.Widget), Value);*)
if AInfo.LCLObject is TRadioButton then
begin
DebugLn('CarbonPrivateCommon_ValueChanged Uncheck Sibling');
// uncheck sibling radio buttons
RadioButton := (AInfo.LCLObject as TRadioButton);
if RadioButton.Parent <> nil then
if GetControl32BitValue(ControlRef(AInfo.Widget))
= kControlCheckBoxCheckedValue then
begin
for I := 0 to RadioButton.Parent.ControlCount - 1 do
if (RadioButton.Parent.Controls[I] is TRadioButton) and
(RadioButton.Parent.Controls[I] <> RadioButton) then
(RadioButton.Parent.Controls[I] as TRadioButton).Checked := False;
DebugLn('CarbonPrivateCommon_ValueChanged Uncheck Sibling');
// uncheck sibling radio buttons
RadioButton := (AInfo.LCLObject as TRadioButton);
if RadioButton.Parent <> nil then
begin
for I := 0 to RadioButton.Parent.ControlCount - 1 do
if (RadioButton.Parent.Controls[I] is TRadioButton) and
(RadioButton.Parent.Controls[I] <> RadioButton) then
(RadioButton.Parent.Controls[I] as TRadioButton).Checked := False;
end;
end;
end;
end;
if AInfo.LCLObject is TCustomScrollBar then
begin
FillChar(ScrollMsg, SizeOf(TLMScroll), 0);

8
lcl/interfaces/carbon/carbonprivateedit.inc
View File

@ -24,7 +24,7 @@ function CarbonPrivateEdit_TextChanged(ANextHandler: EventHandlerCallRef;
AInfo: TCarbonWidgetInfo): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
var
S: String;
M: Integer;
M, SelStart: Integer;
Msg: TLMessage;
MemoStrings: TCarbonMemoStrings;
begin
@ -37,11 +37,13 @@ begin
M := (AInfo.LCLObject as TCustomEdit).MaxLength;
if M > 0 then
begin
if TCarbonWSCustomEdit.GetText(AInfo.LCLObject as TWinControl, S) then
if GetEditControlText(HWnd(AInfo.Widget), S) then
if UTF8Length(S) > M then
begin
GetEditControlSelStart(HWnd(AInfo.Widget), SelStart);
S := UTF8Copy(S, 1, M);
TCarbonWSCustomEdit.SetText(AInfo.LCLObject as TWinControl, S);
if SetEditControlText(HWnd(AInfo.Widget), S) then
SetEditControlSelStart(HWnd(AInfo.Widget), SelStart);
end;
end;

10
lcl/interfaces/carbon/carbonprivatehiview.inc
View File

@ -22,16 +22,14 @@
function CarbonPrivateHIView_Hit(ANextHandler: EventHandlerCallRef;
AEvent: EventRef;
AInfo: TCarbonWidgetInfo): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
var
Value: UInt32;
I: Integer;
RadioButton: TRadioButton;
begin
{$ifdef VerboseMouse}
DebugLn('PrivateHiView_Hit: ', (AInfo.LCLObject as TComponent).Name);
{$endif}
Result := CallNextEventHandler(ANextHandler, AEvent);
if AInfo.LCLObject is TCustomCheckBox then
// pass changed to check box to update checked property before click
LCLSendChangedMsg(AInfo.LCLObject as TControl);
LCLSendClickedMsg(AInfo.LCLObject as TControl);
end;

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

@ -80,25 +80,19 @@ function CarbonPrivateWindow_Close(ANextHandler: EventHandlerCallRef;
var
Msg: TLMessage;
begin
DebugLn('CarbonPrivateWindow_Close: ', (AInfo.LCLObject as TComponent).Name);
// Do canclose query, if false then exit
FillChar(Msg, SizeOf(Msg),0);
Msg.msg := LM_CLOSEQUERY;
// Message results : 0 - do nothing, 1 - destroy or hide window
// Message results : 0 - do nothing, 1 - destroy window
if DeliverMessage(AInfo.LCLObject, Msg) = 0 then
begin
DebugLn('CarbonPrivateWindow_Close Can''t close: ', (AInfo.LCLObject as TComponent).Name);
Result := noErr;
Exit;
end;
if (AInfo.LCLObject is TCustomForm) and
(fsModal in (AInfo.LCLObject as TCustomForm).FormState) then
begin // form is modal - avoid destroy
Result := noErr;
DebugLn('CarbonPrivateWindow_Close Hide modal form');
Exit;
end;
Result := CallNextEventHandler(ANextHandler, AEvent);
end;
@ -311,7 +305,7 @@ var
Msg^.YPos := MousePoint.Y;
Msg^.Keys := GetCarbonMsgKeyState;
// ???? What rae we doing here ????
// ???? What are we doing here ????
Spec := MakeEventSpec(kEventClassControl, kEventControlTrack);
InstallControlEventHandler(Control, RegisterEventHandler(@CarbonPrivateWindow_ControlTrack),
1, @Spec, Info, nil);
@ -326,7 +320,7 @@ var
Msg: ^TLMMouse;
begin
{$IFDEF VerboseMouse}
DebugLN('HandleMouseUpEvent');
DebugLn('HandleMouseUpEvent');
{$ENDIF}
// this is not called if NextHandler is called on MouseDown
// perhaps mousetracking can fix this

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

@ -767,7 +767,8 @@ end;
Returns: If the function suceeds
Creates the ATSU text layout for the specified text and manages the device
context to render the text
context to render the text.
NOTE: Coordination system is upside-down!
------------------------------------------------------------------------------}
function BeginTextRender(DC: TCarbonDeviceContext; AStr: PChar;
ACount: Integer; out ALayout: ATSUTextLayout): Boolean;
@ -778,6 +779,7 @@ var
W: WideString;
Tag: ATSUAttributeTag;
DataSize: ByteCount;
TempContext: CGContextRef;
PContext: ATSUAttributeValuePtr;
begin
Result := False;
@ -786,6 +788,10 @@ begin
// save context
CGContextSaveGState(DC.CGContext);
// change coordination system
CGContextScaleCTM(DC.CGContext, 1, -1);
CGContextTranslateCTM(DC.CGContext, 0, 0);
// convert UTF-8 string to UTF-16 string
if ACount < 0 then S := AStr
else S := Copy(AStr, 1, ACount);
@ -810,7 +816,8 @@ begin
Tag := kATSUCGContextTag;
DataSize := SizeOf(CGContextRef);
PContext := Pointer(DC.CGContext);
TempContext := DC.CGContext;
PContext := @TempContext;
Result := ATSUSetLayoutControls(ALayout, 1, @Tag, @DataSize, @PContext) = noErr;
end;
end;

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

@ -360,7 +360,7 @@ begin
ADC := TCarbonDeviceContext(DC);
R := GetCGRect(X1, -Y1, X2, -Y2);
R := GetCGRect(X1, Y1, X2, Y2);
CGContextFillEllipseInRect(ADC.CGContext, R);
CGContextStrokeEllipseInRect(ADC.CGContext, R);
@ -565,7 +565,7 @@ begin
// finally draw the text
Result := ATSUDrawText(TextLayout, kATSUFromTextBeginning, kATSUToTextEnd,
X shl 16 - TextBefore, -(Y shl 16) - Descent) = noErr;
X shl 16 - TextBefore, -(Y shl 16) - Ascent) = noErr;
if Result then
DebugLn('ExtTextOut text drawed');
finally
@ -735,8 +735,6 @@ begin
if lpRect <> nil then
begin
lpRect^ := CGRectToRect(CGContextGetClipBoundingBox(ADC.CGContext));
lpRect^.Top := -lpRect^.Top;
lpRect^.Bottom := -lpRect^.Bottom;
end;
end;
@ -881,7 +879,7 @@ var
Window: WindowRef;
begin
Result := 0;
Window := WindowRef(GetActiveWindow);
Window := WindowRef(GetUserFocusWindow);
if Window = nil then Exit;
Control := nil;
@ -1482,8 +1480,8 @@ begin
ADC := TCarbonDeviceContext(DC);
CGContextBeginPath(ADC.CGContext);
CGContextMoveToPoint(ADC.CGContext, ADC.PenPos.x, -ADC.PenPos.y);
CGContextAddLineToPoint(ADC.CGContext, X, -Y);
CGContextMoveToPoint(ADC.CGContext, ADC.PenPos.x, ADC.PenPos.y);
CGContextAddLineToPoint(ADC.CGContext, X, Y);
CGContextStrokePath(ADC.CGContext);
Result := True;
@ -1567,12 +1565,12 @@ begin
ADC := TCarbonDeviceContext(DC);
CGContextBeginPath(ADC.CGContext);
CGContextMoveToPoint(ADC.CGContext, Points^.x, -Points^.y);
CGContextMoveToPoint(ADC.CGContext, Points^.x, Points^.y);
while NumPts > 1 do
begin
Inc(Points);
CGContextAddLineToPoint(ADC.CGContext, Points^.x, -Points^.y);
CGContextAddLineToPoint(ADC.CGContext, Points^.x, Points^.y);
Dec(NumPts);
end;
@ -1607,12 +1605,12 @@ begin
ADC := TCarbonDeviceContext(DC);
CGContextBeginPath(ADC.CGContext);
CGContextMoveToPoint(ADC.CGContext, Points^.x, -Points^.y);
CGContextMoveToPoint(ADC.CGContext, Points^.x, Points^.y);
while NumPts > 1 do
begin
Inc(Points);
CGContextAddLineToPoint(ADC.CGContext, Points^.x, -Points^.y);
CGContextAddLineToPoint(ADC.CGContext, Points^.x, Points^.y);
Dec(NumPts);
end;
@ -1666,7 +1664,7 @@ begin
ADC := TCarbonDeviceContext(DC);
R := GetCGRect(X1, -Y1, X2, -Y2);
R := GetCGRect(X1, Y1, X2, Y2);
CGContextFillRect(ADC.CGContext, R);
CGContextStrokeRect(ADC.CGContext, R);
@ -1824,28 +1822,17 @@ end;
{------------------------------------------------------------------------------
Method: SendMessage
Params: HandleWnd - Handle of destination window
Msg - LCL message to send
Msg - Message to send
WParam - First message parameter
LParam - Second message parameter
Returns: The result of the message processing
Sends the specified LCL message to the specified window
Sends the specified message to the specified window
------------------------------------------------------------------------------}
function TCarbonWidgetSet.SendMessage(HandleWnd: HWND; Msg: Cardinal;
wParam: WParam; lParam: LParam): LResult;
var
Info: TCarbonWidgetInfo;
AMsg: TLMessage;
begin
Result := 0;
Info := GetWidgetInfo(Pointer(HandleWnd));
if Info = nil then Exit;
AMsg.Msg := Msg;
AMsg.WParam := wParam;
AMsg.LParam := lParam;
Result := DeliverMessage(Info.LCLObject, AMsg);
Result := inherited SendMessage(HandleWnd, Msg, wParam, lParam);
end;
{------------------------------------------------------------------------------
@ -1950,7 +1937,7 @@ begin
Info := GetWidgetInfo(Pointer(HWnd));
Window := GetTopParentWindow(Info.LCLObject as TWinControl);
ActivateWindow(Window, True); // can change focus!
SetUserFocusWindow(Window); // can change focus!
if HWnd <> THandle(Window) then
begin
GetKeyboardFocus(Window, Control);
@ -2196,7 +2183,7 @@ begin
end;
CGContextDrawImage(TCarbonDeviceContext(SrcDC).CGContext,
GetCGRect(X, -Y, Width, -Y - Height),
GetCGRect(X, Y, X + Width, Y + Height),
TCarbonBitmapContext(SrcDC).Bitmap.CGImage);
Result := True;
end;

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

@ -32,7 +32,7 @@ uses
// LCL
Controls, Buttons, LCLType, LCLProc,
// widgetset
WSButtons, WSLCLClasses,
WSButtons, WSLCLClasses, WSProc,
// interface
CarbonDef, CarbonProc, CarbonPrivate,
CarbonWSControls;
@ -46,6 +46,7 @@ type
protected
public
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
class procedure ActiveDefaultButtonChanged(const AButton: TCustomButton); override;
end;
{ TCarbonWSBitBtn }
@ -106,6 +107,25 @@ begin
TCarbonPrivateHandleClass(WSPrivate).RegisterEvents(Info);
end;
{------------------------------------------------------------------------------
Method: TCarbonWSButton.ActiveDefaultButtonChanged
Params: AButton - LCL button control
Returns: Nothing
Updates default button indication
------------------------------------------------------------------------------}
class procedure TCarbonWSButton.ActiveDefaultButtonChanged(
const AButton: TCustomButton);
var
ADefault: Boolean;
begin
if not WSCheckHandleAllocated(AButton, 'ActiveDefaultButtonChanged') then Exit;
ADefault := AButton.Default;
SetControlData(ControlRef(AButton.Handle), kControlEntireControl,
kControlPushButtonDefaultTag, SizeOf(Boolean), @ADefault);
end;
{ TCarbonWSBitBtn }
@ -115,8 +135,8 @@ end;
AParams - Creation parameters
Returns: Handle to the control in Carbon interface
Creates new bitmap button control in Carbon interface with the specified
parameters
Creates new bevel button with bitmap control in Carbon interface with the
specified parameters
------------------------------------------------------------------------------}
class function TCarbonWSBitBtn.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): TLCLIntfHandle;
@ -127,7 +147,6 @@ var
begin
Result := 0;
// create the button at bounds with title
CreateCarbonString(AParams.Caption, CFString);
try
if CreateBevelButtonControl(GetTopParentWindow(AWinControl), ParamsToCarbonRect(AParams),
@ -140,10 +159,7 @@ begin
end;
if Result = 0 then Exit;
// add the info (our data, like which TWinControl belong to this carbon widget)
Info := TCarbonWidgetInfo.CreateForControl(Control, AWinControl);
// register events (e.g. mouse, focus, keyboard, size, ...)
TCarbonPrivateHandleClass(WSPrivate).RegisterEvents(Info);
end;

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

@ -71,6 +71,7 @@ type
class procedure SetChildZPosition(const AWinControl, AChild: TWinControl;
const AOldPos, ANewPos: Integer;
const AChildren: TFPList); override;
class procedure SetColor(const AWinControl: TWinControl); override;
class procedure SetFont(const AWinControl: TWinControl; const AFont: TFont); override;
class procedure SetText(const AWinControl: TWinControl; const AText: String); override;
class procedure Invalidate(const AWinControl: TWinControl); override;
@ -245,6 +246,32 @@ begin
HIViewSetZOrder(HIViewRef(AChild.Handle), Order, RefView);
end;
{------------------------------------------------------------------------------
Method: TCarbonWSWinControl.SetColor
Params: AWinControl - LCL control
Returns: Nothing
Sets the color of control in Carbon interface according to the LCL control
NOTE: Functions only for edit
------------------------------------------------------------------------------}
class procedure TCarbonWSWinControl.SetColor(const AWinControl: TWinControl);
var
FontStyle: ControlFontStyleRec;
begin
if not WSCheckHandleAllocated(AWinControl, 'SetColor') then Exit;
// preserve other font settings
GetControlData(ControlRef(AWinControl.Handle), kControlEntireControl,
kControlFontStyleTag, SizeOf(FontStyle), @FontStyle, nil);
FontStyle.flags := FontStyle.flags or kControlUseBackColorMask;
FontStyle.backColor := ColorToCarbonColor(AWinControl.Color);
SetControlFontStyle(ControlRef(AWinControl.Handle), FontStyle);
// invalidate control
InvalidateCarbonControl(AWinControl.Handle);
end;
{------------------------------------------------------------------------------
Method: TCarbonWSWinControl.SetFont
Params: AWinControl - LCL control
@ -363,9 +390,7 @@ begin
ParentView := HIViewRef(AControl.Parent.Handle);
end;
HIViewAddSubview(ParentView,
HIViewRef((AControl as TWinControl).Handle));
HIViewSetVisible(HIViewRef((AControl as TWinControl).Handle), AControl.Visible);
HIViewAddSubview(ParentView, HIViewRef((AControl as TWinControl).Handle));
end;
{------------------------------------------------------------------------------

56
lcl/interfaces/carbon/carbonwsdialogs.pp
View File

@ -33,10 +33,14 @@ uses
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
// Dialogs,
////////////////////////////////////////////////////
LCLType, WSDialogs, WSLCLClasses;
// libs
FPCMacOSAll,
// LCL
Controls, Dialogs, LCLType, LCLProc,
// widgetset
WSLCLClasses, WSProc, WSDialogs,
// interface
CarbonDef, CarbonProc, CarbonPrivate;
type
{ TCarbonWSCommonDialog }
@ -85,6 +89,7 @@ type
private
protected
public
class procedure ShowModal(const ACommonDialog: TCommonDialog); override;
end;
{ TCarbonWSColorButton }
@ -106,6 +111,47 @@ type
implementation
{ TCarbonWSColorDialog }
{------------------------------------------------------------------------------
Method: TCarbonWSColorDialog.ShowModal
Params: ACommonDialog - LCL color dialog
Returns: Nothing
Shows Carbon interface color picker
------------------------------------------------------------------------------}
class procedure TCarbonWSColorDialog.ShowModal(
const ACommonDialog: TCommonDialog);
var
ColorInfo: ColorPickerInfo;
ColorDialog: TColorDialog;
begin
ColorDialog := ACommonDialog as TColorDialog;
FillChar(ColorInfo, SizeOf(ColorPickerInfo), 0);
ColorInfo.theColor.color.rgb := CMRGBColor(ColorToCarbonColor(ColorDialog.Color));
ColorInfo.theColor.profile := nil;
ColorInfo.dstProfile := nil;
ColorInfo.flags := kColorPickerDialogIsModal or kColorPickerDialogIsMoveable or
kColorPickerInPickerDialog;
ColorInfo.placeWhere := kCenterOnMainScreen;
ColorInfo.pickerType := 0; // use last picker subtype
ColorInfo.eventProc := nil;
ColorInfo.colorProc := nil;
ColorInfo.prompt := UTF8ToAnsi(ColorDialog.Title); // does not function!
if PickColor(ColorInfo) = noErr then
if ColorInfo.newColorChosen then
begin
ColorDialog.Color := CarbonColorToColor(
RGBColor(ColorInfo.theColor.color.rgb));
ACommonDialog.UserChoice := mrOK;
Exit;
end;
ACommonDialog.UserChoice := mrCancel;
end;
initialization
////////////////////////////////////////////////////
@ -119,7 +165,7 @@ initialization
// RegisterWSComponent(TOpenDialog, TCarbonWSOpenDialog);
// RegisterWSComponent(TSaveDialog, TCarbonWSSaveDialog);
// RegisterWSComponent(TSelectDirectoryDialog, TCarbonWSSelectDirectoryDialog);
// RegisterWSComponent(TColorDialog, TCarbonWSColorDialog);
RegisterWSComponent(TColorDialog, TCarbonWSColorDialog);
// RegisterWSComponent(TColorButton, TCarbonWSColorButton);
// RegisterWSComponent(TFontDialog, TCarbonWSFontDialog);
////////////////////////////////////////////////////

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

@ -350,14 +350,10 @@ end;
Invalidates window in Carbon interface
------------------------------------------------------------------------------}
class procedure TCarbonWSCustomForm.Invalidate(const AWinControl: TWinControl);
var
AWndRect: FPCMacOSAll.Rect;
Result: Boolean;
begin
if not WSCheckHandleAllocated(AWinControl, 'Invalidate') then Exit;
Result := GetWindowBounds(WindowRef(AWinControl.Handle), kWindowContentRgn, AWndRect) <> 0;
if Result then InvalWindowRect(WindowRef(AWinControl.Handle), AWndRect);
HIViewSetNeedsDisplay(GetCarbonWindowContent(AWinControl.Handle), True);
end;
{------------------------------------------------------------------------------

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

@ -202,6 +202,7 @@ type
private
protected
public
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
end;
{ TCarbonWSRadioButton }
@ -412,7 +413,7 @@ begin
// set edit single line
SetControlData(Control, kControlEntireControl, kControlEditTextSingleLineTag,
SizeOf(Boolean), @SingleLine);
SizeOf(Boolean), @SingleLine);
Info := TCarbonWidgetInfo.CreateForControl(Control, AWinControl);
Info.UserData := IsPassword;
@ -775,13 +776,20 @@ var
Control: ControlRef;
CFString: CFStringRef;
Info: TCarbonWidgetInfo;
Value: UInt32;
begin
Result := 0;
case (AWinControl as TCustomCheckBox).State of
cbChecked : Value := kControlCheckBoxCheckedValue;
cbUnChecked: Value := kControlCheckBoxUncheckedValue;
cbGrayed : Value := kControlCheckBoxMixedValue;
end;
CreateCarbonString(AParams.Caption, CFString);
try
if CreateCheckBoxControl(GetTopParentWindow(AWinControl),
ParamsToCarbonRect(AParams), CFString, 0, True, Control) = noErr
ParamsToCarbonRect(AParams), CFString, Value, True, Control) = noErr
then
Result := TLCLIntfHandle(Control);
finally
@ -835,6 +843,52 @@ begin
SetControl32BitValue(ControlRef(ACustomCheckBox.Handle), Value);
end;
{ TCarbonWSToggleBox }
{------------------------------------------------------------------------------
Method: TCarbonWSToggleBox.CreateHandle
Params: AWinControl - LCL control
AParams - Creation parameters
Returns: Handle to the control in Carbon interface
Creates new toggle push button in Carbon interface with the specified
parameters
------------------------------------------------------------------------------}
class function TCarbonWSToggleBox.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): TLCLIntfHandle;
var
Control: ControlRef;
CFString: CFStringRef;
Info: TCarbonWidgetInfo;
Value: UInt32;
begin
Result := 0;
case (AWinControl as TToggleBox).State of
cbChecked : Value := kControlCheckBoxCheckedValue;
cbUnChecked: Value := kControlCheckBoxUncheckedValue;
cbGrayed : Value := kControlCheckBoxMixedValue;
end;
CreateCarbonString(AParams.Caption, CFString);
try
if CreateBevelButtonControl(GetTopParentWindow(AWinControl),
ParamsToCarbonRect(AParams), CFString, kControlBevelButtonNormalBevel,
kControlBehaviorToggles, nil, 0, 0, 0, Control) = noErr
then
Result := TLCLIntfHandle(Control);
finally
FreeCarbonString(CFString);
end;
if Result = 0 then Exit;
SetControl32BitValue(Control, Value);
Info := TCarbonWidgetInfo.CreateForControl(Control, AWinControl);
TCarbonPrivateHandleClass(WSPrivate).RegisterEvents(Info);
end;
{ TCarbonWSRadioButton }
{------------------------------------------------------------------------------
@ -851,14 +905,20 @@ var
Control: ControlRef;
CFString: CFStringRef;
Info: TCarbonWidgetInfo;
Value: UInt32;
begin
Result := 0;
case (AWinControl as TRadioButton).State of
cbChecked : Value := kControlCheckBoxCheckedValue;
cbUnChecked: Value := kControlCheckBoxUncheckedValue;
cbGrayed : Value := kControlCheckBoxMixedValue;
end;
CreateCarbonString(AParams.Caption, CFString);
try
if CreateRadioButtonControl(GetTopParentWindow(AWinControl),
ParamsToCarbonRect(AParams), CFString,
Ord((AWinControl as TRadioButton).Checked), True, Control) = noErr
ParamsToCarbonRect(AParams), CFString, Value, True, Control) = noErr
then
Result := TLCLIntfHandle(Control);
finally
@ -962,7 +1022,7 @@ var
S: String;
begin
S := '';
DebugLn('TCarbonMemoStrings.InternalUpdate ' + FOwner.Name);
//DebugLn('TCarbonMemoStrings.InternalUpdate ' + FOwner.Name);
if GetEditControlText(FOwner.Handle, S) then
FStringList.Text := S;
@ -977,7 +1037,7 @@ end;
------------------------------------------------------------------------------}
procedure TCarbonMemoStrings.ExternalUpdate;
begin
DebugLn('TCarbonMemoStrings.ExternalUpdate ' + FOwner.Name + ' Text: ' + FStringList.Text);
//DebugLn('TCarbonMemoStrings.ExternalUpdate ' + FOwner.Name + ' Text: ' + FStringList.Text);
SetEditControlText(FOwner.Handle, FStringList.Text);
end;
@ -1151,7 +1211,7 @@ initialization
// RegisterWSComponent(TButtonControl, TCarbonWSButtonControl);
RegisterWSComponent(TCustomCheckBox, TCarbonWSCustomCheckBox, TCarbonPrivateValueControl);
// RegisterWSComponent(TCheckBox, TCarbonWSCheckBox);
// RegisterWSComponent(TToggleBox, TCarbonWSToggleBox);
RegisterWSComponent(TToggleBox, TCarbonWSToggleBox, TCarbonPrivateValueControl);
RegisterWSComponent(TRadioButton, TCarbonWSRadioButton, TCarbonPrivateValueControl);
RegisterWSComponent(TCustomStaticText, TCarbonWSCustomStaticText);
// RegisterWSComponent(TStaticText, TCarbonWSStaticText);