屏幕关灯

http://files.cnblogs.com/xe2011/ScreenLight_pas.rar

窗体文件

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 220
  ClientWidth = 447
  Color = clBtnFace
  TransparentColor = True
  TransparentColorValue = clPurple
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  FormStyle = fsStayOnTop
  OldCreateOrder = False
  PopupMenu = PopupMenu1
  OnCloseQuery = FormCloseQuery
  OnCreate = FormCreate
  OnMouseDown = FormMouseDown
  OnShow = FormShow
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    AlignWithMargins = True
    Left = 32
    Top = 47
    Width = 345
    Height = 74
    BevelOuter = bvNone
    Caption = 'Panel1'
    ParentBackground = False
    ShowCaption = False
    TabOrder = 0
    OnMouseDown = Panel1MouseDown
    OnMouseLeave = Panel1MouseLeave
    OnMouseMove = Panel1MouseMove
    DesignSize = (
      345
      74)
    object Panel2: TPanel
      Left = 6
      Top = 6
      Width = 334
      Height = 63
      Anchors = [akLeft, akTop, akRight, akBottom]
      BevelOuter = bvNone
      Color = clPurple
      ParentBackground = False
      TabOrder = 0
    end
  end
  object TrayIcon1: TTrayIcon
    PopupMenu = PopupMenu1
    Visible = True
    OnClick = Hide1Click
    Left = 296
    Top = 160
  end
  object PopupMenu1: TPopupMenu
    Left = 344
    Top = 160
    object Hide1: TMenuItem
      Caption = #38544#34255'(&H)'
      ShortCut = 32881
      OnClick = Hide1Click
    end
    object N2: TMenuItem
      Caption = '-'
    end
    object Color1: TMenuItem
      Caption = #39068#33394'(&C)'
      OnClick = Color1Click
    end
    object Transparent1: TMenuItem
      AutoCheck = True
      Caption = #21322#36879#26126'(&T)'
    end
    object Reset1: TMenuItem
      Caption = #37325#35774'(&R)'
      OnClick = Reset1Click
    end
    object N1: TMenuItem
      Caption = '-'
    end
    object Exit1: TMenuItem
      Caption = #36864#20986'(&E)'
      ShortCut = 16465
      OnClick = Exit1Click
    end
  end
end

Unit1单元

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ExtCtrls, IniFiles, AppEvnts, StdCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    TrayIcon1: TTrayIcon;
    PopupMenu1: TPopupMenu;
    Hide1: TMenuItem;
    N2: TMenuItem;
    Reset1: TMenuItem;
    Color1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    Transparent1: TMenuItem;
    procedure Hide1Click(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Reset1Click(Sender: TObject);
    procedure Color1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: Integer);
    procedure Panel1MouseLeave(Sender: TObject);
    procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    procedure SaveConfig(fileName: string);
    procedure LoadConfig(fileName: string);
    procedure HideShell_TrayWnd;
    procedure ShowShell_TrayWnd;

    procedure HotKeyDown(var Msg: TMessage);
    message WM_HOTKEY;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  HotKeyId: Integer;

implementation

uses CtrlDesign;
{$R *.dfm}

procedure TForm1.Color1Click(Sender: TObject);
begin
  with TColorDialog.Create(nil) do
  begin
    if Execute then
    begin
      Form1.Color := Color;
      Panel1.Color := Color;
    end;
  end;
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.HotKeyDown(var Msg: TMessage);
begin
  if (Msg.LparamLo = MOD_ALT) and (Msg.LParamHi = VK_F2) then
  begin
    Hide1.Click;
  end;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  SaveConfig('Screen.ini');
  ShowShell_TrayWnd;

  UnRegisterHotKey(Handle, HotKeyId); // 注销HotKey, 释放资源。
  DeleteAtom(HotKeyId);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // Panel1
  //

  LoadConfig('Screen.ini');
  Panel1.Color := Form1.Color;
  Panel1.BevelInner := BvNone;
  // Form1
  BorderStyle := BsNone;
  FormStyle := fsStayOnTop;
  WindowState := wsMaximized;

  HotKeyId := GlobalAddAtom('MyHotKey') - $C000;
  RegisterHotKey(Handle, HotKeyId, MOD_ALT, VK_F2); { alt+F2 }
  HideShell_TrayWnd;

end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
    if Transparent1.Checked then
    begin
      Form1.AlphaBlend := True;
      Form1.AlphaBlendValue := 120;
    end;

  ReleaseCapture;
  SendMessage(Panel1.Handle, WM_NCLBUTTONDOWN, HTCAPTION, 0);

  Form1.AlphaBlend := False;
  Form1.AlphaBlendValue := 255;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  ShowWindow(Application.Handle, SW_HIDE);
end;

procedure TForm1.Hide1Click(Sender: TObject);
begin
  if Hide1.Caption = '隐藏(&H)' then
  begin
    Hide;
    Hide1.Caption := '显示(&S)';
    ShowShell_TrayWnd;
  end
  else
  begin
    Show;
    Hide1.Caption := '隐藏(&H)';
    HideShell_TrayWnd;
  end;
end;

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  CtrlCursorMouseDown(Panel1, Button, Shift, X, Y);
end;

procedure TForm1.Panel1MouseLeave(Sender: TObject);
begin
  Panel1.Color := Form1.Color;
  Panel1.BevelInner := BvNone;
