Maybe someone also can give me the hint, how to activate the WM_COPY in external applications (firefox, opera)
I loads a text file with questions and answers (like seen at the end) and displays the found question (just start the program, load the textfile into the internet browser and select a word from a question)....
Code: Select all
; Define
	EnableExplicit
	#Textdaten="tutor.txt"
	#Maxzeilen=10000
	#Maxfragen=2500
	#ProgrammName="Super Tutor"
	#Versionstext="V0.2"
	#Idletext="-"
	#Antwortkennung="»»"
	#IllegaleZeichen=" !?.,:;()[]/&%$'-_"+#CRLF$
	#MinAlpha=64
	#MaxAlpha=240
	#AlphaStep=8
	#FadeOut=6000
	#BrowserWait=1000
	Global AlphaStatus
	Global NoProblem
	Global Bold
	#Caption=24
	#Quarter=#Caption>>2
	#Space=16
	#Border=1
	#WinX=460
	#WinY=260
	#Title=#Caption+#Border
	#TopLine=4
	#StatusLen=60
	#SearchLen=#WinX-#StatusLen-20
	#Edit=#WinY-#Title
	; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	Structure FragenTyp
		Start.l
		Zeilen.l
		Antworten.l
	EndStructure
	Global Dim Text.s(#Maxzeilen)
	Global Dim Fragen.FragenTyp(#Maxfragen)
	Global Dim Searchlist(#Maxfragen)
	Global GesamtText
	Global GesamtFragen
	Global SearchtextOriginal.s
	Global Searchtext.s
	Global SearchResult
	Global Anzeige
	Global WinID
	Global VerlaufID
	Global ImageID
	Global Timer,Ticker,Now
	Global Dummy.s
	Global i,j,k,x,y
	Global local,lol,lili,loop
	Global quit
	Global char.s
	Global Font1=LoadFont(0,"Verdana",10,#PB_Font_Bold)
	Global Font2=LoadFont(0,"Verdana",10)
	Global Font1y
	Global Font2y
	Enumeration
		#Frage
		#FrageFertig
		#AntwortFehlt
		#Antwort
		#AntwortFertig
	EndEnumeration
	Enumeration
		#Textfeld
		#Statustext
		#Windowtext
		#Image
		#Verlauf
	EndEnumeration
	#TextHeader="{\rtf {\fonttbl{\f0 Verdana;}}{\colortbl ;\red255\green255\blue96;\red192\green0\blue0;\red64\green64\blue255;}"
	#TextBigSum=36
	#TextSmallSum=32
	#TextAbsatzSum=96
	Global TextBig=20
	Global TextSmall=18
	Global TextAbsatz=60
	Declare MyDummy(x)
	; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	Global Browser
	Global SelectedText.s
	DataSection
		IID_IHTMLDocument2: ; {332C4425-26CB-11D0-B483-00C04FD90119}
		Data.l $332C4425
		Data.w $26CB, $11D0
		Data.b $B4, $83, $00, $C0, $4F, $D9, $01, $19
		IID_NULL: ; {00000000-0000-0000-0000-000000000000}
		Data.l $00000000
		Data.w $0000, $0000
		Data.b $00, $00, $00, $00, $00, $00, $00, $00
	EndDataSection
; EndDefine
Procedure.l GetIHTMLDocument2(ExplorerServerWindow)
	Protected HtmlDoc.IHTMLDocument2=0
	Protected OleAcc=OpenLibrary(#PB_Any, "OLEACC.DLL")
	If OleAcc And GetFunction(OleAcc, "ObjectFromLresult")
		Protected Message=RegisterWindowMessage_("WM_HTML_GETOBJECT")
		Protected MessageResult
		SendMessageTimeout_(ExplorerServerWindow, Message, 0, 0, #SMTO_ABORTIFHUNG, 1000, @MessageResult)
		CallFunction(OleAcc, "ObjectFromLresult", MessageResult, ?IID_IHTMLDocument2, 0, @HtmlDoc)
		CloseLibrary(OleAcc)
	EndIf
	ProcedureReturn HtmlDoc
EndProcedure
Procedure.s ReadBSTR(bstr)
	Protected length
	Protected text.s
	length=WideCharToMultiByte_(#CP_ACP, 0, bstr, -1, 0, 0, 0, 0)
	Text=Space(length)
	WideCharToMultiByte_(#CP_ACP, 0, bstr, -1, @Text, length, 0, 0)
	ProcedureReturn Text
EndProcedure
Procedure MakeBSTR(String$)
	Protected Unicode$ = Space(Len(String$)*2+2)
	MultiByteToWideChar_(#CP_ACP, 0, @String$, -1, @Unicode$, Len(String$)*2+2)
	ProcedureReturn SysAllocString_(@Unicode$)
EndProcedure
Procedure ErrorMessage(Value)
	Protected Message$ = Space(3000)
	FormatMessage_(#FORMAT_MESSAGE_IGNORE_INSERTS|#FORMAT_MESSAGE_FROM_SYSTEM, 0, Value, 0, @Message$, 3000, 0)
	MessageRequester("Error","Error:"+Chr(13)+Message$, #MB_ICONERROR)
EndProcedure
Procedure EnumProc(hwnd,*bingo.long)
	Shared Resultstr
	Protected tmp.s=Space(255)
	GetClassName_(hwnd, @tmp, 255)
	;Debug "Handle: " + Str(hwnd) + "  Class: " + Trim(tmp)
	;SendMessage_(hwnd,#WM_COPY,0,0)
	;WaitWindowEvent(10)
	;a.s=GetClipboardText()
	;Debug Left(a,3)+" - " + Trim(tmp)
	If tmp = "Internet Explorer_Server"
		*bingo\l=HWnd
		ProcedureReturn #False
	EndIf
	ProcedureReturn #True
EndProcedure
Procedure.s GetSelected(Serverwindow)
	Protected Document.IHTMLDocument2
	Protected Selection.IHTMLSelectionObject
	Protected bstr_string
	Protected bstr_name
	Protected dispid
	Protected text.s
	Protected type.s
	Protected TextRangeDispatch.IDispatch
	Protected arguments.DISPPARAMS
	Protected result
	Protected varResult.VARIANT
	Document=GetIHTMLDocument2(ServerWindow)
	If Document
		If Document\get_selection(@Selection.IHTMLSelectionObject)=#S_OK
			; first we should check the type of the selection, because if a control
			; is selected, you will get a different object from createRange()!
			If Selection\get_type(@bstr_string)=#S_OK
				Type=ReadBSTR(bstr_string)
				SysFreeString_(bstr_string)
			EndIf
			Select LCase(Type)
				;Case "none"
				;	Text=""
			Case "text"
				; ok, get the IDispatch for the TextRange object
				If Selection\createRange(@TextRangeDispatch.IDispatch) = #S_OK
					; bstr_name = MakeBSTR("htmlText") ; use this to get html code
					bstr_name = MakeBSTR("text")
					; get the dispid of the property we want to get
					If TextRangeDispatch\GetIDsOfNames(?IID_NULL, @bstr_name, 1, 0, @dispid.l) = #S_OK
						arguments.DISPPARAMS\cArgs = 0
						; now read the actual property.
						result= TextRangeDispatch\Invoke(dispid, ?IID_NULL, 0, #DISPATCH_PROPERTYGET, @arguments, @varResult.VARIANT, 0, 0)
						If result = #S_OK And varResult\vt = #VT_BSTR
							Text=ReadBSTR(varResult\bstrVal)
							SysFreeString_(varResult\bstrVal)
						Else
							ErrorMessage(result)
						EndIf
						SysFreeString_(bstr_name)
					EndIf
					TextRangeDispatch\Release()
				EndIf
				;Case "control"
				;MessageRequester("", "A control is selected.")
				;Default
				;MessageRequester("", "Error!")
			EndSelect
			Selection\Release()
		EndIf
		Document\Release()
	EndIf
	ProcedureReturn Text
EndProcedure
Procedure InitData()
	NoProblem=#False
	If FileSize(#Textdaten)>0
		If ReadFile(0,#Textdaten)
			NoProblem=#True
			k=#AntwortFertig;						nächste Zeile ist eine neue Frage...
			While Eof(0)=0
				Dummy=Trim(ReadString(0))
				If Len(Dummy)
					Select k
					Case #AntwortFertig,#Frage
						If (Right(Dummy,1)="?") Or ((Right(Dummy,1)=")") And (FindString(Dummy,"?",1)<>0))
							If Fragen(GesamtFragen)\Start=0
								Fragen(GesamtFragen)\Start=GesamtText
							EndIf
							Fragen(GesamtFragen)\Zeilen=GesamtText-Fragen(GesamtFragen)\Start+1
							Debug Str(GesamtFragen)+": "+Str(Fragen(GesamtFragen)\Start)+"/"+Str(Fragen(GesamtFragen)\Zeilen)+" - "+Dummy
							k=#FrageFertig
						Else
							If Fragen(GesamtFragen)\Start=0
								Fragen(GesamtFragen)\Start=GesamtText
							EndIf
							k=#Frage
						EndIf
					Case #FrageFertig,#AntwortFehlt,#Antwort
						k=#Antwort
						If Left(Dummy,3)="***"
							MyDummy('*')
						ElseIf Left(Dummy,3)="+++"
							MyDummy('+')
						EndIf
					EndSelect
					Text(GesamtText)=ReplaceString(Dummy,"§","\par\tab ")
					GesamtText+1
				Else
					Select k
					Case #Frage
						;NoProblem=#False
						Debug "!"
						;End
					Case #Antwort
						k=#AntwortFertig
						Fragen(GesamtFragen)\Antworten=GesamtText-Fragen(GesamtFragen)\Start-Fragen(GesamtFragen)\Zeilen
						;Debug ">"+Str(Fragen(GesamtFragen)\Antworten)
						GesamtFragen+1
					EndSelect
				EndIf
				;Debug GesamtText
			Wend
			CloseFile(0)
		EndIf
	EndIf
EndProcedure
Procedure.s MyFilter(x.s)
	Dummy=""
	loop=0
	While loop<Len(x)
		loop+1
		char=Mid(x,loop,1)
		If FindString(#IllegaleZeichen,char,1)=0
			Dummy+char
		EndIf
	Wend
	ProcedureReturn LCase(Dummy)
EndProcedure
Procedure MyDummy(x)
	local=0
	While PeekB(@Dummy+local)=x
		local+1
	Wend
	Dummy=#Antwortkennung+Mid(Dummy,local+1,#MAXSHORT)
EndProcedure
Procedure MyCaption(text.s,status.s)
	StartDrawing(ImageOutput(#Image))
	DrawImage(VerlaufID,0,0)
	If text=""
		text=#ProgrammName
	EndIf
	DrawingMode(#PB_2DDrawing_Transparent)
	DrawingFont(Font1)
	DrawText(#Border+1,Font1y,text,#Black)
	DrawText(#Border,Font1y-1,text,#White)
	If Len(status)
		DrawingFont(Font2)
		lol=#WinX-TextWidth(status)
		DrawText(lol+1,Font2y,status,#Black)
		DrawText(lol,Font2y-1,status,#White)
	EndIf
	StopDrawing()
	SetGadgetState(#Image,ImageID)
EndProcedure
Procedure MyText()
	Dummy=#TextHeader+"\tx600\li100\sa"+Str(TextAbsatz)
	If SearchResult
		Dummy+"\sl-"+Str(TextBig*11)+"\fs4 \par\fs"+Str(TextBig)+"\highlight1\cf0\b"+Str(Bold)
		;Dummy+"\brdrt\brdrs\brdrw10\brsp20 \brdrl\brdrs\brdrw10\brsp80 \brdrb\brdrs\brdrw10\brsp20 \brdrr\brdrs\brdrw10\brsp80 "
		lol=Fragen(Searchlist(Anzeige))\Start
		local=0
		While local<Fragen(Searchlist(Anzeige))\Zeilen
			Dummy+Text(lol+local)+"\par "
			local+1
		Wend
		Dummy+"\fs4 \par\li600\tx600\fi-350\fs"+Str(TextSmall)+"\b0\cf0\highlight0 "
		lol+local
		local=0
		While local<Fragen(Searchlist(Anzeige))\Antworten
			Dummy+"\cf0\b "+Chr(65+local)+"\b0:\tab "
			If Left(Text(lol+local),2)=#Antwortkennung
				Dummy+"\b\cf2 "
			Else
				Dummy+"\cf3 "
			EndIf
			Dummy+Text(lol+local)+"\b0\par "
			local+1
		Wend
		MyCaption(">> "+Left(SearchtextOriginal,50)+"...",Str(Anzeige+1)+" / "+Str(SearchResult))
	Else
		Dummy+"\fs50\b\highlight1\cf0\par \qc   "+#ProgrammName+" "+#Versionstext+"  \b0\cf0\highlight0\par \par\fs24\qc"
		If NoProblem
			Dummy+"\b1©2006 by Michael Vogel"
		Else
			Dummy+"\cf2\b1Tutor file corrupted!"
		EndIf
		MyCaption("","")
	EndIf
	SetGadgetText(#Textfeld,Dummy)
EndProcedure
Procedure MySearch()
	;Debug Searchtext
	SearchResult=0
	Anzeige=0
	local=0
	While local<GesamtFragen
		lol=0
		lili=Fragen(local)\Start
		Dummy=""
		While lol<Fragen(local)\Zeilen
			Dummy+Text(lili+lol)
			lol+1
		Wend
		If FindString(MyFilter(Dummy),Searchtext,1)
			;Debug "!!!"+Dummy
			Searchlist(SearchResult)=local
			SearchResult+1
		EndIf
		local+1
	Wend
	MyText()
EndProcedure
Procedure FadeWindow(mode)
	If mode
		lol=#MaxAlpha
		local=#MinAlpha
		loop=#AlphaStep
	Else
		lol=#MinAlpha
		local=#MaxAlpha
		loop=-#AlphaStep
	EndIf
	While local<>lol
		local+loop
		SetLayeredWindowAttributes_(WinID,0,local,#LWA_ALPHA)
		Delay(10)
	Wend
	AlphaStatus=mode
	Timer=#MAXLONG
	While WindowEvent() : Wend
EndProcedure
Procedure.l Scale(color,a,b)
	ProcedureReturn RGB(Red(color)*a/b,Green(color)*a/b,Blue(color)*a/b)
EndProcedure
Procedure InitWindow()
	VerlaufID=CreateImage(#Verlauf,#WinX+#Border<<1,#Caption)
	StartDrawing(ImageOutput(#Verlauf))
	x=#WinX+#Border<<1
	For i=0 To #Caption>>2
		y=i
		LineXY(0,y,x,y,$f0d0d0-Scale($006060,i,#Quarter))
		y+#Caption>>2
		LineXY(0,y,x,y,$a00000)
		y+#Caption>>2
		LineXY(0,y,x,y,$a00000+Scale($202020,i,#Quarter))
		y=#Caption-i
		LineXY(0,y,x,y,$400000+Scale($802020,i,#Quarter))
	Next i
	DrawingFont(Font1)
	Font1y=(#Caption-TextHeight("Wg"))>>1
	DrawingFont(Font2)
	Font2y=(#Caption-TextHeight("Wg"))>>1
	StopDrawing()
	ImageID=CreateImage(#Image,#WinX+#Border<<1,#Caption)
	#MOD_WIN=8
	WinID=OpenWindow(0,GetSystemMetrics_(#SM_CXFULLSCREEN)-#WinX-#Space-#Border<<1,#Space,#WinX+#Border<<1,#WinY+#Border,#ProgrammName,#PB_Window_BorderLess|#WS_DLGFRAME|#PB_Window_Invisible)
	SetWindowLong_(WinID,#GWL_EXSTYLE,GetWindowLong_(WinID,#GWL_EXSTYLE)|#WS_EX_LAYERED|#WS_EX_TOOLWINDOW)
	SetLayeredWindowAttributes_(WinID,0,0,#LWA_ALPHA)
	;SetWindowColor(0,#Blue)
	CreateGadgetList(WindowID(0))
	ImageGadget(#Image,0,0,#WinX,#Caption,ImageID)
	EditorGadget(#Textfeld,#Border,#Title,#WinX,#Edit,#PB_Editor_ReadOnly)
	SendMessage_(GadgetID(#Textfeld),#EM_SETTARGETDEVICE,0,0)
	;TextGadget(#Windowtext,10,#TopLine,#SearchLen,20,#ProgrammName)
	;SetGadgetFont(#Windowtext,Font1)
	;TextGadget(#Statustext,#WinX-#StatusLen-#Border<<1,#TopLine,#StatusLen,20,"-",#PB_Text_Right)
	;SetGadgetFont(#Statustext,Font2)
	RegisterHotKey_(WinID,23000,#MOD_WIN,#VK_ESCAPE)
	RegisterHotKey_(WinID,23001,#MOD_WIN,#VK_C)
	RegisterHotKey_(WinID,23002,#MOD_WIN,#VK_V)
	RegisterHotKey_(WinID,23003,#MOD_WIN|#MOD_SHIFT,#VK_V)
	RegisterHotKey_(WinID,23004,#MOD_WIN,#VK_SPACE)
	RegisterHotKey_(WinID,23005,#MOD_WIN|#MOD_SHIFT,#VK_C)
	SetLayeredWindowAttributes_(WinID,0,0,#LWA_ALPHA)
	MyText()
	MyCaption("","")
	StickyWindow(0,1)
	HideWindow(0,0)
	While WaitWindowEvent(10) : Wend
	FadeWindow(1)
	Now=GetTickCount_()
	Timer=Now+#FadeOut
	Ticker=Now+#BrowserWait<<1
	;Delay(100)
	;FadeWindow(0)
EndProcedure
Procedure Main()
	CoInitialize_(0)
	InitData()
	InitWindow()
	Repeat
		Now=GetTickCount_()
		If Now>Ticker
			EnumChildWindows_(GetForegroundWindow_(),@EnumProc(),@Browser)
			If Browser
				SelectedText=GetSelected(Browser)
				If Len(SelectedText) And (SelectedText<>SearchTextOriginal)
					SearchTextOriginal=SelectedText
					Searchtext=MyFilter(SearchtextOriginal)
					SearchtextOriginal=ReplaceString(SearchtextOriginal,#CRLF$," ")
					If NoProblem : MySearch() : EndIf
					WaitWindowEvent(10)
					If AlphaStatus=0
						FadeWindow(1)
					EndIf
					Timer=GetTickCount_()+#FadeOut
				EndIf
			EndIf
		EndIf
		If Now>Timer
			FadeWindow(0)
		EndIf
		Select WaitWindowEvent(100)
		Case #PB_Event_Gadget;#WM_LBUTTONDOWN
			SendMessage_(WinID,#WM_NCLBUTTONDOWN,#HTCAPTION,0)
		Case #WM_RBUTTONDOWN
				FadeWindow(1-AlphaStatus)
				Timer=GetTickCount_()+#FadeOut
			;Case #WM_PAINT
		Case #WM_HOTKEY
			Select EventwParam()
			Case 23000
				quit=1
			Case 23001
				;SendMessage_(GetTopWindow_(0)
				;SendMessage_(GetTopWindow_(0),#WM_COPY,0,0)
				;PostMessage_(GetTopWindow_(0),#WM_CHAR,3,0)
				Debug "?"
				PostMessage_(GetForegroundWindow_(),#WM_COPY,0,0)
				Debug GetClipboardText()
				PostMessage_(GetFocus_(),#WM_COPY,0,0)
				Debug GetClipboardText()
				PostMessage_(GetTopWindow_(0),#WM_COPY,0,0)
				Debug GetClipboardText()
				;SendMessage_(GetFocus_(),#WM_CHAR,3,3<<32+1)
				SearchTextOriginal=GetClipboardText()
				Searchtext=MyFilter(SearchtextOriginal)
				SearchtextOriginal=ReplaceString(SearchtextOriginal,#CRLF$," ")
				If NoProblem : MySearch() : EndIf
				WaitWindowEvent(10)
				If AlphaStatus=0
					FadeWindow(1)
				EndIf
				Timer=GetTickCount_()+#FadeOut
			Case 23002
				If Anzeige+1<SearchResult
					Anzeige+1
					MyText()
				EndIf
				If AlphaStatus=0
					FadeWindow(1)
				EndIf
				Timer=GetTickCount_()+#FadeOut
			Case 23003
				If Anzeige*SearchResult>0
					Anzeige-1
					MyText()
				EndIf
				If AlphaStatus=0
					FadeWindow(1)
				EndIf
				Timer=GetTickCount_()+#FadeOut
			Case 23004
				FadeWindow(1-AlphaStatus)
				Timer=GetTickCount_()+#FadeOut
			Case 23005
				TextBig=#TextBigSum-TextBig
				TextSmall=#TextSmallSum-TextSmall
				TextAbsatz=#TextAbsatzSum-TextAbsatz
				MyText()
				WaitWindowEvent(10)
				If AlphaStatus=0
					FadeWindow(1)
				EndIf
				Timer=GetTickCount_()+#FadeOut
			EndSelect
		Case #PB_Event_CloseWindow
			quit=1
		EndSelect
	Until quit
	CoUninitialize_()
EndProcedure
Main()