Re: ToolTip von Control wieder entfernen - Wie?

Hallo NineBerry

erst einmal Danke für den Hinweis.

NineBerry Schwarz schrieb:
Es würde sich anbieten, diese Funktionalität in einer Klasse zu kapseln.
Das hat mich richtig nervös gemacht. Ich habe heute meine erste eigene Klasse außerhalb einer Form entwickelt. Der Code ist unten zum nachschauen, ob das sinnvoll ist was ich gemacht habe.

Nun würde mich interessieren wie man es am besten macht die kreierte Instanz zu merken und später abzuprüfen, ob für dieses Control bereits ein ToolTip erzeugt wurde. Ein Array of TWinControl? oder besser ein Array of Object oder was ganz anderes?
Was ist hier die einfachste und beste Vorgehensweise. Und wie findet man dann seine Instanzen wieder?

Die DestroyWindow Methode muß ich noch machen. Ich denke die kann ich erst machen wenn ich das Merkerproblem gelöst habe. Denn erst dann stehen mir ja die kreierten Handles zur Verfügung.

Danke nochmal

Und hier der SourceCode der Klasse. Bitte Anregungen und Fehler und Verbesserungen so beschreiben das ein Klassenentwicklerneuling diese auch verstehen kann.

unit ToolTip;

interface

uses Windows, Messages, Graphics, CommCtrl, Controls, Classes;
const
TTS_BALLOON = $40;
TTM_SETTITLE = (WM_USER + 32);

OhneIcon = $00;
HinweisIcon = $01;
AchtungIcon = $02;
FehlerIcon = $03;

type
TOOLINFO = packed record
cbSize: Integer;
uFlags: Integer;
hwnd: THandle;
uId: Integer;
rect: TRect;
hinst: THandle;
lpszText: PWideChar;
lParam: Integer;
end;

TToolTip = class
private
FBackgroundColor : TColor;
FTextColor : TColor;
FIcon : Integer;
FText : PWideChar;
FTitle : PChar;
FToolTipHandle: THandle;
FOwnerControlHandle : THandle;
FToolInfo: TOOLINFO;
FShowToolTip : Boolean;
procedure SetBackGroundColor(Color: TColor);
procedure SetTextColor(Color: TColor);
procedure SetIcon(Icon: Integer);
function GetText: String;
procedure SetText(Text: String);
procedure SetTitle(Title: String);
function GetTitle: String;
published
constructor Create(AOwner: TWinControl);
procedure ShowBalloonTip;

property Titel : String read GetTitle write SetTitle;
property Text : String read GetText write SetText;
property TextColor : TColor read FTextColor write SetTextColor;
property BackGroundColor : TColor read FBackGroundColor write SetBackGroundColor;
property Icon : Integer read FIcon write SetIcon;
end;

implementation

constructor TToolTip.Create(AOwner: TWinControl);
begin
inherited create;
SetBackGroundColor(clWhite);
SetTextColor(clBlack);
SetIcon(OhneIcon);
FOwnerControlHandle := AOwner.Handle;
FToolTipHandle := 0;
end;

procedure TToolTip.SetBackGroundColor(Color: TColor);
begin
FBackGroundColor := Color;
end;

procedure TToolTip.SetTextColor(Color: TColor);
begin
FTextColor := Color;
end;

procedure TToolTip.SetIcon(Icon: Integer);
begin
FIcon := Icon;
end;

function TToolTip.GetText: String;
begin
Result := AnsiString(FText);
end;

procedure TToolTip.SetText(Text: string);
begin
FText := PWideChar(Text);
end;

function TToolTip.GetTitle: String;
begin
Result := AnsiString(FTitle);
end;
procedure TToolTip.SetTitle(Title: string);
begin
FTitle := PChar(Title);
end;

procedure TToolTip.ShowBalloonTip;
Var lNewToolTip: Boolean;
begin
lNewToolTip := False;
If FToolTipHandle = 0 then
begin
FToolTipHandle := CreateWindow(TOOLTIPS_CLASS, nil, WS_POPUP or TTS_NOPREFIX or TTS_BALLOON or TTS_ALWAYSTIP,
0, 0, 0, 0, FOwnerControlHandle, 0, HInstance, nil);
lNewToolTip := True;
end;
If FToolTipHandle <> 0 then
begin
SetWindowPos(FToolTipHandle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
FToolInfo.cbSize := SizeOf(FToolinfo);
FToolInfo.uFlags := TTF_CENTERTIP or TTF_TRANSPARENT or TTF_SUBCLASS;
FToolInfo.hwnd := FOwnerControlHandle;
FToolInfo.lpszText := FText;
Windows.GetClientRect(FOwnerControlHandle, FToolinfo.rect);
SendMessage(FToolTipHandle, TTM_SETTIPBKCOLOR, FBackgroundColor, 0);
SendMessage(FToolTipHandle, TTM_SETTIPTEXTCOLOR, FTextColor, 0);
If lNewToolTip then
SendMessage(FToolTipHandle, TTM_ADDTOOL, 0, Integer(@FToolinfo));
SendMessage(FToolTipHandle, TTM_SETTITLE, FIcon mod 4, Integer(FTitle));
end;
end;

end.

Klaus Dewald
.

Relevant Pages

  • Re: Detecting a page break when filling a table
    ... Dim CntryName As String ... Dim OldCntryName As String ... Dim J'As Integer ...
    (microsoft.public.office.developer.vba)
  • Re: Datei binär einlesen
    ... >> Sub ReadETBFile(ByVal sFilename As String) As String ... >> Dim ff As Integer, ... Rechner speichern Daten in hexadezimaler ...
    (microsoft.public.de.vb)
  • Re: Ini Funktion fehlerhaft?
    ... Was ein bissl merkwürdig aussieht, ist, daß der Buffer mit MAX_ENTRY als Array Obergrenze angelegt wird. ... Private Declare Auto Function GetPrivateProfileSectionNames Lib "kernel32" (ByVal lpszReturnBuffer As IntPtr, ... ByVal nSize As Integer, _ ... Public Function GetSectionNames(ByVal iniFilename As String) As IEnumerable ...
    (microsoft.public.de.german.entwickler.dotnet.vb)
  • Datei binär einlesen
    ... Sub ReadETBFile(ByVal sFilename As String) As String ... Dim ff As Integer, bChar As Byte ... Die Rufnummer ist im Klartext in den Hexwerten vorhanden und zwar so, ...
    (microsoft.public.de.vb)
  • Re: String to TColor
    ... string to TColor. ... - Get separate R, G, and B values (Unit Windows) ... Function GetBValue(rgb: DWORD): Byte; ...
    (borland.public.delphi.language.objectpascal)