Je suis incorrigible: il m'est impossible de vouloir faire tourner Scintilla. Alors j'ai fait ce visualisateur de programme.
Il invite à charger un programme PB pour le visualiser (flèche haut et bas). J'ai commencé à intégrer le highlighting à ma propre sauce.
Si vous pouviez tester ce code et lui faire sa misère en testant plusieurs code source pour me ramener des n° de ligne et des noms d'erreur, ça me fait grand plaisir.
Code : Tout sélectionner
EnableExplicit
Structure HLSet
DC.I ; Départ en caractères
LC.I ; Longueur en caractères
C.I ; Couleur
F.I ; Fonte utilisée (peut-être l'ID à l'avenir)
L.I ; Longueur en pixels
EndStructure
Global Dim FW.I(1) ; Largeur de la fonte
FW(0) = 10
FW(1) = 10
Define n.I
n = 1024
Global Dim Txt.S(n)
Global Dim TxtQ.L(n) ; Quantité d'objets par ligne
;Global Dim TxtD.L(n) ; Départ de ligne en pixels
Global Dim TxtDC.L(n, 15) ; Départ en caractères
Global Dim TxtLC.L(n, 15) ; Longueur en caractères
Global Dim TxtC.L(n, 15) ; Couleur
Global Dim TxtF.L(n, 15) ; Fonte
Global Dim TxtL.L(n, 15) ; Longueur en pixel
Global Dim FnDef.S(4095) ; Définitions de fonctions
Structure Text
*EdiCreate
*Edit
*EdiKill
Cpl.I
FnQty.I
EdiTitle.S
EdiWin.I
EdiX.I
EdiY.I
EdiW.I
EdiH.I
EdiVLineI.I
EdiVLineQty.I
EdiFontH.I
EdiFont.I[4]
EdiFontName.S
EdiFile.I
WinEvt.I
EvtMenu.I
EdiHSh.I
EdiWSh.I
EdiGdtCreated.I
EdiMaxLine.I
I.I
TtlGdt.I
TtlImg.I
EndStructure
Structure TextSet
Cpn.S
EndStructure
Structure TextTable
Get.TextSet[65536]
EndStructure
Procedure SysPcssFnList(*C.Text)
Protected Fn.S
Protected n.I
With *C
WriteProgramStringN(\Cpl, "FUNCTIONLIST")
Repeat
;Delay(1)
Fn = ReadProgramString(\Cpl)
If Fn = "OUTPUT" + Chr(9) + "COMPLETE"
Break
EndIf
;Debug Fn
FnDef(n) = Fn
n + 1
ForEver
\FnQty = n
EndWith
EndProcedure
Procedure SysPcssCreate(*C.Text)
With *C
\Cpl = RunProgram(#PB_Compiler_Home + "\Compilers\pbcompiler", "/STANDBY", "", #PB_Program_Open|#PB_Program_Read|#PB_Program_Write|#PB_Program_Hide)
Delay(100)
MessageRequester("Compilateur PureBasic", ReadProgramString(\Cpl) )
Repeat
Delay(100)
Until ReadProgramString(\Cpl) = "READY"
EndWith
SysPcssFnList(*C.Text)
EndProcedure
Procedure SysPcssKill(*C.Text)
With *C
WriteProgramStringN(\Cpl, "END")
While ProgramRunning(\Cpl)
Delay(100)
Wend
If ProgramExitCode(\Cpl) <> 0
MessageRequester("Avertissement", "Une erreur est survenue lors de la fermeture du compilateur.")
EndIf
CloseProgram(\Cpl)
EndWith
EndProcedure
Procedure TextEdiCreate(*C.Text)
With *C
\EdiWin = OpenWindow(-1, 0, 0, 400, 300, \EdiTitle, $CF0001)
\EdiFont[0] = LoadFont(-1, \EdiFontName, 12)
\EdiFont[1] = LoadFont(-1, \EdiFontName, 12, #PB_Font_Bold)
EndWith
EndProcedure
Procedure TextEdiHLMid(*C.Text, I, QuoteStart, J, FontCode.I, Color.I)
Protected Q.I
Protected Qp.I
If QuoteStart > 1
Q = TxtQ(I)
Qp = Q - 1
TxtLC(I, Qp) = QuoteStart - TxtDC(I, Qp)
TxtL(I, Qp) = FW(TxtF(I, Qp) ) * TxtLC(I, Qp)
TxtQ(I) + 1
Else
Q = TxtQ(I) - 1
EndIf
TxtF(I, Q) = FontCode
TxtDC(I, Q) = QuoteStart
TxtLC(I, Q) = (J - QuoteStart) + 1
TxtL(I, Q) = FW(TxtF(I, Q) ) * TxtLC(I, Q)
TxtC(I, Q) = Color
If Len(Txt(I) ) > J
Q = TxtQ(I)
TxtF(I, Q) = 0
TxtDC(I, Q) = J + 1
TxtLC(I, Q) = Len(Txt(I) ) - J
TxtL(I, Q) = FW(TxtF(I, Q) ) * TxtLC(I, Q)
TxtC(I, Q) = #Black
TxtQ(I) + 1
EndIf
EndProcedure
Procedure TextEdiHLFN(*C.Text, I.I, Start.I, _End.I)
Protected Txt.S
Protected KWTest.S
Protected J.I
Protected KW.S
Protected KWStart.I
Protected KWEnd.I
With *C
Txt = Mid(Txt(I), Start, (_End - Start) + 1)
KWTest = UCase(Txt)
For J = 0 To \FnQty
KW = UCase(StringField(FnDef(J), 1, " ") )
KWStart = FindString(UCase(Txt(I) ), KW, 1)
If KWStart
KWEnd = (KWStart + Len(KW) ) - 1
Break
EndIf
Next J
EndWith
EndProcedure
Procedure.S TextEdiHLKW(*C.Text, I.I, Start.I, _End.I)
Protected Txt.S
Protected KWTest.S
Protected KW.S
Protected KWStart.I
Protected KWEnd.I
Protected J.I
Protected Table.S
Protected Nothing.I
; If Start < _End
Nothing = 1
Txt = Mid(Txt(I), Start, (_End - Start) + 1)
KWTest = UCase(Trim(Txt) )
Table = "PROCEDURE;ENDPROCEDURE;STRUCTURE;ENDSTRUCTURE;PROTECTED;DEFINE;GLOBAL;WITH;ENDWITH;ENABLEEXPLICIT"
For J = 1 To (CountString(Table, ";") + 1)
KW = StringField(Table, J, ";")
If Left(KWTest, Len(KW) ) = KW
KWStart = FindString(UCase(Txt(I) ), KW, 1)
KWEnd = (KWStart + Len(KW) ) - 1
TextEdiHLMid(*C, I, KWStart, KWEnd, 1, RGB(0, 128, 0) )
Nothing = 0
EndIf
Next
If Nothing
TextEdiHLFN(*C.Text, I.I, Start.I, _End.I)
EndIf
; EndIf
EndProcedure
Procedure TextEdiHL(*C.Text)
Protected I.I
Protected J.I
Protected A.I
Protected Q.I
Protected Qp.I ; Quantité précédente
Protected QuoteFlag.I
Protected QuoteStart.I
Protected Txt.S
Protected Analyse.I
Protected NormalStart.I
With *C
For I = 0 To \EdiMaxLine
NormalStart = 1
Txt = Txt(I)
TxtQ(I) = 1
TxtDC(I, 0) = 1
TxtLC(I, 0) = Len(Txt)
TxtC(I, 0) = #Black
TxtF(I, 0) = 0
TxtL(I, 0) = FW(TxtF(I, 0) ) * Len(Txt)
For J = 1 To Len(Txt)
A = Asc(Mid(Txt, J, 1) )
If A = 34
QuoteFlag = 1 - QuoteFlag
If QuoteFlag
TextEdiHLKW(*C, I, NormalStart, J - 1)
QuoteStart = J
Else
TextEdiHLMid(*C, I, QuoteStart, J, 1, #Red)
NormalStart = J + 1
EndIf
Else
If QuoteFlag = 0
If A = 59
TextEdiHLKW(*C, I, NormalStart, J - 1)
TextEdiHLMid(*C, I, J, Len(Txt), 0, RGB(96, 128, 0) )
Break
Else
If J = Len(Txt)
TextEdiHLKW(*C, I, NormalStart, J)
EndIf
EndIf
EndIf
EndIf
Next J
Next I
EndWith
EndProcedure
Procedure TextEdiDrawLine(*C.Text)
Protected I.I
Protected J.I
Protected X.I
Protected L.I
Protected Tmp.S
With *C
Box(0, 0, \EdiW, \EdiH, #White)
I = \I + \EdiHSh
Tmp = Txt(I)
X = 0
L = 1
For J = 0 To TxtQ(I) - 1
; DrawingFont(FontID(TxtF(I, J) ) )
DrawingFont(FontID(\EdiFont[TxtF(I, J) ] ) )
DrawText(X, -2, Mid(Tmp, L, TxtLC(I, J) ), TxtC(I, J), #White)
L + TxtLC(I, J)
X + TxtL(I, J)
Next J
EndWith
EndProcedure
Procedure TextEdiUpdate(*C.Text)
Protected I.I
Protected J.I
Protected TrimLen.I
Protected LenTxt.I
With *C
For I = 0 To \EdiVLineQty
StartDrawing(ImageOutput(I) )
\I = I
TextEdiDrawLine(*C)
StopDrawing()
Next I
StartDrawing(ImageOutput(\TtlImg) )
Box(0, 0, 80, \EdiH, #White)
For I = 0 To \EdiMaxLine
Txt(I) = RTrim(Txt(I) ) ; /!\
LenTxt = Len(Txt(I) )
For J = 1 To LenTxt
TrimLen = Len(LTrim(Txt(I) ) )
;Box(LenTxt - TrimLen + 1, 2 * I, TrimLen, 2, #Black)
If Asc(Mid(Txt(I), J, 1) ) > 32
; Line(J, I * 2, 0, 2, #Black)
Line(J, I, 0, 1, #Black)
EndIf
Next J
Next I
StopDrawing()
If \EdiGdtCreated
For I = 0 To \EdiVLineQty
SetGadgetState(I, ImageID(I) )
Next I
EndIf
EndWith
EndProcedure
Procedure TextEdiFollowUp(*C.Text)
Protected I.I
With *C
StartDrawing(ImageOutput((\EdiHSh) % (\EdiVLineQty + 1) ) )
\I = 0
TextEdiDrawLine(*C)
StopDrawing()
If \EdiGdtCreated
For I = 0 To \EdiVLineQty
SetGadgetState(I, ImageID((I + \EdiHSh) % (\EdiVLineQty + 1) ) )
Next I
EndIf
EndWith
EndProcedure
Procedure TextEdiFollowDown(*C.Text)
Protected I.I
With *C
StartDrawing(ImageOutput((\EdiHSh - 1) % (\EdiVLineQty + 1) ) )
\I = \EdiVLineQty
TextEdiDrawLine(*C)
StopDrawing()
If \EdiGdtCreated
For I = 0 To \EdiVLineQty
SetGadgetState(I, ImageID((I + \EdiHSh) % (\EdiVLineQty + 1) ) )
Next I
EndIf
EndWith
EndProcedure
Procedure TextEdit(*C.Text)
Protected I.I
Protected Fichier$
With *C
Fichier$ = OpenFileRequester("Choisir un fichier PB", "", "", 0)
\EdiFile = OpenFile(-1, Fichier$)
If \EdiFile
I = 0
Repeat
Txt(I) = ReadString(\EdiFile)
I + 1
Until Eof(\EdiFile)
\EdiMaxLine = I
EndIf
TextEdiHL(*C)
\EdiVLineQty = \EdiH / \EdiFontH
For I = 0 To \EdiVLineQty
CreateImage(I, \EdiW, \EdiFontH)
Next I
TextEdiUpdate(*C)
For I = 0 To \EdiVLineQty
ImageGadget(I, 0, I * \EdiFontH, \EdiW, \EdiFontH, ImageID(I) )
Next I
\TtlImg = CreateImage(-1, 80, \EdiH)
\EdiGdtCreated = 1
AddKeyboardShortcut(\EdiWin, #PB_Shortcut_Up, 1)
AddKeyboardShortcut(\EdiWin, #PB_Shortcut_Down, 2)
AddKeyboardShortcut(\EdiWin, #PB_Shortcut_Left, 3)
AddKeyboardShortcut(\EdiWin, #PB_Shortcut_Right, 4)
Repeat
Delay(16)
\WinEvt = WindowEvent()
Select \WinEvt
Case #PB_Event_SizeWindow
For I = 0 To \EdiVLineQty
FreeGadget(I)
FreeImage(I)
Next I
FreeGadget(\TtlGdt)
FreeImage(\TtlImg)
\EdiGdtCreated = 0
\EdiW = WindowWidth(\EdiWin) - 80
\EdiH = WindowHeight(\EdiWin)
\EdiVLineQty = \EdiH / \EdiFontH
For I = 0 To \EdiVLineQty
CreateImage(I, \EdiW, \EdiFontH)
Next I
\TtlImg = CreateImage(-1, 80, \EdiH)
TextEdiUpdate(*C)
For I = 0 To \EdiVLineQty
ImageGadget(I, 0, I * \EdiFontH, \EdiW, \EdiFontH, ImageID(I) )
Next I
\TtlGdt = ImageGadget(-1, \EdiW, 0, 80, \EdiH, ImageID(\TtlImg) )
\EdiGdtCreated = 1
Case #PB_Event_Menu
\EvtMenu = EventMenu()
Select \EvtMenu
Case 1
If \EdiHSh > 0
\EdiHSh - 1
;TextEdiUpdate(*C)
TextEdiFollowUp(*C)
EndIf
Case 2
If \EdiHSh < 65000 ; /!\
\EdiHSh + 1
;TextEdiUpdate(*C)
TextEdiFollowDown(*C)
EndIf
Case 3
If \EdiWSh > 0
\EdiWSh - 1
TextEdiUpdate(*C)
EndIf
Case 4
If \EdiWSh < 65000 ; /!\
\EdiWSh + 1
TextEdiUpdate(*C)
EndIf
EndSelect
EndSelect
Until \WinEvt = 16
For I = 0 To \EdiVLineQty
FreeImage(I)
Next I
EndWith
EndProcedure
Procedure TextEdiKill(*C.Text)
With *C
CloseWindow(\EdiWin)
EndWith
EndProcedure
Define Text.Text
SysPcssCreate(Text)
Text\EdiTitle = "Editeur"
Text\EdiFontName = "Courier New"
TextEdiCreate(Text)
Text\EdiX = 16
Text\EdiY = 16
Text\EdiW = 400
Text\EdiH = 300
Text\EdiFontH = 16
TextEdit(Text)
TextEdiKill(Text)
SysPcssKill(Text)