Leider war der Code auf meinem Laptop arg langsam. Und auch für mich unübersichtlich und schwer verständlich.
Ich nehme an #NULL wollte durch Verwendung von Konstanten etc. das Programm beschleunigen. Dabei hätte er nur das Editgadget nicht mit AddGadgetItem() füllen müssen, sondern mit streaming.
Aber egal, hier meine Version für Windows 10. Sogar auf XP funktioniert es bis auf die Webfunktion. Für andere OS muß man halt kleinere Änderungen vornehmen. Api und Schreibweise etc.
Code: Alles auswählen
; Konstantenliste etc aus dem PBCompiler auslesen
; Vorbild der AusleseRoutine ist ein Posting von #NULL siehe http://www.purebasic.fr/english/viewtopic.php?f=27&t=69984
; von HJBremer - Januar 2018, PB 5.60 x64 Windows 10
EnableExplicit
Global progversion.s = "1.07 HJBremer 2018"
LoadFont(1, "Consolas", 11) ;wird Default
LoadFont(2, "Consolas", 9) ;für Textgadgets + Checkbox
SetGadgetFont(#PB_Default, FontID(1))
;- Enumerations
Enumeration
#window ;Mainwindow
#statusbar
#container ;Container unten für Buttons etc
#listicon ;Liste oben für alle Konstanten
#listsuch ;Liste unten für Suchausgaben
#webgadget ;verstecktes Webgadget für 1.Aufruf CallMsdn
#edit_help ;verstecktes Editgadget für Hilfe
#text_sucheName ;Textgadget Info Suche nach Name
#input_sucheName ;Stringgadget Eingabe
#check_sucheName ;Checkbox Suche enthalten oder ist gleich
#text_suchewert ;Textgadget Info Suche nach Wert
#input_suchewert ;Stringgadget Eingabe
#combo_Liste
#button_suchliste ;Suchliste verschwinden lassen
#button_clipboard ;markierte Konstante ins Clipboard
#button_callmsdn ;markierte Konstante bei MSDN suchen
#button_saveList ;
#button_compiler ;zeigt CompilerInterface.txt
#button_helpinfo ;F1 = Hilfe
#button_ProgEnde ;
EndEnumeration
;- Proceduren
Procedure.i SetListRedraw(liste, flag)
If flag = #False
SendMessage_(GadgetID(liste), #WM_SETREDRAW, #False, 0)
Else
SendMessage_(GadgetID(liste), #WM_SETREDRAW, #True, 0)
InvalidateRect_(GadgetID(liste), 0, #True)
EndIf
;oder HideGadget(liste, 1) und HideGadget(liste, 0) ist aber nicht so schön
EndProcedure
Procedure.i SetListLabelTip(liste)
Protected exstyle = SendMessage_(GadgetID(liste), #LVM_GETEXTENDEDLISTVIEWSTYLE, 0, 0)
SendMessage_(GadgetID(liste), #LVM_SETEXTENDEDLISTVIEWSTYLE, 0, exstyle | #LVS_EX_LABELTIP)
EndProcedure
Procedure.i searchList()
;durchsucht Hauptliste nach Name und/oder Wert
Protected j, k, show, lfdnr = 0
Protected anz = CountGadgetItems(#listicon) - 1
Protected name$, wert$, item$
Protected suchname$ = UCase(GetGadgetText(#input_sucheName)) ;UCase weil nicht jeder Name UCase ist !
Protected suchnamelg = Len(suchname$)
Protected suchwert$ = UCase(GetGadgetText(#input_suchewert))
Protected suchwertlg = Len(suchwert$)
Protected equal_name = Bool(GetGadgetState(#check_sucheName) = #PB_Checkbox_Checked) ;Status Checkbox
Protected foundname, foundwert
SetListRedraw(#listsuch, #False)
ClearGadgetItems(#listsuch)
For j = 0 To anz
foundname = #False: foundwert = #False: show = #False
name$ = UCase(GetGadgetItemText(#listicon, j, 0))
wert$ = UCase(GetGadgetItemText(#listicon, j, 2))
;- search name
If suchnamelg
If equal_name
If Left(name$, suchnamelg) = suchname$: foundname = #True: EndIf
Else
If FindString(name$, suchname$): foundname = #True: EndIf
EndIf
EndIf
;- search wert
If suchwertlg
Select Asc(wert$)
Case 48 To 57
If wert$ = suchwert$: foundwert = #True: EndIf
Default
If Left(wert$, suchwertlg) = suchwert$: foundwert = #True: EndIf
EndSelect
EndIf
;- search Auswertung + Anzeige
If Bool(suchnamelg And suchwertlg) ;Eingabe in beiden Feldern
If Bool(foundname And foundwert)
show = #True
EndIf
ElseIf Bool(suchnamelg And foundname) ;Eingabe in Name
show = #True
ElseIf Bool(suchwertlg And foundwert) ;Eingabe in Wert
show = #True
EndIf
If show = #True
item$ = ""
For k = 0 To 3
item$ + GetGadgetItemText(#listicon, j, k) + #LF$
Next
AddGadgetItem(#listsuch, -1, item$)
lfdnr + 1
EndIf
Next
SetListRedraw(#listsuch, #True)
StatusBarText(#statusbar, 2, "Anzahl: " + lfdnr)
EndProcedure
Procedure.i saveList()
Protected filename.s = GetGadgetText(#combo_Liste) +".txt"
Protected j, k, cols, line.s
Protected anz = CountGadgetItems(#listicon) - 1
Protected dnr = CreateFile(#PB_Any, filename)
If GetGadgetText(#combo_Liste) = "CONSTANTLIST": cols = 3: EndIf
For j = 0 To anz
line = ""
For k = 0 To cols
line + GetGadgetItemText(#listicon, j, k) + #TAB$
Next
WriteStringN(dnr, line) ;hängt #crlf automatisch an
Next
CloseFile(dnr)
StatusBarText(#statusbar, 3, filename, #PB_StatusBar_Center)
EndProcedure
Procedure.i setColumnWidth(indexnr)
Protected col, br = GadgetWidth(#listicon) - 22 ;22 ist breite Scrollbalken
Dim columnbr(1,3)
columnbr(0,0) = 320
columnbr(0,1) = 120
columnbr(0,2) = 320
columnbr(0,3) = br - 320 - 120 - 320
columnbr(1,0) = br
For col = 0 To 3
SetGadgetItemAttribute(#listicon, 0, #PB_ListIcon_ColumnWidth, columnbr(indexnr, col), col)
SetGadgetItemAttribute(#listsuch, 0, #PB_ListIcon_ColumnWidth, columnbr(indexnr, col), col)
Next
EndProcedure
Procedure.i getCompilerList(listname.s)
;Liste aus dem PBCompiler auslesen,
;Infos: im Verzeichnis PureBasic5.xx\SDK\CompilerInterface.txt ganz unten
Structure ListInfo
type.s
name.s
value.s
EndStructure
NewList constants.ListInfo()
Protected version.s, line.s = ""
Protected compiler.s = #PB_Compiler_Home + "\compilers\pbcompiler" ;PBCompiler.exe
;Windows 10 x64 und Unix ?
;Protected prog = RunProgram(compiler, "--standby", GetPathPart(compiler), #PB_Program_Open | #PB_Program_Read | #PB_Program_Write|#PB_Program_Hide)
;Windows
Protected prog = RunProgram(compiler, "/standby", GetPathPart(compiler), #PB_Program_Open | #PB_Program_Read | #PB_Program_Write|#PB_Program_Hide)
If prog
StatusBarText(#statusbar, 3, "Werte auslesen")
StatusBarText(#statusbar, 1, "Daten werden geladen", #PB_StatusBar_Center)
SetGadgetItemText(#listicon, -1, listname + " - Name", 0)
While ProgramRunning(prog)
If AvailableProgramOutput(prog)
line = ReadProgramString(prog) : ;Debug line
If StringField(line, 1, #TAB$) = "STARTING" : Debug "STARTING: " + line
version = StringField(line, 3, #TAB$) : Debug version
ElseIf line = "READY" : Debug "READY: " + line
WriteProgramStringN(prog, listname) ; z.B. "CONSTANTLIST"
ElseIf line = "OUTPUT" + #TAB$ + "COMPLETE" : Debug "OUTPUT COMPLETE: " + line
WriteProgramStringN(prog, "END")
Else
AddElement(constants())
If listname = "CONSTANTLIST"
constants()\type = StringField(line, 1, #TAB$)
constants()\name = StringField(line, 2, #TAB$)
constants()\value = StringField(line, 3, #TAB$)
Else
constants()\name = line
EndIf
EndIf
EndIf
Wend
CloseProgram(prog)
EndIf
;im 1.Element steht die Anzahl, bei der CONSTANTLIST in Type, sonst in Name
FirstElement(constants())
If Val(constants()\name): constants()\name = "": EndIf
;Sortieren nach Name
SortStructuredList(constants(), #PB_Sort_Ascending | #PB_Sort_NoCase, OffsetOf(ListInfo\name), #PB_String)
;- Liste füllen und speichern
StatusBarText(#statusbar, 1, version)
StatusBarText(#statusbar, 3, "Liste erstellen")
SetListRedraw(#listicon, #False) ;Liste wird schneller gefüllt, Hidegadget geht auch
ClearGadgetItems(#listicon)
If listname = "CONSTANTLIST"
setColumnWidth(0)
Else
setColumnWidth(1)
EndIf
ForEach constants()
If constants()\name ;item erstellen wenn name vorhanden
line = constants()\name + #LF$
If listname = "CONSTANTLIST"
Select constants()\type
Case "0"
line + constants()\type + " (Quad)" + #LF$
line + constants()\value + #LF$
line + "$" + Hex(Val(constants()\value))
Case "1"
line + constants()\type + " (Double)" + #LF$
line + constants()\value + #LF$
Case "2"
line + constants()\type + " (String)" + #LF$
If Asc(constants()\value) < 33
line + "Chr(" + Asc(constants()\value) + ")" + #LF$
Else
line + constants()\value + #LF$
EndIf
EndSelect
EndIf
AddGadgetItem(#listicon, -1, line)
Else
Debug "Name ist leer"
EndIf
Next
SetListRedraw(#listicon, #True)
SetActiveGadget(#listicon)
StatusBarText(#statusbar, 3, "Anzahl: " + Str(CountGadgetItems(#listicon)))
EndProcedure
Procedure.i CallMsdn(suchwort$)
;versucht zu einer Konstanten eine MSDN-Seite zu finden und im Standardbrowser anzuzeigen, Windows 10 ?!
;urls + Variablen
Protected event, p1, p2, error = 1
Protected html$
Protected suchurl$ = "https://search.msdn.microsoft.com/search/en-US/Default.aspx?siteId=0&tab=0&query="
Protected msdnurl$ = "https://msdn.microsoft.com/en-us/library/windows/desktop"
;los gehts, zuerst "search.msdn" mit suchwort aufrufen, dafür wird das Webgadget benutzt.
SetGadgetText(#webgadget, suchurl$ + suchwort$)
StatusBarText(#statusbar, 1, "suche " + suchwort$ + " - bitte warten", #PB_StatusBar_Center)
;Busy
While GetGadgetAttribute(#webgadget, #PB_Web_Busy)
event = WindowEvent()
Delay(1)
Wend
;search.Msdn Übersichtseite auslesen
html$ = GetGadgetItemText(#webgadget, #PB_Web_HtmlCode)
SetGadgetText(#webgadget, "")
;suchen
p1 = FindString(html$, msdnurl$) ;auf "search.msdn" url des 1.Eintrags suchen
If p1
p2 = FindString(html$, ".aspx", p1) ;p1, p2 - warum wieso weshalb, hab ich vergessen
If p2
error = 0 ;wenn p1 + p2 wahr
msdnurl$ = Mid(html$, p1, p2-p1) + ".aspx" ;MSDN Seite des Suchwortes
RunProgram(msdnurl$) ;im Standardbrowser anzeigen
EndIf
EndIf
If error: MessageRequester("Error", suchwort$ + " nicht gefunden"): EndIf
StatusBarText(#statusbar, 1, "", #PB_StatusBar_Center)
EndProcedure
Procedure.i CallPbHlp(suchwort$)
;versucht zu einer Funktion eine PB-Seite zu finden und im Standardbrowser anzuzeigen, Windows 10 ?!
;urls + Variablen
Protected event, p1, p$
Protected html$
Protected indexurl$ = "https://www.purebasic.com/german/documentation/reference/commandindex.html"
Protected pbhlpurl$ = "https://www.purebasic.com/german/documentation/"
;los gehts, zuerst "search.msdn" mit suchwort aufrufen, dafür wird das Webgadget benutzt.
SetGadgetText(#webgadget, indexurl$)
StatusBarText(#statusbar, 1, "suche " + suchwort$ + " - bitte warten", #PB_StatusBar_Center)
;Busy
While GetGadgetAttribute(#webgadget, #PB_Web_Busy)
event = WindowEvent()
Delay(1)
Wend
;Übersichtseite auslesen
html$ = GetGadgetItemText(#webgadget, #PB_Web_HtmlCode)
SetGadgetText(#webgadget, "")
;suchen
p1 = FindString(html$, suchwort$) ;auf Indexseite suchen
If p1
p$ = Mid(html$, p1-100, 100 + Len(suchwort$))
p1 = CountString(p$, "href=..")
p$ = StringField(p$, p1 + 1, "href=..")
pbhlpurl$ + StringField(p$, 2, "/") + "/" + LCase(suchwort$) + ".html"
RunProgram(pbhlpurl$) ;im Standardbrowser anzeigen
Else
MessageRequester("Error", suchwort$ + " nicht gefunden")
EndIf
StatusBarText(#statusbar, 1, "", #PB_StatusBar_Center)
EndProcedure
Procedure.i CreateWindow()
Protected winbr = 1012, winhh = 690, conhh = 100, stbhh = 23, buthh = 24
Protected lvihh = winhh - conhh, lvshh = lvihh / 2, ze = lvshh
Protected flags = #PB_ListIcon_GridLines|#PB_ListIcon_AlwaysShowSelection|#PB_ListIcon_FullRowSelect
OpenWindow(#window, 0, 0, winbr, winhh + stbhh, "PB Listen", #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget)
AddKeyboardShortcut(#window, #PB_Shortcut_Return, #PB_Shortcut_Return)
AddKeyboardShortcut(#window, #PB_Shortcut_F1, #PB_Shortcut_F1)
AddKeyboardShortcut(#window, #PB_Shortcut_Escape, #PB_Shortcut_Escape)
EditorGadget(#edit_help, 2, 0, winbr-2, lvihh)
HideGadget(#edit_help, 1)
ListIconGadget(#listicon, 0, 0, winbr, lvihh, "Name", 0, flags) ;Hauptliste oben
AddGadgetColumn(#listicon, 1, "Typ", 0)
AddGadgetColumn(#listicon, 2, "Wert", 0)
AddGadgetColumn(#listicon, 3, "Hex", 0)
ListIconGadget(#listsuch, 0, ze, winbr, lvshh, "Suchliste: Name", 0, flags)
AddGadgetColumn(#listsuch, 1, "Typ", 0)
AddGadgetColumn(#listsuch, 2, "Wert", 0)
AddGadgetColumn(#listsuch, 3, "Hex", 0)
HideGadget(#listsuch, 1)
setColumnWidth(0) ;für Konstantlist
SetGadgetColor(#listicon, #PB_Gadget_BackColor, $A1FCB7)
SetGadgetColor(#listsuch, #PB_Gadget_BackColor, $C6ECBA)
SetListLabelTip(#listicon)
SetListLabelTip(#listsuch)
SetWindowTheme_(GadgetID(#listicon), @"Explorer", 0)
SetWindowTheme_(GadgetID(#listsuch), @"Explorer", 0)
CreateStatusBar(#statusbar, WindowID(#window))
AddStatusBarField(200)
AddStatusBarField(#PB_Ignore)
AddStatusBarField(100)
AddStatusBarField(200)
;- Webgadget für CallMsdn + PB Help
WebGadget(#webgadget, 0, 0, 0, 0, ""): HideGadget(#webgadget, 1)
;keine Fehlermeldungen vom Webgadget
Protected browser.IWebBrowser2
browser = GetWindowLongPtr_(GadgetID(#webgadget), #GWL_USERDATA)
If browser: browser\put_Silent(#True): EndIf
;- Container
ContainerGadget(#container, 0, winhh - conhh, winbr, conhh, #PB_Container_Flat)
HideGadget(#container, 1) ;wird erst nach Daten laden angezeigt, sieht sonst doof aus
Protected sp = 10, br = 230
TextGadget(#text_sucheName, sp, 10, br, 20, "in Spalte Name enthalten")
StringGadget(#input_sucheName, sp, 30, br, buthh, "")
CheckBoxGadget(#check_sucheName, sp, 40 + buthh, br, 20, "Name ist gleich Länge Eingabe"): sp + br + 20
TextGadget(#text_suchewert, sp, 10, br, 20, "ist gleich Spalte Wert")
StringGadget(#input_suchewert, sp, 30, br, buthh, "")
SetGadgetFont(#text_sucheName, FontID(2))
SetGadgetFont(#text_suchewert, FontID(2))
SetGadgetFont(#check_sucheName, FontID(2))
sp = GadgetWidth(#container) - 390
ButtonGadget(#button_suchliste, sp, 10, 130, buthh, "Suchliste off"): DisableGadget(#button_suchliste, 1)
ButtonGadget(#button_clipboard, sp, 40, 130, buthh, "Clipboard")
ComboBoxGadget(#combo_Liste, sp, 70, 130, buthh)
sp + 145
ButtonGadget(#button_callmsdn, sp, 10, 120, buthh, "Web")
ButtonGadget(#button_compiler, sp, 40, 120, buthh, "Info")
ButtonGadget(#button_helpinfo, sp, 70, 120, buthh, "F1 = Hilfe")
sp + 135
ButtonGadget(#button_saveList, sp, 10, 100, buthh, "Speichern")
ButtonGadget(#button_ProgEnde, sp, 70, 100, buthh, "Ende")
AddGadgetItem(#combo_Liste, 0, "CONSTANTLIST")
AddGadgetItem(#combo_Liste, 1, "FUNCTIONLIST")
AddGadgetItem(#combo_Liste, 2, "STRUCTURELIST")
AddGadgetItem(#combo_Liste, 3, "INTERFACELIST")
If #PB_Compiler_Version > 540
AddGadgetItem(#combo_Liste, 4, "IMPORTLIST")
EndIf
SetGadgetState(#combo_Liste, 0)
CloseGadgetList()
;Daten laden
getCompilerList(GetGadgetText(#combo_Liste))
HideGadget(#container, 0)
StatusBarText(#statusbar, 0, progversion)
EndProcedure
Procedure.i CreateHelpText()
SendMessage_(GadgetID(#edit_help), #EM_SETMARGINS, #EC_LEFTMARGIN, 10)
Protected i$ = #LF$
i$ + "Suchen:" + #LF$
i$ + "Eingabe links sucht in Spalte Name ob Eingabe enthalten ist" + #LF$
i$ + "Checkbox aktiv: dann wird mit der gleichen Anzahl Zeichen ab 1.Zeichen auf Übereinstimmung verglichen." + #LF$ + #LF$
i$ + "Eingabe rechts sucht in Spalte Wert" + #LF$
i$ + "wird eine Zahl eingegeben, so wird numerisch gesucht" + #LF$
i$ + "wird Text eingegeben, dann wird auf Übereinstimmung verglichen ab 1. Zeichen." + #LF$
i$ + "Sonderzeichen 0-32 werden als Chr() angezeigt, z.B. Backspace als Chr(8)" + #LF$ + #LF$
i$ + "Stringkonstanten welche erst zur Laufzeit gefüllt werden, haben Chr(0) z.B. PB_Compiler_Home" + #LF$ + #LF$
i$ + "Suche wird mit Taste Enter gestartet. Die Hauptliste wird halbiert und es erscheint die Suchliste." + #LF$ + #LF$
i$ + "Buttons:" + #LF$
i$ + "Suchliste off läßt die Suchliste verschwinden" + #LF$
i$ + "Clipboard kopiert markierten Namen, egal welche Liste" + #LF$
i$ + "in der Combobox Liste auswählen. IMPORTLIST gibt es ab 5.41" + #LF$
i$ + "Save speichert Liste, Spalten durch Tab getrennt" + #LF$
i$ + "Info ruft #PB_Compiler_Home/sdk/compilerinterface.txt auf. Hier steht wo/wie die Konstanten herkommen." + #LF$ + #LF$
i$ + "Web versucht zum markierten Namen die passende Webseite im Standardbrowser anzuzeigen (Windows 10)" + #LF$
i$ + " Leider nicht immer erfolgreich. INTERFACELIST funktioniert nicht ! " + #LF$
i$ + #LF$ + #LF$ + #LF$ + #LF$ + "ESC = zurück"
SetGadgetText(#edit_help, i$)
EndProcedure
;- Main
CreateWindow()
CreateHelpText()
Define event, quit, name$, suchlisteshow = 0 ;Variablen in Main Eventschleife sind praktisch Static
;- Main Eventschleife
Repeat
event = WaitWindowEvent()
Select event
Case #PB_Event_CloseWindow: quit = 1 ;user has pressed on the close button
Case #PB_Event_Menu
Select EventMenu()
Case #PB_Shortcut_Return ;Taste Return wurde gedrückt - Suche starten
searchList()
If suchlisteshow = 0
suchlisteshow = 1
ResizeGadget(#listicon, #PB_Ignore, #PB_Ignore, #PB_Ignore, GadgetHeight(#listicon) / 2)
HideGadget(#listsuch, 0): DisableGadget(#button_suchliste, 0)
EndIf
Case #PB_Shortcut_F1
HideGadget(#edit_help, 0): HideGadget(#listicon, 1): HideGadget(#listsuch, 1)
Case #PB_Shortcut_Escape
HideGadget(#edit_help, 1): HideGadget(#listicon, 0)
If suchlisteshow = 1
HideGadget(#listsuch, 0)
EndIf
EndSelect
Case #PB_Event_Gadget
Select EventGadget()
Case #listicon:
name$ = GetGadgetItemText(#listicon, GetGadgetState(#listicon))
If EventType() = #PB_EventType_LeftDoubleClick
PostEvent(#PB_Event_Gadget, #window, #button_callmsdn) ;Button drücken
EndIf
Case #listsuch:
name$ = GetGadgetItemText(#listsuch, GetGadgetState(#listsuch))
If EventType() = #PB_EventType_LeftDoubleClick
PostEvent(#PB_Event_Gadget, #window, #button_callmsdn)
EndIf
Case #combo_Liste:
PostEvent(#PB_Event_Gadget, #window, #button_suchliste) ;Suchliste off
getCompilerList(GetGadgetText(#combo_Liste))
Case #button_suchliste
If suchlisteshow = 1
suchlisteshow = 0
ResizeGadget(#listicon, #PB_Ignore, #PB_Ignore, #PB_Ignore, GadgetHeight(#listicon) * 2)
HideGadget(#listsuch, 1): DisableGadget(#button_suchliste, 1)
EndIf
Case #button_callmsdn
If name$ = ""
MessageRequester("", "keine Auswahl")
Else
Select GetGadgetText(#combo_Liste)
Case "INTERFACELIST": MessageRequester("", "geht nicht")
Case "CONSTANTLIST", "STRUCTURELIST": CallMsdn(name$)
Case "IMPORTLIST": name$ = StringField(name$, 1, "_(" ): CallMsdn(name$)
Case "FUNCTIONLIST": name$ = StringField(name$, 1, " (" ): CallPbHlp(name$)
EndSelect
EndIf
Case #check_sucheName
If EventType() = #PB_EventType_LeftClick
If GetGadgetState(#check_sucheName) = #PB_Checkbox_Unchecked
SetGadgetText(#text_sucheName, "in Spalte Name enthalten")
Else
SetGadgetText(#text_sucheName, "Name ist gleich ab 1.Zeichen")
EndIf
PostEvent(#PB_Event_Menu, #window, #PB_Shortcut_Return)
EndIf
Case #button_saveList: saveList()
Case #button_helpinfo: PostEvent(#PB_Event_Menu, #window, #PB_Shortcut_F1)
Case #button_compiler: RunProgram(#PB_Compiler_Home + "\sdk\compilerinterface.txt")
Case #button_clipboard: SetClipboardText(name$)
If GetGadgetText(#combo_Liste) = "CONSTANTLIST": SetClipboardText("#" + name$): EndIf
Case #button_ProgEnde: quit = 1
EndSelect
EndSelect
Until quit = 1