Drag & Drop in TWebBrowser funtioniert nicht

[Erutan]

Hallo,

ich hab' mal wieder ein Problem.

Ich habe einen Code vom Swissdelphicenter verwendet und ein bisschen an meine Umgebung angepaßt. Es sollte damit möglich sein, die Caption eines Labels via Drag & Drop in ein Formularfeld einer Seite zu schieben, die im TWebBrowser aufgerufen wird.

Das Problem: Es geht nicht. Dabei scheint das Problem beim Label zu liegen. Fasse ich den Labeltext nämlich mit dem Mauszeiger an, verwndelt sich dieser in ein Stop-Symbol. Ziehe ich ihn dann über ein Formularfeld, wird daraus ein Formular-Symbol. Ich schließe daraus, daß irgendwas beim Label falsch ist.

Hier der Code:

Delphi-Quellcode:

procedure TForm1.WebBrowser1DragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
var
  item: Variant;
begin
  //check if document is interactive
  if (Webbrowser1.ReadyState and READYSTATE_INTERACTIVE) = 3 then
  begin
    item := WebBrowser1.OleObject.Document.elementFromPoint(x, y);
    if Source is TLabel then
      Accept := True;
    Accept := (item.tagname = 'INPUT') and ((item.type = 'text') or
      (item.type = 'password')) or (item.tagname = 'TEXTAREA');
  end;
end;


procedure TForm1.WebBrowser1DragDrop(Sender, Source: TObject; X,
  Y: Integer);
var
  item: Variant;
begin
  //check if document is interactive
  if (Webbrowser1.ReadyState and READYSTATE_INTERACTIVE) = 3 then
  begin
    item       := WebBrowser1.OleObject.Document.elementFromPoint(x, y);
    item.Value := labelHaupttext.Caption;
  end;
end;

Bei oncreate habe ich außerdem eingetragen:
labelHaupttext.DragMode := dmAutomatic; Vielleicht weiß jemand Rat.

Viele Grüße
Holger

[Helmi]

Hallo,

bist du dir sicher, dass es das Label ist?

Ich hab auch eine Anwendung in der ich mittels Drag&Drop etwas verschiebe (in diesem Fall Bitmaps).
Dort wird der Cursor auch erstmal zum Halteverbot, wenn ich es drage und es wird zum Formularsymbol
wenn ich auf das andere Control verschiebe.

Teste mal ob es nicht am Accept liegt und kommentier mal diese Zeile aus:

Delphi-Quellcode:

    Accept := (item.tagname = 'INPUT') and ((item.type = 'text') or
       (item.type = 'password')) or (item.tagname = 'TEXTAREA');

Theoretisch sollte es dann funktionieren

[Erutan]

Hi Helmi,

vielen Dank für den Tipp. Hab's auskommentiert. Funktioniert aber leider immer noch nicht. Im Formular kommt nichts an.

Könnte es sein, daß ein gleichzeitiger Autofiller stört? Das Drag & Drop war eigentlich für solche Formularfelder gedacht, die in Fieldsets liegen oder sich aus irgendwelchen anderen Gründen nicht automatisch ausfüllen lassen.

[Volker Z.]

Hallo,

Zitat:

Das Problem: Es geht nicht. Dabei scheint das Problem beim Label zu liegen [...]

Nö, das Label ist sicher nicht das Problem. Ich würde eher auf die Bedingung Deiner if-Abfragen tippen - schau mal in die OH was da zu READYSTATE_INTERACTIVE und Konsorten steht. Ein if (Webbrowser1.ReadyState = READYSTATE_INTERACTIVE) or (Webbrowser1.ReadyState = READYSTATE_COMPLETE) then an der richtigen Stelle könnte vielleicht schon Wunder wirken.

Allerdings würde ich eher zu nachfolgendem Lösungsansatz tendieren:

Delphi-Quellcode:

  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    labelHaupttext: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure WebBrowser1DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure WebBrowser1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
  private
    { Private-Deklarationen }
    FDropTarget : IHTMLInputElement;
  public
    { Public-Deklarationen }
  end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FDropTarget := nil
end;

procedure TForm1.WebBrowser1DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  if Assigned (FDropTarget) then
    begin
      FDropTarget.value := labelHaupttext.Caption;
      FDropTarget := nil
    end
end;

procedure TForm1.WebBrowser1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
var
  d    : IHTMLDocument2;
  e    : IHtmlElement;
  i    : IHTMLInputElement;
  s, t : string;
begin
  FDropTarget := nil; 
  if (Source is TLabel) and Assigned (WebBrowser1.Document) then
    begin
      d := WebBrowser1.Document as IHTMLDocument2;
      e := d.elementFromPoint (X, Y);
      if Assigned (e) then
        begin
          s := LowerCase (e.tagName);
          if (s = 'input') or (s = 'textarea') then
            begin
              i := e as IHTMLInputElement;
              if s = 'textarea' then
                FDropTarget := i
              else
                begin
                  t := LowerCase (i.type_);
                  if (t = 'text') or (t = 'password') then
                    FDropTarget := i
                end
            end
        end
    end;
  Accept := Assigned (FDropTarget)
end;

Das sollte funktionieren.

Zitat:

Das Drag & Drop war eigentlich für solche Formularfelder gedacht, die in Fieldsets liegen oder sich aus irgendwelchen anderen Gründen nicht automatisch ausfüllen lassen.

Wenn Du mal mehr Infos gibst, dann könnte man da vielleicht was machen.

Gruß

[Erutan]

Hi Volker,

vielen herzlichen Dank für die große Müh, die Du Dr gemacht hast. Ich hab's x mal probiert aber ich kriege den Code nicht zum Laufen.

