distal-attribute
distal-attribute
distal-attribute
distal-attribute

Title bar buttons flicker in Windows 10

mikemanger posted 2 years ago in General
They still work but the close/help/mini/max buttons all flicker when you hover over them. Seems to happen in all windows (session manager, preferences, etc).

I am seeing this on Windows 10 64bit using HeidiSQL 9.3
ansgar posted 2 years ago
I'm not having that issue here, on Windows 10 64 bit with Heidi 9.3 . Could it be a graphics driver issue? I had issues with my Nvidia drivers on Windows 10 until I had updated my system bios.
mikemanger posted 2 years ago
Yep, working OK for me at home.

I'll check the drivers and stuff tomorrow, could also be from DPI scaling. Seems odd because I'm not getting the issue in other programs.
mikemanger posted 2 years ago
Does seem to be related to the display settings - I had my primary at 125% and my secondary display at 100%. Ticking 'Disable display scaling oh high DPI settings' for heidisql.exe fixes the issue.
abides posted 2 years ago
Hello,

I have the same problem but its not only heidi sql, all file browser windows and most of the application windows except chrome. Chrome windows and tabs are stand still and almost all other windows title bars flickering.

I realize something, i'm using slideshow desktop background and it does everything when background switch to another.

Probably its related about graphic adapter or windows itself.

here is it video i captured when it happens to show what its look like (skip to 25. sec)

https://www.youtube.com/watch?v=r9XoV0p69WE
abides posted 2 years ago

everything when background switch to another

*everytime when background switch to another
mikemanger posted 2 years ago
Hey abides, that looks different to my issue which only affects the title bar buttons not highlighting.
qxxx posted 2 years ago

Hi,

I still have this problem. Updated to 9.3.0.5049. The problem shows up sporadically every few minutes but If you want to quick test the issue just start heidi and then change your screensaver! If you change the screensaver while heidi runs everything is flickering. if I close heidi and change the screensaver everything is fine.

Here I uploaded a video: https://www.youtube.com/watch?v=d-PfhE4knY8

Please do something as I am working with heidi every day and it annoys the hell out of me. I reinstalled my graphic drivers and rechecked my system.. after months I finally found the cause of this flickering.. :( (I am on windows 10 but it also was in win 8 a problem)

ansgar posted 2 years ago

Your video shows the issue quite well. Every window flickers when HeidiSQL window is visible. If Heidi is not visible, nothing flickers.

This post says I shall ensure the FullRepaint property of all TPanel instances are set. That is the case, I just checked that.

I could not find any other threads related to flickering Delphi XE5 applications yet.

qxxx posted 2 years ago

@ansgar - thanks for your reply. If it helps: it also flickers when only the connection manager windows is visible and no connection was opened yet (like I just start heidi) - I tried to solve the problem myself but I have no delphi, tried it with lazarus but I am lacking pascal / delphi knowledge ;)

I guess there is like in c++ some kind of a loop that listens for some system specific events and if the event was triggered heidi is doing something that causes the flickering.

ansgar posted 2 years ago

HeidiSQL has some code in a so called TApplicationEvents.Idle event. That is, when the application does nothing, then do something. You can imagine that there is a chance that HeidiSQL does something weird here which could cause flicker, but the code in that event is written very carefully and lightweight.

It is more likely that the action list and imagelist which HeidiSQL has, is updated automatically by the underlying VCL library. For example, updating the enabled/disabled properties of all contained TActions could cause flicker. Indeed, in Delphi, when I add an image to Heidi's main TImageList, I can see a flicker issue for 1 or 2 seconds. Probably this has the same cause as the flicker in Win10.

What I already checked: FullRepaint property on all TPanel's: (was already the case)

There is more to check: DoubleBuffered property on all TMemo's:

physcopanda@hotmail.com posted 2 years ago

I get this too - it's driving me mad - please please fix if at all possible as Heidi is otherwise an excellent tool! Is anyone actively working on this? I do have one 4k monitor and two smaller 1280 x 1024 monitors plugged in so I too have a mix of DPI but turning it off for Heidi is really undesirable!

Keep up the good work guys - it's a really really good product :-)

qxxx posted 2 years ago

Keep up the good work guys - it's a really really good product :-)

agree! in my opinion the best. I tried all similar products, paid and open source and heidi is the best for me. I just wish this flickering could go away. I am running heidi now in a virtual machine on windows 7 so it wont flicker, I am using it a lot. I will try to get delphi somewhere and try to fix the error. Maybe there is a way to set some properties for that imagelist ala autoRedraw = false.. ?

bzoks posted 1 year ago

I also have this problem... if I have more instances of Heidi open (also multi-monitor setup), this flickering off all windows lasts even longer... Best regards, Bostjan

webdbase posted 1 year ago

Yes, I confirm the same behaviour. Is it reletaed somehow to the problem with autocomplete and virtual desktops described at

webdbase posted 1 year ago

http://www.heidisql.com/forum.php?t=20815#p21002

joaojacome posted 1 year ago

Hello!

I fixed the problem by disabling the wallpapers slideshow fade, in the system settings.

1 attachment(s):
  • Screenshot_1
joaojacome posted 1 year ago

Hello!

I fixed the problem by disabling the wallpapers slideshow fade, in the system settings.

Oops! It's the first checkbox!

qxxx posted 1 year ago

Hello!

I fixed the problem by disabling the wallpapers slideshow fade, in the system settings.

Can you please test it by activating and disabling the screensaver? I don't think it helps disabling that checkbox in the performance window.

I tried to solve that problem myself but I was unable to get the heidi sourcecodes to work with various delphi versions.. the problem still exists and is pain in the ass. :(

Vanav posted 1 year ago

I confirm this bug. If HeidiSQL is running (it can be minimized), then most of windows, including taskbar, flicker multiple times during some seconds after some events.

Vanav posted 1 year ago

Bug triggers for me:

  • group policy update at regular intervals, can be run manually: gpupdate.exe /target:computer.
  • change any checkbox and press Apply in Advanced System Settings - Visual Effects: see screenshot by joaojacome above.

Environment: Windows 10 Pro version 1607 (build 14393.187), HeidiSQL 9.3.0.5118.

I have no screen saver, animation settings made no difference.

Vanav posted 1 year ago

Other related threads:

  • Windows 10 - UI elements periodically flickering - Super User - superuser.com/questions/1011142/ui-elements-periodically-flickering
  • The system slows down and the gui flickers while it repaints itself - Microsoft Community - answers.microsoft.com/en-us/insider/forum/insider_wintp-insider_perf/the-system-slows-down-and-the-gui-flickers-while/556f860f-0057-4d67-bfcc-2de06527b801
  • Bug: HeidiSQL causes slowdowns on Windows 10 - www.heidisql.com/forum.php?t=18120
  • Menu and bars are flickering under Windows 10 Insider Preview 14342 - www.heidisql.com/forum.php?t=21342

(I'm sorry, forum doesn't allow me to post links).

qxxx posted 1 year ago

Hi everyone. Can it be that it was fixed? Because I don't experience that issue for weeks (months?) anymore.

Everything still flickers if I change the screensaver but it doesn't flicker on its own now, which was really annoying. That method with changing screensaver is just to force the flickering caused by heidi. I am happy that it doesn't flicker on its own now every few minutes!

Thank you to devs for fixing this. :)))

ShirleyFWilliams posted 1 year ago

yes

mikemanger posted 1 year ago

I just tried and my issue with the title buttons is still happening

1 attachment(s):
  • flicker2
qxxx posted 1 year ago

@mikemanger,

what should it do? (or not do)? You are hovering the top right buttons, I don't see any issue there, only that the hovering is not always executed? Just tried it on my machine and it looks like this:

https://p-it-s.tinytake.com/sf/MTAyOTUwNF80MjA1MzM2

qxxx posted 1 year ago

I just realized the issue from @mikemanger and my issue are different 2 cases.. my problem is (was?) that the every window (not just heidisql) was flickering every few minutes when heidi was running. And @mikemanger has an issue with the buttons. Sorry for the confusion and that I stole your topic for my own problem ;) I hope it gets fixed what you are experiencing

mikemanger posted 1 year ago

No problem - my fault for not posting a gif originally (I don't think the technology existed back then :P).

Yes, my problem is the hover state isn't kept - it just flickers on and off when the mouse moves. I can fix it by disabling DPI scaling on the .exe and it works fine (but obviously the window is not scaled).

Glad the other issue is fixed now tho.

Vanav posted 1 year ago

Issue about all windows flickering every few minutes is not fixed. But it is triggered periodically only in some environments. I've collected some known triggers above, including periodic ones (domain group policy update).

apric posted 1 year ago

The global flickering happens reproducible when resuming from sleep, even when HeidiSQL window is not directly visible. Every open window flashes uncontrollable for a few seconds.

wolis posted 11 months ago

Setting up Sticky Keys will cause this:

Control Panel\All Control Panel Items\Ease of Access Centre\Make the keyboard easier to use

  • Click on: Set up Stick Keys
  • Click on: first checkbox (toggle on or off)
  • Click on: OK and screen elements like title bars and task bar and some windows will flicker.

Go back in and toggle it again and it will flicker again - very reliable. Exit HeidiSQL and there is no flicker.

qxxx posted 11 months ago

I just uninstalled heidisql.. and bought commercial app (SQLyog).. Heidi is a cool software but I can't work with all the flickering. :/

UB@HS posted 8 months ago

This always happens on our site, when heidisql is open and group-policies get aplied (about every 15 minutes). Especially group-policies dealing with registry-entries or drive-mappings seem to cause the flickering. When no heidisql-instance is running, nothing flickers.

Each additional instance of heidisql causes the flicker to appear with a lower frequency, but making the whole system less responsive.

I assume that heidisql performs as some kind of "event-multiplier". It fires broadcast-events to all other processes, when some kind of external system-event arrives.

It´s really a pain in the ass.

Is someone still working on that issue?

ansgar posted 8 months ago

That someone could only be me, but I don't currently. I was watching out for different suspicious automatic things which HeidiSQL does in the background. But without luck. Probably now that I am soon on Windows 10 finally, I will get some more background on what could cause the flickering.

apric posted 8 months ago

Problem is easily reproduced by changing mouse speed in Windows mouse settings and hitting "apply". With HeidiSQL open, everything flickers for a few seconds like crazy until the settings are actually applied. Without HeidiSQL open, the settings are being applies instantly, no flickering.

ansgar posted 8 months ago

Nice reproduction recipe. I can reproduce that issue here exactly as you say.

ansgar posted 8 months ago

In the just added r5161, I am activating a "DoubleBuffered" property on the dialogs, which can probably help a bit against that flickering.

Btw, the Delphi IDE is even more flickering than HeidiSQL.

Will check further things.

TomasB posted 8 months ago

Hi Ansgar, after installing the latest version I'm getting this toolbar on Win7.

1 attachment(s):
  • 2017-03-07_084645
ansgar posted 8 months ago

Yes, seems that does not work as expected. Will roll back this change.

ansgar posted 8 months ago

I just reverted that change in r5162. Please update.

Vanav posted 8 months ago

I have no issue with toolbar. Flickering become a bit less annoying, it seems, but not fixed yet.

ansgar posted 7 months ago

r5165 adds my above mentioned modification again, but this time only on Win10.

Misha v.3 posted 7 months ago

Wow. I even did not realise that this the flickering was caused by Heidi. Anyway, it is much better now. Many thanks.

P.S. I hope it will be completely fixed one day.

rahulbhojwani posted 7 months ago

I am also facing the same issue from a long time. It's really frustrating. Let's see what happens after I update to r5165. I will keep you guys updated. I am sure we all can put our efforts and make sure this is fixed forever. And Thanks @ansgar

Clarkey posted 6 months ago

I will donate £100 when this is permanently fixed.

ansgar posted 6 months ago

Oh, I would fix that without getting money :) If only I knew how.

cacofony posted 5 months ago

This might be related as if effects Delphi (All version / Windows 10)

In my case every 15 min the "Accent color" of my personalization settings was changing to match the current background picture.

In windows, Settings -> Colors -> Choose a Color -> switch off "Automatically pick an accent color from my background".

