/*****************************************************************************/ gezeigt wird, wie auf den Plaintext zugegrifen wird. Dieser wird in ein TMemo geladen. Weiterhin werden Möglichkeiten zur wahlweisen Unterstützung der Funktionstasten (Strg+C, Strg+V) oder der Entertaste gezeigt. Der Inhalt stammt aus unterschiedlichen Foren. Die Bedeutung der einzelnen Funktionen ist dort nachzuelesen. /*****************************************************************************/ uses ..., ActiveX; type TForm1 = class(TForm) CheckBoxTaSt: TCheckbox; WebBrowser1: TWebBrowser; Memo1.TMemo; EditURL: TEdit; BtnNav: TButton; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure CheckBoxTaStClick(Sender: TObject); procedure BtnNavClick(Sender: TObject); procedure WebBrowser1DocumentComplete(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant); private FOleInPlaceActiveObject: IOleInPlaceActiveObject; // wg. Entertastenproblematik procedure SaveDocumentSourceToStream(Document: IDispatch; Stream: TStream); procedure ExtractDataFromHtml; procedure FillMemo; procedure MsgHandler(var Msg: TMsg; var Handled: Boolean); end; implementation procedure TForm1.MsgHandler(var Msg: TMsg; var Handled: Boolean); const DialogKeys: set of Byte = [VK_LEFT, VK_RIGHT, VK_BACK, $30..$39, $41..$5A]; var iOIPAO: IOleInPlaceActiveObject; Dispatch: IDispatch; begin if (WebBrowser1 = nil) then begin Handled := System.False; Exit; end; Handled := (IsDialogMessage(WebBrowser1.Handle, Msg) = System.True); if (Handled) and (not WebBrowser1.Busy) then begin if FOleInPlaceActiveObject = nil then begin Dispatch := WebBrowser1.Application; if Dispatch <> nil then begin Dispatch.QueryInterface(IOleInPlaceActiveObject, iOIPAO); if iOIPAO <> nil then FOleInPlaceActiveObject := iOIPAO; end; end; if FOleInPlaceActiveObject <> nil then if not (((Msg.message = WM_KEYDOWN) or (Msg.message = WM_KEYUP)) and (Msg.wParam in DialogKeys)) then FOleInPlaceActiveObject.TranslateAccelerator(Msg); end; end; procedure TForm1.FormDestroy(Sender: TObject); begin FOleInPlaceActiveObject := nil; end; procedure TForm1.FormCreate(Sender: TObject); begin Application.OnMessage := MsgHandler; end; procedure TForm1.CheckBoxTaStClick(Sender: TObject); begin // Schaltet zwischen Unterstützung Entertaste und Steuertasten um if CheckBox4.Checked then Application.OnMessage := MsgHandler else Application.OnMessage := nil; end; procedure TForm1.SaveDocumentSourceToStream(Document: IDispatch; Stream: TStream); var PersistStreamInit: IPersistStreamInit; StreamAdapter: IStream; begin Stream.Size:= 0; Stream.Position:= 0; if Document.QueryInterface(IPersistStreamInit, PersistStreamInit) = S_OK then begin StreamAdapter:= TStreamAdapter.Create(Stream, soReference); PersistStreamInit.Save(StreamAdapter, False); StreamAdapter:= nil; end; end; procedure TForm1.FillMemo; var sStr: TStringStream; begin // speicher den Plaintext in ein TMemo sStr := TStringStream.Create(''); SaveDocumentSourceToStream(WebBrowser1.Document, sStr); Memo1.Text := sStr.DataString; sStr.Free; end; procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant); begin FillMemo; end; procedure TForm1.BtnNavClick(Sender: TObject); begin WebBrowser1.Navigate( EditURL.Text ); end; initialization OleInitialize(nil); finalization OleUninitialize; end. |