inno-setup - TLabel 或 TNewStaticText - 在 Focus 上更改 .Font.Style,就像 Cursor 随 .Cursor 更改一样

标签 inno-setup onfocus tlabel

是否可以在焦点 TLabelTNewStaticText 上更改 .Font.Style,就像我们使用 时光标发生的那样。光标

最佳答案

Inno Setup 目前不支持跟踪鼠标悬停。但是,通过拦截控件的窗口过程,您可以自行跟踪。对于以下示例,您将需要 InnoCallback图书馆:

[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;

关于inno-setup - TLabel 或 TNewStaticText - 在 Focus 上更改 .Font.Style,就像 Cursor 随 .Cursor 更改一样,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/22968537/

相关文章:

inno-setup - Inno 安装程序 : Execute a Pascal function in [Run] section

mysql - 使用 inno setup 中的代码部分在 MySQL 中插入用户和密码

jQuery-:focus Triggering When Switching Windows/Tabs

javascript - 在焦点上显示数据列表的所有选项

delphi - 在Delphi中删除TLabel

inno-setup - Inno Setup - 显示 MsgBox 并单击 'OK' 返回上一页

inno-setup - Inno Setup 中的 #emit 指令有什么意义?

javascript - this.type ='password' 在 IE 中不起作用,但它在所有其他浏览器中都起作用

delphi - Delphi TLabel 标题中制表符的行为是否已定义?

delphi - 获取 MaxLen 参数以与 MinimizeName 一起使用