返回列表 回复 发帖

Inno Setup Message 插件 WinMsgCtrl


                                                                                                       


引用来自  test.iss,2008-10-27 0:42:57
; -- test.iss --
; restools
; http://restools.hanzify.org
; WinMsgCtrl.dll 为一个用于Inno Setup的 5.5 KB 的 Windows 消息获取插件。
; 以下例子是演示如何处理安装程序的 Windows Message。
; 这里的例子只是示范了 Mouse Message, 你同样可以处理诸如 keyboard Message etc.
; 需要插件: InnoCallback.dll, 大小: 63.5KB 原插件地址: www.sherlocksoftware.org

[Setup]
AppName=MyApp
AppVerName=MyApp Ver 1.0
DefaultDirName={pf}\MyApp
DefaultGroupName=MyApp
Compression=lzma

[Components]
Name: "Basque"; Description: "Basque"; Types: full compact custom; Flags: fixed
Name: "BrazilianPortuguese"; Description: "BrazilianPortuguese"; Types: full
Name: "Catalan"; Description: "Catalan"; Types: full compact
Name: "Czech"; Description: "Czech"; Types: full
Name: "Danish"; Description: "Danish"; Types: full
Name: "Dutch"; Description: "Dutch"; Types: full
Name: "Finnish"; Description: "Finnish"; Types: full
Name: "French"; Description: "French"; Types: full
Name: "German"; Description: "German"; Types: full
Name: "Hebrew"; Description: "Hebrew"; Types: full
Name: "Hungarian"; Description: "Hungarian"; Types: full
Name: "Italian"; Description: "Italian"; Types: full
Name: "Norwegian"; Description: "Norwegian"; Types: full
Name: "Polish"; Description: "Polish"; Types: full
Name: "Portuguese"; Description: "Portuguese"; Types: full
Name: "Russian"; Description: "Russian"; Types: full
Name: "Slovak"; Description: "Slovak"; Types: full
Name: "Slovenian"; Description: "Slovenian"; Types: full
Name: "Spanish"; Description: "Spanish"; Types: full

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

[code]
const
  
LB_GETTOPINDEX = $018E;
  LB_GETITEMRECT = $0198;
  WH_MOUSE = 7;

type
  
TMouseHook = record
   
pt: TPoint;
    hwnd: HWND;
    wHitTestCode: UINT;
    dwExtraInfo: DWORD;
  end;

// 回调函数参数格式声明
//TMessageProc = procedure(nCode: LongWord; wParam: LongWord; lParam: LongWord);
  
TMouseMsgProc = procedure(nCode: LongWord; wParam: LongWord; lParam: TMouseHook);

// 使用回调函数的主要入口转换函数.
function WrapMessageProc(Callback: TMouseMsgProc; ParamCount: Integer): LongWord; external 'wrapcallback@files:innocallback.dll stdcall';

// 接收 WizardForm 的 Window Message
function HookWinMessage(Callback, idHook: LongWord): Boolean; external 'hookwinmessage@files:winmsgctrl.dll stdcall';
// idHook: LongWord
//    WH_JOURNALRECORD    0
//    WH_JOURNALPLAYBACK  1
//    WH_KEYBOARD         2
//    WH_GETMESSAGE       3
//    WH_CALLWNDPROC      4
//    WH_CBT              5
//    WH_SYSMSGFILTER     6
//    WH_MOUSE            7
//    WH_HARDWARE         8
//    WH_DEBUG            9
//    WH_SHELL           10
//    WH_FOREGROUNDIDLE  11
//    WH_CALLWNDPROCRET  12
function UnHookWinMessage(): Boolean; external 'unhookwinmessage@files:winmsgctrl.dll stdcall';

function ScreenToClient(hWnd: HWND; var lpPoint: TPoint): BOOL; external 'ScreenToClient@user32.dll stdcall';

//以一个相当弯曲的方法来调用 API 函数。
//functionSendMessage(const Wnd: HWND; const Msg, WParam, LParam: Longint):Longint; external 'SendMessageA@user32.dll stdcall';
function GetListItemRect(const Wnd: HWND; const Msg, WParam: Longint; var LParam: TRect): Longint; external 'SendMessageA@user32.dll stdcall';

var
  
Old_Desc: String;
  HandleMark: Boolean;
  
function MyPtInRect(const lprc: TRect; pt: TPoint): BOOL;
begin
  
Result := (pt.x >= lprc.Left) and (pt.x <= lprc.Right) and (pt.y >= lprc.Top) and (pt.y <= lprc.Bottom);
end;
  
procedure MyMessageProc(nCode: LongWord; wParam: LongWord; lParam: TMouseHook);
var
  
TopIndex, ItemCount, CurIndex: Integer;
  ItemRect: TRect;
  MPpt: TPoint;
  s: String;
begin
  if
HandleMark then exit;
  if nCode >= 0 then
  try
   
HandleMark := True;
    if lParam.hwnd = WizardForm.ComponentsList.Handle then
    begin
      TopIndex := SendMessage(WizardForm.ComponentsList.Handle, LB_GETTOPINDEX, 0, 0);
      ItemCount := WizardForm.ComponentsList.Items.Count;
      CurIndex := TopIndex;
      while CurIndex < ItemCount do
      begin
        
GetListItemRect(WizardForm.ComponentsList.Handle, LB_GETITEMRECT, CurIndex, ItemRect);
        MPpt := lParam.pt;
        ScreenToClient(WizardForm.ComponentsList.Handle, MPpt);
        if MyPtInRect(ItemRect, MPpt) then
        begin
         
s := 'Current Component Caption: ' + WizardForm.ComponentsList.ItemCaption[CurIndex];
          if Old_Desc <> s  then
          begin
            
WizardForm.ComponentsDiskSpaceLabel.Caption := s;
            Old_Desc := s;
            WizardForm.ComponentsDiskSpaceLabel.Enabled := True;
          end;
          exit;
        end;
        CurIndex := CurIndex + 1;
      end;
    end
   
s := 'Position your mouse over a component to see its description.';
    if Old_Desc <> s then
    begin
      
WizardForm.ComponentsDiskSpaceLabel.Caption := s;
      Old_Desc := s;
      WizardForm.ComponentsDiskSpaceLabel.Enabled := False;
    end;
  finally
   
HandleMark := False;
  end;
end;

procedure CurPageChanged(CurPageID: Integer);
var
  
MessageCallback: LongWord;
begin
  if
CurPageID = wpSelectComponents then
  begin
   
HandleMark := False;
    MessageCallback := WrapMessageProc(@MyMessageProc, 3);
    HookWinMessage(MessageCallback, WH_MOUSE);
  end else
  begin
   
UnHookWinMessage();
  end;
end;

procedure DeinitializeSetup();
begin
  
UnHookWinMessage();
end;



点击下面连接下载例子。
http://restools.hanzify.org/inno/winmsgctrl/InnoMsgCtrl.zip
附件: 您所在的用户组无法下载或查看附件
欢迎光临 我的百度空间

请将已得到答案的帖子改为 【已解决】 分类!!!

谢谢合作!
返回列表