end;

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  CtrlCursorMouseMove(Panel1, Shift, X, Y);
  Panel1.Color := clSilver;
  Panel1.BevelInner := bvRaised;
end;

procedure TForm1.Reset1Click(Sender: TObject);
begin
  Panel1.Width := 345;
  Panel1.Height := 74;
  Panel1.Left := ClientWidth div 2 - Panel1.Width div 2;
  Panel1.Top := ClientHeight div 2 - Panel1.Height div 2;
  Form1.Color := clBlack;
end;

procedure TForm1.SaveConfig(fileName: string);
var
  f: string;
begin
  f := ExtractFilePath(Application.ExeName) + fileName;
  with TIniFile.Create(f) do
  begin
    WriteString('MainForm', 'Color', ColorToString(Form1.Color));
    WriteInteger('MainForm', 'PanelLeft', Panel1.Left);
    WriteInteger('MainForm', 'PanelTop', Panel1.Top);
    WriteInteger('MainForm', 'PanelWidth', Panel1.Width);
    WriteInteger('MainForm', 'PanelHeight', Panel1.Height);
  end;
end;

procedure TForm1.LoadConfig(fileName: string);
var
  s: string;
  f: string;
begin
  f := ExtractFilePath(Application.ExeName) + fileName;
  with TIniFile.Create(f) do
  begin
    s := ReadString('MainForm', 'Color', 'clBlack');
    Form1.Color := StringToColor(s);
    // Panel1.COLOR := StringToColor(s);

    Panel1.Left := ReadInteger('MainForm', 'PanelLeft', 0);
    Panel1.Top := ReadInteger('MainForm', 'PanelTop', 0);
    Panel1.Width := ReadInteger('MainForm', 'PanelWidth', Panel1.Width);
    Panel1.Height := ReadInteger('MainForm', 'PanelHeight', Panel1.Height);
  end;
end;

procedure TForm1.HideShell_TrayWnd;
var
  h: HWND;
begin
  h := FindWindow('Shell_TrayWnd', nil);
  if IsWindowVisible(h) then
    ShowWindow(h, SW_HIDE)
end;

procedure TForm1.ShowShell_TrayWnd;
var
  h: HWND;
begin
  h := FindWindow('Shell_TrayWnd', nil);
  if not IsWindowVisible(h) then
    ShowWindow(h, SW_SHOW);
end;

end.

其他 单元

unit CtrlDesign;


interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

procedure CtrlCursorMouseDown(Ctrl: TWinControl; Button: TMouseButton;  Shift: TShiftState; X, Y: Integer);
procedure CtrlCursorMouseMove(Ctrl: TWinControl;Shift: TShiftState;X, Y: Integer);


implementation

//CtrlMouseMove(Panel1, Shift, X, Y);
procedure CtrlCursorMouseMove(Ctrl: TWinControl; Shift: TShiftState;X, Y: Integer);
begin
   with Ctrl do
   begin
      if (X >= 0) and (X <= 3) then
      begin
        if (Y >= 0) and (Y <= 3)                then  Cursor := crSizeNWSE;
        if (Y > 3) and (Y < Height - 3)         then  Cursor := cRsizewe;
        if (Y >= Height - 3) and (Y <= Height)  then  Cursor := crSizeNESW;
      end
      else if (X > 3) and (X < Width - 3) then
      begin
        if (Y >= 0) and (Y <= 3)                then  Cursor := crSizeNS;
        if (Y > 3) and (Y < Height - 3)         then  Cursor := cRarrow;
        if (Y >= Height - 3) and (Y <= Width)   then  Cursor := crSizeNS;
      end
      else if (X >= Width - 3) and (X <= Width) then
      begin
        if (Y >= 0) and (Y <= 3)                then  Cursor := crSizeNESW;
        if (Y > 3) and (Y < Height - 3)         then  Cursor := cRsizewe;
        if (Y >= Height - 3) and (Y <= Width)   then  Cursor := crSizeNWSE;
      end;
   end;
end;


// CtrlCursorMouseDown(Panel1,Button,Shift,X,Y);
procedure CtrlCursorMouseDown(Ctrl: TWinControl; Button: TMouseButton;  Shift: TShiftState; X, Y: Integer);
var
  WParam: Integer;
begin
  with Ctrl do
  begin
    if (X >= 0) and (X <= 3) then
    begin
      if (Y >= 0) and (Y <= 3)                 then  WParam:=$F004;
      if (Y > 3)  and (Y < Height - 3)         then  WParam:=$F001;
      if (Y >= Height - 3) and (Y <= Height)   then  WParam:=$F007;
    end
    else if (X > 3) and (X < Width - 3) then
    begin
      if (Y >= 0) and (Y <= 3)                 then  WParam:=$F003;
      if (Y > 3) and (Y < Height - 3)          then  WParam:=$F012;
      if (Y >= Height - 3) and (Y <= Width)    then  WParam:=$F006;
    end
    else if (X >= Width - 3) and (X <= Width)  then
    begin
      if (Y >= 0) and (Y <= 3)                 then  WParam:=$F005;
      if (Y > 3) and (Y < Height - 3)          then  WParam:=$F002;
      if (Y >= Height - 3) and (Y <= Width)    then  WParam:=$F008;
    end;
   ReleaseCapture;
   SendMessage(Handle,WM_SYSCOMMAND,WParam,0);
  end;
end;


end.