在表单上拖放位图

Question

我正在绘制onformpaint事件,在表单上的不同位置使用相同的位图,我想要做的是向这些位图添加拖放功能,以使用户能够在表单上按照自己的意愿放置它们.我有一个想法,但它看起来很简陋,我不想付出无用的努力.我很欣赏你们的一些实施想法.

谢谢.

PS我想在这些位图上实现一个OnClick事件

Answer 1

除非你有特定的理由这样做,否则我不会在OnFormPaint处理程序中绘制位图,因为这会使你想要实现的目标复杂化.相反,您可以在表单上使用Timages,并且解决了OnClick处理程序的第二个要求.在处理TImage组件时,TIamges的拖放不应该太复杂.

编辑:受到布鲁斯答案的启发,我在他提到的例子中使用了这些技术想出了一个工作样本.我将TPanel和TImage子类化,以达到预期的效果.重要的是TImage是TPanel的父级.请注意,这只是一个快速而肮脏的样本,没有检查等(如果Timahe的父级确实是TParent).为了使示例有效,请在表单上删除TPanel,在TPanel上删除Timage.

unit Unit66;

interface

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

const
  sizeBorder = 2;
  sc_SizeLeft = $F001; { these are the variations }
  sc_SizeRight = $F002; { on the SC_SIZE value }
  sc_SizeTop = $F003;
  sc_SizeTopLeft = $F004;
  sc_SizeTopRight = $F005;
  sc_SizeBottom = $F006;
  sc_SizeBottomRight = $F008;
  sc_SizeBottomLeft = $F007;
  sc_DragMove = $F012;

type
  TPanel = class(ExtCtrls.TPanel)
  public
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: integer); override;
  end;

  TImage = class(ExtCtrls.TImage)
  public
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: integer); override;

  end;

  TForm66 = class(TForm)
    Panel1: TPanel;
    Image1: TImage;
    procedure Image1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form66: TForm66;

implementation

{$R *.dfm}
{ TImage }

procedure TPanel.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: integer);
begin
  if Button = mbLeft then
  begin
    ReleaseCapture;
    if (X >= Width - sizeBorder) And NOT((Y <= sizeBorder) or (Y >= Height - sizeBorder)) then
      Self.Perform(WM_SysCommand, sc_SizeRight, 0)
    else if Not((X <= sizeBorder) or (X >= Width - sizeBorder)) And (Y <= sizeBorder) then
      Self.Perform(WM_SysCommand, sc_SizeTop, 0)
    else if (X <= sizeBorder) And (Y <= sizeBorder) then
      Self.Perform(WM_SysCommand, sc_SizeTopLeft, 0)
    else if (X >= Width - sizeBorder) and (Y <= sizeBorder) then
      Self.Perform(WM_SysCommand, sc_SizeTopRight, 0)
    else if Not((X <= sizeBorder) or (X >= Width - sizeBorder)) And (Y >= Height - sizeBorder) then
      Self.Perform(WM_SysCommand, sc_SizeBottom, 0)
    else if (Y >= Height - sizeBorder) And (X <= sizeBorder) then
      Self.Perform(WM_SysCommand, sc_SizeBottomLeft, 0)
    else if (Y >= Height - sizeBorder) and (X >= Width - sizeBorder) then
      Self.Perform(WM_SysCommand, sc_SizeBottomRight, 0)
    else if Not((Y <= sizeBorder) or (Y >= Height - sizeBorder)) And (X <= sizeBorder) then
      Self.Perform(WM_SysCommand, sc_SizeLeft, 0)
    else
    begin
      Self.Perform(WM_SysCommand, sc_DragMove, 0);
    end;
  end;

end;

procedure TPanel.MouseMove(Shift: TShiftState; X, Y: integer);
begin
  if (X <= sizeBorder) or (X >= Width - sizeBorder) then
  begin
    if (Y >= Height - sizeBorder) then
    begin
      if (X >= Width - sizeBorder) then
        Cursor := crSizeNWSE
      else
        Cursor := crSizeNESW;
    end
    else if (Y <= sizeBorder) then
    begin
      if (X >= Width - sizeBorder) then
        Cursor := crSizeNESW
      else
        Cursor := crSizeNWSE;
    end
    else
      Cursor := crSizeWE;
  end
  else if (Y <= sizeBorder) or (Y >= Height - sizeBorder) then
  begin
    Cursor := crSizeNS;
  end
  else
    Cursor := crDefault;
end;

procedure TForm66.Image1Click(Sender: TObject);
begin
  ShowMessage('Image clicked');
end;

{ TImage }

type
  TWinControlHack = class(TWinControl);

procedure TImage.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: integer);
begin
  if ssCtrl in Shift then
    TWinControlHack(Parent).MouseDown(Button, Shift, X, Y);
end;

procedure TImage.MouseMove(Shift: TShiftState; X, Y: integer);
begin
  TWinControlHack(Parent).MouseMove(Shift, X, Y);
end;

end.