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

LCL: TPageControl: Win32: Fixed Pagecontrol does show space for tabs, but no tabs in it. Issue #19278

Browse Source 
git-svn-id: trunk@54781 -
This commit is contained in:
michl 2017-04-30 14:53:32 +00:00
parent 8ccf033501
commit d26cecd517
2 changed files with 43 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
lcl/interfaces/win32/win32pagecontrol.inc
View File

@ -142,14 +142,14 @@ begin
RealIndex := TCustomTabControl(AWinControl.Parent).PageToTabIndex(PageIndex); RealIndex := TCustomTabControl(AWinControl.Parent).PageToTabIndex(PageIndex);
if RealIndex <> -1 then if RealIndex <> -1 then
begin begin
Windows.SendMessage(PageControlHandle, TCM_DELETEITEM, Windows.WPARAM(RealIndex), 0); TWin32WSCustomTabControl.DeletePage(TCustomTabControl(AWinControl.Parent), RealIndex);
AWinControl.Parent.InvalidateClientRectCache(False); AWinControl.Parent.InvalidateClientRectCache(False);
end; end;
end; end;
TWSWinControlClass(ClassParent).DestroyHandle(AWinControl); TWSWinControlClass(ClassParent).DestroyHandle(AWinControl);
end; end;
class procedure TWin32WSCustomPage.ThemeChange(Wnd: HWnd); class procedure TWin32WSCustomPage.ThemeChange(Wnd: HWND);
var var
WindowInfo: PWin32WindowInfo; WindowInfo: PWin32WindowInfo;
begin begin
@ -279,6 +279,44 @@ begin
Dec(ORect.Bottom, ARect.Bottom); Dec(ORect.Bottom, ARect.Bottom);
end; end;
class procedure TWin32WSCustomTabControl.DeletePage(
const ATabControl: TCustomTabControl; const AIndex: integer);
var
Wnd: HWND;
function TabsScrollingNeeded: Boolean;
var
HitTestInfo: TC_HITTESTINFO;
ARect: TRect;
TabCount, FirstShowedIndex: Integer;
begin
if AIndex <= 0 then Exit(False);
TabCount := Windows.SendMessage(Wnd, TCM_GETITEMCOUNT, 0, 0);
if AIndex < TabCount - 1 then Exit(False);
// we have to look, if the first shown tab is the tab that is to be deleted
Windows.GetClientRect(Wnd, @ARect);
Windows.SendMessage(Wnd, TCM_AdjustRect, 0, LPARAM(@ARect));
HitTestInfo.pt.x := ARect.Left;
HitTestInfo.pt.y := ARect.Top div 2;
FirstShowedIndex := Windows.SendMessage(Wnd, TCM_HITTEST, 0, LPARAM(@HitTestInfo));
Result := (FirstShowedIndex > 0) and (FirstShowedIndex = AIndex);
end;
begin
// There is a bug in Windows. When only one tab is left in a scrolled Tab Control
// and this is deleted, Windows doesn't scroll it automatically. So we have to
// do it manually. See Mantis #19278
Wnd := ATabControl.Handle;
if TabsScrollingNeeded then
Windows.SendMessage(Wnd, TCM_SETCURSEL, Windows.WPARAM(AIndex - 1), 0);
Windows.SendMessage(Wnd, TCM_DELETEITEM, Windows.WPARAM(AIndex), 0);
end;
class function TWin32WSCustomTabControl.CreateHandle(const AWinControl: TWinControl; class function TWin32WSCustomTabControl.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND; const AParams: TCreateParams): HWND;
const const
@ -391,7 +429,7 @@ begin
if ATabControl is TTabControl then if ATabControl is TTabControl then
exit; exit;
Windows.SendMessage(ATabControl.Handle, TCM_DELETEITEM, Windows.WPARAM(AIndex), 0); DeletePage(ATabControl, AIndex);
if LCLControlSizeNeedsUpdate(ATabControl, True) then if LCLControlSizeNeedsUpdate(ATabControl, True) then
AdjustSizeTabControlPages(ATabControl); AdjustSizeTabControlPages(ATabControl);
end; end;

2
lcl/interfaces/win32/win32wscomctrls.pp
View File

@ -50,6 +50,8 @@ type
{ TWin32WSCustomTabControl } { TWin32WSCustomTabControl }
TWin32WSCustomTabControl = class(TWSCustomTabControl) TWin32WSCustomTabControl = class(TWSCustomTabControl)
public
class procedure DeletePage(const ATabControl: TCustomTabControl; const AIndex: integer);
published published
class function CreateHandle(const AWinControl: TWinControl; class function CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND; override; const AParams: TCreateParams): HWND; override;