unit ut_balloonhint;
inte***ce
uses
windows, messages,graphics, sysutils, stdctrls,commctrl;
const
tts_balloon = $40;
ttm_settitle = (wm_user + 32);
type
tballoonhint = class(tobject)
private
htooltip: cardinal; //氣球視窗控制代碼
hexternal : thandle; //外部控制項控制代碼（如按鈕等）
buffer : array[0..255] of char; //存放提示資訊
ti: ttoolinfo;
//backcolor,textcolor分別是背景顏色和文字顏色,如果是0則取預設值.
procedure addtooltip(hwnd: dword; lpti: ptoolinfo; icontype: integer; text, title: pchar; backcolor,textcolor:tcolor);
public
constructor create(hwnd: cardinal);
procedure showmsg(contype: integer; msg,msgtitle: string; backcolor :tcolor = 0; textcolor:tcolor =0);
end;
implementation
//**********====實現飛躍提示——包括提示的標題、內容、圖示等專案********************====
procedure tballoonhint.addtooltip(hwnd: dword; lpti: ptoolinfo;
icontype: integer; text, title: pchar; backcolor, textcolor: tcolor);
varrect: trect;
begin
if (hwnd <> 0) and (getclientrect(hwnd, rect)) then
begin
lpti.hwnd := hwnd;
lpti.rect := rect;
lpti.lpsztext := text;
sendmessage(htooltip, ttm_addtool, 0, integer(lpti));
fillchar(buffer, sizeof(buffer), #0);
lstrcpy(buffer, title);
if (icontype > 3) or (icontype < 0) then icontype := 0;
if backcolor<>0 then
sendmessage(htooltip, ttm_settipbkcolor, backcolor, 0);
if textcolor<>0 then
sendmessage(htooltip, ttm_settiptextcolor, textcolor, 0);
sendmessage(htooltip, ttm_settitle, icontype, integer(@buffer));
end;
end;
//**********====氣泡建構函式********************====
constructor tballoonhint.create(hwnd: cardinal);
begin
hexternal := hwnd;
// createwindowex 建立乙個具有擴充套件風格的子視窗
htooltip := createwindowex(0, 'tooltips_class32', nil, tts_alwaystip or tts_balloon,
integer(cw_usedefault), integer(cw_usedefault),integer(cw_usedefault),
integer(cw_usedefault), hwnd, 0, hinstance, nil);
if htooltip <> 0 then
begin
//設定位置
setwindowpos(htooltip, hwnd_topmost, 0,0, 0, 0, swp_nomove or swp_nosize or swp_noactivate);
ti.cbsize := sizeof(ttoolinfo);
ti.uflags := ttf_subclass or ttf_transparent;
ti.hinst := hinstance;
end;
end;
//**********====顯示氣泡提示********************====
procedure tballoonhint.showmsg(contype: integer; msg,msgtitle: string; backcolor, textcolor: tcolor);
begin
addtooltip(hexternal, @ti, contype, pchar(msg), pchar(msgtitle) ,backcolor,textcolor);
end;
end.
頁面2 ：
unit test;
inte***ce
uses
windows, messages, sysutils, variants, classes, graphics, controls, forms,
dialogs,ut_balloonhint, stdctrls;
type
tform1 = class(tform)
button1: tbutton;
button2: tbutton;
button3: tbutton;
button4: tbutton;
procedure button1click(sender: tobject);
procedure button2click(sender: tobject);
procedure button3click(sender: tobject);
procedure button4click(sender: tobject);
private
public
end;
varform1: tform1;
implementation
//***************===無圖示的飛躍提示***************===
procedure tform1.button1click(sender: tobject);
varh :tballoonhint;
begin
h := tballoonhint.create(button1.handle);
h.showmsg(0,'氣泡提示','');
h.free;
end;
//***************===藍色資訊提示圖示的飛躍提示***************===
procedure tform1.button2click(sender: tobject);
varh :tballoonhint;
begin
h := tballoonhint.create(button2.handle);
h.showmsg(1,'氣泡提示','資訊圖示');
h.free;
end;
//***************===黃色警告圖示的飛躍提示***************===
procedure tform1.button3click(sender: tobject);
varh :tballoonhint;
begin
h := tballoonhint.create(button3.handle);
h.showmsg(2,'氣泡提示','警告圖示');
h.free;
end;
//***************===紅色錯誤圖示的飛躍提示***************===
procedure tform1.button4click(sender: tobject);
varh :tballoonhint;
begin
h := tballoonhint.create(button4.handle);
h.showmsg(3,'氣泡提示','錯誤圖示');
h.free;
end;
end.
彈出式選單
彈出式選單 popmenu 大家都熟悉，在win98的桌面上單擊滑鼠右鍵彈出的選單就是彈出式選單。通常情況下，彈出式選單在滑鼠右鍵單擊時彈出，當然，也可以根據需要隨時彈出。在vc 5的mfc中，管理選單的類叫cmenu。下面我向大家介紹建立乙個彈出式選單的基本方法。一 在資源編輯器中建立乙個選單資源...
彈出式選單（PopMenu）
彈出式選單 popmenu 大家都熟悉，在win98的桌面上單擊滑鼠右鍵彈出的選單就是彈出式選單。通常情況下，彈出式選單在滑鼠右鍵單擊時彈出，當然，也可以根據需要隨時彈出。在vc 5的mfc中，管理選單的類叫cmenu。下面我向大家介紹建立乙個彈出式選單的基本方法。一 在資源編輯器中建立乙個選單資源...
製作彈出式選單
lonkil 很老的一篇關於選單的文章，還是不錯的。發出來吧！一 在資源編輯器中建立乙個選單資源 新建乙個選單資源，比如把選單的id號為idc popmenu。此選單有一項兩層，即有乙個可彈出的選單項，而此選單項的彈出內容即為將要建立的彈 出式選單的內容。如右圖，可彈出項 下的選單即為將要建立的彈出...