git-svn-id: https://svn.code.sf.net/p/kolmck/code@86 91bb2d04-0c0c-4d2d-88a5-bbb6f4c1fa07
This commit is contained in:
dkolmck
437
KOLMHTooltip_implem.inc
Normal file
437
KOLMHTooltip_implem.inc
Normal file
@ -0,0 +1,437 @@
|
||||
// part of KOLMHToolTip -- interface_part.
|
||||
// Moved to separate inc-file still Delphi20XX does not allow compile
|
||||
// in DEBUG mode.
|
||||
|
||||
const
|
||||
Dummy1 = 1;
|
||||
|
||||
TTDT_AUTOMATIC = 0;
|
||||
TTDT_RESHOW = 1;
|
||||
TTDT_AUTOPOP = 2;
|
||||
TTDT_INITIAL = 3;
|
||||
|
||||
function NewMHToolTip(AParent: PControl): PMHToolTip;
|
||||
const
|
||||
CS_DROPSHADOW = $00020000;
|
||||
begin
|
||||
DoInitCommonControls(ICC_BAR_CLASSES);
|
||||
New(Result, Create);
|
||||
|
||||
Result.fHandle := CreateWindowEx(WS_EX_TOPMOST, TOOLTIPS_CLASS, '', 0, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, AParent.GetWindowHandle, 0, HInstance, nil);
|
||||
end;
|
||||
|
||||
function TMHToolTip.GetDelay(const Index: Integer): Integer;
|
||||
begin
|
||||
Result := SendMessage(fHandle, TTM_GETDELAYTIME, Index, 0);
|
||||
end;
|
||||
|
||||
|
||||
procedure TMHToolTip.SetDelay(const Index, Value: Integer);
|
||||
begin
|
||||
SendMessage(handle, TTM_SETDELAYTIME, Index, MAKELONG(Value, 0));
|
||||
end;
|
||||
|
||||
|
||||
function TMHToolTip.GetColor(const Index: Integer): TColor;
|
||||
begin
|
||||
Result := SendMessage(handle, TTM_GETTIPBKCOLOR + Index, 0, 0);
|
||||
end;
|
||||
|
||||
procedure TMHToolTip.SetColor(const Index: Integer; const Value: TColor);
|
||||
begin
|
||||
SendMessage(handle, TTM_SETTIPBKCOLOR + Index, Value, 0);
|
||||
end;
|
||||
|
||||
function TMHToolTip.GetMaxWidth: Integer;
|
||||
begin
|
||||
Result := SendMessage(fHandle, TTM_GETMAXTIPWIDTH, 0, 0);
|
||||
end;
|
||||
|
||||
procedure TMHToolTip.SetMaxWidth(const Value: Integer);
|
||||
begin
|
||||
SendMessage(fHandle, TTM_SETMAXTIPWIDTH, 0, Value);
|
||||
end;
|
||||
|
||||
function TMHToolTip.GetMargin: TRect;
|
||||
begin
|
||||
SendMessage(fHandle, TTM_GETMARGIN, 0, DWord(@Result));
|
||||
end;
|
||||
|
||||
procedure TMHToolTip.SetMargin(const Value: TRect);
|
||||
begin
|
||||
SendMessage(fHandle, TTM_SETMARGIN, 0, DWord(@Value));
|
||||
end;
|
||||
|
||||
function TMHToolTip.GetActivate: Boolean;
|
||||
begin
|
||||
// ??????
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
procedure TMHToolTip.SetActivate(const Value: Boolean);
|
||||
begin
|
||||
SendMessage(fHandle, TTM_ACTIVATE, DWord(Value), 0);
|
||||
end;
|
||||
|
||||
procedure TMHToolTip.Pop;
|
||||
begin
|
||||
SendMessage(fHandle, TTM_POP, 0, 0);
|
||||
end;
|
||||
|
||||
procedure TMHToolTip.Popup;
|
||||
begin
|
||||
SendMessage(fHandle, $0422 {TTM_POPUP}, 0, 0);
|
||||
end;
|
||||
|
||||
procedure TMHToolTip.Update;
|
||||
begin
|
||||
inherited; // ???
|
||||
SendMessage(fHandle, TTM_UPDATE, 0, 0);
|
||||
end;
|
||||
|
||||
function NewHint(A: PControl): PMHHint;
|
||||
begin
|
||||
New(Result, Create);
|
||||
|
||||
with Result^ do
|
||||
begin
|
||||
Parent := A;
|
||||
ToolTip := nil; // ???
|
||||
HasTool := False; // ???
|
||||
end;
|
||||
A.Add2AutoFree(Result);
|
||||
end;
|
||||
|
||||
function NewManager: PMHToolTipManager;
|
||||
begin
|
||||
New(Result, Create);
|
||||
end;
|
||||
|
||||
{ TMHHint }
|
||||
|
||||
function TMHHint.GetDelay(const Index: Integer): Integer;
|
||||
begin
|
||||
// CreateToolTip;
|
||||
Result := 0;
|
||||
if Assigned(ToolTip) then
|
||||
Result := ToolTip.GetDelay(Index);
|
||||
end;
|
||||
|
||||
function TMHHint.GetFI: TFI;
|
||||
begin
|
||||
/// !!! DANGER-WITH !!!
|
||||
with Result, ToolTip^ do
|
||||
begin
|
||||
FE := FE + [eTextColor];
|
||||
Colors[1] := TextColor;
|
||||
|
||||
FE := FE + [eBkColor];
|
||||
Colors[0] := BkColor;
|
||||
|
||||
FE := FE + [eAPDelay];
|
||||
Delays[TTDT_AUTOPOP] := AutoPopDelay;
|
||||
|
||||
FE := FE + [eRDelay];
|
||||
Delays[TTDT_RESHOW] := ReshowDelay;
|
||||
|
||||
FE := FE + [eIDelay];
|
||||
Delays[TTDT_INITIAL] := InitialDelay;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMHHint.ReConnect(FI: TFI);
|
||||
var
|
||||
TMP: PMHToolTip;
|
||||
begin
|
||||
with GetManager^ do
|
||||
begin
|
||||
TMP := FindNeed(FI);
|
||||
if not Assigned(TMP) then
|
||||
TMP := CreateNeed(FI);
|
||||
if Assigned(ToolTip) and HasTool then
|
||||
MoveTool(TMP);
|
||||
ToolTip := TMP;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMHHint.MoveTool(T1: PMHToolTip);
|
||||
var
|
||||
TI: TToolInfo;
|
||||
TextL: array[0..255] of KOLChar;
|
||||
begin
|
||||
if T1 = ToolTip then
|
||||
Exit;
|
||||
with TI do
|
||||
begin
|
||||
cbSize := SizeOf(TI);
|
||||
hWnd := Parent.GetWindowHandle;
|
||||
uId := Parent.GetWindowHandle;
|
||||
lpszText := @TextL[0];
|
||||
end;
|
||||
|
||||
SendMessage(ToolTip.handle, TTM_GETTOOLINFO, 0, DWord(@TI));
|
||||
SendMessage(ToolTip.handle, TTM_DELTOOL, 0, DWORD(@TI));
|
||||
ToolTip.Count := ToolTip.Count - 1;
|
||||
SendMessage(T1.handle, TTM_ADDTOOL, 0, DWORD(@TI));
|
||||
T1.Count := T1.Count - 1;
|
||||
|
||||
HasTool := True;
|
||||
|
||||
end;
|
||||
|
||||
procedure TMHHint.SetColor(const Index: Integer; const Value: TColor);
|
||||
var
|
||||
FI: TFI;
|
||||
begin
|
||||
if Assigned(ToolTip) then
|
||||
begin
|
||||
if ToolTip.Count + Byte(not HasTool) = 1 then
|
||||
begin
|
||||
ToolTip.SetColor(Index, Value);
|
||||
Exit;
|
||||
end;
|
||||
FI := GetFI;
|
||||
end;
|
||||
|
||||
case Index of
|
||||
0: FI.FE := FI.FE + [eBkColor];
|
||||
1: FI.FE := FI.FE + [eTextColor];
|
||||
end;
|
||||
FI.Colors[Index] := Value;
|
||||
|
||||
ReConnect(FI);
|
||||
end;
|
||||
|
||||
function TMHHint.GetColor(const Index: Integer): TColor;
|
||||
begin
|
||||
Result := 0;
|
||||
if Assigned(ToolTip) then
|
||||
Result := ToolTip.GetColor(Index);
|
||||
end;
|
||||
|
||||
procedure TMHHint.SetDelay(const Index, Value: Integer);
|
||||
var
|
||||
FI: TFI;
|
||||
begin
|
||||
if Assigned(ToolTip) then
|
||||
begin
|
||||
if ToolTip.Count + Byte(not HasTool) = 1 then
|
||||
begin
|
||||
ToolTip.SetDelay(Index, Value);
|
||||
Exit;
|
||||
end;
|
||||
FI := GetFI;
|
||||
end;
|
||||
|
||||
case Index of
|
||||
TTDT_AUTOPOP: FI.FE := FI.FE + [eAPDelay]; // Spec
|
||||
TTDT_INITIAL: FI.FE := FI.FE + [eIDelay]; // Spec
|
||||
TTDT_RESHOW: FI.FE := FI.FE + [eRDelay]; // Spec
|
||||
end; //case
|
||||
|
||||
FI.Delays[Index] := Value; //Spec
|
||||
|
||||
ReConnect(FI);
|
||||
end;
|
||||
|
||||
procedure TMHHint.SetText(Value: KOLString);
|
||||
var
|
||||
TI: TToolInfo;
|
||||
begin
|
||||
ProcBegin(TI);
|
||||
|
||||
with TI do
|
||||
begin
|
||||
uFlags := TTF_SUBCLASS or TTF_IDISHWND; // Spec
|
||||
lpszText := PKOLChar(Value); // Spec
|
||||
end;
|
||||
|
||||
procEnd(TI);
|
||||
|
||||
if HasTool then
|
||||
begin
|
||||
TI.lpszText := PKOLChar(Value);
|
||||
SendMessage(ToolTip.handle, TTM_SETTOOLINFO, 0, DWord(@TI));
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
{ TMHToolTipManager }
|
||||
|
||||
function TMHToolTipManager.AddTip: Integer;
|
||||
begin
|
||||
SetLength(TTT, Length(TTT) + 1);
|
||||
TTT[Length(TTT) - 1] := NewMHToolTip(Applet);
|
||||
Result := Length(TTT) - 1;
|
||||
end;
|
||||
|
||||
function TMHToolTipManager.FindNeed(FI: TFI): PMHToolTip;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
Result := nil;
|
||||
for i := 0 to length(TTT) - 1 do
|
||||
begin
|
||||
if ((eTextColor in FI.FE) and (not (FI.Colors[1] = TTT[i].TextColor))) or
|
||||
((eBkColor in FI.FE) and (not (FI.Colors[0] = TTT[i].BkColor))) or
|
||||
((eAPDelay in FI.FE) and (not (FI.Delays[TTDT_AUTOPOP] = TTT[i].AutoPopDelay))) or
|
||||
((eIDelay in FI.FE) and (not (FI.Delays[TTDT_INITIAL] = TTT[i].InitialDelay))) or
|
||||
((eRDelay in FI.FE) and (not (FI.Delays[TTDT_RESHOW] = TTT[i].ReshowDelay))) then
|
||||
Continue;
|
||||
Result := TTT[i];
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMHToolTipManager.CreateNeed(FI: TFI): PMHToolTip;
|
||||
|
||||
begin
|
||||
Setlength(TTT, length(TTT) + 1);
|
||||
TTT[length(TTT) - 1] := NewMHToolTip(Applet);
|
||||
with TTT[length(TTT) - 1]^ do
|
||||
begin
|
||||
if (eTextColor in FI.FE) then
|
||||
TextColor := FI.Colors[1];
|
||||
if (eBkColor in FI.FE) then
|
||||
BkColor := FI.Colors[0];
|
||||
if (eAPDelay in FI.FE) then
|
||||
AutoPopDelay := FI.Delays[TTDT_AUTOPOP];
|
||||
if (eIDelay in FI.FE) then
|
||||
InitialDelay := FI.Delays[TTDT_INITIAL];
|
||||
if (eRDelay in FI.FE) then
|
||||
ReshowDelay := FI.Delays[TTDT_RESHOW];
|
||||
end;
|
||||
Result := TTT[length(TTT) - 1];
|
||||
end;
|
||||
|
||||
procedure TMHHint.ProcBegin(var TI: TToolInfo);
|
||||
begin
|
||||
CreateToolTip;
|
||||
|
||||
with TI do
|
||||
begin
|
||||
cbSize := SizeOf(TI);
|
||||
hWnd := Parent.GetWindowHandle;
|
||||
uId := Parent.GetWindowHandle;
|
||||
hInst := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMHHint.ProcEnd(var TI: TToolInfo);
|
||||
var
|
||||
TextLine: array[0..255] of KOLChar;
|
||||
begin
|
||||
if not HasTool then
|
||||
begin
|
||||
SendMessage(ToolTip.handle, TTM_ADDTOOL, 0, DWORD(@TI));
|
||||
HasTool := True;
|
||||
ToolTip.Count := ToolTip.Count + 1;
|
||||
end
|
||||
else
|
||||
begin
|
||||
with TI do
|
||||
begin
|
||||
lpszText := @TextLine[0];
|
||||
end;
|
||||
SendMessage(ToolTip.handle, TTM_SETTOOLINFO, 0, DWord(@TI));
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor TMHToolTipManager.Destroy;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i := 0 to Length(TTT) - 1 do
|
||||
TTT[i].Free;
|
||||
SetLength(TTT, 0);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TMHHint.Pop;
|
||||
begin
|
||||
if Assigned(ToolTip) and (HasTool) then
|
||||
begin // ^^^^^^^^^^^^ ???
|
||||
// CreateToolTip;
|
||||
ToolTip.Pop;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMHHint.Popup;
|
||||
begin
|
||||
if Assigned(ToolTip) and (HasTool) then
|
||||
begin // ^^^^^^^^^^^^ ???
|
||||
// CreateToolTip;
|
||||
ToolTip.Popup;
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor TMHHint.Destroy;
|
||||
var
|
||||
TI: TToolInfo;
|
||||
i: integer;
|
||||
begin
|
||||
with TI do
|
||||
begin
|
||||
cbSize := SizeOf(TI);
|
||||
hWnd := Parent.GetWindowHandle;
|
||||
uId := Parent.GetWindowHandle;
|
||||
end;
|
||||
|
||||
SendMessage(ToolTip.handle, TTM_DELTOOL, 0, DWORD(@TI));
|
||||
ToolTip.Count := ToolTip.Count - 1;
|
||||
if ToolTip.Count <= 0 then begin
|
||||
i:=Length(Manager.TTT);
|
||||
if i > 1 then begin
|
||||
Manager.TTT[i - 1].Free;
|
||||
SetLength(Manager.TTT, i - 1);
|
||||
end
|
||||
else
|
||||
Free_And_Nil(Manager);
|
||||
end;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
destructor TMHToolTip.Destroy;
|
||||
begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TMHHint.CreateToolTip;
|
||||
begin
|
||||
if not Assigned(ToolTip) then
|
||||
begin
|
||||
if Length(GetManager.TTT) = 0 then
|
||||
GetManager.AddTip;
|
||||
ToolTip := GetManager.TTT[0];
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMHHint.GetText: KOLString;
|
||||
var
|
||||
TI: TToolInfo;
|
||||
TextL: array[0..255] of KOLChar;
|
||||
begin
|
||||
if Assigned(ToolTip) and (HasTool) then
|
||||
begin
|
||||
// !!!
|
||||
with TI do
|
||||
begin
|
||||
// ????
|
||||
// FillChar(TI, SizeOf(TI), 0);
|
||||
cbSize := SizeOf(TI);
|
||||
hWnd := Parent.GetWindowHandle;
|
||||
uId := Parent.GetWindowHandle;
|
||||
lpszText := @TextL[0];
|
||||
end;
|
||||
SendMessage(ToolTip.handle, TTM_GETTOOLINFO, 0, DWord(@TI));
|
||||
Result := TextL; //TI.lpszText;// := PChar(Value);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMHHint.GetManager: PMHToolTipManager;
|
||||
begin
|
||||
if Manager=nil then
|
||||
Manager:=NewManager;
|
||||
Result:=Manager;
|
||||
end;
|
||||
|
||||
13
KOLMHTooltip_intf2.inc
Normal file
13
KOLMHTooltip_intf2.inc
Normal file
@ -0,0 +1,13 @@
|
||||
// part of KOLMHToolTip -- interface_part.
|
||||
// Moved to separate inc-file still Delphi20XX does not allow compile
|
||||
// in DEBUG mode.
|
||||
const
|
||||
Dummy = 0;
|
||||
|
||||
|
||||
function NewHint(A: PControl): PMHHint;
|
||||
function NewManager: PMHToolTipManager;
|
||||
function NewMHToolTip(AParent: PControl): PMHToolTip;
|
||||
|
||||
var
|
||||
Manager: PMHToolTipManager;
|
||||
Reference in New Issue
Block a user