mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-07 11:36:18 +02:00
Carbon intf: TSynEdit fixed textout, improved scrolling
- enhanced clipboard to use more text formats - TComboBox.OnDropDown and OnCloseUp partial implementation git-svn-id: trunk@12509 -
This commit is contained in:
tombo
parent
3badd0dfcc
commit
1a9ab26796
@ -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);
|
||||
|
||||
@ -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]);
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -350,9 +350,9 @@ begin
|
||||
end;
|
||||
|
||||
if FocusPart <> kControlFocusNoPart then
|
||||
LCLSendSetFocusMsg(AWidget.LCLObject)
|
||||
AWidget.FocusSet
|
||||
else
|
||||
LCLSendKillFocusMsg(AWidget.LCLObject);
|
||||
AWidget.FocusKilled;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user