屏幕关灯

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.