让应用程序在多桌面间自由飞翔

Windows支持多桌面，Delphi了支持多桌面，今天让程序也支持上多桌面了。

程序运行时会在标题栏最小化按钮旁边显示一个按钮（支持Theme效果），按钮引出一个菜单供用户选择要显示的桌面位置，通过它即可在多桌面间自由往返。（PS:可惜CSDN现在不能上图了。）

演示程序如下：

[c-sharp] view plain copy

1. unit Unit1;
2. interface
3. uses
4. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
5. Dialogs, uxtheme, StdCtrls, Menus;
6. type
7. TForm1 = class(TForm)
8. PopupMenu1: TPopupMenu;
9. procedure FormCreate(Sender: TObject);
10. procedure MenuItemClick(Sender: TObject);
11. private
12. ButtonLastState: Boolean;
13. procedure DrawThemeButton(Hot: Boolean);
14. public
15. procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT;
16. procedure WMActivate(var Msg: TWMActivate); message WM_ACTIVATE;
17. procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
18. procedure WMNCLButtonDown(var Msg: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
19. end;
20. var
21. Form1: TForm1;
22. implementation
23. {R *.dfm}
24. procedure TForm1.DrawThemeButton(Hot: Boolean);
25. var
26. ht: HTHEME;
27. WinDC: HDC;
28. R: TRect;
29. State: Integer;
30. begin
31. if ButtonLastState = Hot then Exit;
32. WinDC := GetWindowDC(Handle);
33. R.Left := Width-4*GetSystemMetrics(SM_CXSIZE)-1;//GetSystemMetrics(SM_CXFRAME);
34. R.Right := R.Left+GetSystemMetrics(SM_CXSIZE)-1;
35. R.Top := GetSystemMetrics(SM_CYFRAME);
36. R.Bottom := R.Top+GetSystemMetrics(SM_CYCAPTION)-1;
37. if IsAppThemed then begin
38. if Hot then State := SPLS_HOT else State := SPLS_NORMAL;
39. ht := OpenThemeData(Handle, ‘STARTPANEL‘);
40. DrawThemeBackground(ht, WinDC, SPP_LOGOFFBUTTONS, State, R, nil);
41. CloseThemeData(ht);
42. end else begin
43. InflateRect(R, 0, -2);
44. if Hot then State := DFCS_BUTTONPUSH or DFCS_HOT else State := DFCS_BUTTONPUSH;
45. DrawFrameControl(WinDC, R, DFC_BUTTON, State);
46. end;
47. ReleaseDC(Handle, WinDC);
48. ButtonLastState := Hot;
49. end;
50. procedure TForm1.MenuItemClick(Sender: TObject);
51. begin
52. if TMenuItem(Sender).Tag = Monitor.MonitorNum then Exit;
53. if WindowState = wsMaximized then begin
54. WindowState := wsNormal;
55. MakeFullyVisible(Screen.Monitors[TMenuItem(Sender).Tag]);
56. WindowState := wsMaximized;
57. end else
58. MakeFullyVisible(Screen.Monitors[TMenuItem(Sender).Tag]);
59. //Left := Screen.Monitors[TMenuItem(Sender).Tag].Left;
60. //Top := Screen.Monitors[TMenuItem(Sender).Tag].Top;
61. end;
62. procedure TForm1.FormCreate(Sender: TObject);
63. var
64. i: integer;
65. Item: TMenuItem;
66. begin
67. for i := 0 to Screen.MonitorCount - 1 do begin
68. Item := TMenuItem.Create(PopupMenu1);
69. Item.Caption := Format(‘显示器%d-[%d*%d]‘, [i+1,Screen.Monitors[i].Width,Screen.Monitors[i].Height]);
70. Item.Tag := i;
71. Item.OnClick := MenuItemClick;
72. PopupMenu1.Items.Add(Item);
73. end;
74. end;
75. procedure TForm1.WMActivate(var Msg: TWMActivate);
76. var
77. PaintMsg: TWMNCPaint;
78. begin
79. Msg.Result := 1;
80. if not Boolean(Msg.Active) then inherited
81. else begin
82. PaintMsg.Msg := Msg.Msg;
83. PaintMsg.RGN := Msg.Active;
84. WMNCPaint(PaintMsg);
85. end;
86. end;
87. procedure TForm1.WMNCHitTest(var Msg: TWMNCHitTest);
88. var
89. R: TRect;
90. Pt: TPoint;
91. begin
92. R.Left := Width-4*GetSystemMetrics(SM_CXSIZE);//GetSystemMetrics(SM_CXFRAME);
93. R.Right := R.Left+GetSystemMetrics(SM_CXSIZE)-1;
94. R.Top := GetSystemMetrics(SM_CYFRAME);
95. R.Bottom := R.Top+GetSystemMetrics(SM_CYCAPTION)-1;
96. Pt.X := Msg.Pos.x - Left;
97. Pt.Y := Msg.Pos.y - Top;
98. if PtInRect(R, Pt) then begin
99. Msg.Result := htSizeLast + 1;
100. DrawThemeButton(true);
101. end
102. else begin
103. inherited;
104. DrawThemeButton(false);
105. end;
106. end;
107. procedure TForm1.WMNCLButtonDown(var Msg: TWMNCLButtonDown);
108. begin
109. inherited;
110. if (Msg.HitTest = htSizeLast + 1) then
111. PopupMenu1.Popup(Left+Width-4*GetSystemMetrics(SM_CXSIZE), Top+GetSystemMetrics(SM_CYFRAME)+GetSystemMetrics(SM_CYCAPTION)-2);
112. end;
113. procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);
114. var
115. ht: HTHEME;
116. WinDC: HDC;
117. R: TRect;
118. begin
119. inherited;
120. if not Application.Active then Exit;
121. ButtonLastState := true;
122. DrawThemeButton(false);
123. end;
124. end.

DFM文件：

[delphi] view plain copy

1. object Form1: TForm1
2. Left = 0
3. Top = 0
4. Caption = ‘Form1‘
5. ClientHeight = 292
6. ClientWidth = 490
7. Color = clBtnFace
8. Font.Charset = DEFAULT_CHARSET
9. Font.Color = clWindowText
10. Font.Height = -11
11. Font.Name = ‘Tahoma‘
12. Font.Style = []
13. OldCreateOrder = False
14. OnCreate = FormCreate
15. PixelsPerInch = 96
16. TextHeight = 13
17. object PopupMenu1: TPopupMenu
18. Left = 112
19. Top = 152
20. end
21. end

http://blog.csdn.net/nhconch/article/details/4005102