delphi spy++ 拖拽功能

 
 
 
 {使用资源中的图标}
  Image1.Picture.Icon.LoadFromResourceName(HInstance,'DragIcon');
  Image1.Picture.Icon.LoadFromResourceName(HInstance,'DefaultIcon');

 

  {使用资源中的光标}
  var  h: HCURSOR;
  begin
    h:= LoadCursor(HInstance,'DragCursor');
    SetSystemCursor(h,ocr_normal);
  end;

 

  {恢复默认光标}
  SystemParametersinfo(SPI_SETCURSORS,0,nil,SPIF_SENDCHANGE);

 

//{对目标窗口黑画线}这个有个问题 清空画面

{对目标窗口黑画线}
procedure
DrawRectangle; var C: TCanvas; h: HWND; Rec: TRect; p: TPoint; begin GetCursorPos(p); h := WindowFromPoint(p); GetWindowRect(h, Rec); C := TCanvas.Create; C.Handle := Windows.GetWindowDC(h); with C do begin Pen.Color := clBlack; Brush.Style := bsClear; Pen.Width := 5; FillRect(Rec); // -------------OBJ WIDTH OBJ HEIGHT Rectangle(0, 0, Rec.Right - Rec.Left, Rec.Bottom - Rec.Top); Free; end; end;

 



 
 
 
自定义鼠标
通常鼠标形状是默认的箭头形状,本例演示如何通过编程来改变鼠标的形状,使程序可以更好地和用户交互。单击 “改变光标”按钮将鼠标形状,单击“恢复原型”按钮将鼠标改为默认形状。
Windows 提供设定鼠标形状的API 函数SetSystemCursor,首先要通过调用由LoadCursorFromFile读入的光标文件,然后调用SetSystemCursor 设定系统默认鼠标。它们的函数原型如下:
HCURSOR LoadCursorFromFile ( LPCTSTR lpFileName );
BOOL SetSystemCursor ( HCURSOR hcur, DWORD id );
如果要恢复Windows 默认形状,可以调用函数SystemParametersinfo,它的函数原型如下:
BOOL SystemParametersInfo(
UINT uiAction, //查询还是设定系统参数
UINT uiParam, //该参数取决于要采取的动作
PVOID pvParam, //该参数取决于要采取的动作
UINT fWinIni //用户配置文件更新标志
);
下面利用一个示例来介绍自定义鼠标的方法。
(1)创建一个新Delphi 项目,为窗体添加两个按钮,标题分别设为“改变光标”和“恢复原型”。
(2)添加“改变光标”按钮的OnClick 事件的处理过程,用来改变光标的形状,代码如下:

{使用自定义的光标}
procedure TForm1.Button1Click(Sender: TObject);
var  h: HCURSOR;
begin
  h:=LoadCursorFromFile('a.cur'); 
  SetSystemCursor(h,ocr_normal);
end;

{恢复默认光标}
procedure TForm1.Button2Click(Sender: TObject);
begin
  SystemParametersinfo(SPI_SETCURSORS,0,nil,SPIF_SENDCHANGE);
end;
 
 
 
 
如何制作.CUR文件
 
png -> icon
 
 
1 用ps处理个32*32 的rgb png文件
2 用格式工厂 转换png->ico 32*32的
 
 



完整代码

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Image1: TImage;
    Label3: TLabel;
    Label4: TLabel;
    LabelPosition: TLabel;
    Edit1: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Memo1: TMemo;
    procedure Timer1Timer(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Memo1DblClick(Sender: TObject);
  private
    { Private declarations }
    procedure SetIcon1;
    procedure SetIcon2;
    procedure SetMyCursor;
    procedure RestoreCursor;
    procedure SetLabelTimerProEnable;
    procedure SetLabelTimerProDisable;
    procedure DrawRectangle;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
{$R SpyRES.RES}
(*
  {使用资源中的图标}
  Image1.Picture.Icon.LoadFromResourceName(HInstance,'DragIcon');
  Image1.Picture.Icon.LoadFromResourceName(HInstance,'DefaultIcon');

  {使用资源中的光标}
  var  h: HCURSOR;
  begin
  h:= LoadCursor(HInstance,'DragCursor');
  SetSystemCursor(h,ocr_normal);
  end;

  {恢复默认光标}
  SystemParametersinfo(SPI_SETCURSORS,0,nil,SPIF_SENDCHANGE);

*)

// ------------------------------------------------------------------------------
procedure TForm1.SetIcon1;
begin
  Form1.Image1.Picture.Icon.LoadFromResourceName(HInstance, 'DefaultIcon');
end;

procedure TForm1.SetIcon2;
begin
  Form1.Image1.Picture.Icon.LoadFromResourceName(HInstance, 'DragIcon');
end;

procedure TForm1.SetMyCursor;
var
  h: HCURSOR;
begin
  h := LoadCursor(HInstance, 'DragCursor');
  SetSystemCursor(h, ocr_normal);
end;

procedure TForm1.RestoreCursor;
begin
  SystemParametersinfo(SPI_SETCURSORS, 0, nil, SPIF_SENDCHANGE);
end;

procedure TForm1.SetLabelTimerProEnable;
begin
  LabelPosition.Caption := '';
  LabelPosition.Visible := True;
  Timer1.Enabled := True;
end;

procedure TForm1.SetLabelTimerProDisable;
begin
  LabelPosition.Visible := False;
  Timer1.Enabled := False;
end;

procedure TForm1.DrawRectangle;
var
  C: TCanvas;
  h: HWND;
  Rec: TRect;
  p: TPoint;
begin
  GetCursorPos(p);
  h := WindowFromPoint(p);
  GetWindowRect(h, Rec);
  C := TCanvas.Create;
  C.Handle := Windows.GetWindowDC(h);
  with C do
  begin
    Pen.Color := clBlack;
    Brush.Style := bsClear;
    Pen.Width := 5;
    FillRect(Rec);
    // -------------OBJ WIDTH               OBJ HEIGHT
    Rectangle(0, 0, Rec.Right - Rec.Left, Rec.Bottom - Rec.Top);
    Free;
  end;
end;

// ------------------------------------------------------------------------------
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  SetIcon2;
  SetMyCursor;
  SetLabelTimerProEnable;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  SetIcon1;
  RestoreCursor;
  SetLabelTimerProDisable;
end;

procedure TForm1.Memo1DblClick(Sender: TObject);
begin
  Memo1.SelectAll;
end;

// -------------------------------------------------------------------------------

procedure TForm1.Timer1Timer(Sender: TObject);
var
  h: HWND;
  p: TPoint;
  Rec: TRect;
  sClassName, sWindowText: array [0 .. 254] of Char;
begin
  GetCursorPos(p);
  LabelPosition.Caption := Format('%d,%d', [p.X, p.Y]);

  h := WindowFromPoint(p);
  Edit1.Text := Format('%.8x', [h]);

  GetClassName(h, sClassName, SizeOf(sClassName));
  GetWindowText(h, sWindowText, SizeOf(sClassName));

  Memo1.Text := sWindowText;
  Edit3.Text := sClassName;

  GetWindowRect(h, Rec);
  Edit4.Text := Format('(%d %d %d %d) %d x %d', [Rec.Left, Rec.Top, Rec.Right,
    Rec.Bottom, Rec.Right - Rec.Left, Rec.Bottom - Rec.Top]);
  DrawRectangle();
end;

end.

 

 

posted @ 2012-05-31 08:21  XE2011  阅读(1087)  评论(0编辑  收藏  举报