Solved

Dragging an item

Posted on 2006-06-16
7
468 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
Comment Utility
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
Comment Utility
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 250 total points
Comment Utility
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
6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

 

Author Comment

by:JackKuti
Comment Utility
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
Comment Utility
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
Comment Utility

////////////////////////////////////////////////////////////////////////////////
//   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
Comment Utility
Trying if it looks better without the ring, if it won´t  the ring will be returned. Many thanks to you!
0

Featured Post

What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

Join & Write a Comment

Suggested Solutions

Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
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…
This video gives you a great overview about bandwidth monitoring with SNMP and WMI with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're looking for how to monitor bandwidth using netflow or packet s…

743 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

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now