Delphi Drop Textbox probléma probléma

Keresés
Hírlevél
 
ASPC#C++CSSDelphiFlashJavaJavaScriptPascalPerlPHPPythonuniPaaSVisual BasicVisual C++  »    
nyitotta: Syriuss, idő: 2012.06.30., moderátor: netangel, megoldás elfogadva: 2012.07.03. 22:48
  Értesítés változás esetén Felvétel kedvencekhez Küldés emailben

Kategóriák:Programozási nyelvek » Delphi
Operációs rendszerek » Windows

Sorrend:
Időzóna:
Blokkméret:
Oszd meg!
Sziasztok,

Szeretnék egy Delphis alkalmazás TextBox-ára dobni egy böngészőből áthúzott URL-t.
Kiindulásként a SoftwareOnline oldalon lévő Drag & Drop külső alkalmazásból kódját használom Delphi XE alatt.

Egy olyan problémám lenne, hogy amikor rádobom a linket a Data mező csupa hieroglifát tartalmaz, nem azt amit rádobtam. Mi a túrót kell még itt csinálni, hogy jó legyen?
Már szét gugliztam az agyam, de semmi értelmeset nem találok


function TForm1.DragEnter(const dataObj: IDataObject; grfKeyState: Integer;
  pt: TPoint; var dwEffect: Integer): HResult;
begin
  dwEffect:=DROPEFFECT_COPY;
  Result:=S_OK;
end;

function TForm1.DragLeave: HResult;
begin
  Result:=S_OK;
end;

function TForm1.DragOver(grfKeyState: Integer; pt: TPoint;
  var dwEffect: Integer): HResult;
begin
  dwEffect:=DROPEFFECT_COPY;
  Result:=S_OK;
end;

function TForm1.Drop(const dataObj: IDataObject; grfKeyState: Integer;
  pt: TPoint; var dwEffect: Integer): HResult;
var
  f: TFORMATETC;
  s: TSTGMEDIUM;
  Data: PChar;
begin
  Result:=0;
  if (dataObj=Nil) then
    Exit;
  with f do begin
    cfFormat:=CF_TEXT;
    ptd:=Nil;
    dwAspect:=DVASPECT_CONTENT;
    lindex:=-1;
    tymed:=TYMED_HGLOBAL;
  end;
  OleCheck(dataObj.GetData(f,s));
  try
    Data:=GlobalLock(s.hGlobal);
    Edit1.Text:=Data;
  finally
    GlobalUnlock(s.hGlobal);
    ReleaseStgMedium(s);
  end;
  Result:=S_OK;
end;

A Drop végén a Try blokkban lévő Data pl. a Google URL-re ezt adja vissza:
'瑨灴⼺眯睷朮潯汧'#$2E65'畨椯㽧汨栽♵潳牵散眽扥灨'#$AB00#$ABAB#$ABAB#$ABAB'ﺫﻮﻮ'
 with Format do
   begin
    cfFormat := CF_UNICODETEXT;//CF_TEXT;

Persze Xe

A softvareonlinen es a neten kerengo kodok nagyresze d7 -ben irodott,viszont d2006-tol felfele unicode tamogatassal jott ki a Delphi.Erre majd a kesobbiekben figyelj oda,ha krikszkrakszokat latsz megjelenni.



Hát nem tudom. Valamit vagy nem csinálok jól, vagy passz.
Nekem ez a progi nem fogadja a rádobott szöveget.

Fogadja az


procedure TForm1.FormCreate(Sender: TObject);
begin
   OleInitialize(nil);
   DropTarget := TDropTarget.Create;
   RegisterDragDrop(Handle, DropTarget);
   
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 RevokeDragDrop(Handle);
 OleUninitialize;
end;
előzmény
Törölve. előzmény
unit Unit1;

interface

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


 type
  TDropTarget = class (TInterfacedObject, IDropTarget)
   function DragEnter(const dataObj: IDataObject; grfKeyState: Longint;
   pt: TPoint; var dwEffect: Longint): HResult; stdcall;

   function DragOver(grfKeyState: Longint; pt: TPoint;
    var dwEffect: Longint): HResult; stdcall;

    function DragLeave: HResult; stdcall;

    function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint;
    var dwEffect: Longint): HResult; stdcall;
 end;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    DropTarget: TDropTarget;

    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function TDropTarget.DragEnter(const dataObj: IDataObject; grfKeyState: Longint;
pt: TPoint; var dwEffect: Longint): HResult;
begin
Result := S_OK;
end;

function TDropTarget.DragOver(grfKeyState: Longint; pt: TPoint;
var dwEffect: Longint): HResult;
begin
Result := S_OK;
end;

function TDropTarget.DragLeave: HResult;
begin
Result := S_OK;
end;

function TDropTarget.Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint;
var dwEffect: Longint): HResult;
var
Format: TFORMATETC;
Data: TSTGMEDIUM;
Buffer: PChar;
 begin
  with Format do
   begin
    cfFormat := CF_TEXT;
    dwAspect := DVASPECT_CONTENT;
    ptd := nil;
    lindex := -1;
    tymed := -1;
   end;
Result := dataObj.GetData(Format, Data);
 if (Result = S_OK) and (Data.tymed = TYMED_HGLOBAL) then
  begin
   Buffer := GlobalLock(Data.hGlobal);
   Form1.Edit1.Text := Buffer;
   GlobalFree(Data.hGlobal);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  if OleInitialize(nil) = S_OK then
   begin
    DropTarget := TDropTarget.Create;
    RegisterDragDrop(Handle, DropTarget);
   end;
end;

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

end.

Link

De figyelheted a vagolap valtozast is,regex-el megnezed hogy
url e,es elkapod előzmény
Hát nem tudom. Valamit vagy nem csinálok jól, vagy passz.
Nekem ez a progi nem fogadja a rádobott szöveget.

Amit csináltam:
Új projekt, rádobtam a TEdit-et, bemásoltam a TDroptargetet és az implementációját, valamint a Form Private változóját, majd létrehoztam a FormCreate és FormDestroy függvényeket, ez után belemásoltam a megadott sorokat.

Drag&Dropot szeretnék, ha jól tudom ott nem használja a vágólapot. Vagy nem jól tudom? előzmény
Próbáltad több böngészőből is ? Csatoltam ugyancsak az általad említett oldalról egy komponenst és egy példát, nekem az működik, a Chrome-ból tudok linkeket is áthúzni. előzmény
Oledragdrop_bmxql.zip
Ezt nem hiszem el...

Firefox-al ez az eredmény. IE-ről nem tudok linket rádobni. Nem engedi. Más böngészőm nincs, de FF lenne a forrás. előzmény
Drag'n'Drop.PNG
ÁÁÁÁÁÁÁÁ

Ott a pont!

Köszönöm! előzmény
Oszd meg!