mouse_drag.pas

delphi的学习资料

unit Mouse_Drag;

interface

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

type
  TfmMouse_Drag = class(TForm)
    Panel1: TPanel;
    ListBox: TListBox;
    btnAdd: TButton;
    edt1: TEdit;
    edt2: TEdit;
    ListBox2: TListBox;
    pnl0: TPanel;
    Shape1: TShape;
    Shape2: TShape;
    Shape3: TShape;
    GroupBox1: TGroupBox;
    rbtn1: TRadioButton;
    rbtn2: TRadioButton;
    edt0: TEdit;
    Lb3: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure btnAddClick(Sender: TObject);
    procedure edt2Enter(Sender: TObject);
    procedure ListBoxClick(Sender: TObject);
    procedure ListBoxKeyDown(Sender: TObject; var Key: Word;
        Shift: TShiftState);
    procedure ListBoxDragOver(Sender, Source: TObject; X, Y: Integer;
        State: TDragState; var Accept: Boolean);
    procedure ListBoxDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure ListBoxEnter(Sender: TObject);
    procedure ListBox2Enter(Sender: TObject);
    procedure Shape1MouseDown(Sender: TObject; Button: TMouseButton;
        Shift: TShiftState; X, Y: Integer);
    procedure Shape1MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
    procedure Shape1MouseUp(Sender: TObject; Button: TMouseButton;
        Shift: TShiftState; X, Y: Integer);
    procedure Shape2DragOver(Sender, Source: TObject; X, Y: Integer;
        State: TDragState; var Accept: Boolean);
    procedure Shape2DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure Shape3DragOver(Sender, Source: TObject; X, Y: Integer;
        State: TDragState; var Accept: Boolean);
    procedure Shape3EndDrag(Sender, Target: TObject; X, Y: Integer);
    procedure Shape3StartDrag(Sender: TObject; var DragObject: TDragObject);
    procedure Shape3MouseDown(Sender: TObject; Button: TMouseButton;
        Shift: TShiftState; X, Y: Integer);
    procedure edt0DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure edt0DragOver(Sender, Source: TObject; X, Y: Integer;
        State: TDragState; var Accept: Boolean);
    procedure ListBoxMouseUp(Sender: TObject; Button: TMouseButton;
        Shift: TShiftState; X, Y: Integer);
  private    { Private declarations }
  public     { Public declarations }
  end;

type
	TPtListBox= ^TListBox;

var
  fmMouse_Drag: TfmMouse_Drag;
  ptListBox: TPtListBox;
  r1,r2,r3,r4: word;
  dx1,dy1,dx2,dy2,dx3,dy3: Integer;
  Derect: boolean;
  src,send: ShortString;//string[55];
const
	ass:Array[0..9] of string
    =('AAA','BBB','CCC','DDD','EEE','FFF','GGG','HHH','III','JJJ');
  T=True;		F=False;

////////////////////////////////////////////////
implementation
{$R *.DFM}

procedure TfmMouse_Drag.FormCreate(Sender: TObject);
var
	i:word;
begin
  for i:=0 to Length(ass)-1 do
  begin
  	ListBox.Items.Add(ass[i]+'///');
  	ListBox2.Items.Add(LowerCase(ass[i]+'---'));
  end;

  ListBox.ItemIndex:=0;
  ListBox.ExtendedSelect:=True;
  ListBox2.ExtendedSelect:=True;//False;
  ListBox.DragMode:=dmAutomatic;	ListBox2.DragMode:=dmAutomatic;

  Shape1.DragMode:=dmManual;
  Shape2.DragMode:=dmAutomatic;
  Shape3.DragMode:=dmManual;

  r1:=22;  r2:=33;  r3:=28;  r4:=11;
  Shape1.Width:=r1*2;		Shape1.Height:=r1*2;
  Shape2.Width:=r2*2;		Shape2.Height:=r2*2;
  Shape3.Width:=r3*2;		Shape3.Height:=r3*2;

  Shape2.EndDrag(T);
  Shape3.EndDrag(T);
  Derect:=T;

  edt0.controlStyle:=[];
  edt0.DragKind:=dkDock;   //Shape1--3 is dkDrag
  edt0.DragMode:=dmManual;//dmAutomatic;
  edt0.EndDrag(T);
