diff --git a/lcl/interfaces/carbon/carboncanvas.pp b/lcl/interfaces/carbon/carboncanvas.pp index ad5175d982..e199ef15df 100644 --- a/lcl/interfaces/carbon/carboncanvas.pp +++ b/lcl/interfaces/carbon/carboncanvas.pp @@ -609,6 +609,7 @@ var W: WideString; Tag: ATSUAttributeTag; DataSize: ByteCount; + Options: ATSLineLayoutOptions; PValue: ATSUAttributeValuePtr; const SName = 'BeginTextRender'; @@ -643,7 +644,19 @@ begin PValue := @(CurrentFont.LineRotation); if OSError(ATSUSetLayoutControls(ALayout, 1, @Tag, @DataSize, @PValue), Self, SName, 'ATSUSetLayoutControls', 'LineRotation') then Exit; - + + // disable fractional positions of glyphs in layout + // TODO: restrict to monspaced fonts only + Tag := kATSULineLayoutOptionsTag; + DataSize := SizeOf(ATSLineLayoutOptions); + + Options := kATSLineFractDisable or kATSLineDisableAutoAdjustDisplayPos or + kATSLineDisableAllLayoutOperations or kATSLineUseDeviceMetrics; + PValue := @Options; + if OSError(ATSUSetLayoutControls(ALayout, 1, @Tag, @DataSize, @PValue), + Self, SName, 'ATSUSetLayoutControls', 'LineLayoutOptions') then Exit; + + // set layout context Tag := kATSUCGContextTag; DataSize := SizeOf(CGContextRef); diff --git a/lcl/interfaces/carbon/carbonclipboard.pp b/lcl/interfaces/carbon/carbonclipboard.pp index e212b77197..26041d6b85 100644 --- a/lcl/interfaces/carbon/carbonclipboard.pp +++ b/lcl/interfaces/carbon/carbonclipboard.pp @@ -38,9 +38,10 @@ type { TCarbonClipboard } TCarbonClipboard = class + FOwnerShips: Integer; private FPasteboards: Array [TClipboardType] of PasteboardRef; - FFormats: TList; // list of CFStringRef UTIs, 1 is reserved for text/plain + FFormats: TList; // list of CFStringRef UTIs FOnClipboardRequest: Array [TClipboardType] of TClipboardRequestEvent; function FindFormat(const UTI: CFStringRef): TClipboardFormat; @@ -59,14 +60,16 @@ type OnRequestProc: TClipboardRequestEvent; FormatCount: Integer; Formats: PClipboardFormat): Boolean; function RegisterFormat(const AMimeType: String): TClipboardFormat; + public + property OwnerShips: Integer read FOwnerShips; end; var ClipboardTypeToPasteboard: Array [TClipboardType] of CFStringRef = ( {ctPrimarySelection } kPasteboardUniqueName, // local application pasteboard -{ctSecondarySelection} nil, // Find pasteboard -{ctClipboard } nil // standard global pasteboard +{ctSecondarySelection} nil, // Find pasteboard +{ctClipboard } nil // standard global pasteboard ); Clipboard: TCarbonClipboard; @@ -88,7 +91,7 @@ var begin for I := 1 to FFormats.Count - 1 do begin - if UTTypeConformsTo(UTI, CFStringRef(FFormats[I])) then + if UTTypeEqual(UTI, CFStringRef(FFormats[I])) then begin Result := I; Exit; @@ -113,8 +116,14 @@ begin FOnClipboardRequest[T] := nil; end; + FOwnerShips := 0; + FFormats := TList.Create; - FFormats.Add(nil); + + FFormats.Add(nil); // add default supported text formats + FFormats.Add(kUTTypePlainText); + FFormats.Add(kUTTypeUTF8PlainText); + FFormats.Add(kUTTypeUTF16PlainText); RegisterFormat(PredefinedClipboardMimeTypes[pcfText]); end; @@ -128,7 +137,7 @@ var I: Integer; S: CFStringRef; begin - for I := 0 to FFormats.Count - 1 do + for I := 4 to FFormats.Count - 1 do // 0..3 are predefined begin S := FFormats[I]; FreeCFString(S); @@ -157,6 +166,7 @@ begin if (PasteboardSynchronize(FPasteboards[T]) and kPasteboardClientIsOwner) = 0 then begin // inform LCL about ownership lost + Dec(FOwnerShips); FOnClipboardRequest[T](0, nil); end; end; @@ -192,12 +202,6 @@ var begin if (FormatID > 0) and (FormatID < FFormats.Count) then begin - if FormatID = 1 then - begin - Result := PredefinedClipboardMimeTypes[pcfText]; - Exit; - end; - S := UTTypeCopyPreferredTagWithClass(CFStringRef(FFormats[FormatID]), kUTTagClassMIMEType); try Result := CFStringToStr(S); @@ -221,17 +225,34 @@ function TCarbonClipboard.GetData(ClipboardType: TClipboardType; FormatID: TClipboardFormat; Stream: TStream): Boolean; var Pasteboard: PasteboardRef; - I, J: Integer; - L: SizeUInt; + I: Integer; + UTI, CFString: CFStringRef; + Encoding: CFStringEncoding; Flavors: CFArrayRef; - UTI: CFStringRef; - FlavorCount: CFIndex; FlavorData: CFDataRef; Count: ItemCount; ID: PasteboardItemID; S: String; const SName = 'GetData'; + + function HasFormat(Format: CFStringRef): Boolean; + var + FlavorCount: CFIndex; + J: Integer; + begin + Result := False; + FlavorCount := CFArrayGetCount(Flavors); + + for J := 0 to FlavorCount - 1 do + if UTTypeEqual(Format, CFArrayGetValueAtIndex(Flavors, J)) then + begin + //DebugLn('Has UTI ' + CFStringToStr(Format)); + Result := True; + Break; + end; + end; + begin Result := False; @@ -255,46 +276,55 @@ begin if OSError(PasteboardCopyItemFlavors(Pasteboard, ID, Flavors), Self, SName, 'PasteboardCopyItemFlavors') then Continue; - FlavorCount := CFArrayGetCount(Flavors); - for J := 0 to FlavorCount - 1 do + UTI := FFormats[FormatID]; + if FormatID = 1 then begin - UTI := CFArrayGetValueAtIndex(Flavors, J); - //DebugLn('TCarbonClipboard.GetData FlavorType: ' + CFStringToStr(UTI) + - // ' ' + CFStringToStr(FFormats[FormatID])); - if UTTypeConformsTo(FFormats[FormatID], UTI) then + if HasFormat(FFormats[2]) then UTI := FFormats[2] // check UTF-8 text + else + if HasFormat(FFormats[3]) then UTI := FFormats[3] // check UTF-16 text + else + if not HasFormat(UTI) then Exit; // check plain text + end + else + if not HasFormat(UTI) then Exit; + + //DebugLn('TCarbonClipboard.GetData Paste FlavorType: ' + CFStringToStr(UTI)); + + if OSError(PasteboardCopyItemFlavorData(Pasteboard, ID, UTI, FlavorData), + Self, SGetData, 'PasteboardCopyItemFlavorData') then Continue; + try + if CFDataGetLength(FlavorData) = 0 then begin - //DebugLn('TCarbonClipboard.GetData Paste FlavorType: ' + CFStringToStr(UTI)); - - if OSError(PasteboardCopyItemFlavorData(Pasteboard, ID, UTI, FlavorData), - Self, SGetData, 'PasteboardCopyItemFlavorData') then Continue; - try - if CFDataGetLength(FlavorData) = 0 then - begin - Result := True; - Exit; - end; - //DebugLn('TCarbonClipboard.GetData Paste FlavordataLength: ' + DbgS(CFDataGetLength(FlavorData))); - - if FormatID = 1 then // convert text/plain UTF-16 to UTF-8 - begin - SetLength(S, (CFDataGetLength(FlavorData) div 2) * 3); - if ConvertUTF16ToUTF8(PChar(S), Length(S) + 1, - PWideChar(CFDataGetBytePtr(FlavorData)), CFDataGetLength(FlavorData) div 2, - [toInvalidCharToSymbol], L) <> trNoError then Exit; - - SetLength(S, L - 1); - Stream.Write(S[1], L - 1); - end - else - Stream.Write(CFDataGetBytePtr(FlavorData)^, CFDataGetLength(FlavorData)); - finally - CFRelease(FlavorData); - end; - Result := True; Exit; end; + //DebugLn('TCarbonClipboard.GetData Paste FlavordataLength: ' + DbgS(CFDataGetLength(FlavorData))); + + if FormatID = 1 then + begin + if UTI = FFormats[2] then // UTF-8 text + Encoding := kCFStringEncodingUTF8; + if UTI = FFormats[3] then // UTF-16 text + Encoding := kCFStringEncodingUTF16; + if UTI = FFormats[1] then // plain text + Encoding := CFStringGetSystemEncoding; + + CreateCFString(FlavorData, Encoding, CFString); + try + S := CFStringtoStr(CFString); + Stream.Write(S[1], Length(S)); + finally + FreeCFString(CFString); + end; + end + else + Stream.Write(CFDataGetBytePtr(FlavorData)^, CFDataGetLength(FlavorData)); + finally + CFRelease(FlavorData); end; + + Result := True; + Exit; end; end; @@ -343,10 +373,14 @@ begin for J := 0 to FlavorCount - 1 do begin UTI := CFArrayGetValueAtIndex(Flavors, J); + //DebugLn('TCarbonClipboard.GetFormats ' + CFStringToStr(UTI)); FormatID := FindFormat(UTI); if FormatID = 0 then FormatID := FFormats.Add(UTI); + if FormatID < 4 then // if it is text format, add plain text format + if Formats.IndexOf(Pointer(1)) = -1 then Formats.Add(Pointer(1)); + if Formats.IndexOf(Pointer(FormatID)) = -1 then begin @@ -388,46 +422,53 @@ function TCarbonClipboard.GetOwnerShip(ClipboardType: TClipboardType; OnRequestProc: TClipboardRequestEvent; FormatCount: Integer; Formats: PClipboardFormat): Boolean; + procedure AddData(Format: CFStringRef; CFData: CFDataRef); + begin + if CFData = nil then Exit; + //DebugLn('Add Data ' + CFStringToStr(Format)); + + OSError(PasteboardPutItemFlavor(FPasteboards[ClipboardType], + PasteboardItemID(1), Format, CFData, 0), + Self, 'GetOwnerShip', 'PasteboardPutItemFlavor'); + end; + procedure PutOnClipboard; var - Data: CFDataRef; - UTI: CFStringRef; - DataStream: TMemoryStream; + DataStream: TStringStream; I: Integer; - L: SizeUInt; - W: WideString; + CFString: CFStringRef; begin - DataStream := TMemoryStream.Create; + DataStream := TStringStream.Create(''); for I := 0 to FormatCount - 1 do begin - DataStream.Size := 0; - DataStream.Position := 0; - if not ((Formats[I] > 0) and (Formats[I] < FFormats.Count)) then begin DebugLn('TCarbonClipboard.GetOwnerShip Error: Invalid Format ' + DbgS(Formats[I]) + ' specified!'); Continue; end; - UTI := CFStringRef(FFormats[Formats[I]]); + DataStream.Size := 0; + DataStream.Position := 0; FOnClipBoardRequest[ClipboardType](Formats[I], DataStream); - - if Formats[I] = 1 then // convert plain/text UTF-8 to UTF-16 + + if Formats[I] = 1 then // add more unicode and mac text formats begin - SetLength(W, DataStream.Size); - if ConvertUTF8ToUTF16(PWideChar(W), Length(W) + 1, PChar(DataStream.Memory), - DataStream.Size, [toInvalidCharToSymbol], L) <> trNoError then Exit; - - SetLength(W, L - 1); - Data := CFDataCreate(nil, PChar(W), (L - 1) * 2); + CreateCFString(DataStream.DataString, CFString); + try + // UTF-8 text + AddData(FFormats[2], CFStringToData(CFString, kCFStringEncodingUTF8)); + // UTF-16 text + AddData(FFormats[3], CFStringToData(CFString, kCFStringEncodingUTF16)); + // plain text + AddData(FFormats[1], CFStringToData(CFString, CFStringGetSystemEncoding)); + finally + FreeCFString(CFString); + end; end else - Data := CFDataCreate(nil, DataStream.Memory, DataStream.Size); - - OSError(PasteboardPutItemFlavor(FPasteboards[ClipboardType], - PasteboardItemID(1), UTI, Data, 0), - Self, 'GetOwnerShip', 'PasteboardPutItemFlavor'); + AddData(FFormats[Formats[I]], CFDataCreate(nil, @DataStream.DataString[1], + DataStream.Size)); end; DataStream.Free; @@ -435,13 +476,14 @@ function TCarbonClipboard.GetOwnerShip(ClipboardType: TClipboardType; begin Result := False; - DebugLn('TCarbonClipboard.GetOwnerShip'); + //DebugLn('TCarbonClipboard.GetOwnerShip'); if (FormatCount = 0) or (OnRequestProc = nil) then begin // The LCL indicates it doesn't have the clipboard data anymore // and the interface can't use the OnRequestProc anymore. FOnClipboardRequest[ClipboardType] := nil; + Dec(FOwnerShips); end else begin @@ -450,6 +492,7 @@ begin FOnClipboardRequest[ClipboardType] := nil; if not Clear(ClipboardType) then Exit; + Inc(FOwnerShips); FOnClipboardRequest[ClipboardType] := OnRequestProc; PutOnClipboard; end; @@ -467,16 +510,11 @@ function TCarbonClipboard.RegisterFormat(const AMimeType: String): TClipboardFor var UTI, M: CFStringRef; begin - if AMimeType = PredefinedClipboardMimeTypes[pcfText] then - CreateCFString('public.utf16-plain-text', UTI) - else - begin - CreateCFString(AMimeType, M); - try - UTI := UTTypeCreatePreferredIdentifierForTag(kUTTagClassMIMEType, M, nil); - finally - FreeCFString(M); - end; + CreateCFString(AMimeType, M); + try + UTI := UTTypeCreatePreferredIdentifierForTag(kUTTagClassMIMEType, M, nil); + finally + FreeCFString(M); end; Result := FindFormat(UTI); @@ -497,7 +535,7 @@ initialization finalization - Clipboard.Free; + FreeAndNil(Clipboard); FreeCFString(ClipboardTypeToPasteboard[ctSecondarySelection]); FreeCFString(ClipboardTypeToPasteboard[ctClipboard]); diff --git a/lcl/interfaces/carbon/carbondef.pp b/lcl/interfaces/carbon/carbondef.pp index 7393412d92..3e6e5215f8 100644 --- a/lcl/interfaces/carbon/carbondef.pp +++ b/lcl/interfaces/carbon/carbondef.pp @@ -75,11 +75,14 @@ type LCLObject: TWinControl; // LCL control which created this widget Context: TCarbonContext; // Carbon content area context Widget: Pointer; // Reference to the Carbon window or control + public + procedure FocusSet; dynamic; + procedure FocusKilled; dynamic; + procedure BoundsChanged; virtual; public constructor Create(const AObject: TWinControl; const AParams: TCreateParams); destructor Destroy; override; procedure AddToWidget(AParent: TCarbonWidget); virtual; abstract; - procedure BoundsChanged; virtual; function GetClientRect(var ARect: TRect): Boolean; virtual; abstract; function GetPreferredSize: TPoint; virtual; function GetMousePos: TPoint; virtual; abstract; @@ -373,6 +376,26 @@ begin end; end; +{------------------------------------------------------------------------------ + Method: TCarbonWidget.FocusSet + + Handles set focus + ------------------------------------------------------------------------------} +procedure TCarbonWidget.FocusSet; +begin + LCLSendSetFocusMsg(LCLObject); +end; + +{------------------------------------------------------------------------------ + Method: TCarbonWidget.FocusKilled + + Handles kill focus + ------------------------------------------------------------------------------} +procedure TCarbonWidget.FocusKilled; +begin + LCLSendKillFocusMsg(LCLObject); +end; + {------------------------------------------------------------------------------ Method: TCarbonWidget.BoundsChanged diff --git a/lcl/interfaces/carbon/carbonedits.pp b/lcl/interfaces/carbon/carbonedits.pp index b35fc9c9b2..1d137a5a73 100644 --- a/lcl/interfaces/carbon/carbonedits.pp +++ b/lcl/interfaces/carbon/carbonedits.pp @@ -82,6 +82,8 @@ type class function GetValidEvents: TCarbonControlEvents; override; procedure ListItemSelected(AIndex: Integer); virtual; procedure ValueChanged; override; + procedure FocusSet; override; + procedure FocusKilled; override; public function GetText(var S: String): Boolean; override; procedure SetReadOnly(AReadOnly: Boolean); override; @@ -630,6 +632,30 @@ begin if FReadOnly then ListItemSelected(GetValue - 1); end; +{------------------------------------------------------------------------------ + Method: TCarbonComboBox.FocusSet + + Handles set focus + ------------------------------------------------------------------------------} +procedure TCarbonComboBox.FocusSet; +begin + inherited; + // emulate DropDown event here + LCLSendDropDownMsg(LCLObject); +end; + +{------------------------------------------------------------------------------ + Method: TCarbonComboBox.FocusKilled + + Handles kill focus + ------------------------------------------------------------------------------} +procedure TCarbonComboBox.FocusKilled; +begin + inherited; + // emulate CloseUp event here + LCLSendCloseUpMsg(LCLObject); +end; + {------------------------------------------------------------------------------ Method: TCarbonComboBox.GetText Params: S - Text diff --git a/lcl/interfaces/carbon/carbonobject.inc b/lcl/interfaces/carbon/carbonobject.inc index 41d4affdd0..e72a3459de 100644 --- a/lcl/interfaces/carbon/carbonobject.inc +++ b/lcl/interfaces/carbon/carbonobject.inc @@ -471,7 +471,8 @@ begin SendEventToEventTarget(Event, Target); ReleaseEvent(Event); - Clipboard.CheckOwnerShip; + if Clipboard <> nil then + if Clipboard.OwnerShips > 0 then Clipboard.CheckOwnerShip; until Application.Terminated; diff --git a/lcl/interfaces/carbon/carbonprivate.pp b/lcl/interfaces/carbon/carbonprivate.pp index 61569dece1..fca1f45a55 100644 --- a/lcl/interfaces/carbon/carbonprivate.pp +++ b/lcl/interfaces/carbon/carbonprivate.pp @@ -171,17 +171,19 @@ type TCarbonCustomControl = class(TCarbonControl) private FScrollView: HIViewRef; - FScrollOrigin: TPoint; + FScrollOrigin: HIPoint; FScrollSize: TPoint; FScrollPageSize: TPoint; + FMulX: Single; // multiply x coords to fit real page size + FMulY: Single; // multiply y coords to fit real page size protected procedure RegisterEvents; override; procedure CreateWidget(const AParams: TCreateParams); override; procedure DestroyWidget; override; function GetFrame(Index: Integer): ControlRef; override; public - procedure GetInfo(out AImageSize, AViewSize, ALineSize, AOrigin: TPoint); dynamic; - procedure ScrollTo(const ANewOrigin: TPoint); dynamic; + procedure GetInfo(out AImageSize, AViewSize, ALineSize: HISize; out AOrigin: HIPoint); virtual; + procedure ScrollTo(const ANewOrigin: HIPoint); virtual; public procedure SetColor(const AColor: TColor); override; procedure SetFont(const AFont: TFont); override; @@ -363,7 +365,6 @@ function CarbonScrollable_GetInfo(ANextHandler: EventHandlerCallRef; AEvent: EventRef; AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF} var - ImageSize, ViewSize, LineSize, Origin: TPoint; ImageHISize, ViewHISize, LineHISize: HISize; HIOrigin: HIPoint; const @@ -373,12 +374,7 @@ begin DebugLn('CarbonScrollable_GetInfo ', DbgSName(AWidget.LCLObject)); {$ENDIF} - (AWidget as TCarbonCustomControl).GetInfo(ImageSize, ViewSize, LineSize, Origin); - - ImageHISize := PointToHISize(ImageSize); - ViewHISize := PointToHISize(ViewSize); - LineHISize := PointToHISize(LineSize); - HIOrigin := PointToHIPoint(Origin); + (AWidget as TCarbonCustomControl).GetInfo(ImageHISize, ViewHISize, LineHISize, HIOrigin); OSError(SetEventParameter(AEvent, kEventParamImageSize, typeHISize, SizeOf(HISize), @ImageHISize), SName, SSetEvent, 'kEventParamImageSize'); @@ -411,7 +407,7 @@ begin SizeOf(HIPoint), nil, @Origin), 'CarbonScrollable_ScrollTo', SGetEvent, 'kEventParamOrigin') then Exit; - (AWidget as TCarbonCustomControl).ScrollTo(HIPointToPoint(Origin)); + (AWidget as TCarbonCustomControl).ScrollTo(Origin); Result := noErr; end; @@ -455,7 +451,9 @@ begin FScrollView := EmbedInScrollView(AParams); FScrollSize := Classes.Point(0, 0); FScrollPageSize := Classes.Point(0, 0); - FScrollOrigin := Classes.Point(0, 0); + FScrollOrigin := GetHIPoint(0, 0); + FMulX := 1; + FMulY := 1; inherited; end; @@ -489,15 +487,27 @@ end; ALineSize - Size of scrollable line AOrigin - Scroll position - Handles scrollableget info event + Handles scrollable get info event ------------------------------------------------------------------------------} -procedure TCarbonCustomControl.GetInfo(out AImageSize, AViewSize, - ALineSize, AOrigin: TPoint); +procedure TCarbonCustomControl.GetInfo(out AImageSize, AViewSize, ALineSize: HISize; + out AOrigin: HIPoint); +var + C: TRect; begin - AOrigin := FScrollOrigin; - AImageSize := FScrollSize; - AViewSize := FScrollPageSize; - ALineSize := Classes.Point(10, 10); + // modify coordinates to fit real page size + GetClientRect(C); + + if FScrollPageSize.X = 0 then FMulX := 1 + else + FMulX := (C.Right - C.Left) / FScrollPageSize.X; + if FScrollPageSize.Y = 0 then FMulY := 1 + else + FMulY := (C.Bottom - C.Top) / FScrollPageSize.Y; + + AOrigin := GetHIPoint(FScrollOrigin.X * FMulX, FScrollOrigin.Y * FMulY); + AImageSize := GetHISize(FScrollSize.X * FMulX, FScrollSize.Y * FMulY); + AViewSize := GetHISize(C.Right - C.Left, C.Bottom - C.Top); + ALineSize := GetHISize(FScrollPageSize.X * FMulX / 40, FScrollPageSize.Y * FMulY / 40); {$IFDEF VerboseScroll} DebugLn('TCarbonCustomControl.GetInfo ' + LCLObject.Name + ' Origin: ' + @@ -512,7 +522,7 @@ end; Handles scrollable scroll to event ------------------------------------------------------------------------------} -procedure TCarbonCustomControl.ScrollTo(const ANewOrigin: TPoint); +procedure TCarbonCustomControl.ScrollTo(const ANewOrigin: HIPoint); var ScrollMsg: TLMScroll; begin @@ -521,14 +531,19 @@ begin DbgS(ANewOrigin)); {$ENDIF} - FScrollOrigin := ANewOrigin; + if FMulX = 0 then FScrollOrigin.X := 0 + else + FScrollOrigin.X := ANewOrigin.X / FMulX; + if FMulY = 0 then FScrollOrigin.Y := 0 + else + FScrollOrigin.Y := ANewOrigin.Y / FMulY; // send vertical scroll FillChar(ScrollMsg, SizeOf(TLMScroll), 0); with ScrollMsg do begin Msg := LM_VSCROLL; - Pos := ANewOrigin.Y; + Pos := Round(FScrollOrigin.Y); ScrollCode := SB_THUMBPOSITION; end; DeliverMessage(LCLObject, ScrollMsg); @@ -538,7 +553,7 @@ begin with ScrollMsg do begin Msg := LM_HSCROLL; - Pos := ANewOrigin.X; + Pos := Round(FScrollOrigin.X); ScrollCode := SB_THUMBPOSITION; end; DeliverMessage(LCLObject, ScrollMsg); @@ -590,9 +605,9 @@ begin {$ENDIF} if SBStyle = SB_HORZ then - Result := FScrollOrigin.X; + Result := Round(FScrollOrigin.X); if SBStyle = SB_VERT then - Result := FScrollOrigin.Y; + Result := Round(FScrollOrigin.Y); if (SIF_RANGE and ScrollInfo.fMask) > 0 then begin @@ -665,9 +680,9 @@ begin if (SIF_POS and ScrollInfo.fMask) > 0 then begin if SBStyle = SB_HORZ then - ScrollInfo.nPos := FScrollOrigin.X; + ScrollInfo.nPos := Round(FScrollOrigin.X); if SBStyle = SB_VERT then - ScrollInfo.nPos := FScrollOrigin.Y; + ScrollInfo.nPos := Round(FScrollOrigin.Y); end; if (SIF_PAGE and ScrollInfo.fMask) > 0 then diff --git a/lcl/interfaces/carbon/carbonprivatecommon.inc b/lcl/interfaces/carbon/carbonprivatecommon.inc index c9d1ed6bcc..4b8643fa9e 100644 --- a/lcl/interfaces/carbon/carbonprivatecommon.inc +++ b/lcl/interfaces/carbon/carbonprivatecommon.inc @@ -350,9 +350,9 @@ begin end; if FocusPart <> kControlFocusNoPart then - LCLSendSetFocusMsg(AWidget.LCLObject) + AWidget.FocusSet else - LCLSendKillFocusMsg(AWidget.LCLObject); + AWidget.FocusKilled; end; {------------------------------------------------------------------------------ diff --git a/lcl/interfaces/carbon/carbonproc.pp b/lcl/interfaces/carbon/carbonproc.pp index 426d803e93..4917727637 100644 --- a/lcl/interfaces/carbon/carbonproc.pp +++ b/lcl/interfaces/carbon/carbonproc.pp @@ -78,8 +78,10 @@ const DEFAULT_CFSTRING_ENCODING = kCFStringEncodingUTF8; procedure CreateCFString(const S: String; out AString: CFStringRef); +procedure CreateCFString(const Data: CFDataRef; Encoding: CFStringEncoding; out AString: CFStringRef); procedure FreeCFString(var AString: CFStringRef); -function CFStringToStr(AString: CFStringRef): String; +function CFStringToStr(AString: CFStringRef; Encoding: CFStringEncoding = DEFAULT_CFSTRING_ENCODING): String; +function CFStringToData(AString: CFStringRef; Encoding: CFStringEncoding = DEFAULT_CFSTRING_ENCODING): CFDataRef; function RoundFixed(const F: Fixed): Integer; @@ -104,6 +106,8 @@ function HIRectToCarbonRect(const ARect: HIRect): FPCMacOSAll.Rect; function PointToHIPoint(const APoint: TPoint): HIPoint; function PointToHISize(const APoint: TPoint): HISize; function HIPointToPoint(const APoint: HIPoint): TPoint; +function GetHIPoint(X, Y: Single): HIPoint; +function GetHISize(X, Y: Single): HISize; function ColorToRGBColor(const AColor: TColor): RGBColor; function RGBColorToColor(const AColor: RGBColor): TColor; @@ -111,6 +115,8 @@ function CreateCGColor(const AColor: TColor): CGColorRef; function DbgS(const ARect: FPCMacOSAll.Rect): string; overload; function DbgS(const AColor: FPCMacOSAll.RGBColor): string; overload; +function DbgS(const APoint: HIPoint): string; overload; +function DbgS(const ASize: HISize): string; overload; implementation @@ -493,13 +499,30 @@ end; Params: S - UTF-8 string AString - Core Foundation string ref - Creates new Core Foundation string form specified string + Creates new Core Foundation string from the specified string ------------------------------------------------------------------------------} procedure CreateCFString(const S: String; out AString: CFStringRef); begin AString := CFStringCreateWithCString(nil, Pointer(PChar(S)), DEFAULT_CFSTRING_ENCODING); end; +{------------------------------------------------------------------------------ + Name: CreateCFString + Params: Data - CFDataRef + Encoding - Data encoding format + AString - Core Foundation string ref + + Creates new Core Foundation string from the specified data and format + ------------------------------------------------------------------------------} +procedure CreateCFString(const Data: CFDataRef; Encoding: CFStringEncoding; out + AString: CFStringRef); +begin + AString := nil; + if Data = nil then Exit; + AString := CFStringCreateWithBytes(nil, CFDataGetBytePtr(Data), + CFDataGetLength(Data), Encoding, False); +end; + {------------------------------------------------------------------------------ Name: FreeCFString Params: AString - Core Foundation string ref to free @@ -514,12 +537,13 @@ end; {------------------------------------------------------------------------------ Name: CFStringToStr - Params: AString - Core Foundation string ref + Params: AString - Core Foundation string ref + Encoding - Result data encoding format Returns: UTF-8 string Converts Core Foundation string to string ------------------------------------------------------------------------------} -function CFStringToStr(AString: CFStringRef): String; +function CFStringToStr(AString: CFStringRef; Encoding: CFStringEncoding): String; var Str: Pointer; StrSize: CFIndex; @@ -532,7 +556,7 @@ begin end; // Try the quick way first - Str := CFStringGetCStringPtr(AString, DEFAULT_CFSTRING_ENCODING); + Str := CFStringGetCStringPtr(AString, Encoding); if Str <> nil then Result := PChar(Str) else @@ -541,16 +565,35 @@ begin StrRange.location := 0; StrRange.length := CFStringGetLength(AString); - CFStringGetBytes(AString, StrRange, DEFAULT_CFSTRING_ENCODING, - 0, False, nil, 0, StrSize); + CFStringGetBytes(AString, StrRange, Encoding, + Ord('?'), False, nil, 0, StrSize); SetLength(Result, StrSize); if StrSize > 0 then - CFStringGetBytes(AString, StrRange, DEFAULT_CFSTRING_ENCODING, - 0, False, @Result[1], StrSize, StrSize); + CFStringGetBytes(AString, StrRange, Encoding, + Ord('?'), False, @Result[1], StrSize, StrSize); end; end; +{------------------------------------------------------------------------------ + Name: CFStringToData + Params: AString - Core Foundation string ref + Encoding - Result data encoding format + Returns: CFDataRef + + Converts Core Foundation string to data + ------------------------------------------------------------------------------} +function CFStringToData(AString: CFStringRef; Encoding: CFStringEncoding): CFDataRef; +var + S: String; +begin + Result := nil; + if AString = nil then Exit; + S := CFStringToStr(AString, Encoding); + + Result := CFDataCreate(nil, @S[1], Length(S)); +end; + {------------------------------------------------------------------------------ Name: RoundFixed Params: F - Fixed value @@ -810,6 +853,28 @@ begin Result.Y := Trunc(APoint.Y); end; +{------------------------------------------------------------------------------ + Name: GetHIPoint + Params: X, Y + Returns: HIPoint + ------------------------------------------------------------------------------} +function GetHIPoint(X, Y: Single): HIPoint; +begin + Result.X := X; + Result.Y := Y; +end; + +{------------------------------------------------------------------------------ + Name: GetHISize + Params: X, Y + Returns: HISize + ------------------------------------------------------------------------------} +function GetHISize(X, Y: Single): HISize; +begin + Result.width := X; + Result.height := Y; +end; + {------------------------------------------------------------------------------ Name: ColorToRGBColor Params: AColor - Color @@ -875,6 +940,16 @@ begin ' B: ' + IntToHex(AColor.Blue, 4); end; +function DbgS(const APoint: HIPoint): string; +begin + Result := 'X: ' + DbgS(APoint.X) + ' Y: ' + DbgS(APoint.Y); +end; + +function DbgS(const ASize: HISize): string; +begin + Result := 'W: ' + DbgS(ASize.width) + ' H: ' + DbgS(ASize.height); +end; + {------------------------------------------------------------------------------ Name: CustomControlHandler Handles custom control class methods