123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909 |
- //{$DEFINE DEBUG}
- {$IFDEF DEBUG}
- {$DEFINE interface}
- {$DEFINE implementation}
- {$DEFINE initialization}
- {$DEFINE finalization}
- {$ENDIF}
-
- {$IFDEF Frame}
- unit KOLMHToolTip;
-
- interface
-
- uses Windows, KOL, Messages;
-
- type
- {$ENDIF Frame}
- {$IFDEF interface}
-
- TFE = (eTextColor, eBkColor, eAPDelay, eRDelay, eIDelay);
-
- TFI = record
- FE: set of TFE;
- Colors: array[0..1] of TColor;
- Delays: array[0..3] of Integer;
- end;
-
- PMHToolTipManager = ^TMHToolTipManager;
- TKOLMHToolTipManager = PMHToolTipManager;
-
- PMHToolTip = ^TMHToolTip;
- TKOLMHToolTip = PMHToolTip;
-
- {$ENDIF interface}
-
- {$IFDEF pre_interface}
- PMHHint = ^TMHHint;
- TKOLMHHint = PMHHint;
- {$ENDIF pre_interface}
-
- {$IFDEF interface}
-
- TMHToolTipManager = object(TObj)
- protected
- destructor Destroy; virtual;
- public
- TTT: array of PMHToolTip;
- function AddTip: Integer;
- function FindNeed(FI: TFI): PMHToolTip;
- function CreateNeed(FI: TFI): PMHToolTip;
- end;
-
- TMHHint = object(TObj)
- private
- function GetManager:PMHToolTipManager;
- // Spec
- procedure ProcBegin(var TI: TToolInfo);
- procedure ProcEnd(var TI: TToolInfo);
- procedure ReConnect(FI: TFI);
- procedure MoveTool(T1: PMHToolTip);
- procedure CreateToolTip;
- function GetFI: TFI;
-
- // Group
- function GetDelay(const Index: Integer): Integer;
- procedure SetDelay(const Index: Integer; const Value: Integer);
- function GetColor(const Index: Integer): TColor;
- procedure SetColor(const Index: Integer; const Value: TColor);
-
- // Local
- procedure SetText(Value: KOLString);
- function GetText: KOLString;
- public
- ToolTip: PMHToolTip;
- HasTool: Boolean;
- Parent: PControl;
- destructor Destroy; virtual;
- procedure Pop;
- procedure Popup;
-
- property AutoPopDelay: Integer index 2 read GetDelay write SetDelay;
- property InitialDelay: Integer index 3 read GetDelay write SetDelay;
- property ReshowDelay: Integer index 1 read GetDelay write SetDelay;
-
- property TextColor: TColor index 1 read GetColor write SetColor;
- property BkColor: TColor index 0 read GetColor write SetColor;
- property Text: KOLString read GetText write SetText;
- end;
-
- TMHToolTip = object(TObj)
-
- private
- fHandle: THandle;
- Count: Integer;
-
- function GetDelay(const Index: Integer): Integer;
- procedure SetDelay(const Index: Integer; const Value: Integer);
- function GetColor(const Index: Integer): TColor;
- procedure SetColor(const Index: Integer; const Value: TColor);
- function GetMaxWidth: Integer;
- procedure SetMaxWidth(const Value: Integer);
- function GetMargin: TRect;
- procedure SetMargin(const Value: TRect);
- function GetActivate: Boolean;
- procedure SetActivate(const Value: Boolean);
- // function GetText: string;
- // procedure SetText(const Value: string);
- // function GetToolCount: Integer;
- // function GetTool(Index: Integer): TToolInfo;
-
-
-
- protected
-
- public
- destructor Destroy; virtual;
- procedure Pop;
- procedure Popup;
- procedure Update;
-
- // function GetInfo: TToolInfo; // Hide in Info
- // procedure SetInfo(Value: TToolInfo);
-
- // handle:Thandle;
- // procedure SetC(C: PControl);
- // procedure SetI(C: PControl; S: string);
- // procedure Add(Value: TToolInfo);
- // procedure Delete(Value: TToolInfo);
- // function Connect(Value: PControl): Integer;
-
-
- // property OnCloseUp: TOnEvent read GetOnDropDown write SetOnDropDown;
-
-
-
- property AutoPopDelay: Integer index 2 read GetDelay write SetDelay;
- property InitialDelay: Integer index 3 read GetDelay write SetDelay;
- property ReshowDelay: Integer index 1 read GetDelay write SetDelay;
-
- property TextColor: TColor index 1 read GetColor write SetColor;
- property BkColor: TColor index 0 read GetColor write SetColor;
-
- property MaxWidth: Integer read GetMaxWidth write SetMaxWidth;
-
- property Margin: TRect read GetMargin write SetMargin;
- property Activate: Boolean read GetActivate write SetActivate;
- property Handle: THandle read fHandle;
- // property Text: string read GetText write SetText;
- // property ToolCount: Integer read GetToolCount;
- // property Tools[Index: Integer]: TToolInfo read GetTool;
-
- end;
-
- const
- Dummy = 0;
-
-
- function NewHint(A: PControl): PMHHint;
- function NewManager: PMHToolTipManager;
- function NewMHToolTip(AParent: PControl): PMHToolTip;
-
- var
- Manager: PMHToolTipManager;
-
- {$ENDIF interface}
-
- {$IFDEF Frame}
-
- implementation
-
- {$ENDIF Frame}
-
- {$IFDEF implementation}
-
- const
- Dummy1 = 1;
-
- TTDT_AUTOMATIC = 0;
- TTDT_RESHOW = 1;
- TTDT_AUTOPOP = 2;
- TTDT_INITIAL = 3;
-
- //function WndProcMHDateTimePicker(Sender: PControl; var Msg: TMsg; var Rslt: Integer): Boolean;
- {begin
- Result := False;}
- //end;
-
-
-
- function NewMHToolTip(AParent: PControl): PMHToolTip;
- //var
- // Data: PDateTimePickerData;
- // T: TWndClassEx;
- // a: integer;
- 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);
- // SetClassLong(Result.handle,GCL_STYLE,CS_DROPSHADOW);
-
- // Result := PMHToolTip(_NewControl(AParent, TOOLTIPS_CLASS, 0, False, 0)); //PMHToolTip(_NewCommonControl(AParent,TOOLTIPS_CLASS, 0{TTS_ALWAYSTIP}{WS_CHILD or WS_VISIBLE},False,0));
- // Result.Style:=0;
- // Result.ExStyle:=0;
- // GetMem(Data,Sizeof(Data^));
- // FillChar(Data^,Sizeof(Data^),0);
- // a:=SetClassLong(Result.Handle,GCL_STYLE,CS_DROPSHADOW);
- // ShowMessage(Int2Str(a));
- // Result.CustomData:=Data;
-
- { T.cbSize:=SizeOf(T);
- GetClassInfoEx(hInstance,TOOLTIPS_CLASS,T);
- T.style:=T.style or CS_DROPSHADOW;
- T.hInstance:=hInstance;
- T.lpszClassName:='ZharovHint';
- a:=RegisterClassEx(T);
- ShowMessage(Int2Str(a)); }
- // Result.handle := CreateWindowEx(0, {'ZharovHint'} TOOLTIPS_CLASS, '', 0 {orCS_DROPSHADOW or WS_POPUP or WS_BORDER or CS_SAVEBITS or WS_CHILD or WS_CLIPSIBLINGS}, CW_USEDEFAULT, CW_USEDEFAULT,
- // CW_USEDEFAULT, CW_USEDEFAULT, AParent.Handle, 0, HInstance, nil);
- // Data.ttt:=CreateWindowEx (CS_IMEWS_EX_TOOLWINDOW or WS_EX_CONTROLPARENT{ or CS_SAVEBITS or WS_POPUP or WS_BORDER}{65536},{'ZharovHint'}TOOLTIPS_CLASS,'',{WS_CHILD or}{ WS_VISIBLE}{100663296}{WS_EX_TOOLWINDOW}CS_DROPSHADOW or WS_POPUP or WS_BORDER or CS_SAVEBITS or WS_CHILD or WS_CLIPSIBLINGS,CW_USEDEFAULT,CW_USEDEFAULT,
- // CW_USEDEFAULT,CW_USEDEFAULT,AParent.Handle,0,HInstance,NIL);
- // SetClassLong(Data.ttt,GCL_STYLE,CS_DROPSHADOW);
- // SendMessage (Data.ttt,TTM_SETDELAYTIME,TTDT_INITIAL,5);
- // SendMessage (Data.ttt,TTM_SETDELAYTIME,TTDT_RESHOW,20);
- // SendMessage (Result.handle,TTM_SETDELAYTIME,TTDT_AUTOPOP,2000);
- // Result.CreateWindow;
- // Result.Parent := AParent;
- // Result.Perform(TTM_SETTIPTEXTCOLOR,clRed,0);
- // SendMessage (Result.handle,TTM_SETTIPTEXTCOLOR,clBlue,0);
- // SendMessage (Result.handle,TTM_SETTIPTEXTCOLOR,clRed,0);
- // Result.Color:=clRed;
- // Result.Font.Color:=clRed;
- // Data.FCalColors:=NewMonthCalColors(Result);
- // Data.FOnDropDown:=nil;
- // Result.AttachProc(WndProcMHDateTimePicker);
- // Result.AttachProc(WndProcMHDateTimePicker);
- end;
-
- {procedure TMHToolTip.SetC(C: PControl);
- var
- TI: TToolInfo;
- R: Trect;
- // Data:PDateTimePickerData;
- begin
- R := C.ClientRect;
- // Control:= C.Handle;
- with TI do
- begin
- cbSize := SizeOf(TI);
- uFlags := TTF_SUBCLASS; // or TTF_IDISHWND;
- hWnd := C.GetWindowHandle; //Control;
- uId := 0;
- rect.Left := R.Left;
- rect.Top := R.Top;
- rect.Right := R.Right;
- rect.Bottom := R.Bottom;
- hInst := 0;
- lpszText := Pchar('I am ' + C.Caption);
- end;
- PostMessage(handle, TTM_ADDTOOL, 0, DWORD(@TI));
- // Perform(TTM_ADDTOOL, 0, DWord(@TI));
- 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;
-
- {procedure TMHToolTip.SetI(C: PControl; S: string);
- var
- TI: TToolInfo;
- R: Trect;
- // Data:PDateTimePickerData;
- begin
- R := C.ClientRect;
- // Control:= C.Handle;
- with TI do
- begin
- cbSize := SizeOf(TI);
- uFlags := TTF_SUBCLASS;
- hWnd := C.GetWindowHandle; //Control;
- uId := 0;
- rect.Left := R.Left;
- rect.Top := R.Top;
- rect.Right := R.Right;
- rect.Bottom := R.Bottom;
- hInst := 0;
- lpszText := PChar(S);
- end;
- // PostMessage (handle,TTM_ADDTOOL,0,DWORD (@TI));
- // Perform(TTM_SETTOOLINFO, 0, DWord(@TI));
- 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;
-
- {function TMHToolTip.GetText: string;
- begin
-
- end;
-
- procedure TMHToolTip.SetText(const Value: string);
- var
- TI: TToolInfo;
- begin
- TI := GetInfo;
- TI.lpszText := PChar(Value);
- SetInfo(TI);
- end; }
-
- {function TMHToolTip.GetInfo: TToolInfo;
- begin
- with Result do
- begin
- // ????
- FillChar(Result, SizeOf(Result), 0);
- cbSize := SizeOf(Result);
- // hWnd := Parent.GetWindowHandle;
- uId := 0;
- end;
- // Perform(TTM_GETTOOLINFO, 0, DWord(@Result));
- end;
-
- procedure TMHToolTip.SetInfo(Value: TToolInfo);
- begin
- // Perform(TTM_SETTOOLINFO, 0, DWord(@Value));
- end;}
-
- {function TMHToolTip.GetToolCount: Integer;
- begin
- // Result := Perform(TTM_GETTOOLCOUNT, 0, 0);
- end;
-
- function TMHToolTip.GetTool(Index: Integer): TToolInfo;
- begin
- FillChar(Result, SizeOf(Result), 0); // ????
- Result.cbSize := SizeOf(Result);
- // Perform(TTM_ENUMTOOLS, Index, DWord(@Result));
- end; }
-
- {procedure TMHToolTip.Add(Value: TToolInfo);
- begin
- // Perform(TTM_ADDTOOL, 0, DWord(@Value));
- end;}
-
- {procedure TMHToolTip.Delete(Value: TToolInfo);
- begin
- // Perform(TTM_DELTOOL, 0, DWord(@Value));
- 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;
-
- (*
- procedure TMHHint.SetText(Value: string);
- var
- TI: TToolInfo;
- R: Trect;
- TextLine: array[0..255] of Char;
- begin
- if not Assigned(ToolTip) then
- begin
- if Length(Manager.TTT) = 0 then
- Manager.AddTip;
- ToolTip := Manager.TTT[0];
- end;
-
- with TI do
- begin
- cbSize := SizeOf(TI);
- hWnd := Parent.GetWindowHandle;
- uId := Parent.GetWindowHandle;
- hInst := 0;
- end;
-
- if not HasTool {TTool = -1} then
- begin
- R := Parent.ClientRect;
- // Control:= C.Handle;
- with TI do
- begin
- // cbSize := SizeOf(TI);
- uFlags := TTF_SUBCLASS;
- // hWnd := Parent.GetWindowHandle; //Control;
- // uId := Parent.GetWindowHandle;
- rect.Left := R.Left;
- rect.Top := R.Top;
- rect.Right := R.Right;
- rect.Bottom := R.Bottom;
- // hInst := 0;
- lpszText := PChar(Value);
- end;
- SendMessage({Manager.TTT[TTip]} ToolTip.handle, TTM_ADDTOOL, 0, DWORD(@TI));
- HasTool := True;
- // TTool := 0;
- ToolTip {Manager.TTT[TTip]}.Count := ToolTip {Manager.TTT[TTip]}.Count + 1;
-
- end
- else
- begin
-
- with TI do
- begin
- // ????
- // FillChar(TI, SizeOf(TI), 0);
- // cbSize := SizeOf(TI);
- // hWnd := Parent.GetWindowHandle;
- // uId := Parent.GetWindowHandle;
- lpszText := @TextLine; //PChar(S);
- end;
- SendMessage(ToolTip {Manager.TTT[TTip]}.handle, TTM_GETTOOLINFO, 0, DWord(@TI));
- TI.lpszText := PChar(Value);
- // Perform(TTM_GETTOOLINFO, 0, DWord(@Result));
- SendMessage(ToolTip {Manager.TTT[TTip]}.handle, TTM_SETTOOLINFO, 0, DWord(@TI));
- end;
- // Manager.TTT[TTip].Tool[TTool].SSSetText(Value);
- end;
- *)
-
- { TMHToolTipManager }
-
- {function TMHToolTipManager.AddColor(C: TColor): Integer;
- begin
- SetLength(TTT, Length(TTT) + 1);
- TTT[Length(TTT) - 1] := NewMHToolTip(Applet);
- TTT[Length(TTT) - 1].SetColor(1, C);
- Result := Length(TTT) - 1;
- end; }
-
- function TMHToolTipManager.AddTip: Integer;
- begin
- SetLength(TTT, Length(TTT) + 1);
- TTT[Length(TTT) - 1] := NewMHToolTip(Applet);
- Result := Length(TTT) - 1;
- end;
-
- {function TMHToolTip.Connect(Value: PControl): Integer;
- var
- TI: TToolInfo;
- R: Trect;
- // Data:PDateTimePickerData;
- begin
- R := Value.ClientRect;
- // Control:= C.Handle;
- with TI do
- begin
- cbSize := SizeOf(TI);
- uFlags := TTF_SUBCLASS;
- hWnd := Value.GetWindowHandle; //Control;
- uId := Value.GetWindowHandle;
- rect.Left := R.Left;
- rect.Top := R.Top;
- rect.Right := R.Right;
- rect.Bottom := R.Bottom;
- hInst := 0;
- lpszText := PChar('Super');
- end;
- PostMessage(handle, TTM_ADDTOOL, 0, DWORD(@TI));
- // Perform(TTM_ADDTOOL, 0, DWord(@TI));
- end;}
-
- {function TMHToolTipManager.FindTip(N: Integer): Integer;
- begin
- Result := -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;
-
- {$ENDIF implementation}
-
- {$IFDEF Frame}
-
- initialization
- {$ENDIF Frame}
- {$IFDEF initialization}
-
- Manager := NewManager;
- {$ENDIF initialization}
-
- {$IFDEF Frame}
- finalization
- {$ENDIF Frame}
- {$IFDEF finalization}
- // Manager.Free;
- {$ENDIF finalization}
-
-
- {$IFDEF Frame}
- end.
- {$ENDIF Frame}
-
- {$IFDEF function}
- function GetHint: PMHHint;
- {$ENDIF function}
-
- {$IFDEF public}
- property Hint: PMHHint read GetHint;
- {$ENDIF public}
-
- {$IFDEF code}
- function TControl.GetHint: PMHHint;
- begin
- if fHint = nil then
- fHint := NewHint(@Self);
- Result := fHint;
- end;
- {$ENDIF code}
-
- {$IFDEF MHdestroy}
- fHint.Free;
- {$ENDIF MHdestroy}
-
- {$IFDEF var}
- fHint: PMHHint;
- {$ENDIF var}
|