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

时间：2016-04-15 01:55:50 阅读：260 评论：0 收藏：0 [点我收藏+]

标签：

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

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

演示程序如下：

[c-sharp] view plain copy

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, uxtheme, StdCtrls, Menus;
type
TForm1 = class(TForm)
PopupMenu1: TPopupMenu;
procedure FormCreate(Sender: TObject);
procedure MenuItemClick(Sender: TObject);
private
ButtonLastState: Boolean;
procedure DrawThemeButton(Hot: Boolean);
public
procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT;
procedure WMActivate(var Msg: TWMActivate); message WM_ACTIVATE;
procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
procedure WMNCLButtonDown(var Msg: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
end;
var
Form1: TForm1;
implementation
{R *.dfm}
procedure TForm1.DrawThemeButton(Hot: Boolean);
var
ht: HTHEME;
WinDC: HDC;
R: TRect;
State: Integer;
begin
if ButtonLastState = Hot then Exit;
WinDC := GetWindowDC(Handle);
R.Left := Width-4*GetSystemMetrics(SM_CXSIZE)-1;//GetSystemMetrics(SM_CXFRAME);
R.Right := R.Left+GetSystemMetrics(SM_CXSIZE)-1;
R.Top := GetSystemMetrics(SM_CYFRAME);
R.Bottom := R.Top+GetSystemMetrics(SM_CYCAPTION)-1;
if IsAppThemed then begin
if Hot then State := SPLS_HOT else State := SPLS_NORMAL;
ht := OpenThemeData(Handle, ‘STARTPANEL‘);
DrawThemeBackground(ht, WinDC, SPP_LOGOFFBUTTONS, State, R, nil);
CloseThemeData(ht);
end else begin
InflateRect(R, 0, -2);
if Hot then State := DFCS_BUTTONPUSH or DFCS_HOT else State := DFCS_BUTTONPUSH;
DrawFrameControl(WinDC, R, DFC_BUTTON, State);
end;
ReleaseDC(Handle, WinDC);
ButtonLastState := Hot;
end;
procedure TForm1.MenuItemClick(Sender: TObject);
begin
if TMenuItem(Sender).Tag = Monitor.MonitorNum then Exit;
if WindowState = wsMaximized then begin
WindowState := wsNormal;
MakeFullyVisible(Screen.Monitors[TMenuItem(Sender).Tag]);
WindowState := wsMaximized;
end else
MakeFullyVisible(Screen.Monitors[TMenuItem(Sender).Tag]);
//Left := Screen.Monitors[TMenuItem(Sender).Tag].Left;
//Top := Screen.Monitors[TMenuItem(Sender).Tag].Top;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
i: integer;
Item: TMenuItem;
begin
for i := 0 to Screen.MonitorCount - 1 do begin
Item := TMenuItem.Create(PopupMenu1);
Item.Caption := Format(‘显示器%d-[%d*%d]‘, [i+1,Screen.Monitors[i].Width,Screen.Monitors[i].Height]);
Item.Tag := i;
Item.OnClick := MenuItemClick;
PopupMenu1.Items.Add(Item);
end;
end;
procedure TForm1.WMActivate(var Msg: TWMActivate);
var
PaintMsg: TWMNCPaint;
begin
Msg.Result := 1;
if not Boolean(Msg.Active) then inherited
else begin
PaintMsg.Msg := Msg.Msg;
PaintMsg.RGN := Msg.Active;
WMNCPaint(PaintMsg);
end;
end;
procedure TForm1.WMNCHitTest(var Msg: TWMNCHitTest);
var
R: TRect;
Pt: TPoint;
begin
R.Left := Width-4*GetSystemMetrics(SM_CXSIZE);//GetSystemMetrics(SM_CXFRAME);
R.Right := R.Left+GetSystemMetrics(SM_CXSIZE)-1;
R.Top := GetSystemMetrics(SM_CYFRAME);
R.Bottom := R.Top+GetSystemMetrics(SM_CYCAPTION)-1;
Pt.X := Msg.Pos.x - Left;
Pt.Y := Msg.Pos.y - Top;
if PtInRect(R, Pt) then begin
Msg.Result := htSizeLast + 1;
DrawThemeButton(true);
end
else begin
inherited;
DrawThemeButton(false);
end;
end;
procedure TForm1.WMNCLButtonDown(var Msg: TWMNCLButtonDown);
begin
inherited;
if (Msg.HitTest = htSizeLast + 1) then
PopupMenu1.Popup(Left+Width-4*GetSystemMetrics(SM_CXSIZE), Top+GetSystemMetrics(SM_CYFRAME)+GetSystemMetrics(SM_CYCAPTION)-2);
end;
procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);
var
ht: HTHEME;
WinDC: HDC;
R: TRect;
begin
inherited;
if not Application.Active then Exit;
ButtonLastState := true;
DrawThemeButton(false);
end;
end.

DFM文件：

[delphi] view plain copy

object Form1: TForm1
Left = 0
Top = 0
Caption = ‘Form1‘
ClientHeight = 292
ClientWidth = 490
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = ‘Tahoma‘
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object PopupMenu1: TPopupMenu
Left = 112
Top = 152
end
end

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

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

标签：

原文地址：http://www.cnblogs.com/findumars/p/5393711.html

踩

(0)

评论一句话评论（0）

分享档案

更多>

2021年07月29日 (22)
2021年07月28日 (40)
2021年07月27日 (32)
2021年07月26日 (79)
2021年07月23日 (29)
2021年07月22日 (30)
2021年07月21日 (42)
2021年07月20日 (16)
2021年07月19日 (90)
2021年07月16日 (35)

周排行