AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Multimedia Delphi THintWindow wird nur einmal angezeigt
Thema durchsuchen
Ansicht
Themen-Optionen

THintWindow wird nur einmal angezeigt

Ein Thema von Captnemo · begonnen am 16. Okt 2014 · letzter Beitrag vom 16. Okt 2014
Antwort Antwort
Benutzerbild von Captnemo
Captnemo

Registriert seit: 27. Jan 2003
Ort: Bodenwerder
1.126 Beiträge
 
Delphi XE4 Architect
 
#1

THintWindow wird nur einmal angezeigt

  Alt 16. Okt 2014, 07:10
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.
Dieter
9 von 10 Stimmen in meinem Kopf sagen ich bin nicht verrückt. Die 10. summt dazu die Melodie von Supermario Bros.
MfG Captnemo
  Mit Zitat antworten Zitat
Benutzerbild von Captnemo
Captnemo

Registriert seit: 27. Jan 2003
Ort: Bodenwerder
1.126 Beiträge
 
Delphi XE4 Architect
 
#2

AW: THintWindow wird nur einmal angezeigt

  Alt 16. Okt 2014, 08:38
Ich hab inzwischen herausgefunden, dass wenn ich die HintWindowClass auf
die Standardklasse setze
  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?
Dieter
9 von 10 Stimmen in meinem Kopf sagen ich bin nicht verrückt. Die 10. summt dazu die Melodie von Supermario Bros.
MfG Captnemo
  Mit Zitat antworten Zitat
Benutzerbild von Captnemo
Captnemo

Registriert seit: 27. Jan 2003
Ort: Bodenwerder
1.126 Beiträge
 
Delphi XE4 Architect
 
#3

AW: THintWindow wird nur einmal angezeigt

  Alt 16. Okt 2014, 08:42
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.
Dieter
9 von 10 Stimmen in meinem Kopf sagen ich bin nicht verrückt. Die 10. summt dazu die Melodie von Supermario Bros.
MfG Captnemo
  Mit Zitat antworten Zitat
Antwort Antwort


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 01:26 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz