delphi spy++ 拖拽功能

本例  https://files.cnblogs.com/xe2011/Delphi_SPY.rar

自用  https://files.cnblogs.com/xe2011/Debug_Delphi_Spy.rar

 

 

 

 ｛使用资源中的图标｝
  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.