When activated, every 15 minutes windows 10 automagically pick an accent color from your background and fires 4x WM_DWMCOLORIZATIONCOLORCHANGED. That makes the IDE repaint itself like crazy.

jgd posted 3 months ago

Hi,

any news regarding this issue. I use your tool a lot (it's awesome) but that flickering somehow drives me mad ;))

Cheers Guido

nickles posted 2 months ago

I found that this happens whenever gpupdate.exe or systemsettings.exe run.

uso posted 2 months ago

The problem is the broadcast of WM_SETTINGCHANGE and how it is handled in the Delphi VCL. So not only HeidiSQL is causing this, also other Delphi based software (like our product, my little demo tool and the RAD Studio itself).

Description:

TApplication.WndProc calles a function named Default for each WM_SETTINGCHANGED and somewhere in the call chain the fonts and screen metrics are updated, regardless of what the Flag (lParam) of WM_SETTINGCHANGED implies.

The VCL calls a TCustomForm.CMFontChanged on that message and this then triggers TToolBar.CreateWnd and/or TCoolBar.CreatWnd which inturn destroys the Windows component underlying those Delphi components.

This causes a mass of WM_CREATE, WM_REPAINT, WM_ERASEBKGND, WM_DESTROY, CMFontChanged calls and so on: the flickering we see. And one can see that also on older Win-Boxes - confirmed Win7 x64.

The uggly part here is that thos calls happen before the programmer has a chance to influence the window message handling of the VCL. The only possibility I found is to utilize TApplication.HookMainWindow:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.ToolWin, AJ.Vcl.ComCtrls, Vcl.ImgList;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private-Deklarationen }

    function HookMainWindow(var Message: TMessage): Boolean;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  WM_MSG_OFFSET = WM_USER * 8;

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.HookMainWindow(HookMainWindow);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Application.UnhookMainWindow(HookMainWindow);
end;

function TForm1.HookMainWindow(var Message: TMessage): Boolean;
const
  WM_SETTINGCHANGE_OFFSET = 8 * WM_USER;
begin
  Result := False;
  if WM_SETTINGCHANGE = Message.Msg then
  begin
    case Message.WParam of
      // Add the setting flag here that triggered the flickering.
      0, 1, SPI_SETMOUSETRAILS, SPI_SETMOUSE, SPI_SETMOUSESPEED:
        begin
          // Do not eat the message, instead hide it from the normal handling by adding
          // an offset. That way it remains possible to catch those messages by the
          // normal message handler methods.
          Inc(Message.Msg, WM_SETTINGCHANGE_OFFSET);
        end;
    end;
  end;
end;

end.
uso posted 2 months ago

TApplication.WndProc calles a function named Default for each WM_SETTINGCHANGED and somewhere in the call chain the fonts and screen metrics are updated, regardless of what the Flag (lParam) of WM_SETTINGCHANGED implies.

I apologize, the method in question is TApplication.CheckIniChange, not Default.

kostgr posted 1 month ago

Thanks to that post we were able to fix a flickering issue by applying following patch (on forms.pas, Delphi2010 version).

Essense of the patch is to modify the TScreen.GetMetricSettings method so, that the Handle of diverse Fonts has only to be changed if there are significant changes of the fonts, not every time the method is called:

procedure SafeChangeFont(aFontToChange: TFont; aLogFont: tagLOGFONTW);
  var
    LTmpFont: TFont;
  begin
    LTmpFont := TFont.Create;
    try
      LTmpFont.Assign(aFontToChange);
      LTmpFont.Handle := CreateFontIndirect(aLogFont);
      if (LTmpFont.Size <> aFontToChange.Size)
        or (LTmpFont.Name <> aFontToChange.Name)
        or (LTmpFont.Style <> aFontToChange.Style) then
      begin
        aFontToChange.Handle := CreateFontIndirect(aLogFont);
      end;
    finally
      FreeAndNil(LTmpFont);
    end;
  end;
// ... and then instead of 
//  FIconFont.Handle := CreateFontIndirect(LogFont);
// use
  SafeChangeFont(FIconFont, LogFont);
1 attachment(s):
jgd posted 1 month ago

Excellent - how will that solve the Heidi-Issue?

kostgr posted 1 month ago

