Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

Dragging an item

Posted on 2006-06-16
7
Medium Priority
?
486 Views
Last Modified: 2013-12-03
I want to click item in the ListBox and then drag the item somewhere on other component (eg. other ListBox), but I want the item still to appear under the cursor while draging. To be more exact, I want to drag name of font from the font list and drop it to some text in other component and by this to change font of the text.  How can be this effect achieved?
0
Comment
Question by:JackKuti
  • 3
  • 3
7 Comments
 
LVL 10

Expert Comment

by:atul_parmar
ID: 16921462
e.g. ListBox1 contains the font names then
Set the following
  1. ListBox1.Drag Mode = dgAutomatic;
  2. ListBox1.Tag := -1; // this will track the item to drag

in the OnMouseDown of ListBox1 write the following line

  ListBox1.Tag := ListBox1.ItemAtPos(Point(X, Y), True);

in the OnDragOver event of other control put the following line

Accept := ListBox1.Tag > -1;

in the OnDragDrop event of other control put the following code

  if ListBox1.Tag > -1 then
  begin
   Edit1.Font.Name := ListBox1.Items.Strings[ListBox1.Tag]; // assuming that the item is being dragged to edit box
   ListBox1.Tag := -1; // reset the dragged item
  end;
0
 

Author Comment

by:JackKuti
ID: 16921838
Thanks, font are changed perfectly, but still, I´d like to achieve the effect of appearing of font name under the cursor while draging it from ListBox untill it is dropped down. This is not necessary for the application to work but its nice.  
0
 
LVL 26

Accepted Solution

by:
Russell Libby earned 1000 total points
ID: 16923312
Example of what you are asking for. Source first, dfm follows.

Regards,
Russell


--- unit1.pas ---

unit Unit1;

interface

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

////////////////////////////////////////////////////////////////////////////////
//   Control accessor
////////////////////////////////////////////////////////////////////////////////
type
  TControlAccess    =  class(TControl);

////////////////////////////////////////////////////////////////////////////////
//   TTextDrag
////////////////////////////////////////////////////////////////////////////////
type
  TTextDrag         =  class(TDragObject)
  private
     // Private declarations
     FDragImage:    TDragImageList;
     FText:         String;
  protected
     // Protected declarations
     function       GetDragImages: TDragImageList; override;
  public
     // Public declarations
     constructor    Create;
     destructor     Destroy; override;
     procedure      UpdateDragImage(Font: TFont; Text: String);
     property       Text: String read FText;
  end;

type
  TForm1            =  class(TForm)
     Memo1:         TMemo;
     ListBox1:      TListBox;
     procedure      FormCreate(Sender: TObject);
     procedure      FormDestroy(Sender: TObject);
     procedure      ListBox1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
     procedure      ListBox1StartDrag(Sender: TObject; var DragObject: TDragObject);
     procedure      Memo1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
     procedure      Memo1DragDrop(Sender, Source: TObject; X, Y: Integer);
  private
     //  Private declarations
     FDragObject:   TTextDrag;
  public
     // Public declarations
  end;

var
  Form1: TForm1;

implementation
{$R *.DFM}

function TTextDrag.GetDragImages: TDragImageList;
begin

  // Return the drag image list
  result:=FDragImage;

end;

procedure TTextDrag.UpdateDragImage(Font: TFont; Text: String);
var  bmpDrag:       TBitmap;
     ptText:        TSize;
begin

  // Free existing drag image list
  if Assigned(FDragImage) then FreeAndNil(FDragImage);

  // Create the bitmap to draw on
  bmpDrag:=TBitmap.Create;

  // Resource protection
  try
     // Update internal text
     FText:=Text;
     // Set canvas font
     bmpDrag.Canvas.Font.Assign(Font);
     // Get text width and height
     ptText:=bmpDrag.Canvas.TextExtent(Text);
     // Add single space around the top/bottom, and 10 to right side side
     Inc(ptText.cx, 22);
     Inc(ptText.cy, 2);
     // Set bitmap size
     bmpDrag.Width:=ptText.cx;
     bmpDrag.Height:=ptText.cy;
     // Draw the text on the bitmap canvas
     bmpDrag.Canvas.TextOut(20, 1, Text);
     // Create the drag image list
     FDragImage:=TDragImageList.CreateSize(ptText.cx, ptText.cy);
     // Add bitmap to the image list
     FDragImage.AddMasked(bmpDrag, bmpDrag.Canvas.Pixels[0, 0]);
     // Set drag image
     FDragImage.SetDragImage(0, 0, 0);
  finally
     // Free the bitmap
     bmpDrag.Free;
  end;

end;

constructor TTextDrag.Create;
begin

  // Perform inherited
  inherited Create;

  // Set default text
  SetLength(FText, 0);

  // Create drag image list with text
  FDragImage:=nil;

