3

Is it possible to change .Font.Style on Focus TLabel or TNewStaticText like it happens with cursor when we use .Cursor?

RobeN
  • 5,346
  • 1
  • 33
  • 50

2 Answers2

2

There is no built-in support to track mouse hovering in Inno Setup at this time. However, by intercepting window procedure of the controls you can track this by yourself. For the following example you will need the InnoCallback library:

[Setup]
AppName=My Program
AppVersion=1.5
DefaultDirName={pf}\My Program
OutputDir=userdocs:Inno Setup Examples Output

[Files]
Source: "InnoCallback.dll"; DestDir: "{tmp}"; Flags: dontcopy

[Code]
#ifdef UNICODE
  #define AW "W"
#else
  #define AW "A"
#endif
const
  GWL_WNDPROC = -4;
  WM_MOUSEMOVE = $0200;

type
  WPARAM = UINT_PTR;
  LPARAM = LongInt;
  LRESULT = LongInt;
  TWindowProc = function(hwnd: HWND; uMsg: UINT; wParam: WPARAM; 
    lParam: LPARAM): LRESULT;

function SetCapture(hWnd: HWND): HWND;
  external 'SetCapture@user32.dll stdcall';
function ReleaseCapture: BOOL;
  external 'ReleaseCapture@user32.dll stdcall';
function GetMessagePos: DWORD;
  external 'GetMessagePos@user32.dll stdcall';
function GetWindowRect(hWnd: HWND; out lpRect: TRect): BOOL;
  external 'GetWindowRect@user32.dll stdcall';
function CallWindowProc(lpPrevWndFunc: LongInt; hWnd: HWND; Msg: UINT; 
  wParam: WPARAM; lParam: LPARAM): LRESULT;
  external 'CallWindowProc{#AW}@user32.dll stdcall';
function SetWindowLong(hWnd: HWND; nIndex: Integer; 
  dwNewLong: LongInt): LongInt;
  external 'SetWindowLong{#AW}@user32.dll stdcall';

function WrapWindowProc(Callback: TWindowProc; ParamCount: Integer): LongWord;
  external 'wrapcallback@files:InnoCallback.dll stdcall';

type
  TControlRec = record
    Hovered: Boolean;     // hovering state
    WndProc: LongInt;     // original window proc
    Control: TWinControl; // control instance
  end;

var
  StaticText1: TNewStaticText;
  StaticText2: TNewStaticText;
  ControlList: array of TControlRec;

// helper function for finding control by handle
function GetControlRec(Handle: HWND): TControlRec;
var
  I: Integer;
begin
  for I := 0 to High(ControlList) do
    if ControlList[I].Control.Handle = Handle then
    begin
      Result := ControlList[I];
      Exit;
    end;
end;

// function which attaches the intercepting window procedure to the control
// and creates and adds the control record to the control list
procedure AttachWndProc(Control: TWinControl; WindowProc: TWindowProc);
begin
  SetArrayLength(ControlList, GetArrayLength(ControlList) + 1);
  ControlList[High(ControlList)].Hovered := False;
  ControlList[High(ControlList)].Control := Control;
  ControlList[High(ControlList)].WndProc := SetWindowLong(Control.Handle,
    GWL_WNDPROC, WrapWindowProc(WindowProc, 4));
end;

// function to restore windows procedures to all controls in the list
procedure RestoreWndProcs;
var
  I: Integer;
begin
  for I := 0 to High(ControlList) do
    SetWindowLong(ControlList[I].Control.Handle, GWL_WNDPROC, ControlList[I].WndProc);
end;

// helper function to create a TPoint structure from the result of GetMessagePos
// function call
function MakePoint(Value: DWORD): TPoint;
begin
  Result.X := Value and $FFFF;
  Result.Y := Value shr 16;
end;

// helper function which substitutes PtInRect Windows API function which I wasn't
// able to import for some reason
function PointInRect(const Rect: TRect; const Point: TPoint): Boolean;
begin
  Result := (Point.X >= Rect.Left) and (Point.X <= Rect.Right) and
    (Point.Y >= Rect.Top) and (Point.Y <= Rect.Bottom);
end;

// interceptor window procedure
function StaticTextWndProc(hwnd: HWND; uMsg: UINT; wParam: WPARAM; 
  lParam: LPARAM): LRESULT;
var
  P: TPoint;
  R: TRect;
  ControlRec: TControlRec;
begin
  // get control record
  ControlRec := GetControlRec(hwnd);
  // if the cursor moves, then...
  if uMsg = WM_MOUSEMOVE then
  begin
    // set mouse capture for this control to be notified by the WM_MOUSEMOVE even if
    // we leave the control
    SetCapture(ControlRec.Control.Handle);
    // get the current cursor position and control rectangle (both screen relative)
    P := MakePoint(GetMessagePos);
    GetWindowRect(ControlRec.Control.Handle, R);
    // check if the cursor is inside the control; if yes, then...
    if PointInRect(R, P) then
    begin
      // if the hovering flag was not yet set, it means we just entered the control
      // with the mouse, so let's change the style and remember the hovering state
      if not ControlRec.Hovered then
      begin
        if ControlRec.Control is TNewStaticText then
          TNewStaticText(ControlRec.Control).Font.Style := [fsBold];
        ControlRec.Hovered := True;
      end;
    end
    else
    begin
      // the cursor is not over the control, so let's release the mouse capture, set
      // the style and remember the hovering state
      ReleaseCapture;
      if ControlRec.Control is TNewStaticText then
        TNewStaticText(ControlRec.Control).Font.Style := [];
      ControlRec.Hovered := False;
    end;
  end;
  // call the original window procedure
  Result := CallWindowProc(ControlRec.WndProc, hwnd, uMsg, wParam, lParam);
end;

procedure InitializeWizard;
begin
  StaticText1 := TNewStaticText.Create(WizardForm);
  StaticText1.Parent := WizardForm;
  StaticText1.Left := 12;
  StaticText1.Top := 336;
  StaticText1.Caption := 'Hello';

  StaticText2 := TNewStaticText.Create(WizardForm);
  StaticText2.Parent := WizardForm;
  StaticText2.Left := 43;
  StaticText2.Top := 336;
  StaticText2.Caption := 'world!';

  AttachWndProc(StaticText1, @StaticTextWndProc);
  AttachWndProc(StaticText2, @StaticTextWndProc);
end;

procedure DeinitializeSetup;
begin
  RestoreWndProcs;
end;
TLama
  • 75,147
  • 17
  • 214
  • 392
  • This is exactly what I wanted to achieve and I did expect that it would not be a simple function :-) Thanks! – RobeN Apr 09 '14 at 19:35
  • is it possible to attach such function to `TBitmapImage`? – RobeN Apr 14 '14 at 09:36
  • 1
    No, because the `TBitmapImage` is a `TGraphicControl` descendant which has no message pump since it is not a window control (has no `Handle` and window proc). The `AttachWndProc` method in this script allows you to pass only controls that are capable to do that, the `TWinControl` descendants. The rest is rejected by the script compiler. – TLama Apr 14 '14 at 10:35
1

for me the following command: High(ControlList) giving me the following error: Unknown identifier "High", I believe that High it's only available for Unicode Inno?? ( Correct me if I'm wrong :-). )

I made it work , by replacing the High(ControlList) with GetArrayLength(ControlList)-1.

BeGiN
  • 363
  • 3
  • 14
  • Yes, I'm dealing always with Unicode Inno Setup. There's no sensible reason to use ANSI one in 2014 ;) – TLama Apr 15 '14 at 08:52