XP Themes in Delphi 2009 Add-in

[Slava Barouline]

Hi

I am trying to move to Delphi 2009 my exisitng Add-in written in Delphi
2006 - to support unicode.

There was a hack in Controls.pas to make Message boxes support XP Themes,
but I cannot make it work for Delphi 2009 though I do the same changes for
Delphi 2009 Controls.pas.

procedure TWinControl.CreateHandle;
var
I: Integer;

//new code
Buffer : array[0..MAX_PATH] of Char;
act : TActCTXA;
bContextActivated : boolean ;
m_hActCtx : THANDLE ;
Cookie : Pointer ;
err : integer;

begin
if FHandle = 0 then
begin

//new code
m_hActCtx:=0;
bContextActivated:=false;
//Windows XP and up
if (Win32Platform = VER_PLATFORM_WIN32_NT) and
((Win32MajorVersion > 5) or ((Win32MajorVersion = 5) and
(Win32MinorVersion >= 1)))
then begin
if GetModuleFileName(0, Buffer, SizeOf(Buffer)) > 0 then begin
//hosting exe (outlook.exe)
ZeroMemory(@act, SizeOf(act));
act.dwFlags := ACTCTX_FLAG_RESOURCE_NAME_VALID or
ACTCTX_FLAG_HMODULE_VALID;
act.lpResourceName := MAKEINTRESOURCE(2); //there must be a manifest
resource in the dll
act.cbSize := sizeof(act);
act.lpSource := Buffer;
act.hModule:=HInstance;
m_hActCtx := CreateActCtxA(act);
if (m_hActCtx <> 0) then begin
bContextActivated:=ActivateActCtx(m_hActCtx, Cookie);
if not bContextActivated then begin
err:=GetLastError;
if err = 0 then;
end;
end;
end;
end;
try

//old code
CreateWnd;
SetProp(FHandle, MakeIntAtom(ControlAtom), THandle(Self));
SetProp(FHandle, MakeIntAtom(WindowAtom), THandle(Self));
if Parent <> nil then
SetWindowPos(FHandle, Parent.PrecedingWindow(Self), 0, 0, 0, 0,
SWP_NOMOVE + SWP_NOSIZE + SWP_NOACTIVATE);
for I := 0 to ControlCount - 1 do
Controls.UpdateAnchorRules;
//end old code

finally
if bContextActivated then DeactivateActCtx(0, Cookie);
if m_hActCtx <> 0 then ReleaseActCtx(m_hActCtx);
end;
end;
end;

I was wondering if somebody already has done it.

I would appretiate some help here.

Thanks

 

[Slava Barouline]

I have done a similar hack in Controls.pas and it works OK with message
boxes

procedure TWinControl.CreateHandle;
var
I: Integer;
//
Buffer : array[0..MAX_PATH] of Char;
act : TActCTXA;
bContextActivated : boolean ;
m_hActCtx : THANDLE ;
Cookie : Pointer ;
err : integer;
begin
if WindowHandle = 0 then
begin
//
m_hActCtx:=0;
bContextActivated:=false;
//Windows XP and up
if (Win32Platform = VER_PLATFORM_WIN32_NT) and
((Win32MajorVersion > 5) or ((Win32MajorVersion = 5) and
(Win32MinorVersion >= 1)))
then begin
if GetModuleFileName(0, Buffer, SizeOf(Buffer)) > 0 then begin
//hosting exe (outlook.exe)
ZeroMemory(@act, SizeOf(act));
act.dwFlags := ACTCTX_FLAG_RESOURCE_NAME_VALID or
ACTCTX_FLAG_HMODULE_VALID;
act.lpResourceName := PAnsiChar(AnsiChar(MAKEINTRESOURCE(2)));
//there must be a manifest resource in the dll
act.cbSize := sizeof(act);
act.lpSource := PAnsiChar(AnsiString(Buffer));
act.hModule:=HInstance;
m_hActCtx := CreateActCtxA(act);
if (m_hActCtx <> 0) then begin
bContextActivated:=ActivateActCtx(m_hActCtx, Cookie);
if not bContextActivated then begin
err:=GetLastError;
if err = 0 then;
end;
end;
end;
end;
try
//old code

CreateWnd;
{$IF NOT DEFINED(CLR)}
SetProp(FHandle, MakeIntAtom(ControlAtom), THandle(Self));
SetProp(FHandle, MakeIntAtom(WindowAtom), THandle(Self));
{$IFEND}
if Parent <> nil then
SetWindowPos(WindowHandle, Parent.PrecedingWindow(Self), 0, 0, 0, 0,
SWP_NOMOVE + SWP_NOSIZE + SWP_NOACTIVATE);
for I := 0 to ControlCount - 1 do
Controls.UpdateAnchorRules;

//end old code
finally
if bContextActivated then DeactivateActCtx(0, Cookie);
if m_hActCtx <> 0 then ReleaseActCtx(m_hActCtx);
end;

end;
end;