Cursors

Does anyone how I can make a cursor at run time with the arrow in the top left hand corner and about five characters at the bottom (similar or exactly like MS Exlorer when doing a drag and drop)???

This is what I mean....

I have two listboxes.  One list is filled, the other is empty.  When I drag an item from one to the other, I want to create a new cursor with the arrow in the top lh corner (just like the crDrag cursor) and with the first few letters from the target item included under the cursor.

   |\
    \
    Filename

I dunno if this is possible or not.  MS have done it for years - maybe they are smarter than they look :)
LVL 6
Stuart_JohnsonAsked:
Who is Participating?

[Webinar] Streamline your web hosting managementRegister Today

x
 
interConnect With a Mentor Commented:
Here is how its done with cursors. Do the following:

1 - Create new project or create a new main form
2 - Add a button to it
3 - Paste following code as unit1
4 - Bind Button1.Onclick to button1click

unit Unit1;
interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

const
  crMyCursor = 5;
var
  CursorWidth, CursorHeight : Integer;

// This one modifies the cursor
procedure ModifyCursor(Index:integer;Text:string);
var
  ic : TIconInfo;
  ms : TBitmap;
  MemSt : TMemoryStream; //this is used for getting bitmap data
  Buf : array[0..10] of char;
  HPtr, TPtr : PChar; // these are just variables two swap bitmap rows
begin
  // Get Standart Arrow
  GetIconInfo( Screen.Cursors[crArrow], ic);
  // For easy manipulation assign it to a internal bitmap
  ms := TBitmap.Create;
  ms.handle := ic.hbmMask;
  // Modify them
  ms.Canvas.Font.Name := 'Small fonts';
  ms.Canvas.Font.Size := 6;
  ms.Canvas.TextOut(0,ms.Height div 2-10, Text);
  // Create new cursor and assign it to Cursors so that delphi knows it
  MemSt := TMemoryStream.Create;
  ms.SaveToStream(MemSt);
  // Align memory image because the first scanline in bitmap is in the last row
  HPtr := PChar(LongInt(MemSt.Memory) + PBitmapFileHeader(MemSt.Memory).bfOffBits);
  TPtr := PChar(LongInt(MemSt.Memory)+ MemSt.Size - CursorWidth);
  while HPtr < TPtr do
  begin
    System.Move(HPtr^, Buf, CursorWidth);
    System.Move(TPtr^, HPtr^, CursorWidth);
    System.Move(Buf, TPtr^, CursorWidth);
    Inc(HPtr, CursorWidth);
    Dec(TPtr, CursorWidth);
  end;
  try
  //delete old cursor
  Screen.Cursors[Index] := crNone;
  //Create new one with bitmap info
  Screen.Cursors[Index] := CreateCursor( HInstance,
    0,0,
    GetSystemMetrics( SM_CXCURSOR),
    GetSystemMetrics( SM_CYCURSOR),
    Pointer(LongInt(MemSt.Memory) + PBitmapFileHeader(MemSt.Memory).bfOffBits),
    Pointer(longint(MemSt.Memory) + PBitmapFileHeader(MemSt.Memory).bfOffBits+CursorWidth*CursorHeight));
  finally
    ms.Free;
    MemSt.Free;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  CursorWidth  := GetSystemMetrics( SM_CXCURSOR) div 8;
  CursorHeight := GetSystemMetrics( SM_CYCURSOR);
  Cursor := crMyCursor;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ModifyCursor(crMyCursor, InputBox('Text To Write','',''));
end;

end.

The key procedure here is procedure ModifyCursor(Index:integer;Text:string);
For using it while draging In your formcreate do this

  ListBox1.DragCursor := crMyCursor;

So when drag begins(OnBeginDrag of the component you want) do the following:

  ModifyCursor(crMyCursor, 'Filename');

As I said this is a solution with just Cursors if you want to drag an image more than 32x32 you should use Shells drag drop COM  interfaces with delphi components which is problematic as far as I know.

Regards,
Igor



0
 
mvz121697Commented:
screen.cursor:=crAppStart ?

0
 
Stuart_JohnsonAuthor Commented:
Edited text of question
0
2018 Annual Membership Survey

Here at Experts Exchange, we strive to give members the best experience. Help us improve the site by taking this survey today! (Bonus: Be entered to win a great tech prize for participating!)

 
BigMadDrongoCommented:
Try creating a lable, setting the text to the letters you want to display, and then move the label whenever the OnMouseMove event is fired.
0
 
Stuart_JohnsonAuthor Commented:
Umm... Its a bit messy.  I actually want to create a new cursor.

Can anyone tell me if a cursor has a canvas at all?  I cant find anything about them so it makes it difficult.

Maybe I could create a resource at runtime and use LoadResource and assign it to the cursor??
0
 
interCommented:
Hi,

I have found a solution but can not code it bynow, may be in few hour I have time to do that.

By the way, The cursors has no canvas. But we may retreive their bits. The problem with the cursors is that they can not be encapsulated as having bits etc. Windows handle them. So if you look in Delphi the cursors are just integer identifiers for example crArrow is -1 or so.

So the algorithm has two parts:

1 - Let Delphi know about the Cursor.
2 - Manipulate the cursor and assign whenever and item is dragged from that list boxes.

So it should be possible. But do not think tha Microsoft guys does this. They are using icon drawing functions to show that drag and drop operations. Note that the hardware cursor can not have colors and it has a specified width and height so we talk CURSORS here and do it in this way. If we want to do it in other way we should specially deal with Delphi's Internal Drag-drop method which is a torture.

Regards,
Igor
0
 
Stuart_JohnsonAuthor Commented:
Igor,

I have tried what you posted. However, I had major problems.  When it attempted to create the cursor and assign it to Screen.Cursor[Index], I got the dreaded blue screen and my machine totally locked up.  Any suggestions???

Stu
0
 
Stuart_JohnsonAuthor Commented:
Never fear, I figured it out.  You can't assign crNone to the cursor array for some reason.  Dunno why.

Thanks for you help.

Stu
0
All Courses

From novice to tech pro — start learning today.