end;

procedure TfmMouse_Drag.ListBoxEnter(Sender: TObject);
begin
  ptListBox:=@ListBox;
end;

procedure TfmMouse_Drag.ListBox2Enter(Sender: TObject);
begin
  ptListBox:=@ListBox2;
end;


procedure TfmMouse_Drag.btnAddClick(Sender: TObject);
begin
  ptListBox^.Items.Insert(ptListBox^.ItemIndex,edt1.Text);
  ptListBox^.ItemIndex:=ptListBox^.ItemIndex+1;
end;

//============================================
procedure TfmMouse_Drag.ListBoxKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
	i: word;
begin
  if (Key=46) and (ptListBox^.Items.Count<>0) then
    for i:=ptListBox^.Items.Count-1 downto 0 do
    begin
      if ptListBox^.Selected[i] then
        ptListBox^.Items.Delete(i);
    end;
end;

procedure TfmMouse_Drag.ListBoxMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
end;

//============================================
procedure TfmMouse_Drag.edt2Enter(Sender: TObject);
begin
  ptListBox^.SetFocus;
end;

procedure TfmMouse_Drag.ListBoxClick(Sender: TObject);
begin
  edt2.Text:=ptListBox^.Items[ptListBox^.itemIndex];
end;

//============================================
procedure TfmMouse_Drag.ListBoxDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  src:=Source.ClassName;
  send:=Sender.ClassName;
  if Sender<>Source then
  	with Sender as TlistBox do
    	ItemIndex:=ItemAtPos(Point(x,y),False);
  Accept:=Source is TlistBox;
end;


procedure TfmMouse_Drag.ListBoxDragDrop(Sender, Source: TObject; X, Y: Integer);
var
	i,SrcCnt: integer;
  idx: integer;
  stmp: string;
begin
 	with Source as TlistBox do
  	if itemIndex<0 then
     	Exit
    else
    	SrcCnt:=Items.Count;

  for i:=SrcCnt-1 downto 0 do
  begin
    with Source as TlistBox do
    begin
      if not Selected[i] then
      	Continue;

      stmp:=Items[i];
      Items.Delete(i);
    end;

    with Sender as TlistBox do
    begin
      idx:=ItemAtPos(Point(x,y),False);
      Items.Insert(idx,stmp);
      SetFocus;
    end;
  end;
end;

//============================================
procedure TfmMouse_Drag.Shape1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  dx1:=x;   dy1:=y;
//  edt0.DragMode:=dmAutomatic;
end;


procedure TfmMouse_Drag.Shape1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if not(ssLeft	in Shift) then
  	Exit;

  Shape1.Left:=Shape1.Left+x-dx1;   Shape1.Top:=Shape1.Top+y-dy1;

  if ( (Shape1.Left+r1-Shape2.Left-r2)*(Shape1.Left+r1-Shape2.Left-r2)
      +(Shape1.Top+r1-Shape2.Top-r2)*(Shape1.Top+r1-Shape2.Top-r2) )
     < (r1+r2)*(r1+r2) then
    begin
      if Shape2.Left>Shape1.Left then
      	Shape2.Left:=Shape2.Left+4
      else
      	Shape2.Left:=Shape2.Left-4;

      if Shape2.Top>Shape1.Top then
      	Shape2.Top:=Shape2.Top+4
      else
      	Shape2.Top:=Shape2.Top-4;

      if (Shape2.Left<-r2) or (Shape2.Left>Shape2.Parent.Width-r2) then
        Shape2.Left:=Shape2.Parent.Width div 2;
      if (Shape2.Top<-r2) or (Shape2.Top>Shape2.Parent.Height-r2) then
        Shape2.Top:=Shape2.Parent.Height div 2;
    end;

  if (Shape1.Left+r1 > edt0.Left) and (Shape1.Left+r1 < edt0.Left+edt0.Width)
      and (Shape1.Top+r1 > edt0.Top) and (Shape1.Top+r1 < edt0.Top+edt0.Width) then
    begin
			edt0.Color:=Shape1.Brush.Color;
      if Shape1.Left < edt0.Left then
      	Shape1.Left:=Shape1.Left-r1
      else
      	Shape1.Left:=edt0.Left+edt0.Width;
    end;
end;


procedure TfmMouse_Drag.Shape1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Shape1.Left<0-r1 then Shape1.Left:=0-r1;
  if Shape1.Left+r1>Shape1.Parent.Width then Shape1.Left:=Shape1.Parent.Width-r1;

  if Shape1.Top<0-r1 then Shape1.Top:=0-r1;
  if Shape1.Top+r1>Shape1.Parent.Height then Shape1.Top:=Shape1.Parent.Height-r1;
{
  if (Shape1.Left+r1 > edt0.Left) and (Shape1.Left+r1 < edt0.Left+edt0.Width)
      and (Shape1.Top+r1 > edt0.Top) and (Shape1.Top+r1 < edt0.Top+edt0.Width) then
		edt0.Color:=Shape1.Brush.Color;
  Panel2.SetFocus;
}
end;

//============================================
procedure TfmMouse_Drag.Shape2DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  src:=Source.ClassName;
  send:=Sender.ClassName;
  if State=dsDragEnter  then
		begin
    	dx2:=x;	dy2:=y;
//      Accept:=F;
    end;
end;

procedure TfmMouse_Drag.Shape2DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  src:=Source.ClassName;
  send:=Sender.ClassName;
  Shape2.Left:=Shape2.Left+x-dx2;
  Shape2.Top:=Shape2.Top+y-dy2;
end;

//============================================
procedure TfmMouse_Drag.Shape3DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  src:=Source.ClassName;
  send:=Sender.ClassName;
  if State=dsDragEnter then
    begin
    	dx3:=x;	dy3:=y;
      Accept:=T;
    end;

  if rbtn1.Checked then
    begin
      if State=dsDragMove then
        begin
          Shape3.Left:=Shape3.Left+x-dx3;
          Shape3.Top:=Shape3.Top+y-dy3;
          Accept:=F;
        end
    end
  else  // rbtn2.Checked
    if State=dsDragLeave then
      begin
        Shape3.Left:=Shape3.Left+x-dx3;
        Shape3.Top:=Shape3.Top+y-dy3;
        Accept:=T;
      end;
  Lb3.Left:=Shape3.Left+19;
  Lb3.Top:=Shape3.Top+15;
end;


procedure TfmMouse_Drag.Shape3EndDrag(Sender, Target: TObject; X, Y: Integer);
var xx,yy: integer;
begin
// 如果rBtn2.Checked＝T 可以不用上一段的 if State=dsDragLeave then ...
// 而改用本事件
{ Shape3.Left:=Shape3.Left+x-dx3;
  Shape3.Top:=Shape3.Top+y-dy3;
}
end;

procedure TfmMouse_Drag.Shape3StartDrag(Sender: TObject;  var DragObject: TDragObject);
begin
;;
end;

procedure TfmMouse_Drag.Shape3MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Shape3.BeginDrag(F,2);
end;

//=========================================
procedure TfmMouse_Drag.edt0DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  src:=Source.ClassName;
  send:=Sender.ClassName;
	Accept:=Source is TShape;
end;


procedure TfmMouse_Drag.edt0DragDrop(Sender, Source: TObject; X, Y: Integer);
var
	cr,cg,cb: byte;
begin
  src:=Source.ClassName;
  send:=Sender.ClassName;
  if (Sender is TEdit) and (Source is TShape) then
    (Sender as TEdit).Color:={(Sender as TMemo).Color+}(Source as TShape).Brush.Color;
end;


end.