| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

из TWebbrowser в Memo [D7, WinXP]

Sergio77 ©   (2006-08-22 18:27:00) 

Привет всем!
как перетащить выделенный текст из TWebbrowser в Memo?

---

Sergio77   (2006-08-23 15:18:00) [1]

> easy ©  


спасибо огромное!!!

если не сложно, растолкуй как превратить этот мемо в компонент у которого будет событие до получения текста и после получения текста, ну и само свойство текст (хотя в мемо оно уже есть)??

---

easy   (2006-08-23 13:39:00) [2]

Unit1.dfm
object Form1: TForm1
 Left = 0
 Top = 0
 Caption = 'Form1'
 ClientHeight = 382
 ClientWidth = 521
 Color = clBtnFace
 Font.Charset = DEFAULT_CHARSET
 Font.Color = clWindowText
 Font.Height = -11
 Font.Name = 'Tahoma'
 Font.Style = []
 OldCreateOrder = False
 OnCreate = FormCreate
 OnDestroy = FormDestroy
 PixelsPerInch = 96
 TextHeight = 13
 object StatusBar1: TStatusBar
   Left = 0
   Top = 363
   Width = 521
   Height = 19
   Panels = <>
 end
 object WebBrowser1: TWebBrowser
   Left = 0
   Top = 0
   Width = 521
   Height = 363
   Align = alClient
   TabOrder = 1
   ExplicitLeft = 288
   ExplicitTop = 112
   ExplicitWidth = 300
   ExplicitHeight = 150
   ControlData = {
     4C000000D9350000842500000000000000000000000000000000000000000000
     000000004C000000000000000000000001000000E0D057007335CF11AE690800
     2B2E126208000000000000004C0000000114020000000000C000000000000046
     8000000000000000000000000000000000000000000000000000000000000000
     00000000000000000100000000000000000000000000000000000000}
 end
end

Unit1.pas
unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, OleCtrls, SHDocVw, ComCtrls, StdCtrls,ActiveX;
type
 TadvMemo = class(TMemo, IDropTarget)
 protected
   function IDropTarget.DragOver = DragOverOLE;
   function DragEnter(const dataObj: IDataObject; grfKeyState: Longint;
     pt: TPoint; var dwEffect: Longint): HResult; stdcall;
   function DragOverOLE(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;
   procedure CreateWnd; override;
   procedure DestroyWnd; override;
 end;

type
 TForm1 = class(TForm)
   StatusBar1: TStatusBar;
   WebBrowser1: TWebBrowser;
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
 private
   { Private declarations }
   advMemo: TadvMemo;
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

{ TadvMemo }

procedure TadvMemo.CreateWnd;
begin
 inherited;
 RegisterDragDrop(Handle, self as IDropTarget);
end;

procedure TadvMemo.DestroyWnd;
begin
 inherited;
 RevokeDragDrop(Handle);
end;

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

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

function TadvMemo.DragOverOLE(grfKeyState: Integer; pt: TPoint;
 var dwEffect: Integer): HResult;
begin
 Result := S_OK;
end;

function TadvMemo.Drop(const dataObj: IDataObject; grfKeyState: Integer;
 pt: TPoint; var dwEffect: Integer): HResult;
var
 FMT: FORMATETC;
 MED: STGMEDIUM;
 Size: DWORD;
 Buffer: PChar;
 Text2: string;
begin
 Result := S_OK;
 FMT.cfFormat := CF_TEXT;
 FMT.ptd := nil;
 FMT.dwAspect := DVASPECT_CONTENT;
 FMT.lindex := -1;
 FMT.tymed := TYMED_HGLOBAL;
 try
   dataObj.GetData(FMT, MED);
   Size := GlobalSize(MED.hGlobal);
   Buffer := GlobalLock(MED.hGlobal);
   SetString(Text2, Buffer, Size);
   GlobalUnlock(MED.hGlobal);
   ReleaseStgMedium(MED);
   SelText := Text2;
 except
   Result := E_UNEXPECTED;
 end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 advMemo:= TadvMemo.Create(self);
 with advMemo do begin
   Align := alLeft;
   parent := self;
 end;
 WebBrowser1.Navigate('yandex.ru');
end;

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

initialization
 OleInitialize(nil);

finalization
 OleUninitialize;
end.

---

Sergio77   (2006-08-23 11:02:00) [3]

> > как перетащить
>
> мышью?


интересует мышью

на счет скопровать и вставить:

function GetBrowserSelection(WB: TWebBrowser): string;
var
 Doc: Variant;
begin
 if WB.Document <> nil then
 begin
   Doc := WB.Document;
   try
     Result := Doc.Selection.createRange.Text
   finally
     Doc := Unassigned;
   end;
 end
 else
   Result := '';
end;

такая функция не всегда помогает, не помогает в частности тогда, когда слева какое-то дерево, а спрва уже информация по ссылкам дерева слева, и когда нажимаешь на ссылки дерева, то вверху не появляется ссылка (в строке ввода браузера обычного)

---

tButton   (2006-08-23 10:28:00) [4]

> как перетащить

мышью?

---

Rentgen   (2006-08-23 10:17:00) [5]

скопировать, вставить?

---

Наверх