Excellent - how will that solve the Heidi-Issue?

As uso perfectly described, the event WM_SETTINGCHANGE comes much more frequently in windows10 as in windows7. This change calls TScreen.GetMetricSettings which itself triggers change of five different system fonts (FIconFont, FHintFont, FMenuFont, FMessageFont and FCaptionFont) via assignment of their Handles to the newly created ones. Those TFont-instances are changed no matter whether the underlying fonts are really changed or not. Each of those Font-Instance changes triggers RecreateWnd of the ToolBars/CoolBars. So each CoolBar recreates itself 5 time. So multiply the number of CoolBars/ToolBars of all open windows in the delphi application with 5 and you will get the number of CoolBars/ToolBars recreations for each WM_SETTINGCHANGE event.

Our patch modifies the GetMetricSettings that way, that we are trying to recognize whether there are significant changes on system fonts before changing them. Most of the time the system fonts are not changed, so there is no need to trigger font instance changes and CoolBar/ToolBar recreations at all.

In our tests we've got no font changes at all. Possibly you'd like to extend the Modification-Check of the SafeChangeFont-procedure to consider font colour as well.

cacofony posted 1 month ago

So does function TForm1.HookMainWindow(var Message: TMessage): Boolean; fix the issue in a sufficient way to avoid a forms.pas patch?

Also has the form.pas patch been reported to Embarcadero?

tb posted 1 month ago

I was able to apply the "SafeChangeFont" patch to Vcl.Forms.pas in Delphi XE5, create a new Vcl.Forms.dcu and finally compile HeidiSQL. The result is a drastically reduced flicker in HeidiSQL for TPanel and TToolbutton but stay reduced at TPagecontrol. Tpagecontrol flickers the same way as the window size is changed.

1 attachment(s):
tb posted 1 month ago

I was able to apply the "SafeChangeFont" patch to Vcl.Forms.pas in Delphi XE5, create a new Vcl.Forms.dcu and finally compile HeidiSQL. The result is a drastically reduced flicker in HeidiSQL for TPanel and TToolbutton but stay reduced at TPagecontrol. Tpagecontrol flickers the same way as the window size is changed.

with latest svn version 5174 the flickering of TPanel and TToolbutton also disappeared.

uso posted 1 month ago

Thanks to kostgr we nailed down a long standing Vcl bug.

Finally I used Delphi-Detours-Library

https COLON SLASH SLASH github DOT com/MahdiSafsafi/delphi-detours-library

