前段時間因爲要在原來的軟件上增加一個快捷鍵提示窗體，這個提示窗要求在顯示的時候比較醒目美觀能引起用戶注意，顯示後不影響用戶操作，能夠關掉。很自然的就想到了Messenger那個從屏幕右下角逐漸彈出的消息提示窗體，不過相對Messenger我更喜歡QQ2004奧運版的配色風格，反正都是偷就多偷點吧，下面快捷鍵提示窗的最終效果：
這個窗體有以下幾個特點：
1、顯示的時候是從屏幕右下角逐漸彈出的；
2、它是個無標題窗體，但它必須允許用戶移動和改變大小，因此要用到無標題窗體拖動、改變大小的技術；
3、它是個不規則的窗體，主要是左上角和右上角是圓形導角，因此要爲窗體創建外形，且窗體改變大小時必須重建；
4、它標題和內容顯示區都有漸層色，標題還有幾個小點點，在實現時使用取巧的方法，直接利用截圖進行填充。
當然界面可以偷，代碼就得老老實實的寫的了，下面是界面設計圖和實現代碼：
界面formPSHotKey.frm內容 ［內容較長，請點擊此處找開/摺疊］
object frmPSHotKey: TfrmPSHotKey
Left = 192
Top = 107
BorderStyle = bsNone
Caption = '快捷鍵提示'
ClientHeight = 168
ClientWidth = 343
Color = clWhite
Constraints.MinWidth = 350
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = '宋體'
Font.Style = []
FormStyle = fsStayOnTop
OldCreateOrder = False
OnCreate = FormCreate
OnPaint = FormPaint
OnResize = FormResize
DesignSize = (
343
168)
PixelsPerInch = 96
TextHeight = 12
object imgTitleBar: TImage
Left = 0
Top = 0
Width = 343
Height = 12
Cursor = crSizeAll
Align = alTop
AutoSize = True
Center = True
Picture.Data = {
07544269746D6170EE010000424DEE010000000000006E000000280000003900
00000C000000010004000000000080010000120B0000120B00000E0000000E00
0000D79D8B00A83A1700F8E6D600C9775E00F6DFCB00FAEDE200F4D7BE00F5DA
C200EAD2BF00FCF5EE00FEFBF800BE796B00FFFFFF0000000000BBBBBBBBBBBB
BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB000D0D0888888888888
888888888888888888888888888888888888888888888000BBBB666666666666
6666666666666666666666666666666666666666666660008888777777777777
777777777777777777777777777777777777777777777000666644CC44CC44CC
44CC44CC44CC44CC44CC44CC44CC44CC44CC44CC44CC40007777231C231C231C
231C231C231C231C231C231C231C231C231C231C231C200044CC503550355035
503550355035503550355035503550355035503550355000231C999999999999
9999999999999999999999999999999999999999999990005035AAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA0009999CCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC000AAAABBBBBBBBBBBB
BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB000CCCCBBBBBBBBBBBB
BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB000BBBB}
OnMouseDown = imgTitleBarMouseDown
OnMouseMove = imgTitleBarMouseMove
end
object imgTitleBarBG: TImage
Left = 248
Top = 32
Width = 7
Height = 12
AutoSize = True
Picture.Data = {
07544269746D617092000000424D920000000000000062000000280000000700
00000C000000010004000000000030000000120B0000120B00000B0000000B00
0000F4D7BE00F8E6D600F6DFCB00F5DAC200EAD2BF00FCF5EE00FEFBF800FAED
E200BE796B00FFFFFF0000000000888888804444444000000000333333302222
222011111110777777705555555066666660999999908888888088888880}
Visible = False
end
object imgShapeBG: TImage
Left = 280
Top = 48
Width = 3
Height = 56
AutoSize = True
Picture.Data = {
07544269746D6170DA010000424DDA01000000000000FA000000280000000300
0000380000000100080000000000E0000000120B0000120B0000310000003100
000000000000FFFFFF00FFFCFC00FFFDFD00FFF9F800FFFAF900FFFBFA00FFF6
F300FFF7F400FFF9F700FFFCFB00FFF0EA00FFF3EE00FFF5F100FFFAF800FFE5
D900FFE7DC00FFE9DF00FFEBE200FFEDE500FFEEE600FFEFE800FFF0E900FFF2
EC00FFF4EF00FFF6F200FFF8F500FFE5D800FFE6D900FFE6DA00FFE7DB00FFE8
DC00FFE8DD00FFE9DE00FFEAE000FFEBE100FFECE300FFEDE400FFEFE700FFF1
EA00FFF3ED00FFF5F000FFF7F300FFF9F600FFFBF900FFFDFC00FFE9DD00FFEC
E200FFF2EB001B1B1B000F0F0F001C1C1C001D1D1D001D1D1D001E1E1E001E1E
1E00101010001F1F1F00202020002E2E2E002121210011111100222222002222
220023232300121212002F2F2F00242424002525250013131300141414001414
14002626260015151500161616000B0B0B002727270030303000171717002828
28000C0C0C001818180018181800292929000D0D0D0019191900070707002A2A
2A00080808001A1A1A001A1A1A002B2B2B0009090900040404000E0E0E000505
05002C2C2C0006060600060606000A0A0A000A0A0A00020202002D2D2D000303
030003030300}
Visible = False
end
object SpeedButton1: TSpeedButton
Left = 323
Top = 16
Width = 14
Height = 14
Anchors = [akTop, akRight]
Flat = True
Glyph.Data = {
8A000000424D8A00000000000000420000002800000009000000090000000100
04000000000048000000120B0000120B00000300000003000000BE604200FFFF
FF00000000001111111110000200100111001000111110001000100010011100
0001100010001110001110001100110000011000111010001000100011001001
1100100010001111111110001001}
OnClick = SpeedButton1Click
end
object Label1: TLabel
Left = 16
Top = 24
Width = 60
Height = 12
Caption = '快捷鍵提示'
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = '宋體'
Font.Style = []
ParentFont = False
Transparent = True
end
object Label2: TLabel
Left = 16
Top = 99
Width = 294
Height = 12
Caption = 'A：光標在“編號”列時，切換數據類型爲“步驟類型”'
Transparent = True
end
object Label3: TLabel
Left = 16
Top = 118
Width = 318
Height = 12
Caption = 'B：光標在“編號”列時，切換數據類型爲“工藝要求類型”'
Transparent = True
end
object Label4: TLabel
Left = 16
Top = 138
Width = 294
Height = 12
Caption = 'C：光標在“編號”列時，切換數據類型爲“用料類型”'
Transparent = True
end
object Label5: TLabel
Left = 16
Top = 42
Width = 132
Height = 12
Caption = 'Alt+↓：打開下拉列表框'
Transparent = True
end
object Label6: TLabel
Left = 16
Top = 61
Width = 108
Height = 12
Caption = 'Ctrl+Ins：插入一行'
Transparent = True
end
object Label7: TLabel
Left = 16
Top = 80
Width = 120
Height = 12
Caption = 'Ctrl+Del：刪除當前行'
Transparent = True
end
object Label8: TLabel
Left = 174
Top = 42
Width = 138
Height = 12
Caption = 'Ins：打開“工藝名稱表”'
Transparent = True
end
object Label9: TLabel
Left = 174
Top = 61
Width = 90
Height = 12
Caption = 'F11：插入“℃”'
Transparent = True
end
object Label10: TLabel
Left = 174
Top = 80
Width = 90
Height = 12
Caption = 'F12：插入“′”'
Transparent = True
end
object Label11: TLabel
Left = 0
Top = 165
Width = 343
Height = 3
Cursor = crSizeNS
Align = alBottom
AutoSize = False
Transparent = True
OnMouseDown = Label11MouseDown
OnMouseMove = Label11MouseMove
end
object Label12: TLabel
Left = 0
Top = 12
Width = 3
Height = 153
Cursor = crSizeWE
Align = alLeft
AutoSize = False
Transparent = True
OnMouseDown = Label12MouseDown
end
object Label13: TLabel
Left = 340
Top = 12
Width = 3
Height = 153
Cursor = crSizeWE
Align = alRight
AutoSize = False
Transparent = True
OnMouseDown = Label13MouseDown
end
end
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Buttons;
{========================================================================
DESIGN BY : 彭國輝
DATE: 2004-10-28
SITE: http://kacarton.yeah.net/
BLOG: http://blog.csdn.net/nhconch
EMAIL: [email protected]
文章爲作者原創，轉載前請先與本人聯繫，轉載請註明文章出處、保留作者信息，謝謝支持！
=========================================================================}
type
TfrmPSHotKey = class(TForm)
imgTitleBar: TImage;
imgTitleBarBG: TImage;
imgShapeBG: TImage;
SpeedButton1: TSpeedButton;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
Label11: TLabel;
Label12: TLabel;
Label13: TLabel;
procedure FormPaint(Sender: TObject);
procedure imgTitleBarMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure Label11MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormResize(Sender: TObject);
procedure Label12MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Label13MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure imgTitleBarMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Label11MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmPSHotKey: TfrmPSHotKey;
implementation
{$R *.dfm}
procedure TfrmPSHotKey.FormCreate(Sender: TObject);
begin
Tag := Height;
Height := 16;
//定位到屏幕右下角
Top := Screen.Height - 40;
Left := Screen.Width - Width - 2;
Show;
//從屏幕右下角逐漸彈出
while Height<Tag do begin
Height := Height + 5;
Top := Top - 5;
Update;
Application.ProcessMessages;
Sleep(10);
end;
Height := Tag;
Tag := 0;
Color := $F4BA9D;
FormResize(Sender);
end;
procedure TfrmPSHotKey.FormPaint(Sender: TObject);
var
i: integer;
rgn: HRGN;
r: TRect;
begin
with Canvas do begin
//利用imgTitleBarBG繪製標題背景
for i:=0 to ClientWidth div imgTitleBarBG.Width do
Draw(i*imgTitleBarBG.Width, 0, imgTitleBarBG.Picture.Bitmap);
if Tag<>0 then Exit; //如果窗體正在彈出狀態，不繪製內容面板背景
//繪製內容面板背景
SetRect(r, 5, 15, Width-5, Height-5);
StretchDraw(r, imgShapeBG.Picture.Bitmap);
Brush.Style := bsClear;
RoundRect(r.Left, r.Top, r.Right, r.Bottom, 6, 6);
//繪製窗體邊框
rgn := CreateRectRgn(0,0,0,0);
GetWindowRgn(Self.Handle, rgn);
Brush.Color := $BE796B;
windows.FrameRgn(Handle, rgn, Brush.Handle, 2, 2);
DeleteObject(rgn);
end;
end;
procedure TfrmPSHotKey.imgTitleBarMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
//在標題按下鼠標鍵時，允許移動窗體或改變窗體大小
ReleaseCapture;
if X < 5 then Perform(WM_SYSCOMMAND, $F004, 0)
else if X > Width - 5 then Perform(WM_SYSCOMMAND, $F005, 0)
else if Y < 3 then Perform(WM_SYSCOMMAND, $F003, 0)
else Perform(WM_SYSCOMMAND, $F012, 0);
end;
procedure TfrmPSHotKey.FormResize(Sender: TObject);
var
rgn, rgn2: HRGN;
begin
if Tag<>0 then Exit;
//窗體改變大小時重建Rgn
rgn := CreateRoundRectRgn(0, 0, Width+1, Height, 4, 4);
rgn2 := CreateRectRgn(0, 11, Width, Height);
CombineRgn(rgn, rgn, rgn2, RGN_OR);
SetWindowRgn(Handle, rgn, True);
DeleteObject(rgn);
DeleteObject(rgn2);
Invalidate;
end;
procedure TfrmPSHotKey.SpeedButton1Click(Sender: TObject);
begin
Close;
end;
//以下幾個Label用來改變窗體大小
procedure TfrmPSHotKey.Label11MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
if X < 5 then Perform(WM_SYSCOMMAND, $F007, 0)
else if X > Width - 5 then Perform(WM_SYSCOMMAND, $F008, 0)
else Perform(WM_SYSCOMMAND, $F006, 0);
end;
procedure TfrmPSHotKey.Label12MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
Perform(WM_SYSCOMMAND, $F001, 0);
end;
procedure TfrmPSHotKey.Label13MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
Perform(WM_SYSCOMMAND, $F002, 0);
end;
//下面代碼判斷鼠標所在位置，並改變鼠標光標，提示用戶可以拖動窗體或改變大小
procedure TfrmPSHotKey.imgTitleBarMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
if X < 5 then imgTitleBar.Cursor := crSizeNWSE
else if X > Width - 5 then imgTitleBar.Cursor := crSizeNESW
else if Y < 3 then imgTitleBar.Cursor := crSizeNS
else imgTitleBar.Cursor := crSizeAll;
end;
procedure TfrmPSHotKey.Label11MouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
if X < 5 then Label11.Cursor := crSizeNESW
else if X > Width - 5 then Label11.Cursor := crSizeNWSE
else Label11.Cursor := crSizeNS;
end;
end.