Der Compiler hält schon oben bei den privaten Deklarationen an und sagt: "Undeclared Identifier: 'IHTMLInputElement'.
Und wenn man nach solchen Fehlern bei google sucht, ist fast alles chinesisch...im wahrsten Sinne des Wortes.

[Volker Z.]

Hallo,

Zitat:

[...] Der Compiler hält schon oben bei den privaten Deklarationen an und sagt: "Undeclared Identifier: 'IHTMLInputElement' [...]

Sorry, habe wohl den Hinweis vergessen, dass die Unit MSHTML eingebunden werden muss.

Gruß

[Erutan]

Juchhuhhh, es funktioniert!!

Vielen herzlichen Dank. Jetzt funktioniert das sogar universell. Ich kann sogar Inhalte von einer anderen Form in das Forlumar verschieben. Das war deutlich mehr als ich erhofft hatte.

Noch mal vielen Dank.

Grüße
Holger

[Erutan]

Oops, geht doch noch nicht. Beim Drag auf eine textarea stürzt das Programm mit einer Exception ab. Ich habe versucht, das durch ein Try-Except aufzufangen. Unter Except habe ich ein ShowMessage eingetragen. Die Message wird zwar dann eingeblendet, das Programm stürzt danach aber trotzdem mit einer Access Violation ab.

Das zweite Problem entsteht weil ich nicht nur ein Label verschieben will, sondern mehrere (nacheinander). Ich hatte gehofft, es würde ausreichen wenn ich die Label einfach alle nacheinander unter

Delphi-Quellcode:

if Assigned (FDropTarget) then
    begin
      FDropTarget.value := Form2.labelHaupttext.Caption;
      FDropTarget.value := Form2.labelVorname.Caption;
      FDropTarget.value := Form2.labelNachname.Caption;
      FDropTarget := nil
    end

eintrage aber dann wird nur der jeweils letzte Eintrag berücksichtig. Im obigen Beispiel wird also die Caption von LabelNachname verschoben, egal welches Label ich tatsächlich mit der Maus anfasse und verschiebe.

Mein Lösungsversuch war eine if-Weiche einzubauen und dabei abzufagen auf welches Label beim Verschieben aktuell geklickt wird.
Ich habe dazu das OnClick-Ereignis gefunden und es so versucht:

Delphi-Quellcode:

if LabelHaupttext.OnClick = true then
begin....

Ich dachte, das sollte eigentlich klappen weil ich ja zum Verschieben erst einmal auf das Label clicken muss.
Das funktioniert aber leider nicht. Der Compiler erwartet zusätzliche Parameter.

Wie kann ich das Problem stattdessen lösen?

Viele Grüße
Holger

[Volker Z.]

Hallo,

Zitat:

[...] Beim Drag auf eine textarea stürzt das Programm mit einer Exception ab [...]

Tut mir leid, das war mein Fehler: Wenn Du was auf eine Textarea ziehst, dann ist das natürliche ein IHTMLTextAreaElement und kein IHTMLInputElement - und dann scheppert es bei der Zuweisung FDropTarget := i .

Zitat:

Das zweite Problem entsteht weil ich nicht nur ein Label verschieben will, sondern mehrere (nacheinander). Ich hatte gehofft, es würde ausreichen wenn ich die Label einfach alle nacheinander unter [...] eintrage aber dann wird nur der jeweils letzte Eintrag berücksichtig [...]

Naja, das ist schon klar, oder?

Zitat:

Mein Lösungsversuch war eine if-Weiche einzubauen und dabei abzufagen auf welches Label beim Verschieben aktuell geklickt wird [...]

Der Eventhandler DragDrop hat auch einen Parameter Source, den man auswerten kann.

Der Code dem angepasst sieht so aus:

Delphi-Quellcode:

  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    procedure WebBrowser1DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure WebBrowser1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
  private
    { Private-Deklarationen }
    FDropTarget : IDispatch;  // <--- Aufpassen!
  public
    { Public-Deklarationen }
  end;

procedure TForm1.WebBrowser1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
  i : IHTMLInputElement;
  t : IHTMLTextAreaElement;
begin
  if Assigned (FDropTarget) then
     begin
       if Succeeded (FDropTarget.QueryInterface (IHTMLTextAreaElement, t)) then
         t.value := TLabel (Source).Caption
       else
         if Succeeded (FDropTarget.QueryInterface (IHTMLInputElement, i)) then
           i.value := TLabel (Source).Caption;

       FDropTarget := nil
     end
end;

procedure TForm1.WebBrowser1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
var
  d : IHTMLDocument2;
  e : IHtmlElement;
  i : IHTMLInputElement;
  s, t : string;
begin
  FDropTarget := nil;
  if (Source is TLabel) and Assigned (WebBrowser1.Document) then
    begin
     d := WebBrowser1.Document as IHTMLDocument2;
     e := d.elementFromPoint (X, Y);
     if Assigned (e) then
       begin
         s := LowerCase (e.tagName);
         if (s = 'input') or (s = 'textarea') then
           begin
             if s = 'textarea' then
               FDropTarget := e
             else
               begin
                 i := e as IHTMLInputElement;
                 t := LowerCase (i.type_);
                 if (t = 'text') or (t = 'password') then
                   FDropTarget := e
               end
           end
       end
    end;

  Accept := Assigned (FDropTarget)
end;

Vielleicht hilft 's weiter.

Gruß

[Erutan]

Hi Volker,

funktioniert absolut perfekt. Besser könnte es gar nicht sein.

Vielen Dank und viele Grüße
Holger