Question

我在表单的不同位置绘制 onformpaint 事件相同的位图我想要做的是向这些位图添加拖放功能以使用户能够按照自己的意愿放置它们在表格上。我有一个想法，但它似乎相当简陋，我不想付出无用的努力。我会很感激你们的一些实施想法。

感谢。

P.S我想在这些位图上实现一个OnClick事件

Answer 1

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

编辑：受Bruce的回答启发，我在他提到的例子中使用了这些技术想出了一个工作样本。我将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.

Answer 2

这是useful example，可让您在运行时移动或调整TCustomControl后代的大小。

我认为您最好的选择是使用TImage而不是自定义绘图。正如iamjoosy指出的那样，上面的例子不适用于TGraphicControls。有一些免费软件组件可能更有帮助here和here。

在表单上拖放位图

2 个答案: