[Çözüldü] Mouser Cursor Durumu?

[xozcanx]

Merhaba;
Mouse imlecinin o anki durumunu tespit etmeye çalışıyorum fakat bir türlü beceremedim.
Form üzerine belge bırakıyorum. Mouse taşıma modunda ise, buna göre formu şekillendirmem gerekiyor.
ApplicationEvent ile kontol etmeye çalıştım onuda beceremedim

[AliZairov]

İyi akşamlar. Bir zaman işime yaramıştı. Kordinatı bulur.

Kod: Tümünü seç

var
  P: TPoint;
begin
  GetCursorPos(P);
  ShowMessage('X = ' + IntToStr(P.X) + ', Y = ' + IntToStr(P.Y));

[xozcanx]

İyi akşamlar. Bir zaman işime yaramıştı. Kordinatı bulur.

Kod: Tümünü seç

var
  P: TPoint;
begin
  GetCursorPos(P);
  ShowMessage('X = ' + IntToStr(P.X) + ', Y = ' + IntToStr(P.Y));

hocam bir yanlış anlaşılma durumu var, koordinatları değil, durumunu tespit etmeye çalışıyorum. bir belgeyi yada klasörü taşımak isteğimizdeki mous durumu. cursor=crDrag

[AliZairov]

Günaydın. Özür dilerim. Bu örnek belki istediğinizdir. http://stackoverflow.com/questions/1368 ... g-and-drop

[SimaWB]

Cursor'un şekline göre birşeyler yapmak bana pek mantıklı gelmedi ama formun OnDragOver olayı işinize yaramıyor mu?

Ama illa öyle yapmak istirosanız :
Cursor hakkında bilgi almak için Windows'un GetCursorInfo APIsini kullanabilirsiniz.

Kod: Tümünü seç

var
  cInfo: TCursorInfo;
begin
  cInfo.cbSize := SizeOf(cInfo);
  GetCursorInfo(cInfo);
//burada cInfo.hCursor değeri size cursor'un şekline göre farklı değerler verir

[xozcanx]

Cursor'un şekline göre birşeyler yapmak bana pek mantıklı gelmedi ama formun OnDragOver olayı işinize yaramıyor mu?

Ama illa öyle yapmak istirosanız :
Cursor hakkında bilgi almak için Windows'un GetCursorInfo APIsini kullanabilirsiniz.

Kod: Tümünü seç

var
  cInfo: TCursorInfo;
begin
  cInfo.cbSize := SizeOf(cInfo);
  GetCursorInfo(cInfo);
//burada cInfo.hCursor değeri size cursor'un şekline göre farklı değerler verir

Veli Hocam GetCursorinfo yu araştırırken bahsettim konudan daha önce forumda(Burada) bahsedildiğini farkettim. o konuyuda inceledim fakat yine çözüm üretemedim.

Yapmak istediğim aşağıdaki olay türünde, Form dışından bir belgeyi form üzerine getirdiğim anda Paneli gizlemeya çalışıyorum Form üzerine bıraktığımda tekrar aktif hale getiriyorum.

[SimaWB]

Yine de GetCursorInfo işinizi görür gibi gözüküyor

[xozcanx]

Yine de GetCursorInfo işinizi görür gibi gözüküyor

hocam siz böyle söylüyorsanız biraz daha tırmalamam gerekiyor demektir
sinir bozucu ama 2 gündür ugraştırıyor

[mrmarman]

Yıllar önce DivXTürk diye bir projem vardı. Onda aynı sorunu irdelemiştim. Hatırladığım kadarıyla File drag drop sırasında formda bu tetiklenmiyordu.

Araştırınca Dosyaları DragDrop yaparken sadece Accept bir de Drop hali destekleniyor, ara durumlar (dragover, dragleave vb.) direkt desteklenmiyordu.

TForm'a ek class ile bir çözüm bulmuştum. Böylece dosyaları projeme sanki aynı proje içinde yerel drag drop yaparcasına detaylı bir şekilde yapmaya imkan bulmuştum.

Arşivimden bulup size bir proje hazıtlar onun üzerinden örneklerim. Önce bilgisayarıma ulaşmam lazım.

Sonuçta tam istediğiniz şey ve fazlası mümkün olduğunu bilin, daha önce tecrübe ettim çünkü.

[mrmarman]

Eve vardım, örnek projemi hazırladım.
Kaynak kodları ile örnek proje bu mesaj ekindedir.

Kaynak kodları incelemek isteyenler için budur.

Ekstra ne yapıldı ? TForm sınıfına IDropTarget implemente edildi. Gerisi kitabi bilgi.
Ezberlik değil. Bir kere kur ve unut tarzı bir örnektir.
Arşvinizde bulunsun ne zaman lazım olacağı belli olmaz.

Örnekte DragOver olunca Panel'in Visible özelliğini FALSE yaptığında istediğin şekilde olacak ama ben örneklerken kırmızı renge dönüştürerek ifade etmek istedim.

Kod: Tümünü seç

type
  TForm1 = class(TForm)

yerine

Kod: Tümünü seç

