Delphi-PRAXiS - Delphi ActivateHint und CreateFont

Hi,

ich möchte mir bei einigen Controls die Hints selber zeichnen. Soweit funktionierts auch schon. Es stellen sich mir nur 2 Probleme.

1. Wenn ich mit der Maus das erst mal auf ein Control gehe, so wird mir in der Procedure ActivateHint beim ersten Mal gar keine Caption angezeigt, und beim zweiten Mal immer die Caption des Controls, auf dem ich unmittelbar davor gewesen bin. Es wird mir die richtige Caption immer nur angezeigt, wenn ich das gleich Control mit der Maus 2 mal hintereinander besuche.

Stört euch nicht an dem Aufbau, der ist hier eher experimentell.

2. Im Paint gebe ich Text auf dem Canvas über den DC mit DrawText aus. Ich möchte aber verschiedene Fontstyles verwenden. Was ich noch nicht verstanden habe, und was auch nicht funktioniert, wie weiß DrawText bzw. der DC welchen Font er jetzt verwenden soll?

Hier mal mein zusammengeschusterter Textcode:

Delphi-Quellcode:

			{ TdwHint }

procedure TdwHint.ActivateHint(Arect: TRect; const AHint: string);

var

  h: Integer;

  w: Integer;

  HeightHeaderFont, HeightFont: Integer;

  Header, Body: string;

begin

  ParseHintText(Caption, Header, Body);

  if Header<>'' then

  begin

    Canvas.Font.Style:=[fsBold];

    h:=Canvas.TextHeight(Header);

    w:=Canvas.TextWidth(Header);

    h:=h+5;

    Canvas.Font.Style:=[];

    h:=h+Canvas.TextHeight(Body);

    if Canvas.TextWidth(Body)>w then

      w:=Canvas.TextWidth(Body);

    h:=h+10;

    w:=w+10;

    Arect.Width:=w;

    Arect.Height:=h;

  end else begin

  end;

  inherited ActivateHint(Arect, AHint);

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;

  HeaderFont, BodyFont: HFONT;

  HeaderFontName, BodyFontName: PWideChar;

  Brush: HBRUSH;

  pen: HPEN;

  Header, Body: string;

begin

  DC:=Canvas.Handle;

  Rect:=ClientRect;

  Brush:=CreateSolidBrush(ColorToRGB(clLime));

  FillRect(DC, Rect, Brush);

  ParseHintText(Caption, Header, Body);

  HeaderRect:=Rect;

  Canvas.Font.Style:=[fsBold];

  HeaderRect.Height:=Canvas.TextHeight(Header);

  BodyRect:=Rect;

  BodyRect.Top:=HeaderRect.Top+HeaderRect.Height+5;

  Canvas.Font.Style:=[];

  if Header<>'' then

  begin

    Canvas.Font.Style:=[fsBold];

    HeaderFontName:='Courier New';

    HeaderFont:=CreateFont(0,0,0,0,FW_BOLD,0,0,0,ANSI_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH, HeaderFontName);

    DrawText(DC, PChar(Header), -1, HeaderRect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);

    Canvas.MoveTo(Rect.Left, Rect.Top+HeaderRect.Height+3);

    Canvas.LineTo(Rect.Right, Rect.Top+HeaderRect.Height+3);

    Canvas.Font.Style:=[];

    BodyFontName:='Courier New';

    BodyFont:=CreateFont(0,0,0,0,FW_NORMAL,0,0,0,ANSI_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH, HeaderFontName);

    DrawText(DC, PChar(Body), -1, BodyRect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);

    MoveToEx(DC, Rect.Left, Rect.Top+HeaderRect.Height+3, nil);

    LineTo(DC, Rect.Right, Rect.Top+HeaderRect.Height+3);

  end else begin

    Canvas.TextRect(Rect, 5, 5, Caption);

  end;

end;

procedure TdwHint.ParseHintText(HintText: string; var Header, Body: string);

begin

    if Pos('§', HintText)>0 then

    begin

      Header:=Copy(HintText, 1, Pos('§', HintText)-1);

      Body:=Copy(HintText, Pos('§', HintText)+1, Length(HintText));

    end else

    begin

      Header:='';

      Body:=HintText;

    end;

end;