Запретить нажатие на эту кнопку можно вот таким кодом:
| Код |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
protected
procedure OnWMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.OnWMNCHitTest(var Msg: TWMNCHitTest);
begin
inherited;
if Msg.Result = HTHELP then
Msg.Result := HTBORDER;
end;
end.
|
Но кнопка будет выглядеть активной (Hint отсутствует). Стандартных средств для того, чтобы сделать ее неактивной, увы, нет. Но нарисовать все же можно. В Windows есть возможность нарисовать эту кнопку (в Disabled режиме) встроенными средствами при включенных темах, например, таким кодом:
| Код |
uses UxTheme;
...
procedure TForm1.Button1Click(Sender: TObject);
var
Theme: HTHEME;
begin
Theme := OpenThemeData(Handle, 'WINDOW');
try
DrawThemeBackground(Theme, Canvas.Handle, WP_HELPBUTTON,
HBS_DISABLED, Rect(0, 0, 21, 21), NIL);
finally
CloseThemeData(Theme);
end;
end;
|
Далее следует учесть несколько вещей:- Window Manager (именно он рисует заголовок) недокументирован, и в каждой версии Windows может быть реализован через различные функции по отрисовке (см.ниже);
- В Win9x (нет Theme API) и 2000-XP (Vista) при классической теме эффекта Disabled не будет, потому что HBS_DISABLED как таковой смысла иметь не будет;
- В Windows XP и Windows Vista заголовок при включенных темах рисуется различными функциями.
Для учебных целей привожу пример для Windows XP, через сплайсинг функции DrawThemeBackground:
| Код |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, UxTheme, Themes, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
protected
procedure OnWMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
private
{ Private declarations }
public
{ Public declarations }
end;
TFarJmp = packed record
PuhsOp: Byte;
PushArg: Pointer;
RetOp: Byte;
end;
TOldCode = packed record
One: Cardinal;
Two: Word;
end;
var
Form1: TForm1;
JmpDTB: TFarJmp;
OldDTB: TOldCode;
DTBAddr: Pointer = NIL;
implementation
{$R *.dfm}
function TrueDrawThemeBackground(hTheme: HTHEME; hdc: HDC; iPartId,
iStateId: Integer; const pRect: TRect; pClipRect: PRECT): HRESULT; stdcall;
begin
WriteProcessMemory(INVALID_HANDLE_VALUE, DTBAddr,
@OldDTB, SizeOf(TOldCode), PDWORD(NIL)^);
Result := DrawThemeBackground(hTheme, hdc, iPartId,
iStateId, pRect, pClipRect);
WriteProcessMemory(INVALID_HANDLE_VALUE, DTBAddr,
@JmpDTB, SizeOf(TFarJmp), PDWORD(NIL)^);
end;
function NewDrawThemeBackground(hTheme: HTHEME; hdc: HDC; iPartId,
iStateId: Integer; const pRect: TRect; pClipRect: PRECT): HRESULT; stdcall;
begin
if iPartId = WP_HELPBUTTON then
iStateId := HBS_DISABLED;
Result := TrueDrawThemeBackground(hTheme, hdc, iPartId,
iStateId, pRect, pClipRect);
end;
procedure TForm1.FormCreate(Sender: TObject);
var
Module: DWORD;
begin
BorderStyle := bsDialog;
BorderIcons := BorderIcons + [biHelp];
if InitThemeLibrary then
begin
Module := GetModuleHandle('uxtheme.dll');
DTBAddr := GetProcAddress(Module, 'DrawThemeBackground');
ReadProcessMemory(INVALID_HANDLE_VALUE, DTBAddr,
@OldDTB, SizeOf(TOldCode), PDWORD(NIL)^);
JmpDTB.PuhsOp := $68;
JmpDTB.PushArg := @NewDrawThemeBackground;
JmpDTB.RetOp := $C3;
WriteProcessMemory(INVALID_HANDLE_VALUE, DTBAddr, @JmpDTB,
SizeOf(TFarJmp), PDWORD(NIL)^);
end;
end;
procedure TForm1.OnWMNCHitTest(var Msg: TWMNCHitTest);
begin
inherited;
if Msg.Result = HTHELP then
Msg.Result := HTBORDER;
end;
end.
|
В аттаче прикрепил пример |