paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-30 12:30:59 +02:00
Code Issues Packages Projects Releases Wiki Activity

cocoa: separate tab controls into its own unit cocoatabcontrols. The history of changes in tab controls code is preserved (using svn cp)

Browse Source 
git-svn-id: trunk@58420 -
This commit is contained in:
dmitry 2018-06-30 20:31:34 +00:00
parent c89a9e17d1
commit 7e936cd4e0
5 changed files with 327 additions and 273 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -8828,6 +8828,7 @@ lcl/interfaces/cocoa/cocoalclintf.inc svneol=native#text/pascal
lcl/interfaces/cocoa/cocoalclintfh.inc svneol=native#text/pascal
lcl/interfaces/cocoa/cocoaobject.inc svneol=native#text/pascal
lcl/interfaces/cocoa/cocoaprivate.pp svneol=native#text/plain
lcl/interfaces/cocoa/cocoatabcontrols.pas svneol=native#text/plain
lcl/interfaces/cocoa/cocoathemes.pas svneol=native#text/plain
lcl/interfaces/cocoa/cocoatrayicon.inc svneol=native#text/pascal
lcl/interfaces/cocoa/cocoautils.pas svneol=native#text/plain

275
lcl/interfaces/cocoa/cocoaprivate.pp
View File

@ -805,60 +805,6 @@ type
message 'tableView:dataCellForTableColumn:row:';
end;
{ TCocoaTabPage }
TCocoaTabPage = objcclass(NSTabViewItem)
public
callback: ICommonCallback;
LCLPage: TCustomPage;
LCLTabCtrl: TCustomTabControl;
function lclGetCallback: ICommonCallback; override;
procedure lclClearCallback; override;
function lclFrame: TRect; override;
function lclClientFrame: TRect; override;
end;
{ TCocoaTabControl }
TCocoaTabControl = objcclass(NSTabView, NSTabViewDelegateProtocol)
public
LCLPageControl: TCustomTabControl;
callback: ICommonCallback;
lclEnabled: Boolean;
// lcl
function lclIsEnabled: Boolean; override;
procedure lclSetEnabled(AEnabled: Boolean); override;
function lclGetCallback: ICommonCallback; override;
procedure lclClearCallback; override;
function lclClientFrame: TRect; override;
// NSTabViewDelegateProtocol
function tabView_shouldSelectTabViewItem(tabView: NSTabView; tabViewItem: NSTabViewItem): Boolean; message 'tabView:shouldSelectTabViewItem:';
procedure tabView_willSelectTabViewItem(tabView: NSTabView; tabViewItem: NSTabViewItem); message 'tabView:willSelectTabViewItem:';
procedure tabView_didSelectTabViewItem(tabView: NSTabView; tabViewItem: NSTabViewItem); message 'tabView:didSelectTabViewItem:';
procedure tabViewDidChangeNumberOfTabViewItems(TabView: NSTabView); message 'tabViewDidChangeNumberOfTabViewItems:';
// mouse events
procedure mouseDown(event: NSEvent); override;
procedure mouseUp(event: NSEvent); override;
procedure rightMouseDown(event: NSEvent); override;
procedure rightMouseUp(event: NSEvent); override;
procedure rightMouseDragged(event: NSEvent); override;
procedure otherMouseDown(event: NSEvent); override;
procedure otherMouseUp(event: NSEvent); override;
procedure otherMouseDragged(event: NSEvent); override;
procedure mouseDragged(event: NSEvent); override;
procedure mouseMoved(event: NSEvent); override;
end;
{ TCocoaTabPageView }
TCocoaTabPageView = objcclass(TCocoaCustomControl)
public
tabView: TCocoaTabControl;
tabPage: TCocoaTabPage;
procedure setHidden(Ahidden: Boolean); override;
end;
{ TListView }
{ TCocoaTableListView }
@ -1074,7 +1020,7 @@ const
implementation
uses CocoaWSComCtrls, CocoaInt;
uses CocoaInt;
{$I mackeycodes.inc}
@ -1094,26 +1040,15 @@ begin
Result := -1;
if not Assigned(view) then Exit;
if not Assigned(view.superview) then Exit;
if view.superview.isKindOfClass_(TCocoaTabPageView) then
Result := TCocoaTabPageView(view.superview).tabview.contentRect.size.height
else
//if view.superview.isKindOfClass_(TCocoaTabPageView) then
//Result := TCocoaTabPageView(view.superview).tabview.contentRect.size.height
//else
Result := view.superview.frame.size.height;
{$IFDEF COCOA_SUPERVIEW_HEIGHT}
WriteLn(Format('GetNSViewSuperViewHeight Result=%f', [Result]));
{$ENDIF}
end;
{ TCocoaTabPageView }
procedure TCocoaTabPageView.setHidden(Ahidden: Boolean);
begin
// Should never be hidden. (The parent NSView would show/hide tabs)
// it seems, that lclSetVisible interferes with
// control visibility TCocoaCustomControl
// todo: there should be a cleaner solution than overriding this method
inherited setHidden(false);
end;
{ TCocoaDesignOverlay }
procedure TCocoaDesignOverlay.drawRect(r: NSRect);
@ -4169,208 +4104,6 @@ begin
end
end;
{ TCocoaTabPage }
function TCocoaTabPage.lclGetCallback: ICommonCallback;
begin
Result := callback;
end;
procedure TCocoaTabPage.lclClearCallback;
begin
callback := nil;
end;
function TCocoaTabPage.lclFrame: TRect;
var
svh: CGFloat;
lParent: TCocoaTabControl;
begin
lParent := TCocoaWSCustomTabControl.GetCocoaTabControlHandle(LCLTabCtrl);
if lParent <> nil then
begin
svh := lParent.contentRect.size.height;
NSToLCLRect(lParent.contentRect, svh, Result);
end
else
begin
svh := tabView.frame.size.height;
NSToLCLRect(tabView.contentRect, svh, Result);
end;
{$IFDEF COCOA_DEBUG_TABCONTROL}
WriteLn('[TCocoaTabPage.lclFrame] '+dbgs(Result)+' '+NSStringToString(Self.label_));
{$ENDIF}
end;
function TCocoaTabPage.lclClientFrame: TRect;
begin
Result := lclFrame();
end;
{ TCocoaTabControl }
function TCocoaTabControl.lclIsEnabled: Boolean;
begin
Result:=lclEnabled and ((Assigned(superview) and superview.lclIsEnabled) or not Assigned(superview));
end;
procedure TCocoaTabControl.lclSetEnabled(AEnabled: Boolean);
begin
lclEnabled := AEnabled;
end;
function TCocoaTabControl.lclGetCallback: ICommonCallback;
begin
Result := callback;
end;
procedure TCocoaTabControl.lclClearCallback;
begin
callback := nil;
end;
function TCocoaTabControl.lclClientFrame: TRect;
begin
if isFlipped then
Result:=NSRectToRect( contentRect )
else
NSToLCLRect( contentRect, frame.size.height, Result );
end;
function TCocoaTabControl.tabView_shouldSelectTabViewItem(tabView: NSTabView;
tabViewItem: NSTabViewItem): Boolean;
begin
Result := True;
end;
procedure TCocoaTabControl.tabView_willSelectTabViewItem(tabView: NSTabView;
tabViewItem: NSTabViewItem);
var
Msg: TLMNotify;
Hdr: TNmHdr;
begin
if LCLPageControl = nil then Exit;
FillChar(Msg, SizeOf(Msg), 0);
Msg.Msg := LM_NOTIFY;
FillChar(Hdr, SizeOf(Hdr), 0);
Hdr.hwndFrom := HWND(tabview);
Hdr.Code := TCN_SELCHANGING;
Hdr.idFrom := PtrUInt(tabview.indexOfTabViewItem(tabViewItem));
Msg.NMHdr := @Hdr;
Msg.Result := 0;
LCLMessageGlue.DeliverMessage(LCLPageControl, Msg);
end;
procedure TCocoaTabControl.tabView_didSelectTabViewItem(tabView: NSTabView;
tabViewItem: NSTabViewItem);
var
Msg: TLMNotify;
Hdr: TNmHdr;
i: Integer;
lTabView, lCurSubview: NSView;
lLCLControl: TWinControl;
lBounds: TRect;
lCurCallback: ICommonCallback;
begin
if LCLPageControl = nil then Exit;
FillChar(Msg, SizeOf(Msg), 0);
Msg.Msg := LM_NOTIFY;
FillChar(Hdr, SizeOf(Hdr), 0);
Hdr.hwndFrom := HWND(tabview);
Hdr.Code := TCN_SELCHANGE;
Hdr.idFrom := PtrUInt(tabview.indexOfTabViewItem(tabViewItem));
Msg.NMHdr := @Hdr;
Msg.Result := 0;
LCLMessageGlue.DeliverMessage(LCLPageControl, Msg);
// Update the coordinates of all children of this tab
// Fixes bug 31914: TPageControl problems with Cocoa
lTabView := tabViewItem.view.subViews.objectAtIndex(0);
for i := 0 to lTabView.subViews.count-1 do
begin
lCurSubview := lTabView.subViews.objectAtIndex(i);
lCurCallback := lCurSubview.lclGetCallback();
if Assigned(lCurCallback) then
begin
lLCLControl := TWinControl(lCurCallback.GetTarget());
lBounds := Classes.Bounds(lLCLControl.Left, lLCLControl.Top, lLCLControl.Width, lLCLControl.Height);
lCurSubview.lclSetFrame(lBounds);
end;
end;
end;
procedure TCocoaTabControl.tabViewDidChangeNumberOfTabViewItems(
TabView: NSTabView);
begin
end;
procedure TCocoaTabControl.mouseDown(event: NSEvent);
begin
if not Assigned(callback) then callback.MouseUpDownEvent(event);
// do not block?
inherited mouseDown(event);
end;
procedure TCocoaTabControl.mouseUp(event: NSEvent);
begin
if not Assigned(callback) then callback.MouseUpDownEvent(event);
// do not block?
inherited mouseUp(event);
end;
procedure TCocoaTabControl.rightMouseDown(event: NSEvent);
begin
if not Assigned(callback) or not callback.MouseUpDownEvent(event) then
inherited rightMouseDown(event);
end;
procedure TCocoaTabControl.rightMouseUp(event: NSEvent);
begin
if not Assigned(callback) or not callback.MouseUpDownEvent(event) then
inherited rightMouseUp(event);
end;
procedure TCocoaTabControl.rightMouseDragged(event: NSEvent);
begin
if not Assigned(callback) or not callback.MouseMove(event) then
inherited rightMouseDragged(event);
end;
procedure TCocoaTabControl.otherMouseDown(event: NSEvent);
begin
if not Assigned(callback) or not callback.MouseUpDownEvent(event) then
inherited otherMouseDown(event);
end;
procedure TCocoaTabControl.otherMouseUp(event: NSEvent);
begin
if not Assigned(callback) or not callback.MouseUpDownEvent(event) then
inherited otherMouseUp(event);
end;
procedure TCocoaTabControl.otherMouseDragged(event: NSEvent);
begin
if not Assigned(callback) or not callback.MouseMove(event) then
inherited otherMouseDragged(event);
end;
procedure TCocoaTabControl.mouseDragged(event: NSEvent);
begin
if not Assigned(callback) or not callback.MouseMove(event) then
inherited mouseDragged(event);
end;
procedure TCocoaTabControl.mouseMoved(event: NSEvent);
begin
if Assigned(callback) then callback.MouseMove(event);
inherited mouseMoved(event);
end;
{ TCocoaTableListView }
function TCocoaTableListView.lclIsHandle: Boolean;

