unit1.pas

由DELPHI制作的可以直接抓取屏幕,并在上面写字绘图的一个软件,请指正.

unit Unit1;


interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Buttons, Menus, shellapi;
const
  mousemsg=wm_user+1;
  iid=100;
type
  TForm1 = class(TForm)
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
  private
    { Private declarations }
    procedure mousemessage(var message: tmessage); message mousemsg;
    procedure DoVisible;
    procedure DoInvisible;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  FullRgn, ClientRgn, CtlRgn : THandle;
  F2:Boolean;
  ntida: TNotifyIcondataA;
implementation

{$R *.DFM}
uses unit2,unit3,unit4;
procedure TForm1.mousemessage(var message: tmessage);
var
mousept: TPoint; //鼠标点击位置
begin
inherited;
if message.LParam = wm_rbuttonup then begin //用鼠标右键点击图标
getcursorpos(mousept); //获取光标位置
popupmenu1.popup(mousept.x, mousept.y);
//在光标位置弹出选单
end;
if message.LParam = wm_lbuttonup then begin //用鼠标左键点击图标
//显示应用程序窗口
ShowWindow(Handle, SW_SHOW);
//在任务栏上显示应用程序窗口
ShowWindow(Application.handle, SW_SHOW);
SetWindowLong(Application.Handle, GWL_EXSTYLE,
not (GetWindowLong(Application.handle, GWL_EXSTYLE)
or WS_EX_TOOLWINDOW AND NOT WS_EX_APPWINDOW));
end;
message.Result := 0;
end;

procedure TForm1.DoVisible;
begin
  //To restore complete visibility:
  FullRgn := CreateRectRgn(0, 0, Width, Height);
  CombineRgn(FullRgn, FullRgn, FullRgn, RGN_COPY);
  SetWindowRgn(Handle, FullRgn, TRUE);
end;

procedure TForm1.DoInvisible;
var
  AControl : TControl;
  A, Margin, X, Y, CtlX, CtlY : Integer;
begin
  Margin := ( Width - ClientWidth ) div 2;
  //First, get form region
  FullRgn := CreateRectRgn(0, 0, Width, Height);
  //Find client area region
  X := Margin;
  Y := Height - ClientHeight - Margin;
  ClientRgn := CreateRectRgn( X, Y, X + ClientWidth, Y + ClientHeight );
  //'Mask' out all but non-client areas
  CombineRgn( FullRgn, FullRgn, ClientRgn, RGN_DIFF );

  //Now, walk through all the controls on the form and 'OR' them
  // into the existing Full region.
  for A := 0 to ControlCount - 1 do begin
    AControl := Controls[A];
    if ( AControl is TWinControl ) or ( AControl is TGraphicControl )
        then with AControl do begin
      if Visible then begin
        CtlX := X + Left;
        CtlY := Y + Top;
        CtlRgn := CreateRectRgn( CtlX, CtlY, CtlX + Width, CtlY + Height );
        CombineRgn( FullRgn, FullRgn, CtlRgn, RGN_OR );
      end;
    end;
  end;
  //When the region is all ready, put it into effect:
  SetWindowRgn(Handle, FullRgn, TRUE);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  //Clean up the regions we created
  DeleteObject(ClientRgn);
  DeleteObject(FullRgn);
  DeleteObject(CtlRgn);
end;



procedure TForm1.FormCreate(Sender: TObject);
var
devicehandle:thandle;
begin
  //We start out as a transparent form....
  form1.Top:=screen.Height-66;
  form1.Left:=screen.Width-60;
  setlength(cdir,144);
  if getcurrentdirectory(144,pchar(cdir))<>0 then
  begin
    setlength(cdir,strlen(pchar(cdir)));
    cdir:=cdir+'\SHULUWENZI.txt';
    if not FileExists(cdir) then
    begin
    DeviceHandle := CreateFile(PChar(cdir), GENERIC_WRITE, FILE_SHARE_READ, nil,CREATE_ALWAYS, 0, 0);
    closehandle(DeviceHandle);
    end;
  end;
  f2:=false;
  ntida.cbSize := sizeof(tnotifyicondataa); //指定ntida的长度
ntida.Wnd := handle; //取应用程序主窗体的句柄
ntida.uID := iid; //用户自定义的一个数值，在uCallbackMessage参数指定的消息中使
ntida.uFlags := nif_icon + nif_tip + nif_message;//指定在该结构中uCallbackMessage、hIcon和szTip参数都有效
ntida.uCallbackMessage := mousemsg;
//指定的窗口消息
ntida.hIcon := Application.Icon.handle;
//指定系统状态栏显示应用程序的图标句柄
ntida.szTip := 'Icon';
//当鼠标停留在系统状态栏该图标上时，出现该提示信息
shell_notifyicona(NIM_ADD, @ntida);
//在系统状态栏增加一个新图标
  Doinvisible;
end;


procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  if f2 then form2.close;
f2:=false;
ShowWindow(Handle, SW_HIDE); //隐藏主窗体
//隐藏应用程序窗口在任务栏上的显示
ShowWindow(Application.Handle, SW_HIDE);
SetWindowLong(Application.Handle, GWL_EXSTYLE,
GetWindowLong(Application.handle, GWL_EXSTYLE)or WS_EX_TOOLWINDOW AND NOT WS_EX_APPWINDOW);
form1.Close;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
  if f2 then
  begin
    form2.close;
    f2:=false;
    n4.Caption:='画板';
  end
  else begin
   application.CreateForm(tform2,form2);
    //form2.show;
    f2:=true;
    n4.Caption:='关闭';
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caNone; //不对窗体进行任何操作
ShowWindow(Handle, SW_HIDE); //隐藏主窗体
//隐藏应用程序窗口在任务栏上的显示
ShowWindow(Application.Handle, SW_HIDE);
SetWindowLong(Application.Handle, GWL_EXSTYLE,
GetWindowLong(Application.handle, GWL_EXSTYLE)
or WS_EX_TOOLWINDOW AND NOT WS_EX_APPWINDOW);
end;

procedure TForm1.N1Click(Sender: TObject);
begin
ntida.cbSize := sizeof(tnotifyicondataa);
ntida.wnd := handle;
ntida.uID := iid;
ntida.uFlags := nif_icon + nif_tip + nif_message;
ntida.uCallbackMessage := mousemsg;
ntida.hIcon := Application.Icon.handle;
ntida.szTip := 'Icon';
shell_notifyicona(NIM_DELETE, @ntida);
//删除已有的应用程序图标
Application.Terminate;
//中断应用程序运行，退出应用程序

end;

procedure TForm1.N2Click(Sender: TObject);
begin
  Aboutbox.show;
end;

procedure TForm1.N3Click(Sender: TObject);
begin
  form4.Show;
end;

end.