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()