end;

destructor TTextDrag.Destroy;
begin

  // Resource protection
  try
     // Free drag image list
     FDragImage.Free;
  finally
     // Perform inherited
     inherited Destroy;
  end;

end;

procedure TForm1.FormCreate(Sender: TObject);
var  dwIndex:       Integer;
begin

  // Create drag object
  FDragObject:=TTextDrag.Create;

  // Update form's control style
  Self.ControlStyle:=Self.ControlStyle + [csDisplayDragImage];

  // Update control style for all controls
  for dwIndex:=0 to Pred(ControlCount) do Controls[dwIndex].ControlStyle:=Controls[dwIndex].ControlStyle + [csDisplayDragImage];

  // Lock listbox
  ListBox1.Items.BeginUpdate;

  // Resource protection
  try
     // Clear list
     ListBox1.Items.Clear;
     // Add font names to list
     for dwIndex:=0 to Pred(Screen.Fonts.Count) do ListBox1.Items.Add(Screen.Fonts[dwIndex]);
  finally
     // Unlock listbox
     ListBox1.Items.EndUpdate;
  end;

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin

  // Free the drag object
  FDragObject.Free;

end;

procedure TForm1.ListBox1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin

  // Set drag if item is selected
  if (ListBox1.ItemIndex >= 0) then ListBox1.BeginDrag(False, 5);

end;

procedure TForm1.ListBox1StartDrag(Sender: TObject; var DragObject: TDragObject);
var  fntDrag:    TFont;
begin

  // Create font to duplicate for dragging
  fntDrag:=TFont.Create;

  // Resource protection
  try
     // Update from control first
     fntDrag.Assign(ListBox1.Font);
     // Update the font name
     fntDrag.Name:=ListBox1.Items[ListBox1.ItemIndex];
     // Update the drag object
     FDragObject.UpdateDragImage(fntDrag, fntDrag.Name);
     // Set the drag object to use
     DragObject:=FDragObject;
  finally
     // Free the temp font
     fntDrag.Free;
  end;

end;

procedure TForm1.Memo1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
begin

  // Accept the drag
  Accept:=True;
 
end;

procedure TForm1.Memo1DragDrop(Sender, Source: TObject; X, Y: Integer);
begin

  // Check drop source
  if (Source is TTextDrag) then Memo1.Font.Name:=TTextDrag(Source).Text;

end;

end.

--- unit1.dfm ---

object Form1: TForm1
  Left = 359
  Top = 278
  Width = 371
  Height = 358
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object Memo1: TMemo
    Left = 164
    Top = 12
    Width = 185
    Height = 297
    Lines.Strings = (
      'Test of custom drag image handling')
    TabOrder = 0
    OnDragDrop = Memo1DragDrop
    OnDragOver = Memo1DragOver
  end
  object ListBox1: TListBox
    Left = 8
    Top = 12
    Width = 149
    Height = 297
    ItemHeight = 13
    TabOrder = 1
    OnMouseDown = ListBox1MouseDown
    OnStartDrag = ListBox1StartDrag
  end
end
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:JackKuti
ID: 16923676
Thanks for your code. And don´t you know how to remove the crossed ring being displayed while dragging?
0
 
LVL 26

Expert Comment

by:Russell Libby
ID: 16923740
Are you sure you want to do that? Its the only UI cue to the user when a  drop operation cannot be performed.

Russell
0
 
LVL 26

Expert Comment

by:Russell Libby
ID: 16923776

////////////////////////////////////////////////////////////////////////////////
//   TTextDrag
////////////////////////////////////////////////////////////////////////////////
type
  TTextDrag         =  class(TDragObject)
  private
     // Private declarations
     FDragImage:    TDragImageList;
     FText:         String;
  protected
     // Protected declarations
     function       GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; override; // ADD
     function       GetDragImages: TDragImageList; override;
  public
     // Public declarations
     constructor    Create;
     destructor     Destroy; override;
     procedure      UpdateDragImage(Font: TFont; Text: String);
     property       Text: String read FText;
  end;

 etc....

implementation
{$R *.DFM}

function TTextDrag.GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor;
begin

  // Perform inherited
  result:=inherited GetDragCursor(Accepted, X, Y);

  // Check accepted = false. You can also remove this check and always return zero
  // which will make it use the default cursor
  if not(Accepted) then result:=0;

end;

0
 

Author Comment

by:JackKuti
ID: 16926020
Trying if it looks better without the ring, if it won´t  the ring will be returned. Many thanks to you!
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…
If you’ve ever visited a web page and noticed a cool font that you really liked the look of, but couldn’t figure out which font it was so that you could use it for your own work, then this video is for you! In this Micro Tutorial, you'll learn yo…
Suggested Courses

963 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question