show hint

hi ws1999,

maybe you can use the onmousemove-event
(not the best choice, fired to often)
with a code like

  Color := Image1.Canvas.Pixels(x,y);
  case color of
    clgreen : image1.hint := 'Green';
    ....
  end;

maybe the application-event onshowhint is a better point for setting the hint

(remark : not tested)

meikl

Hi,ketzschmar:

Use this method ,if cannot show hint within the image(only once)continually,

I mean how to trigger the show hint at will,not just from outside to inside.

Thanks anyway

The problem here is not the hint string but the hint rectangle. This rectangle determines when the mouse pointer is considered to be out-of-rect and a new hint (-positon) must be determined. You cannot change the hint rect with the usual means. For the color picker control I wrote I captured the (internal) CM_HINTSHOW message:

procedure TColorPopup.CMHintShow(var Message: TMessage);

// determine hint message (tooltip) and out-of-hint rect

var Index: Integer;
    r, g, b: Byte;
    Colors: TCombArray;

begin
  Colors := nil;
  with TCMHintShow(Message) do
  begin
    if not TColorPickerButton(Owner).ShowHint then Message.Result := 1
                                              else
    begin
      with HintInfo^ do
      begin
        // show that we want a hint
        Result := 0;
        // predefined colors always get their names as tooltip
        if FHoverIndex >= 0 then
        begin
          GetCellRect(FHoverIndex, CursorRect);
          if FHoverIndex < DefaultColorCount then HintStr := DefaultColors[FHoverIndex].Name
                                             else HintStr := SysColors[FHoverIndex - DefaultColorCount].Name;
        end
        else
          // both special cells get their hint either from the application by
          // means of the OnHint event or the hint string of the owner control
          if (FHoverIndex = DefaultCell) or
             (FHoverIndex = CustomCell) then
          begin
            HintStr := GetHint(FHoverIndex);
            if HintStr = '' then HintStr := TColorPickerButton(Owner).Hint
                            else
            begin
              // if the application supplied a hint by event then deflate the cursor rect
              // to the belonging button
              if FHoverIndex = DefaultCell then CursorRect := FDefaultTextRect
                                           else CursorRect := FCustomTextRect;
            end;
          end
          else
          begin
            // well, mouse is not hovering over one of the buttons, now check for
            // the ramp and the custom color areas
            if PtInRect(FSliderRect, Point(CursorPos.X, CursorPos.Y)) then
            begin
              // in case of the intensity slider we show the current intensity
              HintStr := Format('Intensity: %d%%', [Round(100 * FCenterIntensity)]);
              CursorRect := Rect(FSliderRect.Left, CursorPos.Y - 2,
                                 FSliderRect.Right, CursorPos.Y + 2);
              HintPos := ClientToScreen(Point(FSliderRect.Right, CursorPos.Y - 8));
              HideTimeout := 5000;
              CursorRect := Rect(FSliderRect.Left, CursorPos.Y,
                                 FSliderRect.Right, CursorPos.Y);
            end
            else
            begin
              Index := -1;
              if PtInRect(FBWCombRect, Point(CursorPos.X, CursorPos.Y)) then
              begin
                // considering black&white area...
                if csLButtonDown in ControlState then Index := -(FCustomIndex + 1)
                                                 else Index := FindBWArea(CursorPos.X, CursorPos.Y);
                Colors := FBWCombs;
              end
              else
                if PtInRect(FColorCombRect, Point(CursorPos.X, CursorPos.Y)) then
                begin
                  // considering color comb area...
                  if csLButtonDown in ControlState then Index := FCustomIndex - 1
                                                   else Index := FindColorArea(CursorPos.X, CursorPos.Y);
                  Colors := FColorCombs;
                end;

              if (Index > -1) and (Colors <> nil) then
              begin
                with Colors[Index] do
                begin
                  r := GetRValue(Color);
                  g := GetGValue(Color);
                  b := GetBValue(Color);
                end;
                HintStr := Format('red: %d, green: %d, blue: %d', [r, g, b]);
                HideTimeout := 5000;
              end
              else HintStr := GetHint(NoCell);

              // make the hint follow the mouse
              CursorRect := Rect(CursorPos.X, CursorPos.Y,
                                 CursorPos.X, CursorPos.Y);
            end;
          end;
      end;
    end;
  end;
end;


This looks quite complex but consider, that you don't need all the stuff. Just take out what you don't need.

Ciao, Mike

hi again,

from my paq

---paste begin
here is a sample of a hint that follows your cursor,

