Skip to content

Commit

Permalink
Bug 1529: Toolbar icons are broken with Windows high contrast themes
Browse files Browse the repository at this point in the history
https://winscp.net/tracker/1529

Source commit: ebe3c5e6a71bbb845c5555efe98dbac38ce8428f
  • Loading branch information
martinprikryl committed Jan 28, 2018
1 parent a9ba786 commit c2e61db
Show file tree
Hide file tree
Showing 3 changed files with 10 additions and 73 deletions.
16 changes: 7 additions & 9 deletions source/packages/tbx/TBXOfficeXPTheme.pas
Original file line number Diff line number Diff line change
Expand Up @@ -782,8 +782,6 @@ procedure TTBXOfficeXPTheme.PaintImage(Canvas: TCanvas; ARect: TRect;
end;

{$IFNDEF ALTERNATIVE_DISABLED_STYLE}
HiContrast := IsDarkColor(GetItemImageBackground(ItemInfo), 64);

if not Enabled then
begin
DrawTBXIconFlatShadow(Canvas, ARect, ImageList, ImageIndex,
Expand All @@ -797,16 +795,16 @@ procedure TTBXOfficeXPTheme.PaintImage(Canvas: TCanvas; ARect: TRect;
DrawTBXIconFullShadow(Canvas, ARect, ImageList, ImageIndex, IconShadowColor);
OffsetRect(ARect, -2, -2);
end;
DrawTBXIcon(Canvas, ARect, ImageList, ImageIndex, HiContrast);
DrawTBXIcon(Canvas, ARect, ImageList, ImageIndex);
end
else if HiContrast or TBXHiContrast or TBXLoColor then
DrawTBXIcon(Canvas, ARect, ImageList, ImageIndex, HiContrast)
else if TBXLoColor then
DrawTBXIcon(Canvas, ARect, ImageList, ImageIndex)
else
HighlightTBXIcon(Canvas, ARect, ImageList, ImageIndex, clWindow, 178);
{$ELSE}
HiContrast := ColorIntensity(GetItemImageBackground(ItemInfo)) < 80;
if not Enabled then
begin
HiContrast := ColorIntensity(GetItemImageBackground(ItemInfo)) < 80;
if not HiContrast then
DrawTBXIconShadow(Canvas, ARect, ImageList, ImageIndex, 0)
else
Expand All @@ -821,13 +819,13 @@ procedure TTBXOfficeXPTheme.PaintImage(Canvas: TCanvas; ARect: TRect;
DrawTBXIconShadow(Canvas, ARect, ImageList, ImageIndex, 1);
OffsetRect(ARect, -2, -2);
end;
DrawTBXIcon(Canvas, ARect, ImageList, ImageIndex, HiContrast);
DrawTBXIcon(Canvas, ARect, ImageList, ImageIndex);
end
else
{$IFNDEF NO_IMAGE_DIMMING}
if HiContrast or TBXHiContrast or TBXLoColor then
if TBXLoColor then
{$ENDIF}
DrawTBXIcon(Canvas, ARect, ImageList, ImageIndex, HiContrast)
DrawTBXIcon(Canvas, ARect, ImageList, ImageIndex)
{$IFNDEF NO_IMAGE_DIMMING}
else
HighlightTBXIcon(Canvas, ARect, ImageList, ImageIndex, clWindow, 178)
Expand Down
4 changes: 0 additions & 4 deletions source/packages/tbx/TBXThemes.pas
Original file line number Diff line number Diff line change
Expand Up @@ -377,8 +377,6 @@ procedure ReleaseTBXTheme(var ATheme: TTBXTheme);

{ Auxiliary flags corresponding to the system color scheme }
TBXLoColor: Boolean;
TBXHiContrast: Boolean; // this can me removed in future
TBXNoBlending: Boolean; // TBXNoColor or TBXHiContrast

var
USE_FLATMENUS: Boolean;
Expand Down Expand Up @@ -729,8 +727,6 @@ procedure TTBXThemeManager.UpdateVariables;
DC := GetDC(0);
try
TBXLoColor := GetDeviceCaps(DC, BITSPIXEL) * GetDeviceCaps(DC, PLANES) < 12;
TBXHiContrast := GetSysColor(COLOR_BTNFACE) = $00FFFFFF;
TBXNoBlending := TBXLoColor or TBXHiContrast;
finally
ReleaseDC(0, DC);
end;
Expand Down
63 changes: 3 additions & 60 deletions source/packages/tbx/TBXUtils.pas
Original file line number Diff line number Diff line change
Expand Up @@ -84,7 +84,7 @@ procedure MoveLongword(const Source; var Dest; Count: Integer);

{ extended icon painting routines }
procedure DrawTBXIcon(Canvas: TCanvas; const R: TRect;
ImageList: TCustomImageList; ImageIndex: Integer; HiContrast: Boolean);
ImageList: TCustomImageList; ImageIndex: Integer);
procedure BlendTBXIcon(Canvas: TCanvas; const R: TRect;
ImageList: TCustomImageList; ImageIndex: Integer; Opacity: Byte);
procedure HighlightTBXIcon(Canvas: TCanvas; const R: TRect;
Expand Down Expand Up @@ -1002,66 +1002,9 @@ procedure MoveLongword(const Source; var Dest; Count: Integer);
end;

procedure DrawTBXIcon(Canvas: TCanvas; const R: TRect;
ImageList: TCustomImageList; ImageIndex: Integer; HiContrast: Boolean);
{const
CWeirdColor = $00203241;} {vb -}
var
ImageWidth, ImageHeight: Integer;
I, J: Integer;
Src, Dst: PColor;
S, C: TColor;
ImageList: TCustomImageList; ImageIndex: Integer);
begin
if not HiContrast then
begin
ImageList.Draw(Canvas, R.Left, R.Top, ImageIndex);
Exit;
end;
ImageWidth := R.Right - R.Left;
ImageHeight := R.Bottom - R.Top;
with ImageList do
begin
if Width < ImageWidth then ImageWidth := Width;
if Height < ImageHeight then ImageHeight := Height;
end;

StockBitmap1.Width := ImageWidth;
StockBitmap1.Height := ImageHeight;
StockBitmap2.Width := ImageWidth;
StockBitmap2.Height := ImageHeight;

BitBlt(StockBitmap1.Canvas.Handle, 0, 0, ImageWidth, ImageHeight,
Canvas.Handle, R.Left, R.Top, SRCCOPY);
{for J := 0 to ImageHeight - 1 do
FillLongWord(StockBitmap2.ScanLine[J]^, ImageWidth, CWeirdColor);} {vb -}
BitBlt(StockBitmap2.Canvas.Handle, 0, 0, ImageWidth, ImageHeight,
Canvas.Handle, R.Left, R.Top, SRCCOPY); {vb +}
ImageList.Draw(StockBitmap2.Canvas, 0, 0, ImageIndex);

for J := 0 to ImageHeight - 1 do
begin
Src := StockBitmap2.ScanLine[J];
Dst := StockBitmap1.ScanLine[J];
for I := 0 to ImageWidth - 1 do
begin
{S := Src^ and $00FFFFFF;} {vb -}
S := Src^; {vb +}
{if S <> CWeirdColor then} {vb -}
if S <> Dst^ then {vb +}
begin
{C := (S and $FF0000) shr 16 * 76 + (S and $00FF00) shr 8 * 150 +
(S and $0000FF) * 29;} {vb -}
C := (S and $00FF0000) shr 16 * 76 + (S and $0000FF00) shr 8 * 150 +
(S and $000000FF) * 29; {vb +}
if C > $FD00 then S := $000000
else if C < $6400 then S := $FFFFFF;
Dst^ := Lighten(S, 32);
end;
Inc(Src);
Inc(Dst);
end;
end;
BitBlt(Canvas.Handle, R.Left, R.Top, ImageWidth, ImageHeight,
StockBitmap1.Canvas.Handle, 0, 0, SRCCOPY);
ImageList.Draw(Canvas, R.Left, R.Top, ImageIndex);
end;

procedure BlendTBXIcon(Canvas: TCanvas; const R: TRect;
Expand Down

0 comments on commit c2e61db

Please sign in to comment.