mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-11-21 08:39:50 +01:00
Carbon intf:
- improved custom control focusing - fixed visibility in IDE designer - improved file dialog filtering using masks LCL masks: added TParseStringList for parsing mask lists git-svn-id: trunk@11944 -
This commit is contained in:
parent
61d494b039
commit
f488c6af5e
@ -468,7 +468,7 @@ begin
|
||||
{$ENDIF}
|
||||
|
||||
RegisterEvents;
|
||||
|
||||
|
||||
LCLObject.InvalidateClientRectCache(True);
|
||||
BoundsChanged;
|
||||
|
||||
|
||||
@ -173,7 +173,6 @@ type
|
||||
FScrollOrigin: TPoint;
|
||||
FScrollSize: TPoint;
|
||||
FScrollPageSize: TPoint;
|
||||
FFocusPart: ControlPartCode;
|
||||
protected
|
||||
procedure RegisterEvents; override;
|
||||
procedure CreateWidget(const AParams: TCreateParams); override;
|
||||
@ -452,8 +451,6 @@ begin
|
||||
Widget := CreateCustomHIView(ParamsToHIRect(AParams));
|
||||
if Widget = nil then RaiseCreateWidgetError(LCLObject);
|
||||
|
||||
FFocusPart := kControlNoPart;
|
||||
|
||||
FScrollView := EmbedInScrollView(AParams);
|
||||
FScrollSize := Classes.Point(0, 0);
|
||||
FScrollPageSize := Classes.Point(0, 0);
|
||||
|
||||
@ -40,6 +40,7 @@ function CarbonCommon_Draw(ANextHandler: EventHandlerCallRef;
|
||||
AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
|
||||
var
|
||||
AStruct: PPaintStruct;
|
||||
EraseMsg: TLMEraseBkgnd;
|
||||
begin
|
||||
{$IFDEF VerbosePaint}
|
||||
Debugln('CarbonCommon_Draw ', DbgSName(AWidget.LCLObject));
|
||||
@ -54,9 +55,13 @@ begin
|
||||
SizeOf(CGContextRef), nil, @(AWidget.Context.CGContext)),
|
||||
'CarbonCommon_Draw', SGetEvent, 'kEventParamCGContextRef') then Exit;
|
||||
|
||||
// erase background
|
||||
EraseMsg.Msg := LM_ERASEBKGND;
|
||||
EraseMsg.DC := HDC(AWidget.Context);
|
||||
DeliverMessage(AWidget.LCLObject, EraseMsg);
|
||||
|
||||
// let carbon draw/update
|
||||
Result := CallNextEventHandler(ANextHandler, AEvent);
|
||||
|
||||
|
||||
if (AWidget is TCarbonControl) and
|
||||
(cceDraw in (AWidget as TCarbonControl).GetValidEvents) then
|
||||
@ -304,14 +309,13 @@ function CarbonCommon_SetFocusPart(ANextHandler: EventHandlerCallRef;
|
||||
AEvent: EventRef;
|
||||
AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
|
||||
var
|
||||
CurrentFocus,
|
||||
FocusPart: ControlPartCode;
|
||||
const
|
||||
SName = 'CarbonCommon_SetFocusPart';
|
||||
begin
|
||||
if not (AWidget.LCLObject is TCustomControl) then
|
||||
Result := CallNextEventHandler(ANextHandler, AEvent)
|
||||
else
|
||||
Result := noErr;
|
||||
if not (AWidget is TCarbonCustomControl) then
|
||||
Result := CallNextEventHandler(ANextHandler, AEvent);
|
||||
|
||||
if OSError(
|
||||
GetEventParameter(AEvent, kEventParamControlPart, typeControlPartCode, nil,
|
||||
@ -322,6 +326,28 @@ begin
|
||||
DebugLn('CarbonCommon_SetFocusPart: ', DbgSName(AWidget.LCLObject), ' ' +
|
||||
IntToStr(Integer(FocusPart)));
|
||||
{$ENDIF}
|
||||
|
||||
if AWidget is TCarbonCustomControl then
|
||||
begin
|
||||
OSError(HIViewGetFocusPart(AWidget.Content, CurrentFocus),
|
||||
SName, 'HIViewGetFocusPart');
|
||||
|
||||
case FocusPart of
|
||||
kControlFocusPrevPart,
|
||||
kControlFocusNextPart:
|
||||
if CurrentFocus = kControlNoPart then FocusPart := kControlEditTextPart
|
||||
else FocusPart := kControlEditTextPart;
|
||||
kControlEditTextPart:;
|
||||
else
|
||||
FocusPart := kControlNoPart;
|
||||
end;
|
||||
|
||||
OSError(
|
||||
SetEventParameter(AEvent, kEventParamControlPart, typeControlPartCode,
|
||||
SizeOf(ControlPartCode), @FocusPart), SName, SSetEvent, SControlPart);
|
||||
|
||||
Result := noErr;
|
||||
end;
|
||||
|
||||
if FocusPart <> kControlFocusNoPart then
|
||||
LCLSendSetFocusMsg(AWidget.LCLObject)
|
||||
|
||||
@ -853,7 +853,8 @@ var
|
||||
begin
|
||||
//DebugLn('TCarbonControl.ShowHide ' + DbgSName(LCLobject),' ', DbgS(AVisible));
|
||||
for I := 0 to GetFrameCount - 1 do
|
||||
OSError(HIViewSetVisible(Frames[I], AVisible), Self, 'ShowHide', SViewVisible);
|
||||
OSError(HIViewSetVisible(Frames[I], AVisible or (csDesigning in LCLobject.ComponentState)),
|
||||
Self, 'ShowHide', SViewVisible);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
|
||||
@ -978,7 +978,7 @@ begin
|
||||
|
||||
SetBounds(Bounds(AParams.X, AParams.Y, AParams.Width, AParams.Height));
|
||||
SetText(AParams.Caption);
|
||||
DebugLn('TCarbonWindow.CreateWidget succeeds');
|
||||
//DebugLn('TCarbonWindow.CreateWidget succeeds');
|
||||
SetColor(LCLObject.Color);
|
||||
|
||||
MinSize.width := LCLObject.Constraints.EffectiveMinWidth;
|
||||
@ -1303,7 +1303,9 @@ end;
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TCarbonWindow.ShowHide(AVisible: Boolean);
|
||||
begin
|
||||
if AVisible then
|
||||
//DebugLn('TCarbonWindow.ShowHide ' + DbgSName(LCLobject),' ', DbgS(AVisible));
|
||||
|
||||
if AVisible or (csDesigning in LCLobject.ComponentState) then
|
||||
FPCMacOSAll.ShowWindow(WindowRef(Widget))
|
||||
else
|
||||
FPCMacOSAll.HideWindow(WindowRef(Widget));
|
||||
|
||||
@ -33,7 +33,7 @@ uses
|
||||
// libs
|
||||
FPCMacOSAll,
|
||||
// LCL
|
||||
SysUtils, Controls, Dialogs, LCLType, LCLProc,
|
||||
Classes, SysUtils, Controls, Dialogs, LCLType, LCLProc, Masks,
|
||||
// widgetset
|
||||
WSLCLClasses, WSProc, WSDialogs,
|
||||
// LCL Carbon
|
||||
@ -115,15 +115,17 @@ uses
|
||||
|
||||
{ TCarbonWSFileDialog }
|
||||
|
||||
function FilterByExtCallback(var theItem: AEDesc; info: NavFileOrFolderInfoPtr;
|
||||
var
|
||||
FilterMask: TMaskList;
|
||||
|
||||
function FilterCallback(var theItem: AEDesc; info: NavFileOrFolderInfoPtr;
|
||||
callbackUD: UnivPtr; filterMode: NavFilterModes): Boolean; stdcall;
|
||||
{Custom filter callback function. Pointer to this function is passed as
|
||||
inFilterProc to NavCreateGetFileDialog and NavCreateChooseFolderDialog.
|
||||
If theItem file should be highlighted in file dialog, return True;
|
||||
if it should be dimmed in file dialog, return False.
|
||||
The callbackUD param contains file dialog object passed as inClientData
|
||||
to NavCreateGetFileDialog and NavCreateChooseFolderDialog.
|
||||
Note: This function filters only by file extension, not by wildcard file spec.}
|
||||
to NavCreateGetFileDialog and NavCreateChooseFolderDialog.}
|
||||
var
|
||||
FileRef: FSRef;
|
||||
FileURL: CFURLRef;
|
||||
@ -161,11 +163,9 @@ begin
|
||||
FreeCFString(FileURL);
|
||||
FreeCFString(FileCFStr);
|
||||
|
||||
// TODO: use mask for filtering
|
||||
Result := Pos(LowerCase(ExtractFileExt(FilePath)),
|
||||
LowerCase(TFileDialog(callbackUD).Filter)) > 0;
|
||||
|
||||
end; {FilterByExtCallback}
|
||||
Result := (FilterMask = nil) or FilterMask.Matches(ExtractFilename(FilePath));
|
||||
//DebugLn('FilterCallback ' + DbgS(FilterMask) + ' ' + ExtractFilename(FilePath) + ' ' + DbgS(Result));
|
||||
end; {FilterCallback}
|
||||
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -195,6 +195,8 @@ var
|
||||
FileRef: FSRef;
|
||||
FileURL: CFURLRef;
|
||||
FileCFStr: CFStringRef;
|
||||
Filters: TParseStringList;
|
||||
I: Integer;
|
||||
begin
|
||||
{$IFDEF VerboseWSClass}
|
||||
DebugLn('TCarbonWSFileDialog.ShowModal for ' + ACommonDialog.Name);
|
||||
@ -211,8 +213,20 @@ begin
|
||||
|
||||
FileDialog.UserChoice := mrCancel; // Return this if user cancels or we need to exit
|
||||
|
||||
FilterUPP := NewNavObjectFilterUPP(NavObjectFilterProcPtr(@FilterByExtCallback));
|
||||
FilterUPP := NewNavObjectFilterUPP(NavObjectFilterProcPtr(@FilterCallback));
|
||||
|
||||
Filters := TParseStringList.Create(FileDialog.Filter, '|');
|
||||
try
|
||||
if (FileDialog.FilterIndex >= 0) and
|
||||
(FileDialog.FilterIndex * 2 + 1 < Filters.Count) then
|
||||
begin
|
||||
//DebugLn('Filter ' + Filters[FileDialog.FilterIndex * 2 + 1]);
|
||||
FilterMask := TMaskList.Create(Filters[FileDialog.FilterIndex * 2 + 1]);
|
||||
end;
|
||||
finally
|
||||
Filters.Free;
|
||||
end;
|
||||
|
||||
try
|
||||
if FileDialog is TSaveDialog then
|
||||
begin // Checking for TSaveDialog first since it's descendent of TOpenDialog
|
||||
@ -315,6 +329,7 @@ begin
|
||||
end;
|
||||
|
||||
finally
|
||||
FreeAndNil(FilterMask);
|
||||
DisposeNavObjectFilterUPP(FilterUPP);
|
||||
FreeCFString(CreationOptions.windowTitle);
|
||||
FreeCFString(CreationOptions.saveFileName);
|
||||
|
||||
@ -58,6 +58,13 @@ type
|
||||
function Matches(const AFileName: String): Boolean;
|
||||
end;
|
||||
|
||||
{ TParseStringList }
|
||||
|
||||
TParseStringList = class(TStringList)
|
||||
public
|
||||
constructor Create(const AText, ASeparators: String);
|
||||
end;
|
||||
|
||||
{ TMaskList }
|
||||
|
||||
TMaskList = class
|
||||
@ -322,6 +329,27 @@ begin
|
||||
Result := MatchToEnd(0, 1);
|
||||
end;
|
||||
|
||||
{ TParseStringList }
|
||||
|
||||
constructor TParseStringList.Create(const AText, ASeparators: String);
|
||||
var
|
||||
I, S: Integer;
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
S := 1;
|
||||
for I := 1 to Length(AText) do
|
||||
begin
|
||||
if Pos(AText[I], ASeparators) > 0 then
|
||||
begin
|
||||
if I > S then Add(Copy(AText, S, I - S));
|
||||
S := I + 1;
|
||||
end;
|
||||
end;
|
||||
|
||||
if Length(AText) > S then Add(Copy(AText, S, Length(AText) - S + 1));
|
||||
end;
|
||||
|
||||
{ TMaskList }
|
||||
|
||||
function TMaskList.GetItem(Index: Integer): TMask;
|
||||
@ -336,16 +364,13 @@ end;
|
||||
|
||||
constructor TMaskList.Create(const AValue: String; ASeparator: Char);
|
||||
var
|
||||
S: TStringList;
|
||||
S: TParseStringList;
|
||||
I: Integer;
|
||||
begin
|
||||
FMasks := TObjectList.Create(True);
|
||||
|
||||
S := TStringList.Create;
|
||||
S := TParseStringList.Create(AValue, ASeparator + ' ');
|
||||
try
|
||||
S.Delimiter := ASeparator;
|
||||
S.DelimitedText := AValue;
|
||||
|
||||
for I := 0 to S.Count - 1 do
|
||||
FMasks.Add(TMask.Create(S[I]));
|
||||
finally
|
||||
|
||||
Loading…
Reference in New Issue
Block a user