气泡提示（200分) ( 积分: 200 )

telliu · 2005-04-20

我看了一些代码都类似于ShowHit（都会片刻后会消失），要鼠标移上去才有气泡提示 请教各位，保留原有的功能，我还想指定气泡show的位置，这样我就不用老用messagebox了 他们的代码是用createwindowex建立的，我想应该可以指定位置的。 谢谢了，献上二百分

telliu · 2005-04-20

我看了一些代码都类似于ShowHit（都会片刻后会消失），要鼠标移上去才有气泡提示 请教各位，保留原有的功能，我还想指定气泡show的位置，这样我就不用老用messagebox了 他们的代码是用createwindowex建立的，我想应该可以指定位置的。 谢谢了，献上二百分

Avalon · 2005-04-20

procedure TForm1.Button1Click(Sender: TObject); var  rect :TRect;  MaxWidth,width,height:Integer;  point:TPoint;  x:THintWindow;  i:Integer; begin x := THintWindow.Create(Application); rect := x.CalcHintRect(MaxWidth,Button2.hint,nil); width:=rect.Bottom-rect.Top; height:=rect.Right-rect.Left; point.x:=Button2.Left+Button2.Width;    //显示位置 point.y:=Button2.Top+Button2.Height;    //显示位置 Point:=ClientToScreen(Point); rect.Left:=point.x; rect.Top:=point.y; rect.Right:=point.x+height; rect.Bottom:=point.y+width; x.Color := clWhite; x.ActivateHint(rect,Button2.Hint); for i:=1 to 10000000 do   Application.ProcessMessages; //延时最好不用sleep x.Free; end;

hxb_leiyuan · 2005-04-21

使用cooltray控件，到园地上下载

Beyondbill · 2005-04-21

