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

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

【推广】 免费学中医，健康全家人
原文地址：https://www.cnblogs.com/findumars/p/5393711.html