316
lcl/interfaces/cocoa/cocoatabcontrols.pas Normal file
View File

@ -0,0 +1,316 @@
{ $Id: $}
{ --------------------------------------------
cocoatabcontrols.pas - Cocoa internal classes
--------------------------------------------
This unit contains the private classhierarchy for the Cocoa implemetations
*****************************************************************************
This file is part of the Lazarus Component Library (LCL)
See the file COPYING.modifiedLGPL.txt, included in this distribution,
for details about the license.
*****************************************************************************
}
unit CocoaTabControls;
{$mode objfpc}{$H+}
{$modeswitch objectivec1}
{$modeswitch objectivec2}
{$interfaces corba}
{.$DEFINE COCOA_DEBUG_SETBOUNDS}
{.$DEFINE COCOA_DEBUG_LISTVIEW}
{.$DEFINE COCOA_SPIN_DEBUG}
{.$DEFINE COCOA_SPINEDIT_INSIDE_CONTAINER}
{.$DEFINE COCOA_SUPERVIEW_HEIGHT}
interface
uses
// rtl+ftl
Types, Classes, SysUtils,
CGGeometry,
// Libs
MacOSAll, CocoaAll, CocoaUtils, //CocoaGDIObjects,
cocoa_extra,
// LCL
LMessages, LCLMessageGlue, { ExtCtrls, Graphics, Forms,}
LCLType, LCLProc, Controls, ComCtrls, CocoaPrivate;
type
{ TCocoaTabPage }
TCocoaTabPage = objcclass(NSTabViewItem)
public
callback: ICommonCallback;
LCLPage: TCustomPage; //todo: remove LCL object reference
LCLTabCtrl: TCustomTabControl; //todo: remove LCL object reference
function lclGetCallback: ICommonCallback; override;
procedure lclClearCallback; override;
function lclFrame: TRect; override;
function lclClientFrame: TRect; override;
end;
{ TCocoaTabControl }
TCocoaTabControl = objcclass(NSTabView, NSTabViewDelegateProtocol)
public
LCLPageControl: TCustomTabControl;
callback: ICommonCallback;
lclEnabled: Boolean;
// lcl
function lclIsEnabled: Boolean; override;
procedure lclSetEnabled(AEnabled: Boolean); override;
function lclGetCallback: ICommonCallback; override;
procedure lclClearCallback; override;
function lclClientFrame: TRect; override;
// NSTabViewDelegateProtocol
function tabView_shouldSelectTabViewItem(tabView: NSTabView; tabViewItem: NSTabViewItem): Boolean; message 'tabView:shouldSelectTabViewItem:';
procedure tabView_willSelectTabViewItem(tabView: NSTabView; tabViewItem: NSTabViewItem); message 'tabView:willSelectTabViewItem:';
procedure tabView_didSelectTabViewItem(tabView: NSTabView; tabViewItem: NSTabViewItem); message 'tabView:didSelectTabViewItem:';
procedure tabViewDidChangeNumberOfTabViewItems(TabView: NSTabView); message 'tabViewDidChangeNumberOfTabViewItems:';
// mouse events
procedure mouseDown(event: NSEvent); override;
procedure mouseUp(event: NSEvent); override;
procedure rightMouseDown(event: NSEvent); override;
procedure rightMouseUp(event: NSEvent); override;
procedure rightMouseDragged(event: NSEvent); override;
procedure otherMouseDown(event: NSEvent); override;
procedure otherMouseUp(event: NSEvent); override;
procedure otherMouseDragged(event: NSEvent); override;
procedure mouseDragged(event: NSEvent); override;
procedure mouseMoved(event: NSEvent); override;
end;
{ TCocoaTabPageView }
TCocoaTabPageView = objcclass(TCocoaCustomControl)
public
tabView: TCocoaTabControl;
tabPage: TCocoaTabPage;
procedure setHidden(Ahidden: Boolean); override;
end;
implementation
uses CocoaWSComCtrls; //todo: get rid of use of WS unit
{ TCocoaTabPageView }
procedure TCocoaTabPageView.setHidden(Ahidden: Boolean);
begin
// Should never be hidden. (The parent NSView would show/hide tabs)
// it seems, that lclSetVisible interferes with
// control visibility TCocoaCustomControl
// todo: there should be a cleaner solution than overriding this method
inherited setHidden(false);
end;
{ TCocoaTabPage }
function TCocoaTabPage.lclGetCallback: ICommonCallback;
begin
Result := callback;
end;
procedure TCocoaTabPage.lclClearCallback;
begin
callback := nil;
end;
function TCocoaTabPage.lclFrame: TRect;
var
svh: CGFloat;
lParent: TCocoaTabControl;
begin
lParent := TCocoaWSCustomTabControl.GetCocoaTabControlHandle(LCLTabCtrl);
if lParent <> nil then
begin
svh := lParent.contentRect.size.height;
NSToLCLRect(lParent.contentRect, svh, Result);
end
else
begin
svh := tabView.frame.size.height;
NSToLCLRect(tabView.contentRect, svh, Result);
end;
{$IFDEF COCOA_DEBUG_TABCONTROL}
WriteLn('[TCocoaTabPage.lclFrame] '+dbgs(Result)+' '+NSStringToString(Self.label_));
{$ENDIF}
end;
function TCocoaTabPage.lclClientFrame: TRect;
begin
Result := lclFrame();
end;
{ TCocoaTabControl }
function TCocoaTabControl.lclIsEnabled: Boolean;
begin
Result:=lclEnabled and ((Assigned(superview) and superview.lclIsEnabled) or not Assigned(superview));
end;
procedure TCocoaTabControl.lclSetEnabled(AEnabled: Boolean);
begin
lclEnabled := AEnabled;
end;
function TCocoaTabControl.lclGetCallback: ICommonCallback;
begin
Result := callback;
end;
procedure TCocoaTabControl.lclClearCallback;
begin
callback := nil;
end;
function TCocoaTabControl.lclClientFrame: TRect;
begin
if isFlipped then
Result:=NSRectToRect( contentRect )
else
NSToLCLRect( contentRect, frame.size.height, Result );
end;
function TCocoaTabControl.tabView_shouldSelectTabViewItem(tabView: NSTabView;
tabViewItem: NSTabViewItem): Boolean;
begin
Result := True;
end;
procedure TCocoaTabControl.tabView_willSelectTabViewItem(tabView: NSTabView;
tabViewItem: NSTabViewItem);
var
Msg: TLMNotify;
Hdr: TNmHdr;
begin
if LCLPageControl = nil then Exit;
FillChar(Msg, SizeOf(Msg), 0);
Msg.Msg := LM_NOTIFY;
FillChar(Hdr, SizeOf(Hdr), 0);
Hdr.hwndFrom := HWND(tabview);
Hdr.Code := TCN_SELCHANGING;
Hdr.idFrom := PtrUInt(tabview.indexOfTabViewItem(tabViewItem));
Msg.NMHdr := @Hdr;
Msg.Result := 0;
LCLMessageGlue.DeliverMessage(LCLPageControl, Msg);
end;
procedure TCocoaTabControl.tabView_didSelectTabViewItem(tabView: NSTabView;
tabViewItem: NSTabViewItem);
var
Msg: TLMNotify;
Hdr: TNmHdr;
i: Integer;
lTabView, lCurSubview: NSView;
lLCLControl: TWinControl;
lBounds: TRect;
lCurCallback: ICommonCallback;
begin
if LCLPageControl = nil then Exit;
FillChar(Msg, SizeOf(Msg), 0);
Msg.Msg := LM_NOTIFY;
FillChar(Hdr, SizeOf(Hdr), 0);
Hdr.hwndFrom := HWND(tabview);
Hdr.Code := TCN_SELCHANGE;
Hdr.idFrom := PtrUInt(tabview.indexOfTabViewItem(tabViewItem));
Msg.NMHdr := @Hdr;
Msg.Result := 0;
LCLMessageGlue.DeliverMessage(LCLPageControl, Msg);
// Update the coordinates of all children of this tab
// Fixes bug 31914: TPageControl problems with Cocoa
lTabView := tabViewItem.view.subViews.objectAtIndex(0);
for i := 0 to lTabView.subViews.count-1 do
begin
lCurSubview := lTabView.subViews.objectAtIndex(i);
lCurCallback := lCurSubview.lclGetCallback();
if Assigned(lCurCallback) then
begin
lLCLControl := TWinControl(lCurCallback.GetTarget());
lBounds := Classes.Bounds(lLCLControl.Left, lLCLControl.Top, lLCLControl.Width, lLCLControl.Height);
lCurSubview.lclSetFrame(lBounds);
end;
end;
end;
procedure TCocoaTabControl.tabViewDidChangeNumberOfTabViewItems(
TabView: NSTabView);
begin
end;
procedure TCocoaTabControl.mouseDown(event: NSEvent);
begin
if not Assigned(callback) then callback.MouseUpDownEvent(event);
// do not block?
inherited mouseDown(event);
end;
procedure TCocoaTabControl.mouseUp(event: NSEvent);
begin
if not Assigned(callback) then callback.MouseUpDownEvent(event);
// do not block?
inherited mouseUp(event);
end;
procedure TCocoaTabControl.rightMouseDown(event: NSEvent);
begin
if not Assigned(callback) or not callback.MouseUpDownEvent(event) then
inherited rightMouseDown(event);
end;
procedure TCocoaTabControl.rightMouseUp(event: NSEvent);
begin
if not Assigned(callback) or not callback.MouseUpDownEvent(event) then
inherited rightMouseUp(event);
end;
procedure TCocoaTabControl.rightMouseDragged(event: NSEvent);
begin
if not Assigned(callback) or not callback.MouseMove(event) then
inherited rightMouseDragged(event);
end;
procedure TCocoaTabControl.otherMouseDown(event: NSEvent);
begin
if not Assigned(callback) or not callback.MouseUpDownEvent(event) then
inherited otherMouseDown(event);
end;
procedure TCocoaTabControl.otherMouseUp(event: NSEvent);
begin
if not Assigned(callback) or not callback.MouseUpDownEvent(event) then
inherited otherMouseUp(event);
end;
procedure TCocoaTabControl.otherMouseDragged(event: NSEvent);
begin
if not Assigned(callback) or not callback.MouseMove(event) then
inherited otherMouseDragged(event);
end;
procedure TCocoaTabControl.mouseDragged(event: NSEvent);
begin
if not Assigned(callback) or not callback.MouseMove(event) then
inherited mouseDragged(event);
end;
procedure TCocoaTabControl.mouseMoved(event: NSEvent);
begin
if Assigned(callback) then callback.MouseMove(event);
inherited mouseMoved(event);
end;
end.

2
lcl/interfaces/cocoa/cocoawscomctrls.pas
View File

@ -17,7 +17,7 @@ uses
// WS
WSComCtrls,
// Cocoa WS
CocoaPrivate, CocoaUtils, CocoaWSCommon;
CocoaPrivate, CocoaTabControls, CocoaUtils, CocoaWSCommon;
type

6
lcl/interfaces/lcl.lpk
View File

@ -129,7 +129,7 @@ end;"/>
<License Value="modified LGPL-2
"/>
<Version Major="1" Minor="9"/>
<Files Count="478">
<Files Count="479">
<Item1>
<Filename Value="carbon/agl.pp"/>
<AddToUsesPkgSection Value="False"/>
@ -2366,6 +2366,10 @@ end;"/>
<Filename Value="win32/win32treeview.inc"/>
<Type Value="Include"/>
</Item478>
<Item479>
<Filename Value="cocoa/cocoatabcontrols.pas"/>
<UnitName Value="CocoaTabControls"/>
</Item479>
</Files>
<LazDoc Paths="../../docs/xml/lcl"/>
<i18n>