CODEWITHSUNDEEP
formsdelphi
opc0de
opc0de

Reputation: 11768

Drag and drop bitmap on form

I am drawing onformpaint event the same bitmap in diffrent places on the form what i would like to do is add a drag and drop functionality to those bitmaps to enable the user to place them as he wishes on the form.I have an idea but it seems quite rudimentary and i don't want to put useless effort.I would appreciate some implementation ideas from you guys.

Thanks.

P.S I would like to implement an OnClick event over those bitmaps too

Upvotes: 0

Views: 1133

Answers (2)

iamjoosy
iamjoosy

Reputation: 3349

Unless you have specific reasons to do so, I would not draw the bitmaps in the OnFormPaint handler as this complicates what you want to achieve very much. Instead you could use Timages on your form, and your second requirement of having OnClick handlers is solved. Drag and Drop of TIamges should not be too complicated either when dealing with TImage components.

Edit: Inspired by Bruce's answer, I came up with a working sample using the techniques in his mentioned example. I subclassed a TPanel and a TImage to achieve the desired effect. It's important that the TImage is parented in the TPanel. Note, that this is just a quick and dirty sample, no checks ect (like if the parent of the Timahe really is a TParent). In order for the example to work, drop a TPanel on a form and a Timage on the TPanel.

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.

Upvotes: 5

Bruce McGee
Bruce McGee

Reputation: 15334

Here is a useful example that will let you move or resize TCustomControl descendents at run time.

I think your best option is to use a TImage instead of custom drawing. As iamjoosy points out, the above example won't work with TGraphicControls. There are some freeware components that might be more helpful here and here.

Upvotes: 1

Related Questions