Skip to content

Commit

Permalink
Merge branch 'jrsoftware:main' into master
Browse files Browse the repository at this point in the history
yktoo authored Jan 17, 2025

Verified

This commit was created on GitHub.com and signed with GitHub’s verified signature.
2 parents b324f50 + 9b3b79d commit e46fbb4
Showing 99 changed files with 4,889 additions and 4,414 deletions.
4 changes: 2 additions & 2 deletions CONTRIBUTING.md
Original file line number Diff line number Diff line change
@@ -1,8 +1,8 @@
Inno Setup
==========

Copyright (C) 1997-2024 Jordan Russell. All rights reserved.
Portions Copyright (C) 2000-2024 Martijn Laan. All rights reserved.
Copyright (C) 1997-2025 Jordan Russell. All rights reserved.
Portions Copyright (C) 2000-2025 Martijn Laan. All rights reserved.
For conditions of distribution and use, see LICENSE.TXT.

Contributing issues
10 changes: 2 additions & 8 deletions Components/BrowseFunc.pas
Original file line number Diff line number Diff line change
@@ -86,16 +86,13 @@ function BrowseForFolder(const Prompt: String; var Directory: String;
Pointer(lParam) := PChar(InitialDir);
end;
ActiveWindow := GetActiveWindow;
WindowList := DisableTaskWindows(0);
WindowList := DisableTaskWindows(ParentWnd);
CoInitialize(nil);
try
IDList := SHBrowseForFolder(BrowseInfo);
finally
CoUninitialize();
EnableTaskWindows(WindowList);
{ SetActiveWindow(Application.Handle) is needed or else the focus doesn't
properly return to ActiveWindow }
SetActiveWindow(Application.Handle);
SetActiveWindow(ActiveWindow);
end;
try
@@ -169,7 +166,7 @@ function NewGetOpenOrSaveFileName(const Prompt: String; var FileName: String;
ofn.lpstrDefExt := Pointer(DefaultExtension);

ActiveWindow := GetActiveWindow;
WindowList := DisableTaskWindows(0);
WindowList := DisableTaskWindows(ParentWnd);
try
asm
// Avoid FPU control word change in NETRAP.dll, NETAPI32.dll, etc
@@ -198,9 +195,6 @@ function NewGetOpenOrSaveFileName(const Prompt: String; var FileName: String;
end;
finally
EnableTaskWindows(WindowList);
{ SetActiveWindow(Application.Handle) is needed or else the focus doesn't
properly return to ActiveWindow }
SetActiveWindow(Application.Handle);
SetActiveWindow(ActiveWindow);
end;
end;
155 changes: 93 additions & 62 deletions Components/NewTabSet.pas
Original file line number Diff line number Diff line change
@@ -35,7 +35,8 @@ TNewTabSet = class(TCustomControl)
FTheme: TTheme;
FThemeDark: Boolean;
FHotIndex: Integer;
function GetTabRect(Index: Integer): TRect;
procedure EnsureCurrentTabIsFullyVisible;
function GetTabRect(const Index: Integer; const ApplyTabsOffset: Boolean = True): TRect;
function GetCloseButtonRect(const TabRect: TRect): TRect;
procedure InvalidateTab(Index: Integer);
procedure CloseButtonsListChanged(Sender: TObject; const Item: Boolean;
@@ -48,25 +49,29 @@ TNewTabSet = class(TCustomControl)
procedure SetTabPosition(Value: TTabPosition);
procedure SetTheme(Value: TTheme);
procedure SetHints(const Value: TStrings);
function ToCurrentPPI(const XY: Integer): Integer;
procedure UpdateThemeData(const Open: Boolean);
procedure EnsureCurrentTabIsFullyVisible;
protected
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
procedure WMThemeChanged(var Message: TMessage); message WM_THEMECHANGED;
protected
function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure UpdateHotIndex(NewHotIndex: Integer);
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure Paint; override;
procedure Resize; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property CloseButtons: TBoolList read FCloseButtons write SetCloseButtons;
property Theme: TTheme read FTheme write SetTheme;
published
property Align;
property AutoSize default True;
property Font;
property Hints: TStrings read FHints write SetHints;
property ParentFont;
@@ -161,9 +166,9 @@ function LightenColor(const Color: TColorRef; const Amount: Integer): TColorRef;
{ TNewTabSet }

const
TabSetMarginX = 4;
TabPaddingX = 5;
TabPaddingY = 3;
TabSpacing = 1;
CloseButtonSizeX = 12;

constructor TNewTabSet.Create(AOwner: TComponent);
@@ -176,17 +181,18 @@ constructor TNewTabSet.Create(AOwner: TComponent);
FTabPosition := tpBottom;
FHints := TStringList.Create;
TStringList(FHints).OnChange := HintsListChanged;
FHotIndex := -1;
ControlStyle := ControlStyle + [csOpaque];
Width := 129;
Height := 21;
FHotIndex := -1;
AutoSize := True;
end;

procedure TNewTabSet.CreateParams(var Params: TCreateParams);
begin
inherited;
with Params.WindowClass do
style := style and not (CS_HREDRAW or CS_VREDRAW);
style := style and not CS_HREDRAW;
end;

procedure TNewTabSet.CreateWnd;
@@ -204,6 +210,13 @@ destructor TNewTabSet.Destroy;
inherited;
end;

procedure TNewTabSet.CMFontChanged(var Message: TMessage);
begin
inherited;
if AutoSize then
AdjustSize;
end;

procedure TNewTabSet.CMHintShow(var Message: TCMHintShow);
var
I: Integer;
@@ -249,7 +262,45 @@ procedure TNewTabSet.WMThemeChanged(var Message: TMessage);
inherited;
end;

function TNewTabSet.GetTabRect(Index: Integer): TRect;
procedure TNewTabSet.EnsureCurrentTabIsFullyVisible;
begin
const AdjacentTabVisiblePixels = ToCurrentPPI(30);
const CR = ClientRect;
const R = GetTabRect(FTabIndex, False);
var Offset := FTabsOffset;

{ If the tab is overflowing to the right, scroll right }
var Overflow := R.Right - Offset - CR.Right + AdjacentTabVisiblePixels;
if Overflow > 0 then
Inc(Offset, Overflow);

{ If there's extra space after the last tab, scroll left if possible }
const LastTabRight = GetTabRect(FTabs.Count-1, False).Right +
ToCurrentPPI(TabSetMarginX);
Offset := Min(Offset, Max(0, LastTabRight - CR.Right));

{ If the tab is overflowing to the left, scroll left }
Overflow := Offset - R.Left + AdjacentTabVisiblePixels;
if Overflow > 0 then
Offset := Max(0, Offset - Overflow);

if FTabsOffset <> Offset then begin
FTabsOffset := Offset;
Invalidate;
end;
end;

function TNewTabSet.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
begin
{ We need to manage our own height for correct results with non-default PPI }
Canvas.Font.Assign(Font);
NewHeight := Canvas.TextHeight('0') + (ToCurrentPPI(TabPaddingY) * 2) +
ToCurrentPPI(2);
Result := True;
end;

function TNewTabSet.GetTabRect(const Index: Integer;
const ApplyTabsOffset: Boolean = True): TRect;
var
CR: TRect;
I, SizeX, SizeY: Integer;
@@ -259,13 +310,15 @@ function TNewTabSet.GetTabRect(Index: Integer): TRect;
Canvas.Font.Assign(Font);
if FTabPosition = tpBottom then
Result.Top := 0;
Result.Right := 4 - FTabsOffset;
Result.Right := ToCurrentPPI(TabSetMarginX);
if ApplyTabsOffset then
Dec(Result.Right, FTabsOffset);
for I := 0 to FTabs.Count-1 do begin
Size := Canvas.TextExtent(FTabs[I]);
SizeX := Size.cx + (TabPaddingX * 2) + TabSpacing;
SizeX := Size.cx + (ToCurrentPPI(TabPaddingX) * 2);
if (I < FCloseButtons.Count) and FCloseButtons[I] then
Inc(SizeX, MulDiv(CloseButtonSizeX, CurrentPPI, 96));
SizeY := Size.cy + (TabPaddingY * 2);
Inc(SizeX, ToCurrentPPI(CloseButtonSizeX));
SizeY := Size.cy + (ToCurrentPPI(TabPaddingY) * 2);
if FTabPosition = tpTop then
Result.Top := CR.Bottom - SizeY;
Result := Bounds(Result.Right, Result.Top, SizeX, SizeY);
@@ -277,8 +330,8 @@ function TNewTabSet.GetTabRect(Index: Integer): TRect;

function TNewTabSet.GetCloseButtonRect(const TabRect: TRect): TRect;
begin
Result := TRect.Create(TabRect.Right - MulDiv(CloseButtonSizeX, CurrentPPI, 96) - TabPaddingX div 2,
TabRect.Top, TabRect.Right - TabPaddingX div 2, TabRect.Bottom);
Result := TRect.Create(TabRect.Right - ToCurrentPPI(CloseButtonSizeX) - ToCurrentPPI(TabPaddingX) div 2,
TabRect.Top, TabRect.Right - ToCurrentPPI(TabPaddingX) div 2, TabRect.Bottom);
end;

procedure TNewTabSet.InvalidateTab(Index: Integer);
@@ -287,9 +340,6 @@ procedure TNewTabSet.InvalidateTab(Index: Integer);
begin
if HandleAllocated and (Index >= 0) and (Index < FTabs.Count) then begin
R := GetTabRect(Index);
{ Inc R.Right since the trailing separator of a tab overwrites the first
pixel of the next tab }
Inc(R.Right);
InvalidateRect(Handle, @R, False);
end;
end;
@@ -367,12 +417,12 @@ procedure TNewTabSet.Paint;
if (TabIndex < FCloseButtons.Count) and FCloseButtons[TabIndex] then begin
var R := GetCloseButtonRect(TabRect);
if FMenuThemeData <> 0 then begin
var Offset := MulDiv(1, CurrentPPI, 96);
var Offset := ToCurrentPPI(1);
Inc(R.Left, Offset);
Inc(R.Top, Offset);
DrawThemeBackground(FMenuThemeData, Canvas.Handle, MENU_SYSTEMCLOSE, MSYSC_NORMAL, R, nil);
end else begin
InflateRect(R, -MulDiv(3, CurrentPPI, 96), -MulDiv(6, CurrentPPI, 96));
InflateRect(R, -ToCurrentPPI(3), -ToCurrentPPI(6));
Canvas.Pen.Color := Canvas.Font.Color;
Canvas.MoveTo(R.Left, R.Top);
Canvas.LineTo(R.Right, R.Bottom);
@@ -390,7 +440,6 @@ procedure TNewTabSet.Paint;
for I := 0 to FTabs.Count-1 do begin
R := GetTabRect(I);
if SelectedTab and (FTabIndex = I) then begin
Dec(R.Right, TabSpacing);
if FTheme <> nil then
Canvas.Brush.Color := FTheme.Colors[tcBack]
else
@@ -401,7 +450,7 @@ procedure TNewTabSet.Paint;
Canvas.Font.Color := FTheme.Colors[tcFore]
else
Canvas.Font.Color := clBtnText;
Canvas.TextOut(R.Left + TabPaddingX, R.Top + TabPaddingY, FTabs[I]);
Canvas.TextOut(R.Left + ToCurrentPPI(TabPaddingX), R.Top + ToCurrentPPI(TabPaddingY), FTabs[I]);
DrawCloseButton(R, I);
ExcludeClipRect(Canvas.Handle, R.Left, R.Top, R.Right, R.Bottom);
Break;
@@ -421,7 +470,7 @@ procedure TNewTabSet.Paint;
use plain clBtnHighlight as the text color }
Canvas.Font.Color := clBtnHighlight;
end;
Canvas.TextOut(R.Left + TabPaddingX, R.Top + TabPaddingY, FTabs[I]);
Canvas.TextOut(R.Left + ToCurrentPPI(TabPaddingX), R.Top + ToCurrentPPI(TabPaddingY), FTabs[I]);
if FHotIndex = I then
DrawCloseButton(R, I);
end;
@@ -450,16 +499,16 @@ procedure TNewTabSet.Paint;

{ Top or bottom line }
if FTheme <> nil then
Canvas.Pen.Color := FTheme.Colors[tcBack]
Canvas.Brush.Color := FTheme.Colors[tcBack]
else
Canvas.Pen.Color := clBtnFace;
if FTabPosition = tpBottom then begin
Canvas.MoveTo(0, 0);
Canvas.LineTo(CR.Right, 0);
end else begin
Canvas.MoveTo(0, CR.Bottom-1);
Canvas.LineTo(CR.Right, CR.Bottom-1);
end;
Canvas.Brush.Color := clBtnFace;
const LineRectHeight = ToCurrentPPI(1);
var LineRect := CR;
if FTabPosition = tpBottom then
LineRect.Bottom := LineRect.Top + LineRectHeight
else
LineRect.Top := LineRect.Bottom - LineRectHeight;
Canvas.FillRect(LineRect);

{ Background fill }
if FTheme <> nil then
@@ -469,15 +518,21 @@ procedure TNewTabSet.Paint;
else
Canvas.Brush.Color := clBtnShadow;
if FTabPosition = tpBottom then
Inc(CR.Top)
Inc(CR.Top, LineRectHeight)
else
Dec(CR.Bottom);
Dec(CR.Bottom, LineRectHeight);
Canvas.FillRect(CR);

{ Non-selected tabs }
DrawTabs(False);
end;

procedure TNewTabSet.Resize;
begin
EnsureCurrentTabIsFullyVisible;
inherited;
end;

procedure TNewTabSet.SetCloseButtons(Value: TBoolList);
begin
FCloseButtons.Clear;
@@ -528,6 +583,11 @@ procedure TNewTabSet.SetTheme(Value: TTheme);
end;
end;

function TNewTabSet.ToCurrentPPI(const XY: Integer): Integer;
begin
Result := MulDiv(XY, CurrentPPI, 96);
end;

procedure TNewTabSet.UpdateThemeData(const Open: Boolean);
begin
if FMenuThemeData <> 0 then begin
@@ -543,33 +603,4 @@ procedure TNewTabSet.UpdateThemeData(const Open: Boolean);
end;
end;

procedure TNewTabSet.EnsureCurrentTabIsFullyVisible;
var
rcTab, rcCtl, rcLast: TRect;
iExtra, iDelta, iNewOffset: Integer;
begin
rcCtl := ClientRect;
rcTab := GetTabRect(FTabIndex);

{ Check and modify tabs offset so everything fits }
iExtra := Min(rcCtl.Width div 2, rcTab.Width * 4); { arbitrary value, adjust as needed }
iDelta := rcTab.Width div 2; { arbitrary value, adjust as needed }

{ Left side is easy, limit is always 0 }
if rcTab.Left < rcCtl.Left + iDelta then begin
FTabsOffset := Max(0, FTabsOffset - rcCtl.Left - rcTab.Left - iExtra);
Invalidate;
end;

{ Right side limit depends on last tab and total available space }
if rcTab.Right > rcCtl.Right - iDelta then begin
iNewOffset := FTabsOffset + (rcTab.Right - rcCtl.Right) + iExtra;
FTabsOffset := 0; { We need the last tabs leftmost position w/o any offset }
rcLast := GetTabRect(FTabs.Count-1);
FTabsOffset := Max(0, Min(iNewOffset, rcLast.Right - rcCtl.Width + 10));
Invalidate;
end;
end;


end.
Loading

0 comments on commit e46fbb4

Please sign in to comment.