Get selected Text from other Application

Just starting out? Need help? Post your questions and find answers here.
User avatar
Michael Vogel
Addict
Addict
Posts: 2797
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Get selected Text from other Application

Post by Michael Vogel »

Hi,

I'd tried to automate the following actions:
1) copying text from the browser
2) searching the text in a dictionary
3) displaying the result in a popup window (keeping the focus at the browser)

I solved 2&3 easily, but the simple action to get a marked text into the clipboard does not work! I found some questions like this already in the forum, but was not able to find the right trick how to do it...

I tried to send different messages (e.g. SendMessage(GetTopWindow() or GetFocus() or GetActiveWindow(),#WM_CHAR,3,0) for sending Ctrl-C) to get the text into the clipboard, but everything failed for now.

Can anyone help?

Thanks,
Michael
Trond
Always Here
Always Here
Posts: 7446
Joined: Mon Sep 22, 2003 6:45 pm
Location: Norway

Post by Trond »

WM_COPY
User avatar
Michael Vogel
Addict
Addict
Posts: 2797
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Post by Michael Vogel »

Thanks, Trond :!: Really faaaast :wink:
I think, I've tried this message also, but who knows, maybe I've used the wrong window handle. I'll check it again...
Trond
Always Here
Always Here
Posts: 7446
Joined: Mon Sep 22, 2003 6:45 pm
Location: Norway

Post by Trond »

Most likely you've got the wrong window handle. There's probably a few nested windows that you have to go through.
User avatar
Michael Vogel
Addict
Addict
Posts: 2797
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Post by Michael Vogel »

Yep,
seems to get complicated!

Using applications like the notepad are working, but I'll try to get (automatically) the selected text from my browser window - which does not work for now...

And my code should work in "each" application, so some user will use firefox, internet explorer, opera, maxthon,...

Code: Select all

CompilerIf 0
	#Message=#WM_COPY
	#wParam=0
	#lParam=0
CompilerElse
	#Message=#WM_CHAR
	#wParam=3
	#lParam=$2E0001
CompilerEndIf

#Nil="{}"

Global Handle

Procedure CheckClipboard(variante.s)
	Protected a.s

	SendMessage_(Handle,#Message,#wParam,GetClipboardText())
	WaitWindowEvent(10)
	Delay(5)

	a=GetClipboardText()
	If a<>#Nil
		Debug "Bingo - "+variante+"!"
		Debug "Clipboard is now '"+a+"'"
		End
	EndIf
EndProcedure
Procedure Main()
	Debug "Start..."
	Delay(5000)
	SetClipboardText(#Nil)
	Repeat

		Handle=GetTopWindow_(0)
		CheckClipboard("A")

		Handle=GetFocus_()
		CheckClipboard("B")

		Handle=GetForegroundWindow_()
		CheckClipboard("D")

		Handle=FindWindowEx_(Handle,0,"EDIT",0)
		CheckClipboard("E")

	ForEver
EndProcedure

Main()
Last edited by Michael Vogel on Wed Nov 15, 2006 8:48 am, edited 1 time in total.
User avatar
Michael Vogel
Addict
Addict
Posts: 2797
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Post by Michael Vogel »

Next try, also not successful :(

Still try to get the selected text from a browser (via the clipboard or however)...

Thought, that this could be done easily, Autohotkey and other applications are doing that with no problem...

Any hints :?:

Code: Select all

Delay(2000)

Procedure EnumProc(hwnd, param)
	Shared Resultstr
	tmp.s=Space(255)
	GetClassName_(hwnd, @tmp, 255)
	;resultstr + "Handle: " + Str(hwnd) + "  Class: " + Trim(tmp) + #CRLF$
	SendMessage_(hwnd,#WM_COPY,0,0)
	WaitWindowEvent(10)
	a.s=GetClipboardText()
	Debug Left(a,3)+" - " + Trim(tmp)
	ProcedureReturn 1
EndProcedure

SetClipboardText("{}")

win=GetForegroundWindow_()
Debug win
;win=00080240
If win
	EnumChildWindows_(win, @EnumProc(), 0)
	;MessageRequester("-",Resultstr)
EndIf
User avatar
Shardik
Addict
Addict
Posts: 2058
Joined: Thu Apr 21, 2005 2:38 pm
Location: Germany

Post by Shardik »

Have you tried whether the example code from freak suits your needs?
http://www.purebasic.fr/german/viewtopi ... 9&start=10
User avatar
Michael Vogel
Addict
Addict
Posts: 2797
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Post by Michael Vogel »

Shardik wrote:Have you tried whether the example code from freak suits your needs?
http://www.purebasic.fr/german/viewtopi ... 9&start=10
Now I checked your link, but it seems that I'm not clever enough to get a positive result...

With the examples I could get the selected text from a Webgadget, but I still fail to get the text from an external browser application (like maxthon, internet explorer etc.)

It would be cool to do that without the clipboard (I also tried to send EM_GETSEL message to all handles I could find) but it's also no problem if the clipboard would have to be used (sending the WM_COPY message, like Trond wrote), but how to get the right handle???
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Post by netmaestro »

I was able to get 7/8ths of the way through this, and in the course of my research I found this code written by freak, which goes 8/8ths of the way through it. All credit belongs to freak as all I did was update it to v4, and this program will return the selected text from an IE window. You might massage it a bit to choose a specific IE window if desired:

Code: Select all

; By Freak

Procedure ErrorMessage(Value) 
  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 MakeBSTR(String$) 
  Unicode$ = Space(Len(String$)*2+2) 
  MultiByteToWideChar_(#CP_ACP, 0, @String$, -1, @Unicode$, Len(String$)*2+2) 
  ProcedureReturn SysAllocString_(@Unicode$) 
EndProcedure 

Procedure.s ReadBSTR(bstr) 
  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.l GetIHTMLDocument2(ExplorerServerWindow) 

  HtmlDoc.IHTMLDocument2 = 0 
      
  OleAcc = OpenLibrary(#PB_Any, "OLEACC.DLL") 
  If OleAcc And GetFunction(OleAcc, "ObjectFromLresult") 

    Message = RegisterWindowMessage_("WM_HTML_GETOBJECT") 
    SendMessageTimeout_(ExplorerServerWindow, Message, 0, 0, #SMTO_ABORTIFHUNG, 1000, @MessageResult) 
      
    CallFunction(OleAcc, "ObjectFromLresult", MessageResult, ?IID_IHTMLDocument2, 0, @HtmlDoc)    
  
    CloseLibrary(OleAcc) 
  EndIf 
  
  ProcedureReturn HtmlDoc 
EndProcedure 

Procedure EnumChildProc(hwnd, *hServer.LONG) 
  Class$ = Space(100) 
  GetClassName_(hwnd, @Class$, 100) 
  If Class$ = "Internet Explorer_Server" 
    *hServer\l = hwnd ; server window found. 
    ProcedureReturn #False 
  Else 
    ProcedureReturn #True 
  EndIf 
EndProcedure 

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 


; CoInitialize around the whole thing is important as otherwise it won't work. 
CoInitialize_(0) 

; find the IE server window: 
; 
hWnd.l = FindWindow_("IEFrame", 0) 
EnumChildWindows_(hWnd, @EnumChildProc(), @ServerWindow) 

; get the interface: 
; 
Document.IHTMLDocument2 = 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) 
    Else 
      Type$ = "" 
    EndIf 
    
    Select LCase(Type$) 
      Case "none" 
        MessageRequester("", "Nothing is selected.") 
      
      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 
                  
              SelectedText$ = ReadBSTR(varResult\bstrVal) 
              SysFreeString_(varResult\bstrVal) 
              
              MessageRequester("Selected Text:", SelectedText$) 
              
            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 

CoUninitialize_()   
User avatar
Michael Vogel
Addict
Addict
Posts: 2797
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Post by Michael Vogel »

Thanks to you all,

now I took netmaestros code to get a 3/5 solution :lol: (IE-based browsers work now!)

Maybe someone also can give me the hint, how to activate the WM_COPY in external applications (firefox, opera)

Here is the code where I have included all your hints:

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()
  • This is question 1, hehehehe ?

    Answer 1 (wrong)
    +++Answer 2 (RIGHT!)
    Answer 3 (wrong)
    Answer 4 (wrong)


    This is question number two....
    and so on
    and so on
    ?

    Answer 1 (wrong)
    Answer 2 (wrong)
    ***Answer 3 (RIGHT!)
    +++Answer 4 (RIGHT!)
Post Reply