How to create custom graphic hints (Views: 29)
Problem/Question/Abstract: How can I create my own hint windows, even with bitmaps and so on? Answer: You just have to add the following code to your project (it's just an example). You don't need to change something else in your project. Maybe the code will run in earlier versions of Borland Delphi too, but didn't test it. type TGraphicHintWindow = class(THintWindow) constructor Create(AOwner: TComponent); override; private FActivating: Boolean; public procedure ActivateHint(Rect: TRect; const AHint: string); override; protected procedure Paint; override; published property Caption; end; {...} constructor TGraphicHintWindow.Create(AOwner: TComponent); begin inherited Create(AOwner); //Here you can set custom Font properties: with Canvas.Font do begin Name := 'Arial'; Style := style + [fsBold]; Color := clBlack; end; end; procedure TGraphicHintWindow.Paint; var R: TRect; bmp: TBitmap; l: TStrings; begin R := ClientRect; Inc(R.Left, 2); Inc(R.Top, 2); {******************************************************* The following Code is an example how to create a custom Hint Object. : *******************************************************} bmp := TBitmap.create; bmp.LoadfromFile('D:\hint.bmp'); with Canvas do begin Brush.style := bsSolid; Brush.color := clsilver; Pen.color := clgray; Rectangle(0, 0, 18, R.Bottom + 1); Draw(2,(R.Bottom div 2) - (bmp.height div 2), bmp); end; bmp.free; Color := clWhite; //Beliebige HintFarbe //custom Hint Color Canvas.Brush.style := bsClear; //Canvas.TextOut(20,(R.Bottom div 2)-(canvas.Textheight(caption) div 2),caption); Inc(R.Left, 20); l := TStringlist.create; l.SetText(PChar(Caption)); R.top := (R.Bottom div 2) - ((canvas.Textheight(caption) * l.count) div 2); DrawText(Canvas.Handle, PChar(Caption), -1, R, 0); l.free; {********************************************************} end; procedure TGraphicHintWindow.ActivateHint(Rect: TRect; const AHint: string); begin FActivating := True; try Caption := AHint; Inc(Rect.Bottom, 14); //Set the "Height" Property of the Hint Rect.Right := Rect.right + 20; //Set the "Width" Property of the Hint UpdateBoundsRect(Rect); if Rect.Top + Height > Screen.DesktopHeight then Rect.Top := Screen.DesktopHeight - Height; if Rect.Left + Width > Screen.DesktopWidth then Rect.Left := Screen.DesktopWidth - Width; if Rect.Left < Screen.DesktopLeft then Rect.Left := Screen.DesktopLeft; if Rect.Bottom < Screen.DesktopTop then Rect.Bottom := Screen.DesktopTop; SetWindowPos(Handle, HWND_TOPMOST, Rect.Left, Rect.Top, Width, Height, SWP_SHOWWINDOW or SWP_NOACTIVATE); Invalidate; finally FActivating := False; end; end; procedure TForm1.FormCreate(Sender: TObject); begin HintWindowClass := TGraphicHintWindow; Application.ShowHint := False; Application.ShowHint := True; end; |