type
  TForm1 = class(TForm, IDropTarget)

Kod: Tümünü seç

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ActiveX, ComObj, ExtCtrls, ShellApi;

type
  TForm1 = class(TForm, IDropTarget) // IDropTarget için uses ActiveX ekledik.
    Panel1: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject); 
  private
    { Private declarations }
// -------------------------------------------------------------------------- //
// DragDrop için eklenen IDropTarget metodları
// -------------------------------------------------------------------------- //
  protected
    function IDropTarget.DragEnter = DropTargetDragEnter;
    function DropTargetDragEnter(const dataObj: IDataObject;
      grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult;
      stdcall;
    function IDropTarget.DragOver = DropTargetDragOver;
    function DropTargetDragOver(grfKeyState: Longint; pt: TPoint;
      var dwEffect: Longint): HResult;
      stdcall;
    function IDropTarget.DragLeave = DropTargetDragLeave;
    function DropTargetDragLeave: HResult;
      stdcall;
    function IDropTarget.Drop = DropTargetDrop;
    function DropTargetDrop(const dataObj: IDataObject; grfKeyState:
      Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;
// -------------------------------------------------------------------------- //
// -------------------------------------------------------------------------- //
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

function TForm1.DropTargetDragEnter(const dataObj: IDataObject;
  grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
begin
  Panel1.Visible := True;
  Panel1.Color   := clGreen;

  dwEffect := DROPEFFECT_COPY;
  Result   := S_OK;
end;

function TForm1.DropTargetDragLeave: HResult;
begin
  Panel1.Visible := True;
  Panel1.Color   := clRed;
  Result := S_OK;
end;

function TForm1.DropTargetDragOver(grfKeyState: Integer; pt: TPoint;
  var dwEffect: Integer): HResult;
begin
//Panel1.Visible := False; // Diyebilirsin... Ben biraz daha renklendirdim...
  dwEffect       := DROPEFFECT_COPY;
  Result         := S_OK;
end;

function TForm1.DropTargetDrop(const dataObj: IDataObject; grfKeyState: Integer;
  pt: TPoint; var dwEffect: Integer): HResult;
var
  FmtEtc: TFormatEtc;
  Medium: TStgMedium;
  DroppedFileCount: Integer;
  I: Integer;
  FileNameLength: Integer;
  FileName: string;
begin
  FmtEtc.cfFormat := CF_HDROP;
  FmtEtc.ptd := nil;
  FmtEtc.dwAspect := DVASPECT_CONTENT;
  FmtEtc.lindex := -1;
  FmtEtc.tymed := TYMED_HGLOBAL;
  OleCheck(DataObj.GetData(FmtEtc, Medium));
  try
    try
      DroppedFileCount := DragQueryFile( // DragQueryFile için uses'a ShellApi
        Medium.hGlobal, $FFFFFFFF, nil, 0
      );

      for I := 0 to Pred(DroppedFileCount) do
      begin
        FileNameLength := DragQueryFile(Medium.hGlobal, I, nil, 0);
        SetLength(FileName, FileNameLength);
        DragQueryFile(
          Medium.hGlobal, I, PChar(FileName), FileNameLength + 1
        );
        // Elimizde full file name var....
        Panel1.Caption :=  ExtractFileName( FileName );
      end;
    finally
      DragFinish(Medium.hGlobal);
    end;
  finally
    ReleaseStgMedium(Medium);
  end;

  Panel1.Visible := True;
  Panel1.Color   := clSilver;
  Result := S_OK;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  OleInitialize(nil);
  OleCheck(RegisterDragDrop(Handle, Self)); // OleCheck için uses ComObj
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  RevokeDragDrop(Handle);
  OleUninitialize;
end;

end.

// Gizleme işlemini yapacak şekildeki modifikasyon aşağıdaki gibi. //

Kod: Tümünü seç

function TForm1.DropTargetDragEnter(const dataObj: IDataObject;
  grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
begin
  Panel1.Visible := False;
  //Panel1.Color   := clGreen;

  dwEffect := DROPEFFECT_COPY;
  Result   := S_OK;
end;

function TForm1.DropTargetDragLeave: HResult;
begin
  Panel1.Visible := True;
  //Panel1.Color   := clRed;
  Result := S_OK;
end;

function TForm1.DropTargetDragOver(grfKeyState: Integer; pt: TPoint;
  var dwEffect: Integer): HResult;
begin
//Panel1.Visible := False; // Diyebilirsin... Ben biraz daha renklendirdim...
  dwEffect       := DROPEFFECT_COPY;
  Result         := S_OK;
end;

EDIT: Animasyonlu sunum için kullandığım ScreenToGif programı yerine GIF Screen Recorder kullanarak mouse cursor resimlerini gösterir hallerini. elde ederek güncelledim.

[xozcanx]

Hocam teşekkürler beni büyük bir sıkıntıdan kurtardınız şuan kontrol edemiyorum. kodlar içindeki açıklamalar benim için çok önemliydi bu kısmada herzamanki gibi değinmişsiniz.
Tekrar teşekkürler.