unit hint_f_u;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  TW : THintWindow;  //The HintWindow

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  TW := THintWindow.Create(Panel1);  //CreateHintWindow
  TW.Hint := Panel1.Hint;            //HintText
  TW.Parent := Panel1;
end;

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  R : TRect;
  P : TPoint;
begin
  GetCursorPos(P);       //Calculate HintWindowPosition
  R := TW.CalcHintRect(100,TW.Hint,NIL);
  R.Left := p.x;
  R.Top := p.y;
  R.Bottom := R.Bottom + p.y;
  R.Right := R.Right + p.x;
  TW.ActivateHint(R,TW.Hint);  //Display The Hint on calculated Position
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  TW.ReleaseHandle;  //Hide Hint, not the optimal Method
end;

end.

you see, that you have to create a own HintWindow.
--- paste end

hope this helps (replace Panel1 with image1) by mixing with my comment above

meikl

Listening

Hi,kretzschmar:

It display many hint windows which can not hide when mouse keep moving,how to display only one window at one time,

and it seems there is no hint text in the window

Thans

hi ws1999

of course,
my sample does not
match your context exactly,
because its from my paq to a q
with other needs

define your needs
-when should it appear
-when should it disappear
-what should be the hinttext

i will adapt the code to your needs,
if it is meaningful

meikl

listening...

Hi,

here is code to let the hint appear and remove it manually :
 
A:
 function RevealHint (Control: TControl): THintWindow;
{----------------------------------------------------------------}
{ Pops up Hint window for the specified Control, and returns a   }
{ reference to the hint object so it may subsequently be removed }
{ with RemoveHint (see below).                                   }
{----------------------------------------------------------------}
 var
   ShortHint: string;
   AShortHint: array[0..255] of Char;
   HintPos: TPoint;
   HintBox: TRect;
 begin
   { Create the window: }
   Result := THintWindow.Create(Control);

   { Get first half of hint up to '|': }
   ShortHint := GetShortHint(Control.Hint);

   { Calculate Hint Window position & size: }
   HintPos := Control.ClientOrigin;
   Inc(HintPos.Y, Control.Height + 6);    <<<< See note below
   HintBox := Bounds(0, 0, Screen.Width, 0);
   DrawText(Result.Canvas.Handle,
       StrPCopy(AShortHint, ShortHint), -1, HintBox,
       DT_CALCRECT or DT_LEFT or DT_WORDBREAK or DT_NOPREFIX);
   OffsetRect(HintBox, HintPos.X, HintPos.Y);
   Inc(HintBox.Right, 6);
   Inc(HintBox.Bottom, 2);

   { Now show the window: }
   Result.ActivateHint(HintBox, ShortHint);
 end; {RevealHint}

 procedure RemoveHint (var Hint: THintWindow);
{----------------------------------------------------------------}
{ Releases the window handle of a Hint previously popped up with }
{ RevealHint.                                                    }
{----------------------------------------------------------------}
 begin
   Hint.ReleaseHandle;
   Hint.Free;
   Hint := nil;
 end; {RemoveHint}

The line marked <<<< above is the one that positions the hint
window below the control.  This could obviously be altered if
you want a different position for some reason.

Regards, Zif.

so, you just have to use the onmousemove event and look in which x,y position the mouse cursor is and then use the above code. regards, Zif

What will now happen with this question and all the help you got here ws1999?

     Hi, check this :

unit MovingHintF;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure ShowHint(var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnShowHint := ShowHint;
end;
{-----------------------------------------------------------------------------}
procedure TForm1.ShowHint(var HintStr: string; var CanShow: Boolean;
  var HintInfo: THintInfo);
var colorunder:string;
    Color:TColor;
begin
  if HintInfo.HintControl = Image1 then begin
    Label1.Caption:='Image1';
    With HintInfo do
    begin
        Color := Image1.Canvas.Pixels[CursorPos.x,CursorPos.y];
        case color of
          clgreen : colorunder := 'Green';
          clred : colorunder := 'Red';
          clblue : colorunder := 'Blue';
        end;
        HintStr := 'Image1:'+colorunder+IntToStr(CursorPos.x)+', '+IntToStr(CursorPos.y);
        CursorRect := Rect(0,0,0,0);
    end;
  end
  else begin
    Label1.Caption:='Form1';
    With HintInfo do
    begin
      If HintControl = self then
      Begin
        HintStr := IntToStr(CursorPos.x)+', '+IntToStr(CursorPos.y);
        CursorRect := Rect(0,0,0,0);
      end;
    end;
  end;
end;

end.

      , and if you need add remove hint manually (ZifNab).