Form verliert Focus beim zeigen eines zweiten Hints

[iskywalker]

http://groups.google.de/group/borlan...d5bbd819ad6b73

Hatte ich auch das problem, hier miniprojectcode:
program Project1;

uses
Forms,
Unit1 in 'Unit1.pas' {Form1},
Unit2 in 'Unit2.pas' {Form2};

{$R *.res}

begin
HintWindowClass :=Tmyhint;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.CreateForm(TForm2, Form2);

Application.Run;
end.

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
Tmyhint = class(THintWindow)
private
FActivating:boolean;
FLastActive:Cardinal;
public
procedure ActivateHint(Rect: TRect; const AHint: string); override;
end;

TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;


var
Form1: TForm1;

implementation

uses
Unit2;
{$R *.dfm}

procedure Tmyhint.ActivateHint(Rect: TRect; const AHint: string);
type
TAnimationStyle = (atSlideNeg, atSlidePos, atBlend);
const
AnimationStyle: array[TAnimationStyle] of Integer = (AW_VER_NEGATIVE,
AW_VER_POSITIVE, AW_BLEND);
var
Animate: BOOL;
Style: TAnimationStyle;
begin
FActivating := True;
try
Caption := AHint;
Inc(Rect.Bottom, 4);
UpdateBoundsRect(Rect);
if Rect.Top + Height > Screen.DesktopHeight then
Rect.Top := Screen.DesktopHeight - Height;
if Rect.Left + Width > Screen.DesktopWidth then
Rect.Left := Screen.DesktopWidth - Width;
if Rect.Left < Screen.DesktopLeft then Rect.Left := Screen.DesktopLeft;
if Rect.Bottom < Screen.DesktopTop then Rect.Bottom := Screen.DesktopTop;
SetWindowPos(Handle, HWND_TOPMOST, Rect.Left, Rect.Top, Width, Height,
SWP_NOACTIVATE);
if (GetTickCount - FLastActive > 250) and (Length(AHint) < 100) and
Assigned(AnimateWindowProc) then
begin
SystemParametersInfo(SPI_GETTOOLTIPANIMATION, 0, @Animate, 0);
if Animate then
begin
SystemParametersInfo(SPI_GETTOOLTIPFADE, 0, @Animate, 0);
if Animate then
Style := atBlend
else
if Mouse.CursorPos.Y > Rect.Top then
Style := atSlideNeg
else
Style := atSlidePos;
AnimateWindowProc(Handle, 100, AnimationStyle[Style] or AW_SLIDE);
end;
end;
ShowWindow(Handle, SW_SHOWNOACTIVATE);
Invalidate;
finally
FLastActive := GetTickCount;
FActivating := False;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
//application.createform(tform2,form2);
form2.Show;
end;

end.


unit Unit2;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm2 = class(TForm)
Label1: TLabel;
Button1: TButton;
private
procedure CreateParams(var Params : TCreateParams); override;
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;

var
Form2: TForm2;

implementation

{$R *.dfm}



procedure TForm2.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.ExStyle := Params.ExStyle or WS_EX_APPWINDOW;
Params.WndParent := GetDesktopWindow;
end;

end.