(一个不错的HINT控件) unit Danhint; interface uses SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs; type THintDirection=(hdUpRight,hdUpLeft,hdDownRight,hdDownLeft); TOnSelectHintDirection=procedure(HintControl:TControl;var HintDirection:THintDirection) of object; TDanHint = class(TComponent) private { Private declarations } FHintDirection:THintDirection; FHintColor:TColor; FHintShadowColor:TColor; FHintFont:TFont; FHintPauseTime:Integer; FOnSelectHintDirection:TOnSelectHintDirection; procedure SetHintDirection(Value:THintDirection); procedure SetHintColor(Value:TColor); procedure SetHintShadowColor(Value:TColor); procedure SetHintFont(Value:TFont); procedure CMFontChanged(var Message:TMessage); message CM_FONTCHANGED; procedure SetHintPauseTime(Value:Integer); protected { Protected declarations } public { Public declarations } constructor Create(AOwner:TComponent);override; destructor Destroy;override; procedure Loaded;override; procedure SetNewHintFont; published { Published declarations } property HintDirection:THintDirection read FHintDirection write SetHintDirection default hdUpRight; property HintColor:TColor read FHintColor write SetHintColor default clYellow; property HintShadowColor:TColor read FHintShadowColor write SetHintShadowColor default clPurple; property HintFont:TFont read FHintFont write SetHintFont; property HintPauseTime:Integer read FHintPauseTime write SetHintPauseTime default 600; property OnSelectHintDirection:TOnSelectHintDirection read FOnSelectHintDirection write FOnSelectHintDirection; end; TNewHint = class(THintWindow) private { Private declarations } FDanHint:TDanHint; FHintDirection:THintDirection; procedure SelectProperHintDirection(ARect:TRect); procedure CheckUpRight(Spot:TPoint); procedure CheckUpLeft(Spot:TPoint); procedure CheckDownRight(Spot:TPoint); procedure CheckDownLeft(Spot:TPoint); function FindDanHint:TDanHint; function FindCursorControl:TControl; protected { Protected declarations } procedure Paint;override; procedure CreateParams(var Params: TCreateParams);override; public { Public declarations } constructor Create(AOwner:TComponent);override; destructor Destroy;override; procedure ActivateHint(Rect: TRect; const AHint: string);override; property HintDirection:THintDirection read FHintDirection write FHintDirection default hdUpRight; published { Published declarations } end; procedure Register; implementation const SHADOW_WIDTH=6; N_PIXELS=5; var MemBmp:TBitmap; UpRect,DownRect:TRect; SelectHintDirection:THintDirection; ShowPos:TPoint; procedure Register; begin RegisterComponents('ActiveX', [TDanHint]); end; procedure TDanHint.SetNewHintFont; var I:Integer; begin for I:=0 to Application.ComponentCount-1 do if Application.Components is TNewHint then begin TNewHint(Application.Components).Canvas.Font.Assign(FHintFont); Exit; end; end; constructor TDanHint.Create(AOwner:TComponent); begin inherited Create(AOwner); FHintDirection:=hdUpRight; FHintColor:=clYellow; { $0080FFFF is Delphi's original setting } FHintShadowColor:=clPurple; FHintPauseTime:=600; Application.HintPause:=FHintPauseTime; FHintFont:=TFont.Create; FHintFont.Name:='MS Sans Serif'; FHintFont.Size:=12; FHintFont.Color:=clBlue; FHintFont.Pitch:=fpDefault; FHintFont.Style:=FHintFont.Style+[fsBold,fsItalic]; if not (csDesigning in ComponentState) then begin HintWindowClass:=TNewHint; Application.ShowHint:=not Application.ShowHint; Application.ShowHint:=not Application.ShowHint; { in TApplication's SetShowHint, the private FHintWindow is allocated according to HintWindowClass, so here do so actions to call SetShowHint and keep ShowHint property the same value } SetNewHintFont; end; end; destructor TDanHint.Destroy; begin FHintFont.Free; inherited Destroy; end; procedure TDanHint.Loaded; begin if not (csDesigning in ComponentState) then begin inherited Loaded; HintWindowClass:=TNewHint; Application.ShowHint:=not Application.ShowHint; Application.ShowHint:=not Application.ShowHint; { to activate to allocate a new Hint Window } SetNewHintFont; end; end; procedure TDanHint.SetHintDirection(Value:THintDirection); begin FHintDirection:=Value; end; procedure TDanHint.SetHintColor(Value:TColor); begin FHintColor:=Value; end; procedure TDanHint.SetHintShadowColor(Value:TColor); begin FHintShadowColor:=Value; end; procedure TDanHint.SetHintFont(Value:TFont); begin FHintFont.Assign(Value); Application.ShowHint:=not Application.ShowHint; Application.ShowHint:=not Application.ShowHint; { to activate to allocate a new Hint Window } SetNewHintFont; end; procedure TDanHint.CMFontChanged(var Message:TMessage); begin inherited; Application.ShowHint:=not Application.ShowHint; Application.ShowHint:=not Application.ShowHint; { to activate to allocate a new Hint Window } SetNewHintFont; end; procedure TDanHint.SetHintPauseTime(Value:Integer); begin if (Value<>FHintPauseTime) then begin FHintPauseTime:=Value; Application.HintPause:=Value; end; end; function TNewHint.FindDanHint:TDanHint; var I:Integer; begin Result:=nil; for I:=0 to Application.MainForm.ComponentCount-1 do if Application.MainForm.Components is TDanHint then begin Result:=TDanHint(Application.MainForm.Components); Exit; end; end; constructor TNewHint.Create(AOwner:TComponent); begin inherited Create(AOwner); {if (Application<>nil) and (Application.MainForm<>nil) then FDanHint:=FindDanHint;} ControlStyle:=ControlStyle-[csOpaque]; with Canvas do begin { Font.Name:='MS Sans Serif'; Font.Size:=10;} {if (FDanHint<>nil) then Font.Assign(FDanHint.HintFont);} Brush.Style:=bsClear; Brush.Color:=clBackground; Application.HintColor:=clBackground; end; FHintDirection:=hdUpRight; end; destructor TNewHint.Destroy; begin inherited Destroy; end; procedure TNewHint.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); with Params do begin {Style := WS_POPUP or WS_BORDER or WS_DISABLED;} Style := Style-WS_BORDER; {ExStyle:=ExStyle or WS_EX_TRANSPARENT;} {Add the above makes the beneath window overlap hint} WindowClass.Style := WindowClass.Style or CS_SAVEBITS; end; end; procedure TNewHint.Paint; var R: TRect; CCaption: array[0..255] of Char; FillRegion,ShadowRgn:HRgn; AP:array[0..2] of TPoint; { Points of the Arrow } SP:array[0..2] of TPoint; { Points of the Shadow } X,Y:Integer; AddNum:Integer; { Added num for hdDownXXX } begin R := ClientRect; { R is for Text output } Inc(R.Left,5+3); Inc(R.Top,3); AddNum:=0; if FHintDirection>=hdDownRight then AddNum:=15; Inc(R.Top,AddNum); case HintDirection of hdUpRight:begin AP[0]:=Point(10,Height-15); AP[1]:=Point(20,Height-15); AP[2]:=Point(0,Height); SP[0]:=Point(12,Height-15); SP[1]:=Point(25,Height-15); SP[2]:=Point(12,Height); end; hdUpLeft:begin AP[0]:=Point(Width-SHADOW_WIDTH-20,Height-15); AP[1]:=Point(Width-SHADOW_WIDTH-10,Height-15); AP[2]:=Point(Width-SHADOW_WIDTH,Height); SP[0]:=Point(Width-SHADOW_WIDTH-27,Height-15); SP[1]:=Point(Width-SHADOW_WIDTH-5,Height-15); SP[2]:=Point(Width-SHADOW_WIDTH,Height); end; hdDownRight:begin AP[0]:=Point(10,15); AP[1]:=Point(20,15); AP[2]:=Point(0,0); { for hdDownXXX, SP not used now } SP[0]:=Point(12,Height-15); SP[1]:=Point(25,Height-15); SP[2]:=Point(12,Height); end; hdDownLeft:begin AP[0]:=Point(Width-SHADOW_WIDTH-20,15); AP[1]:=Point(Width-SHADOW_WIDTH-10,15); AP[2]:=Point(Width-SHADOW_WIDTH,0); { for hdDownXXX, SP not used now } SP[0]:=Point(12,Height-15); SP[1]:=Point(25,Height-15); SP[2]:=Point(12,Height); end; end; { Draw Shadow of the Hint Rect} if (FHintDirection<=hdUpLeft) then begin ShadowRgn:=CreateRoundRectRgn(0+10,0+8,Width,Height-9,8,8); { 8 is for RoundRect's corner } for X:=Width-SHADOW_WIDTH-8 to Width do for Y:=8 to Height-14 do begin if (Odd(X)=Odd(Y)) and PtInRegion(ShadowRgn,X,Y) then MemBmp.Canvas.Pixels[X,Y]:=FDanHint.HintShadowColor; end; for X:=10 to Width do for Y:=Height-14 to Height-9 do begin if (Odd(X)=Odd(Y)) and PtInRegion(ShadowRgn,X,Y) then MemBmp.Canvas.Pixels[X,Y]:=FDanHint.HintShadowColor; end; end else { for hdDownXXX } begin ShadowRgn:=CreateRoundRectRgn(0+10,0+8+15,Width,Height-2,8,8); for X:=Width-SHADOW_WIDTH-8 to Width do for Y:=23 to Height-8 do begin if (Odd(X)=Odd(Y)) and PtInRegion(ShadowRgn,X,Y) then MemBmp.Canvas.Pixels[X,Y]:=FDanHint.HintShadowColor; end; for X:=10 to Width do for Y:=Height-8 to Height-2 do begin if (Odd(X)=Odd(Y)) and PtInRegion(ShadowRgn,X,Y) then MemBmp.Canvas.Pixels[X,Y]:=FDanHint.HintShadowColor; end; end; DeleteObject(ShadowRgn); { Draw the shadow of the arrow } if (HintDirection<=hdUpLeft) then begin ShadowRgn:=CreatePolygonRgn(SP,3,WINDING); for X:=SP[0].X to SP[1].X do for Y:=SP[0].Y to SP[2].Y do begin if (Odd(X)=Odd(Y)) and PtInRegion(ShadowRgn,X,Y) then MemBmp.Canvas.Pixels[X,Y]:=FDanHint.HintShadowColor; end; DeleteObject(ShadowRgn); end; { Draw HintRect } MemBmp.Canvas.Pen.Color:=clBlack; MemBmp.Canvas.Pen.Style:=psSolid; MemBmp.Canvas.Brush.Color:=FDanHint.HintColor; MemBmp.Canvas.Brush.Style:=bsSolid; if (FHintDirection<=hdUpLeft) then MemBmp.Canvas.RoundRect(0,0,Width-SHADOW_WIDTH,Height-14,9,9) else MemBmp.Canvas.RoundRect(0,0+AddNum,Width-SHADOW_WIDTH,Height-14+6,9,9); { Draw Hint Arrow } MemBmp.Canvas.Pen.Color:=FDanHint.HintColor; MemBmp.Canvas.MoveTo(AP[0].X,AP[0].Y); MemBmp.Canvas.LineTo(AP[1].X,AP[1].Y); MemBmp.Canvas.Pen.Color:=clBlack; FillRegion:=CreatePolygonRgn(AP,3,WINDING); FillRgn(MemBmp.Canvas.Handle,FillRegion,MemBmp.Canvas.Brush.Handle); DeleteObject(FillRegion); MemBmp.Canvas.LineTo(AP[2].X,AP[2].Y); MemBmp.Canvas.LineTo(AP[0].X,AP[0].Y); { SetBkMode makes DrawText's text be transparent } SetBkMode(MemBmp.Canvas.Handle,TRANSPARENT); MemBmp.Canvas.Font.Assign(FDanHint.HintFont); DrawText(MemBmp.Canvas.Handle, StrPCopy(CCaption, Caption), -1, R, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK); Canvas.CopyMode:=cmSrcCopy; Canvas.CopyRect(ClientRect,MemBmp.Canvas,ClientRect); MemBmp.Free; end; procedure TNewHint.CheckUpLeft(Spot:TPoint); var Width,Height:Integer; begin Dec(Spot.Y,N_PIXELS); Width:=UpRect.Right-UpRect.Left; Height:=UpRect.Bottom-UpRect.Top; SelectHintDirection:=hdUpLeft; if (Spot.X+SHADOW_WIDTH-Width)<0 then begin Inc(Spot.Y,N_PIXELS);{back tp original} CheckUpRight(Spot); Exit; end; if (Spot.Y-Height)<0 then begin Inc(Spot.Y,N_PIXELS); CheckDownLeft(Spot); Exit; end; ShowPos.X:=Spot.X+SHADOW_WIDTH-Width; ShowPos.Y:=Spot.Y-Height; end; procedure TNewHint.CheckUpRight(Spot:TPoint); var Width,Height:Integer; begin Dec(Spot.Y,N_PIXELS); Width:=UpRect.Right-UpRect.Left; Height:=UpRect.Bottom-UpRect.Top; SelectHintDirection:=hdUpRight; if (Spot.X+Width)>Screen.Width then begin Inc(Spot.Y,N_PIXELS); CheckUpLeft(Spot); Exit; end; if (Spot.Y-Height)<0 then begin Inc(Spot.Y,N_PIXELS); CheckDownRight(Spot); Exit; end; ShowPos.X:=Spot.X; ShowPos.Y:=Spot.Y-Height; end; procedure TNewHint.CheckDownRight(Spot:TPoint); var Width,Height:Integer; begin Inc(Spot.Y,N_PIXELS*3); Width:=DownRect.Right-DownRect.Left; Height:=DownRect.Bottom-DownRect.Top; SelectHintDirection:=hdDownRight; if (Spot.X+Width)>Screen.Width then begin Dec(Spot.Y,N_PIXELS*3); CheckDownLeft(Spot); Exit; end; if (Spot.Y+Height)>Screen.Height then begin Dec(Spot.Y,N_PIXELS*3); CheckUpRight(Spot); Exit; end; ShowPos.X:=Spot.X; ShowPos.Y:=Spot.Y; end; procedure TNewHint.CheckDownLeft(Spot:TPoint); var Width,Height:Integer; begin Inc(Spot.Y,N_PIXELS*3); Width:=DownRect.Right-DownRect.Left; Height:=DownRect.Bottom-DownRect.Top; SelectHintDirection:=hdDownLeft; if (Spot.X+SHADOW_WIDTH-Width)<0 then begin Dec(Spot.Y,N_PIXELS*3); CheckDownRight(Spot); Exit; end; if (Spot.Y+Height)>Screen.Height then begin Dec(Spot.Y,N_PIXELS*3); CheckUpLeft(Spot); Exit; end; ShowPos.X:=Spot.X+SHADOW_WIDTH-Width; ShowPos.Y:=Spot.Y; end; function TNewHint.FindCursorControl:TControl; begin {ControlAtPos} end; procedure TNewHint.SelectProperHintDirection(ARect:TRect); var Spot:TPoint; OldHintDirection,SendHintDirection:THintDirection; HintControl:TControl; begin GetCursorPos(Spot); HintCOntrol:=FindDragTarget(Spot,True); Inc(ARect.Right,10+SHADOW_WIDTH); Inc(ARect.Bottom,20); UpRect:=ARect; Inc(ARect.Bottom,9); DownRect:=ARect; OldHintDirection:=FDanHint.HintDirection; SendHintDirection:=FDanHint.HintDirection; { Tricky, why here can't use FDanHint.OnSe...? } if Assigned(FDanHint.FOnSelectHintDirection) then begin FDanHint.FOnSelectHintDirection(HintControl,SendHintDirection); FDanHint.HintDirection:=SendHintDirection; end; case FDanHint.HintDirection of hdUpRight:CheckUpRight(Spot); hdUpLeft:CheckUpLeft(Spot); hdDownRight:CheckDownRight(Spot); hdDownLeft:CheckDownLeft(Spot); end; FDanHint.HintDirection:=OldHintDirection; end; procedure TNewHint.ActivateHint(Rect: TRect; const AHint: string); var ScreenDC:HDC; LeftTop:TPoint; tmpWidth,tmpHeight:Integer; begin MemBmp:=TBitmap.Create; Caption := AHint; { add by Dan from Here } FDanHint:=FindDanHint; SelectProperHintDirection(Rect); HintDirection:=SelectHintDirection; { if the following changes, make sure to modify SelectProperHintDirection also } Inc(Rect.Right,10+SHADOW_WIDTH); Inc(Rect.Bottom,20); if (FHintDirection>=hdDownRight) then Inc(Rect.Bottom,9); { to expand the rect } tmpWidth:=Rect.Right-Rect.Left; tmpHeight:=Rect.Bottom-Rect.Top; Rect.Left:=ShowPos.X; Rect.Top:=ShowPos.Y; Rect.Right:=Rect.Left+tmpWidth; Rect.Bottom:=Rect.Top+tmpHeight; BoundsRect := Rect; MemBmp.Width:=Width; MemBmp.Height:=Height; ScreenDC:=CreateDC('DISPLAY',nil,nil,nil); LeftTop.X:=0; LeftTop.Y:=0; LeftTop:=ClientToScreen(LeftTop); { use MemBmp to store the original bitmap on screen } BitBlt(MemBmp.Canvas.Handle,0,0,Width,Height,ScreenDC, LeftTop.X,LeftTop.Y,SRCCOPY); { SetBkMode(Canvas.Handle,TRANSPARENT);} SetWindowPos(Handle, HWND_TOPMOST, ShowPos.X, ShowPos.Y, 0, 0, SWP_SHOWWINDOW or SWP_NOACTIVATE or SWP_NOSIZE); BitBlt(Canvas.Handle,0,0,Width,Height,MemBmp.Canvas.Handle, 0,0,SRCCOPY); DeleteDC(ScreenDC); end; initialization end.

moonight59 · 2005-04-22

到我的blog上看这篇文章 http://moonight.yculblog.com/post.638979.html 是从CSDN转的 还有这篇也可以看看 http://moonight.yculblog.com/post.638833.html 或许有帮助

telliu · 2005-04-22

cooltray 要做到我的功能应该如何改代码？ 它只对任务栏  TrayIcon1.ShowBalloonHint('Balloon hint',        'Use the balloon hint to display important information.' + #13 +        'The text can be max. 255 chars. and the title max. 64 chars.',        bitInfo, 10); 它这个倒是我想要的，可是它只在右下面显示，而我需要在其它地方显示 其它兄弟给的代码，我正在看，测试完就发分，谢谢各位

telliu · 2005-04-23

Avalon,  的代码只是提示条并没像气泡有个气嘴 然后我结合 Beyondbill, 在newhint增加 Fpoint : Tpoint; TNewHint.ActivateHint中修改 { SetWindowPos(Handle, HWND_TOPMOST, ShowPos.X, ShowPos.Y, 0, 0, SWP_SHOWWINDOW or SWP_NOACTIVATE or SWP_NOSIZE); } SetWindowPos(Handle, HWND_TOPMOST, Fpoint.X, Fpoint.Y, 0, 0, SWP_SHOWWINDOW or SWP_NOACTIVATE or SWP_NOSIZE); 问题已解决  谢谢 不知各位还有什么好的办法

telliu · 2005-04-29

多人接受答案了。

气泡提示（200分) ( 积分: 200 )

telliu

Unregistered / Unconfirmed

telliu

Unregistered / Unconfirmed

Avalon

Unregistered / Unconfirmed

hxb_leiyuan

Unregistered / Unconfirmed

Beyondbill

Unregistered / Unconfirmed

moonight59

Unregistered / Unconfirmed

telliu

Unregistered / Unconfirmed

telliu

Unregistered / Unconfirmed

telliu

Unregistered / Unconfirmed

Similar threads