(sorry I'm not allowed to post http links, yet) to inject a runtime patch (I do not like patching the RTL/VCL) of TScreen.GetScreenMetrics and created a TFontHelper.Equals function to simplify the comparison.

unit OScreenIntercept;

interface

type
  TScreenIntercept = packed record
  strict private type
    TGetMetricSettings = procedure(const Self);
  strict private class var
    GetMetricSettings: TGetMetricSettings;
  strict private
    class constructor Create();
    class destructor Destroy();
    class procedure HookedGetMetricSettings(const Self); static;
  public
    class procedure ForceClassConstructorExec; static;
  end;

implementation

uses
  System.SysUtils, Winapi.Windows, Vcl.Forms, Vcl.Graphics
  //
  , DDetours
  //
  ;

{ TFontHelper }

type
  TFontHelper = class helper for TFont
  public
    function Equals(const AOther: TFont): Boolean;
  end;

function TFontHelper.Equals(const AOther: TFont): Boolean;
begin
  Result := (AOther.PixelsPerInch = self.PixelsPerInch)
    and (AOther.Charset = self.Charset)
    and (AOther.Color = self.Color)
    and (AOther.Height = self.Height)
    and (AOther.Name = self.Name)
    and (AOther.Orientation = self.Orientation)
    and (AOther.Pitch = self.Pitch)
    and (AOther.Size = self.Size)
    and (AOther.Style = self.Style)
    and (AOther.Quality = self.Quality);
end;

{ TScreenIntercept }

class constructor TScreenIntercept.Create;
var
  pGetMetricSettings: Pointer;
begin
  asm
    mov pGetMetricSettings, offset TScreen@GetMetricSettings
  end;

  TScreenIntercept.GetMetricSettings := InterceptCreate(pGetMetricSettings, @TScreenIntercept.HookedGetMetricSettings);
end;

class destructor TScreenIntercept.Destroy;
begin
  if Assigned(TScreenIntercept.GetMetricSettings) then
  begin
    InterceptRemove(@TScreenIntercept.GetMetricSettings);
  end;
end;

class procedure TScreenIntercept.ForceClassConstructorExec;
begin
  // Call this function to force to compiler to execute the class constructor.
end;

class procedure TScreenIntercept.HookedGetMetricSettings(const Self);
  procedure CheckedFontChange(const ACurrFont: TFont; const ANewFont: tagLOGFONTW);
  var
    TmpFont: TFont;
  begin
    TmpFont := TFont.Create;
    try
      TmpFont.Assign(ACurrFont);
      TmpFont.Handle := CreateFontIndirect(ANewFont);
      if not TmpFont.Equals(ACurrFont) then
      begin
        ACurrFont.Handle := CreateFontIndirect(ANewFont);
      end;
    finally
      FreeAndNil(TmpFont);
    end;
  end;
var
  LSize: Cardinal;
  LogFont: TLogFont;
  NonClientMetrics: TNonClientMetrics;
  SaveShowHint: Boolean;
begin
  // Patched copy of TScreen.GetScreenMetrics as suggested by kostgr.
end;

end.
tb posted 1 month ago

Unfortunatly this code will not compile w/ DelphiXE5 and Win64 output. Error E1025 will raise. ASM and delphi code mixing isn't allowed for 64 bit compiler. Also using of a simple copy of the patched TScreen.GetScreenMetrics will not work, because of private variables of TScreen not visible outside.

FHintFont: TFont; FIconFont: TFont; FMenuFont: TFont; FMessageFont: TFont; FCaptionFont: TFont;
uso posted 1 month ago

Unfortunatly this code will not compile w/ DelphiXE5 and Win64 output. Error E1025 will raise. ASM and delphi code mixing isn't allowed for 64 bit compiler. Also using of a simple copy of the patched TScreen.GetScreenMetrics will not work, because of private variables of TScreen not visible outside.

FHintFont: TFont; FIconFont: TFont; FMenuFont: TFont; FMessageFont: TFont; FCaptionFont: TFont;

I do not use the x64 compiler with XE7.

Concerning the private fields, I replaced them in my code with the corresponding public properties of TScreen and it works.

If your compiler does not allow mixing asm and Delphi functions, make a pure asm function and return the pointer to TScreen.GetScreenMetrics from there. See Stackoverflow (https COLON SLASH SLASH stackoverflow DOT com/a/36765512) to get an idea how.

uso posted 1 month ago

Additionally, if you are using XE5 and do not have to be compatible with newer versions of Delphi (>= Berlin) you can also use class helpers to squeeze the GetScreenMetrics address out of TScreen and you can implement your own getters and setters for the mentioned private variables, too (in case side evects caused by the standard (g|s)etters arise).

tb posted 1 month ago

Many thanks for your hints.

See below a working fix for heidiSQL 5174 combining work of kostgr and uso. The fix is tested w/ DelphiXE5 32- and 64-bit output.

unit Vcl.FormsFix;

interface

implementation

uses
  System.SysUtils, Winapi.Windows, Vcl.Forms, Vcl.Graphics, System.UITypes
  //
  , DDetours
  //
  ;

var
  trampoline_GetMetricSettings: Procedure = nil;

type
  TFontHelper = class helper for TFont
  public
    function Equals(const AOther: TFont): Boolean;
  end;

function TFontHelper.Equals(const AOther: TFont): Boolean;
begin
  Result := (AOther.PixelsPerInch = self.PixelsPerInch)
    and (AOther.Charset = self.Charset)
    and (AOther.Color = self.Color)
    and (AOther.Height = self.Height)
    and (AOther.Name = self.Name)
    and (AOther.Orientation = self.Orientation)
    and (AOther.Pitch = self.Pitch)
    and (AOther.Size = self.Size)
    and (AOther.Style = self.Style)
    and (AOther.Quality = self.Quality);
end;

type
  TScreenHelper =  class Helper for TScreen
  public
    function getPtr_GetMetricSettings:Pointer;
  end;

function TScreenHelper.getPtr_GetMetricSettings:Pointer;
begin
  result:=@TScreen.GetMetricSettings;
end;

procedure HookedGetMetricSettings(const Self);

  procedure CheckedFontChange(const ACurrFont: TFont; const ANewFont: tagLOGFONTW);
  var
    TmpFont: TFont;
  begin
    TmpFont := TFont.Create;
    try
      TmpFont.Assign(ACurrFont);
      TmpFont.Handle := CreateFontIndirect(ANewFont);
      if not TmpFont.Equals(ACurrFont) then
      begin
        ACurrFont.Handle := CreateFontIndirect(ANewFont);
      end;
    finally
      FreeAndNil(TmpFont);
    end;
  end;

var
  LSize: Cardinal;
  LogFont: TLogFont;
  NonClientMetrics: TNonClientMetrics;
  SaveShowHint: Boolean;

begin
  SaveShowHint := False;
  if Assigned(Application) then SaveShowHint := Application.ShowHint;
  try
    if Assigned(Application) then Application.ShowHint := False;
{$IF DEFINED(CLR)}
    LSize := Marshal.SizeOf(TypeOf(TLogFont));
{$ELSE}
    LSize := SizeOf(TLogFont);
{$ENDIF}
    if SystemParametersInfo(SPI_GETICONTITLELOGFONT, LSize, {$IFNDEF CLR}@{$ENDIF}LogFont, 0) then
    begin
       CheckedFontChange(Screen.IconFont, LogFont);
    end
    else
      Screen.IconFont.Handle := GetStockObject(SYSTEM_FONT);
{$IF DEFINED(CLR)}
    LSize := Marshal.SizeOf(TypeOf(TNonClientMetrics));
{$ELSE}
    LSize := TNonClientMetrics.SizeOf;
{$ENDIF}
    NonClientMetrics.cbSize := LSize;
    if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, {$IFNDEF CLR}@{$ENDIF}NonClientMetrics, 0) then
    begin
      CheckedFontChange(Screen.HintFont, NonClientMetrics.lfStatusFont);
      CheckedFontChange(Screen.MenuFont, NonClientMetrics.lfMenuFont);
      CheckedFontChange(Screen.MessageFont, NonClientMetrics.lfMessageFont);
      CheckedFontChange(Screen.CaptionFont, NonClientMetrics.lfCaptionFont);
    end else
    begin
      Screen.HintFont.Size := 8;
      Screen.MenuFont.Handle := GetStockObject(SYSTEM_FONT);
      Screen.MessageFont.Handle := GetStockObject(SYSTEM_FONT);
      Screen.CaptionFont.Handle := GetStockObject(SYSTEM_FONT);
    end;
    Screen.HintFont.Color := clInfoText;
    Screen.MenuFont.Color := clMenuText;
    Screen.MessageFont.Color := clWindowText;
  finally
    if Assigned(Application) then Application.ShowHint := SaveShowHint;
  end;

end;

initialization
  @trampoline_GetMetricSettings := InterceptCreate(Screen.getPtr_GetMetricSettings, @HookedGetMetricSettings);

finalization
  InterceptRemove(@trampoline_GetMetricSettings);

end.
webdbase posted 4 weeks ago

Great work, guys! In case Ansgar does not implement the fix, could you please provide a link to the compiled executable?

ansgar posted 22 hours ago

I think I have that fix working here, including the Delphi Detours library. Only one harmless compiler warning remains.

However, I need to update HeidiSQL's AuthentiCode certificate, which has expired some weeks ago. Without a new one, the heidisql.exe updates don't get any certificate, which will bring up the dreaded security dialog on Win10 after downloading. Well, I got it from Certum previously, but that doesn't seem to work any longer, and their page is horrribly translated from Polish and non-working in many places. I managed to buy a certificate there, but I cannot activate it, for some reason. Waiting for response from Certum now, otherwise my 35€ will be gone.

cacofony posted 1 hour ago

Ksign are good

codesigning.ksoftware.net

Please login to leave a reply, or register at first.