THintWindow wird nur einmal angezeigt

[Captnemo]

Hi,

ich zeichne mir mein eigenen HintWindow:

Delphi-Quellcode:

{ TdwHint }

procedure TdwHint.ActivateHint(Arect: TRect; const AHint: string);
begin
  inherited ActivateHint(Arect, AHint);
end;

function TdwHint.CalcHintRect(MaxWidth: Integer; const AHint: string;
  AData: Pointer): TRect;
var
  h: Integer;
  w: Integer;
  HeightHeaderFont, HeightFont: Integer;
  Header, Body: string;
  BodyRect: TRect;
begin
  ParseHintText(AHint, Header, Body);
  if Header<>'' then
  begin
    Canvas.Font.Style:=[fsBold];
    h:=Canvas.TextHeight(Header);
    w:=Canvas.TextWidth(Header);
    h:=h+5;
    Canvas.Font.Style:=[];
    DrawText(Canvas.Handle, PChar(Body), Length(Body), BodyRect, DT_LEFT or DT_WORDBREAK or DT_CALCRECT);
    h:=h+BodyRect.Height;
    if BodyRect.Width>w then
      w:=BodyRect.Width;
    h:=h+10;
    w:=w+10;
    Result:=Rect(0, 0, w, h);
  end;
end;

procedure TdwHint.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style:=Params.Style - WS_BORDER;
  if (Win32Platform = VER_PLATFORM_WIN32_NT) and
     ((Win32MajorVersion > 5) or
     ((Win32MajorVersion = 5) and (Win32MinorVersion >=1))) then
     Params.WindowClass.style := Params.WindowClass.style or $00020000;
end;

procedure TdwHint.Paint;
var
  DC: HDC;
  Rect, HeaderRect, BodyRect: TRect;
  HeaderTextRect, BodyTextRect: TRect;
  HeaderFont, BodyFont: HFONT;
  HeaderFontName, BodyFontName: PWideChar;
  Brush: HBRUSH;
  pen: HPEN;
  Header, Body: string;
  fontheight: Integer;
begin
  DC:=Canvas.Handle;
  Rect:=ClientRect;
  Brush:=CreateSolidBrush(ColorToRGB(clInfoBk));
  FillRect(DC, Rect, Brush);
  ParseHintText(Caption, Header, Body);
  HeaderRect:=Rect;
  Canvas.Font.Style:=[fsBold];
  HeaderRect.Height:=Canvas.TextHeight(Header)+3;
  BodyRect:=Rect;
  BodyRect.Top:=HeaderRect.Top+HeaderRect.Height;
  Canvas.Font.Style:=[];
  HeaderTextRect:=HeaderRect;
  BodyTextRect:=BodyRect;
  HeaderTextRect.Top:=HeaderTextRect.Top+2;
  HeaderTextRect.Left:=HeaderTextRect.Left+2;
  BodyTextRect.Top:=BodyTextRect.Top+2;
  BodyTextRect.Left:=BodyTextRect.Left+2;
    fontheight:=-MulDiv(8, GetDeviceCaps(DC, LOGPIXELSY), 72);
  if Header<>'' then
  begin
    Brush:=CreateSolidBrush(ColorToRGB(clLime));
    FillRect(DC, HeaderRect, Brush);
    HeaderFontName:='Tahoma';
    HeaderFont:=CreateFont(fontheight,0,0,0,FW_BOLD,0,0,0,ANSI_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH, HeaderFontName);
    SelectObject(DC, HeaderFont);
    DrawText(DC, PChar(Header), -1, HeaderTextRect, DT_LEFT or DT_NOPREFIX);
    BodyFontName:='Tahoma';
    BodyFont:=CreateFont(fontheight,0,0,0,FW_NORMAL,0,0,0,ANSI_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH, HeaderFontName);
    SelectObject(DC, BodyFont);
    DrawText(DC, PChar(Body), -1, BodyTextRect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
    MoveToEx(DC, Rect.Left, Rect.Top+HeaderRect.Height, nil);
    LineTo(DC, Rect.Right, Rect.Top+HeaderRect.Height);
    DeleteObject(HeaderFont);
    DeleteObject(BodyFont);
  end else begin
    Canvas.TextRect(Rect, 5, 5, Caption);
  end;
end;

procedure TdwHint.ParseHintText(HintText: string; var Header, Body: string);
begin
    if Pos(LineFeed, HintText)>0 then
    begin
      Header:=Copy(HintText, 1, Pos(LineFeed , HintText)-2);
      Body:=Copy(HintText, Pos(LineFeed, HintText)+1, Length(HintText));
    end else
    begin
      Header:='';
      Body:=HintText;
    end;
end;

Vorher habe ich versucht in der Procedure ActivateHint das Rect für das Hint zu vergrößern, was nicht funktionierte.
Dann habe ich versucht das über CalcHintRect zu machen, was zum Erfolg führt.
Leider wird jetzt aber die Paint-Procedure nur noch einmal aufgerufen, und zwar beim ersten Hint, was angezeigt werden soll. Diese wird auch richtig angezeigt.
Soll aber ein zweites Hint oder das gleiche nochmal angezeigt werden, so wird zwar die Procedure CalcHintRect ausgeführt, nicht jedoch die Paint-Procedure.

Kann mir einer sagen warum das so ist?
Die Procedure ActivateHint wird jedes mal aufgerufen. Und mit inherited sollte das doch weiter gegeben werden.

[Captnemo]

Ich hab inzwischen herausgefunden, dass wenn ich die HintWindowClass auf
die Standardklasse setze

Delphi-Quellcode:

  HintWindowClass:=THintWindow;

und dann wieder auf meine eigene, wird wieder 1 Hint angezeigt. Aber nur eins. Das Spielchen kann ich beliebig oft wiederholen.
Hat denn keiner eine Idee?

[Captnemo]

Sorry, die Aussage stimmt nicht wirklich. Tatsächlich muß ich erst mit der Standardklasse ein Hint anzeigen lassen, bis es mit meiner Klasse wieder funktioniert.