From 7e936cd4e09f8e4d8bac8d850defc35840a03493 Mon Sep 17 00:00:00 2001 From: dmitry Date: Sat, 30 Jun 2018 20:31:34 +0000 Subject: [PATCH] cocoa: separate tab controls into its own unit cocoatabcontrols. The history of changes in tab controls code is preserved (using svn cp) git-svn-id: trunk@58420 - --- .gitattributes | 1 + lcl/interfaces/cocoa/cocoaprivate.pp | 275 +------------------ lcl/interfaces/cocoa/cocoatabcontrols.pas | 316 ++++++++++++++++++++++ lcl/interfaces/cocoa/cocoawscomctrls.pas | 2 +- lcl/interfaces/lcl.lpk | 6 +- 5 files changed, 327 insertions(+), 273 deletions(-) create mode 100644 lcl/interfaces/cocoa/cocoatabcontrols.pas diff --git a/.gitattributes b/.gitattributes index cd3ac7f98c..870373350e 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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 diff --git a/lcl/interfaces/cocoa/cocoaprivate.pp b/lcl/interfaces/cocoa/cocoaprivate.pp index 4f4e89332a..ee446d0f11 100644 --- a/lcl/interfaces/cocoa/cocoaprivate.pp +++ b/lcl/interfaces/cocoa/cocoaprivate.pp @@ -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; diff --git a/lcl/interfaces/cocoa/cocoatabcontrols.pas b/lcl/interfaces/cocoa/cocoatabcontrols.pas new file mode 100644 index 0000000000..3534a3e286 --- /dev/null +++ b/lcl/interfaces/cocoa/cocoatabcontrols.pas @@ -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. + diff --git a/lcl/interfaces/cocoa/cocoawscomctrls.pas b/lcl/interfaces/cocoa/cocoawscomctrls.pas index 7a8b8a0c70..3d333afdd3 100644 --- a/lcl/interfaces/cocoa/cocoawscomctrls.pas +++ b/lcl/interfaces/cocoa/cocoawscomctrls.pas @@ -17,7 +17,7 @@ uses // WS WSComCtrls, // Cocoa WS - CocoaPrivate, CocoaUtils, CocoaWSCommon; + CocoaPrivate, CocoaTabControls, CocoaUtils, CocoaWSCommon; type diff --git a/lcl/interfaces/lcl.lpk b/lcl/interfaces/lcl.lpk index a7c5ed6f40..3fff4afefc 100644 --- a/lcl/interfaces/lcl.lpk +++ b/lcl/interfaces/lcl.lpk @@ -129,7 +129,7 @@ end;"/> - + @@ -2366,6 +2366,10 @@ end;"/> + + + +