 | Syntax-Highlightening of XProfan-Source without Keywords. I have me time rangesetzt - edit is not yet possible - but the Show functions already.
here one funktionierender statement:
CompileMarkSeparation {$cleq}
set(FastMode,1)
def dwp(4) !user32,DefWindowProcA
def mev(5) !USER32,mouse_event
def cwp(5) !user32,CallWindowProcA
def getdc(1) !user32,GetDC
def cnhex(4) !user32,CallNextHookEx
def swhex(4) !user32,SetWindowsHookExA
def gwtpid(2) !user32,GetWindowThreadProcessId
/* lecker kuchen geht einem auf die nüsse :P */
declare sfnt&,bt&,sb&,sbar&,ex%,appname$
declare _hWnd&,fh&,t&,mem#,_hwndyy&,_hwndxx&,ch#,_fsiz&,_hwnddc&,scy&,scymem#,_slines&,scymemwrap#,scymrmem#,more#,kwds#,hKbdHook&
$U lists.pcu = lst.
$U file.pcu = f
appname$:=XPrfIde3
dim kwds#,1024
clear kwds#
dim more#,1024
clear more#
dim scymem#,2000000
clear scymem#
dim scymrmem#,2000000
clear scymrmem#
dim ch#,1
dim scymemwrap#,7
clear scymemwrap#
scy&:=1
cls
app.init
__loadSrcToMem xprfide7.prf
sfnt&:=External(gdi32,GetStockObject,16)
external(gdi32,SelectObject,_hWnddc&,sfnt&)
showwindow(_hwnd&,3)
whilenot ex%
getmessage
wend
messagebox ok,ok,0
dispose more#
dispose scymem#
dispose scymrmem#
dispose ch#
dispose scymemwrap#
dispose mem#
dispose kwds#
external(user32,PostQuitMessage,0)
end
proc _WProc
Parameters Wnd&, Msg&, Wparam&, Lparam&
if msg& == 16// close
ex%:=1
elseif msg& == 3// move
elseif msg& == 5// size
_redrw
elseif msg& == 15// paint
__dispSrcmem 0
elseif msg& == 256// keydwn
settext _hwnd&,str$(wparam&)
elseif msg& == $108// keylast
settext _hwnd&,str$(wparam&)
elseif msg& == 522// wheel
end
if wparam&>0
texter.scrollup 3
else
texter.scrolldown 3
endif
elseif msg&==$0115
if lparam&==sbar&
if wparam&==0
texter.scrollup 1
elseif wparam&==1
texter.scrolldown 1
elseif wparam&==3
texter.scrolldown _hwndyy&15-1
elseif wparam&==2
texter.scrollup _hwndyy&15-1
elseif wparam&>65000
texter.setscrollpos (Wparam&-5)
else
texter.setscrollpos getscrollpos(sbar&)*65536
endif
endif
Endif
return dwp(Wnd&, Msg&, Wparam&, Lparam& )
endproc
proc _createwindow
parameters tit$
declare mem#,l&,apn&,cisreg&
l&:=ProcAddr(_WProc,4)
apn&=addr(tit$)
dim mem#,40
asmstart _cwex
parameters mem#,l&,%HInstance,apn&
return cisreg&
.data
ic dd 32516
cu dd 32512
bg dd 0
.code
invoke LoadIcon,0,ic
mov ic,eax
invoke LoadCursor,0,cu
mov cu,eax
invoke GetStockObject,bg
mov bg,eax
mov eax,para1
mov ebx,0
mov [eax],ebx
mov ebx,para2
mov [eax+4],ebx
mov ebx,0
mov [eax+8],ebx
mov [eax+12],ebx
mov ebx,para3
mov [eax+16],ebx
mov ebx,ic
mov [eax+20],ebx
mov ebx,cu
mov [eax+24],ebx
mov ebx,bg
mov [eax+28],ebx
mov ebx,para4
mov [eax+32],ebx
mov [eax+36],ebx
invoke RegisterClass,eax
.if !eax
jmp eop
.endif
invoke CreateWindowEx,0,para4,para4,13565952,0,0,640,480,0,0,para3,0
eop:
asmend
dispose mem#
casenot cisreg& : end
return cisreg&
endproc
proc app.init
_hWnd&:=_createwindow(appname$)
_hWnddc&:=getdc(_hwnd&)
hKbdHook& = swhex(2,ProcAddr(kbProc, 3), 0,gwtpid(_hwnd&, 0))
sb&:=create(StatusWindow,_hwnd&,Bereit.)
sbar&:=createvscroll(_hwnd&,,0,0,0,0)
_hwndxx&:=width(_hwnd&)
_hwndyy&:=(height(_hwnd&)-height(sb&))
endproc
proc texter.scrollup
parameters v&
scy&:=scy&-v&
case scy&<1:scy&:=1
__dispSrcmem 0
endproc
proc texter.scrolldown
parameters v&
scy&:=scy&+v&
case scy&>_slines&:scy&:=_slines&
__dispSrcmem 0
endproc
proc texter.setscrollpos
parameters v&
v&:=(v&-1)65536
scy&:=v&+1
__dispSrcmem 0
endproc
proc _redrw
declare x&,y&
_hwndxx&:=width(_hwnd&)
_hwndyy&:=(height(_hwnd&)-height(sb&))
/*
external(user32,SetWindowPos,sb&,0,0,0,0,0,28)
external(user32,InvalidateRect,sb&,0,0)
external(user32,UpdateWindow,sb&)
external(user32,SetWindowPos,sbar&,0,(_hwndxx&-17),0,17,_hwndyy&,28)
external(user32,InvalidateRect,sbar&,0,0)
external(user32,UpdateWindow,sbar&)
this now to asm b/c from 6 externals to 1 external! much more than 6 times faster!!! :P
*/
asmstart _fupdte
parameters sb&,sbar&,_hwndxx&,_hwndyy&
invoke SetWindowPos,para1,0,0,0,0,0,28
invoke InvalidateRect,para1,0,0
invoke UpdateWindow,para1
mov eax,para3
sub eax,17
invoke SetWindowPos,para2,0,eax,0,17,para4,28
invoke InvalidateRect,para2,0,0
invoke UpdateWindow,para2
asmend
if _hwndyy&>16
__dispSrcMem 0
endif
endproc
proc __loadSrcToMem
parameters fle$
declare s$,cx&,sz&
fh&:=fopen(fle$,rb)
if fh&
sz&:=getfilesize(#fh&)+1
dim mem#,sz&
_fsiz&:=blockread(#fh&,mem#,0,sz&-1)
fclose fh&
endif
byte mem#,_fsiz&=10
_slines&:=__dispSrcmem(1)
_fsiz&+;
setscrollrange sbar&,1,_slines&
endproc
Proc kbProc
Parameters nCode&, wParam&, lParam&
Declare bval&
settext _hwnd&,str$(wparam&)
If wParam& = 13
If lParam& < 0
EndIf
bval&:=1
elseif wparam& ==40 down
If lParam& > 0
if scy&<_slines&;scy&+
__dispSrcmem 0
endif
EndIf
bval&:=1
elseif wparam& ==38 up
If lParam& > 0
if scy&-1;scy&-
__dispSrcmem 0
endif
EndIf
bval&:=1
elseIf wParam& = 222 Ä
If lParam& < 0
EndIf
bval& = 1
ElseIf wParam& = 192 Ö
If lParam& < 0
EndIf
bval& = 1
ElseIf wParam& = 186 Ü
If lParam& < 0
EndIf
bval& = 1
ElseIf wParam& = 219 ß
If lParam& < 0
EndIf
bval& = 1
Else
cnhex(hKbdHook&, nCode&, wParam&, lParam&)
bval& = 0
EndIf
Return bval&
EndProc
proc fstrl// not while! - is fastr!
parameters s$,n&,c$
declare l&
l&:=len(s$)
if l&==1
return +s$
elseif l&==2
return +s$
elseif l&==3
return +s$
elseif l&==4
return +s$
elseif l&==5
return +s$
endif
return s$
endproc
Proc __dispSrcmem
parameters all%// all is only 1times needed to examine the code
declare yy&,xx&,rcol&,spoint&,inmempt&,z&
yy&:=_hwndyy&-15
xx&:=width(_hwnd&)8-3
case yy&<15 : return -1
case xx&<3 : return -2
external(gdi32,SetBkColor,_hWnddc&,rgb(255,255,255))
external(gdi32,SetTextColor,_hWnddc&,rgb(0,0,0))
external(gdi32,SelectObject,_hWnddc&,external(gdi32,CreatePen,0,1,rgb(255,255,255)))
rcol&:=rgb(160,160,160)
//if scy&==0;spoint&:=0;else;;endif//simpl scyToSpoint wrappa
spoint&:=long(scymem#,(scy&-1)*4)
inmempt&:=scy&*4
case inmempt&<0 : inmempt&:=0
case spoint&<0 : spoint&:=0
string scymemwrap#,0=fstrl(str$(scy&),6,0)
long more#,0=all%// 1==examine code - only 1 time per code after loading!
long more#,4=_hwnddc&// addr(scymrmem#) //multiremmerka
long more#,8=rcol&// remcolor
// 2 3 4 5 6 7 8 9 10 11 12 13 14 15... :P
asmstart _disp
parameters scymrmem#,sfnt&,mem#,ch#,_fsiz&,xx&,yy&,kwds#,scymem#,spoint&,inmempt&,_hwndxx&,_hwndyy&,scymemwrap#,more#
return z&
.data
varx dd 0
vary dd 0
varc dd 0
vare dd 0
varsglr db 0
varmulr db 0
varinstr db 0
varoal db 0
varoax dd 0
varocx dd 0
incycles dd 0
incyclescol dd 0
scymem dd 0
examine dd 0
scymrmem dd 0
scy dd 0
cdc dd 0
inthislnmropened dd 0
thislnAlrdyWrtn dd 0
remcol dd 0
mnoax dd 0
cnt dd 0
oal db 0
isok db 0
cschalt db 0
.code
;check ywin smaller aline {
mov eax,para7
.if eax<15
jmp eop2
.endif ;}
mov eax,para11
mov scy,eax
;cmon gimmy more nfos
mov ebx,para15
mov eax,[ebx]
mov examine,eax
mov eax,[ebx+4]
mov cdc,eax
mov eax,[ebx+8]
mov remcol,eax
;eo morenfos
mov ecx,para3 ;prefill
mov edx,para4
mov ebx,para5
mov varx,56
mov vary,0
mov eax,para10
push eax
mov eax,para11
add scymem,eax
pop eax
;PrintDec eax
.while eax<ebx
push eax ;sichern
push ebx
push ecx
push edx
mov varoax,eax
mov varocx,ecx
mov al,[ecx+eax]
mov [edx],al
;check for multirem storrer / multirem in invisible area?
push eax
push ebx
push edx
push ecx
mov ebx,scy
add ebx,4
mov eax,para1
mov edx,[eax+ebx]
.if edx==1
.if thislnAlrdyWrtn==0
mov varmulr,1
.if examine==0
invoke SetTextColor,cdc,remcol
.endif
.endif
.endif
pop ecx
pop edx
pop ebx
pop eax
;EO check for multirem storrer
.if al==9
mov al,32
mov [edx],al
push eax
push edx
push ebx
push ecx
mov ecx,7
lop:
push edx
push ecx
push eax
mov eax,para12
sub eax,24
.if varx<eax && examine==0
invoke TextOut,cdc,varx,vary,edx,1
.endif
pop eax
add varx,8
pop ecx
pop edx
mov al,32
mov [edx],al
dec ecx
cmp ecx,0
jne lop
pop ecx
pop ebx
pop edx
pop eax
.elseif al==13
mov al,32
mov [edx],al
.endif
.if al>31
.if !examine
.if !cschalt
.if !varmulr && !varinstr && !varsglr
.if al>64
.if incycles==0
.if ((al>64) && (al<91)) || ((al>96) && (al<123)) || al==95 ;wordizer
push ebx ;sichern
push eax
push ecx
push edx
push eax
mov eax,varoax
mov cnt,eax
mov ebx,0
pop eax
mov isok,1
.while isok==1
.if al>96 ;uppercase
sub al,32
.endif
push ecx
mov ecx,para8
mov [ecx+ebx],al
pop ecx
inc ebx
inc cnt
mov eax,cnt
mov al,[ecx+eax]
.if ((al>64) && (al<91)) || ((al>96) && (al<123)) || (al==95) || ((al>47) && (al<58)) || al==46
mov isok,1
.else
mov isok,0
.endif
.endw
mov oal,al
mov incycles,ebx
mov incyclescol,0
push eax
push ebx
push ecx
push edx
.if (oal>34 && oal<39) || oal==33
inc incycles
.if oal==36 ;check whoops not a string buta func?
inc cnt
inc ebx
mov eax,cnt
mov al,[ecx+eax]
.if al==40
invoke SetTextColor,cdc,16711680
.else
invoke SetTextColor,cdc,25600
.endif
.else
invoke SetTextColor,cdc,25600
.endif
.else
invoke SetTextColor,cdc,16711680
.endif
pop edx
pop ecx
pop ebx
pop eax
push ecx
mov ecx,para8
push eax
mov eax,0
mov [ecx+ebx],eax
pop eax
;PrintStringByAddr ecx
pop ecx
pop edx ;total recall :P
pop ecx
pop eax
pop ebx
.endif
.endif
.endif
.endif
.endif
.endif
.if al==123;125{}
.if !varmulr && !varinstr && !varsglr
;lookin cschalt
push eax
push ecx
push ebx
mov ebx,varoax
inc ebx
mov al,[ecx+ebx]
.if al==36
mov cschalt,1
.endif
pop ebx
pop ecx
pop eax ;eo lookin
push eax ;sichern
push ebx
push ecx
push edx
.if cschalt==1
invoke SetTextColor,cdc,255
.else
invoke SetTextColor,cdc,8421504
.endif
pop edx ;total recall :P
pop ecx
pop ebx
pop eax
.endif
.elseif al==125
mov cschalt,0
.if !varmulr && !varinstr && !varsglr
mov incycles,1
mov incyclescol,0
.endif
.elseif al>42 && al<47
.if !varmulr && !varinstr && !varsglr && !cschalt
push eax ;sichern
push ebx
push ecx
push edx
invoke SetTextColor,cdc,255
pop edx ;total recall :P
pop ecx
pop ebx
pop eax
mov incycles,1
mov incyclescol,0
.endif
.elseif al==92 || al==93 || al==91 || al==61 || al==60 || al==62
.if !varmulr && !varinstr && !varsglr && !cschalt
.if examine==0
push eax ;sichern
push ebx
push ecx
push edx
invoke SetTextColor,cdc,255
pop edx ;total recall :P
pop ecx
pop ebx
pop eax
.endif
mov incycles,1
mov incyclescol,0
.endif
.elseif al==34
.if !cschalt
cmp varmulr,0
jne nostr
cmp varsglr,0
jne nostr
.if varinstr==0
mov varinstr,1
.if examine==0
push eax ;sichern
push ebx
push ecx
push edx
invoke SetTextColor,cdc,8421376
pop edx ;total recall :P
pop ecx
pop ebx
pop eax
.endif
.else
mov incycles,1
mov incyclescol,0
mov varinstr,0
.endif
nostr:
.endif
.elseif al==39 ; rem
.if !varmulr && !varinstr && !varsglr && !cschalt
mov varsglr,1
.if examine==0
push eax ;sichern
push ebx
push ecx
push edx
invoke SetTextColor,cdc,remcol
pop edx ;total recall :P
pop ecx
pop ebx
pop eax
.endif
.endif
.elseif al==47 && varinstr==0 && !cschalt ; / r em?/* */
mov varoal,al ;gottaNextByteOfSource->al
mov ecx,varocx
mov eax,varoax
mov al,[ecx+eax+1]
.if al==42 ; * r em?
.if varmulr==0
mov inthislnmropened,1
.if examine==0
push eax ;sichern
push ebx
push ecx
push edx
invoke SetTextColor,cdc,remcol
pop edx ;total recall :P
pop ecx
pop ebx
pop eax
.endif
mov varmulr,1
.endif
.elseif al==47
.if varmulr==0
mov varsglr,1
.if examine==0
push eax ;sichern
push ebx
push ecx
push edx
invoke SetTextColor,cdc,remcol
pop edx ;total recall :P
pop ecx
pop ebx
pop eax
.endif
.endif
.endif
mov al,varoal
.elseif al==42 && varinstr==0 && !cschalt ; * r em?
mov varoal,al ;gottaNextByteOfSource->al
mov ecx,varocx
mov eax,varoax
mov al,[ecx+eax+1]
.if al==47 ; * r em?
.if inthislnmropened==0
push eax
push ebx
push edx
mov edx,1
mov eax,para1
mov ebx,scy
add ebx,4
mov [eax+ebx],edx
pop edx
pop ebx
pop eax
mov varmulr,1
mov thislnAlrdyWrtn,1
.endif
.if varmulr==1
mov incycles,2
mov incyclescol,0
mov varmulr,0
.endif
.endif
mov al,varoal
.endif
push eax
mov eax,para6
shl eax,3
.if varx<eax
.if examine==0
invoke TextOut,cdc,varx,vary,edx,1
.endif
.endif
pop eax
add varx,8
.if incycles>0
dec incycles
.if incycles==0
.if examine==0
push eax ;sichern
push ebx
push ecx
push edx
invoke SetTextColor,cdc,incyclescol
pop edx ;total recall :P
pop ecx
pop ebx
pop eax
.endif
.endif
.endif
.else
mov cschalt,0
mov inthislnmropened,0
push eax ;sichern
push ebx
push ecx
push edx
push eax ;storeScyMem
push ebx
push edx
inc varoax
mov edx,varoax
dec varoax
mov eax,para9
mov ebx,scymem
mov [eax+ebx],edx
pop edx
pop ebx
pop eax
add scymem,4
;eo storeScyMem
mov al,32 ;set edxmem 32 to fill line
mov [edx],al
mov ebx,para6 ;xxwidthcharz
mov eax,varx
shr eax,3
.while eax<ebx
.if examine==0
push eax ;sichern
push ebx
push ecx
push edx
invoke TextOut,cdc,varx,vary,edx,1
pop edx ;total recall :P
pop ecx
pop ebx
pop eax
.endif
add varx,8
inc eax
.endw
.if thislnAlrdyWrtn==0 ;multiremstorrer
push eax
push ebx
push edx
.if varmulr==1
;PrintDec scy
mov edx,1
.else
mov edx,0
.endif
mov eax,para1
mov ebx,scy
add ebx,4
mov [eax+ebx],edx
pop edx
pop ebx
pop eax
.endif ;eo multiremstorrer
mov thislnAlrdyWrtn,0
.if varsglr==1
mov varsglr,0
invoke SetTextColor,cdc,0
.endif
pop edx ;total recall :P
pop ecx
pop ebx
pop eax
add vary,15
add scy,4
mov varx,56
pop edx ;argh
pop ecx
pop ebx
pop eax
;inc eax
push eax
push ebx
push ecx
push edx ;eo argh
.endif
mov eax,para7
.if examine==0
.if vary>eax
pop edx ;make die() easyler :P
pop ecx
pop ebx
pop eax
jmp eop
.endif
.endif
pop edx ;total recall :P
pop ecx
pop ebx
pop eax
inc eax
.endw
eop:
mov eax,para6
shl eax,3
mov ebx,para12
sub ebx,17
push eax
invoke Rectangle,cdc,eax,0,ebx,para13
pop eax
invoke Rectangle,cdc,0,vary,eax,para13
invoke Rectangle,cdc,48,0,56,para13
.if examine==1
jmp eop2
.endif
;lnumbs - function counts a string
invoke SetTextColor,cdc,11842740
mov ecx,para13
sub ecx,15
mov ebx,vary
mov vary,0
mov edx,para14
nwln:
push ebx
push edx
push ecx
invoke TextOut,cdc,0,vary,edx,6
pop ecx
pop edx
add vary,15
push eax
mov eax,5
.while eax>1
mov bl,[edx+eax]
.if bl==57
.if eax==5
mov bl,48
mov [edx+eax],bl
dec eax
mov bl,[edx+eax]
inc bl
.if bl==33
mov bl,49
.endif
mov [edx+eax],bl
.endif
.else
.if eax==5
inc bl
mov [edx+eax],bl
.endif
.endif
.if bl==58
mov bl,48
mov [edx+eax],bl
mov bl,[edx+eax-1]
inc bl
.if bl==33
mov bl,49
.endif
mov [edx+eax-1],bl
.endif
dec eax
.endw
pop eax
pop ebx
.if ebx>vary
cmp vary,ecx
jna nwln
.endif
;eo lnumbs
eop2:
mov eax,scymem
asmend
setscrollpos sbar&,scy&
return z&4
endproc
have Scrollable, ansatzweise keyboard- and Mausradscrolling already umgesetzt. the Control self uses no WindowsControls - it shows each letters self on.
salvo, iF. |
|
(928)
Deutsch
English
Français
Español
Italia