Un éditeur de texte avec trop de scintillement :-(

' PanoEdit.bas

' mnu labels
label mnu_load,mnu_exit

' file labels
label load_file,load_syntax_files,load_font

' gui labels
label tmr_service,get_size,form_resize
label numbers_resize,editor_resize
label numbers_repaint,editor_repaint

' key labels
label key_char
label key_backspace,key_tab,key_enter
label key_page_up,key_page_down
label key_end,key_pos1
label key_cursor_left,key_cursor_up,key_cursor_right,key_cursor_down
label key_F1,key_F2,key_F3,key_F4,key_F5,key_F6,key_F7,key_F8,key_F9,key_F10,key_F11,key_F12
label key_mouse_left,key_mouse_right,key_mouse_midle
label key_win_left,key_win_right,key_win_menu
label key_shift_left,key_shift_right
label key_ctrl_left,key_ctrl_right
label key_alt_left,key_alt_right

dim AppPath$  :AppPath$    = dir_current$ + ""
dim SyntaxPath$:SyntaxPath$ = AppPath$ + "syntax"
dim FileName$

' objects
dim frmMain%

' menu
dim menu%:menu%=number_objects+1:main_menu menu%
dim file%:file%=number_objects+1:sub_menu file%:caption file%,"&File":parent file%,menu%
dim load%:load%=number_objects+1:sub_menu load%:caption load%,"&Load":parent load%,file%
dim sep0%:sep0%=number_objects+1:sub_menu sep0%:caption sep0%,"-"    :parent sep0%,file%
dim exit%:exit%=number_objects+1:sub_menu exit%:caption exit%,"E&xit":parent exit%,file%

dim OpenDialog%:OpenDialog%=number_objects+1:open_dialog OpenDialog%
filter OpenDialog%,"BASIC|*.bas;*.bi|C/C++|*.c;*.cpp;*.h;*.hpp|PASCAL|*.pas|BATCH|*.bat;*.cmd"

' [c]lient region
dim cWidth%,cHeight%,oHeight%,oWidth%
' window [d]ecoration
dim dWidth%,dHeight%
' [n]umbers (optional)
dim Numbers%:Numbers%=number_objects+1:picture Numbers%
' [n]umbers properties
dim nLeft%,nTop%,nWidth%,nHeight%,nRows%,nCols%,nOldRows%,nOldCols%
dim NumbersOn%:NumbersOn% = 1
dim nCount%:nCount% = 6 : ' how many visible numbers +1
width  Numbers%,10
height Numbers%,10

' [e]ditor
dim Editor%:Editor%=number_objects+1:picture Editor%
' [e]ditor properties
dim eLeft%,eTop%,eWidth%,eHeight%,eRows%,eCols%,eOldRows%,eOldCols%,ROffset%,LOffset%
' editor text
dim eText%:eText%=number_objects+1:dlist eText%
' editor cursor
dim cX%,cY%,cOldX%,cOldY%,cOn%
' editor keys
dim KeyCode%,Key$
' [v]isible rows lines
dim vRows%,vLines%

' [f]ont
dim FontName$:FontName$ = "Courier New" : ' should be an monospace font
dim FontSize%:FontSize% = 8            : ' must be between 6 and 30
dim fWidth%,fHeight%

' [s]ervice timer
dim sTmr%:sTmr%=number_objects+1:timer sTmr%
timer_interval sTmr%,20

' get size of the window client region and decoration
full_space Editor%
cWidth%  = width(Editor%)  - 1
cHeight% = height(Editor%) - 1
dWidth%  = width(0)  - cWidth%
dHeight% = height(0) - cHeight%

' some editor properties
2d_target_is  Editor%
2d_pen_color  250,250,250
2d_fill_color 250,250,250
' some number properties
2d_target_is  Numbers%
2d_pen_color  128,128,128
2d_fill_color 128,128,128

' init fonts
dim fDiffs%(23),i%,j%,k%,l%,n%,s$,sCount%,Offset%
for i%=0 to 23: read fDiffs%(i%): next i%
gosub load_font

' menus events
on_click Exit%,mnu_exit
on_click Load%,mnu_load

' init synatx highligting
dim nCategories%,Categories$(10),red%(10),blue%(10),green%(10)
gosub load_syntax_files

' FileName$ = AppPath$ + "PanoEdit.bas"
gosub load_file

on_timer sTmr%,tmr_service
' go in main message loop
end

' ###########
' # service #
' ###########
tmr_service:
  ' keyboard service
  KeyCode%=0
  Key$    =inkey$

  if (len(Key$)>0)
    KeyCode%=asc(Key$)
    if KeyCode%= 8 then goto key_backspace
    if KeyCode%= 9 then goto key_tab
    if KeyCode%=13 then goto key_enter
                        goto key_char
    scancode = 0
  else
    KeyCode%=scancode
    if (KeyCode%>0)
      if (KeyCode%>36) and (KeyCode%<41)
        if KeyCode% = 37 then gosub key_cursor_left
        if KeyCode% = 38 then gosub key_cursor_up
        if KeyCode% = 39 then gosub key_cursor_right
        if KeyCode% = 40 then gosub key_cursor_down
        scancode = 0
      else
        if KeyCode% =  1 then goto key_mouse_left
        if KeyCode% =  2 then goto key_mouse_right
        if KeyCode% =  4 then goto key_mouse_midle

        if KeyCode% = 33 then goto key_page_up
        if KeyCode% = 34 then goto key_page_down
        if KeyCode% = 35 then goto key_end
        if KeyCode% = 36 then goto key_pos1

        if KeyCode% = 91 then goto key_win_left
        if KeyCode% = 92 then goto key_win_right
        if KeyCode% = 93 then goto key_win_menu
     
        if KeyCode% =160 then goto key_shift_left
        if KeyCode% =161 then goto key_shift_right
     
        if KeyCode% =162 then goto key_ctrl_left
        if KeyCode% =163 then goto key_ctrl_right
     
        if KeyCode% =164 then goto key_alt_left
        if KeyCode% =165 then goto key_alt_right

        if KeyCode% =112 then goto key_F1
        if KeyCode% =113 then goto key_F2
        if KeyCode% =114 then goto key_F3
        if KeyCode% =115 then goto key_F4
        if KeyCode% =116 then goto key_F5
        if KeyCode% =117 then goto key_F6
        if KeyCode% =118 then goto key_F7
        if KeyCode% =119 then goto key_F8
        if KeyCode% =120 then goto key_F9
        if KeyCode% =121 then goto key_F10
        if KeyCode% =122 then goto key_F11
        if KeyCode% =123 then goto key_F12
   
        if KeyCode% =160 then goto key_shift_left
        if KeyCode% =161 then goto key_shift_right
   
        if KeyCode% =162 then goto key_ctrl_left
        if KeyCode% =163 then goto key_ctrl_right
   
        if KeyCode% =164 then goto key_alt_left
        if KeyCode% =165 then goto key_alt_right
        scancode=0
      end_if
    end_if
  end_if

  ' resize service
  get_size:
  cWidth%  = width(0)  - dWidth%
  cHeight% = height(0) - dHeight%
  if (cHeight%<(fHeight%*4))
    height 0,height(0)+1
    goto get_size
  end_if

 
  ' new size <> old size ?
  if (cWidth%<>oWidth%) or (cHeight%<>oHeight%)
    oWidth%  = cWidth%
    oHeight% = cHeight%
    cHeight%=(cHeight%-fHeight%)/fHeight%
    cHeight%=cHeight%*fHeight%
    gosub form_resize
  end_if

 
  ' cursor service
  if (cX%<>cOldX%) or (cY%<>cOldY%)
    2d_target_is Editor%
    2d_pen_color 250,250,250
    2d_line cOldX%*fWidth%,cOldY%*fHeight%,cOldX%*fWidth%,(cOldY%+1)*fHeight%
    2d_pen_color 0,0,0
    2d_line cX%*fWidth%,cY%*fHeight%,cX%*fWidth%,(cY%+1)*fHeight%
    cOldX%=cX%:cOldY%=cY%
    cOn%=1
    2d_pen_color 250,250,250
  else
    ' blinking cursor
    if frac(sCount%/10)=0
      2d_target_is Editor%
      if cOn%=1
        2d_pen_color 250,250,250
        2d_line cOldX%*fWidth%,cOldY%*fHeight%,cOldX%*fWidth%,(cOldY%+1)*fHeight%
        cOn%=0
      else
        2d_pen_color 0,0,0
        2d_line cX%*fWidth%,cY%*fHeight%,cX%*fWidth%,(cY%+1)*fHeight%
        cOldX%=cX%:cOldY%=cY%
        cOn%=1
        2d_pen_color 250,250,250
      end_if
  end_if
  end_if
 
 
  ' increment the service counter
  sCount% = sCount% + 1
  active 0
  set_focus 0
  return

' ########
' # menu #
' ########
mnu_load:
  FileName$=""
  gosub load_file
  return
 
mnu_exit:
  terminate
  return
 
' #######
' # gui #
' #######
' the missing ON_RESIZE N,L
form_resize:
  eLeft%  = 0
  eTop%    = 0
  eHeight% = cHeight%
  eWidth%  = cWidth%
   
  if NumbersOn%<>0
    ' numbers
    nLeft% = 0
    nTop%  = 0
    nWidth%  = fWidth% * nCount%
    nHeight% = cHeight%
    nCols% = nWidth%  / fWidth%
    nRows% = nHeight% / fHeight%
    ' new size of number view <> old size ?
    if (nRows%<>nOldRows%)
      gosub numbers_resize
      nOldRows% = nRows%
      nOldCols% = ncols%
    end_if
    eLeft%  = nWidth%
    eWidth% = cWidth% - eLeft%
  end_if

  ' editor
  eCols% = eWidth%  / fWidth%
  eRows% = eHeight% / fHeight%
  ' new editor size <> old size ?
  if (eCols%<>eOldCols%) or (eRows%<>eOldRows%)
    eOldCols%=eCols%
    eOldRows%=eRows%
    gosub editor_resize
  end_if
  return

numbers_resize:
  width  Numbers%,nWidth%
  height Numbers%,nHeight%
  gosub numbers_repaint
  return
 
editor_resize:
  left  Editor%,eLeft%
  top    Editor%,eTop%
  width  Editor%,eWidth%
  height Editor%,eHeight%
  gosub editor_repaint
  return

numbers_repaint:
  2d_target_is Numbers%
  2d_rectangle 0,0,nWidth%,nHeight%
  print_target_is Numbers%

  for i% = 0 to nRows%-1
    s$=str$(ROffset% + i% + 1)+" "
    j%=nCount%-len(s$)
    if j%>0 then s$ = string$(j%," ") + s$
    print_locate 0,i%*fHeight%: print s$
  next i%

  return
 
editor_repaint:
  2d_target_is Editor%
  2d_rectangle 0,0,eWidth%,eHeight%
  ' number of TEXT rows
  n% = count(eText%)
  ' nothing to paint
  if (n%<1) then return
  if (n%>eRows%) then n%=eRows%
  print_target_is Editor%

  for i% = 0 to n%-1
    print_locate 0,i%*fHeight%: print item_read$(eText%,ROffset% + i% +1)
  next i%

  return

' ############
' # keyboard #
' ############

' keys ASCI
key_char:
  return

key_cursor_left:
  if (cX%>0) then cX%=cX%-1
  return
key_cursor_right:
  if ((cX%+1)<eCols%) then cX%=cX%+1
  return
key_cursor_up:
  if (cY%>0)
    cY%=cY%-1
  else
    if (ROffset%>0)
      ROffset%=ROffset%-1
      gosub numbers_repaint
      gosub editor_repaint
    end_if
  end_if
  return
 
key_cursor_down:
  if ((cY%+1)<eRows%)
    cY%=cY%+1
  else
    if ( (ROffset% + eRows% + 1) < count(eText%) )
      ROffset%=ROffset%+1
      gosub numbers_repaint
      gosub editor_repaint
    end_if
  end_if
  return


' keys CTRL
key_backspace:
  return
key_tab:
  return
key_enter:
  return
key_page_up:
  return
key_page_down:
  return
key_end:
  return
key_pos1:
  cX%=0:cY%=0
  return
 


key_mouse_left:
key_mouse_right:
key_mouse_midle:
 return

key_win_left:
key_win_right:
key_win_menu:
  return

key_F1:
key_F2:
key_F3:
key_F4:
key_F5:
key_F6:
key_F7:
key_F8:
key_F9:
key_F10:
key_F11:
key_F12:
  return
 
key_shift_left:
key_shift_right:
  return
key_ctrl_left:
key_ctrl_right:
  return
key_alt_left:
key_alt_right:
  return
 
' ########
' # font #
' ########
load_font:
  if FontSize% <  6 then FontSize% = 6
  if FontSize% > 30 then FontSize% = 30
  fWidth%  = FontSize% + fDiffs%(FontSize%-6)
  fHeight% = FontSize% + FontSize%/2 + 1
  font_name  Editor%,FontName$
  font_size  Editor%,FontSize%
  font_color Editor%,0,0,250
  font_name  Numbers%,FontName$
  font_size  Numbers%,FontSize%
  font_color Numbers%,255,255,255
  return
 
' ########
' # file #
' ########
load_file:
  if (len(FileName$)=0)
    FileName$ = file_name$(OpenDialog%)
  end_if
 
  if (file_exists(FileName$)=1)
    caption frmMain%,FileName$
    file_load eText%,FileName$
    ' for new reapaint
    oWidth%=cWidth%-1
    nOldRows%=nOldRows%-1
    eOldRows%=eOldRows%-1
  end_if
  return
 
load_syntax_files:
  return

'    6, 7, 8, 9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30
data -1,-2,-1,-2,-2,-2,-2,-3,-3,-3,-3,-3,-4,-4,-4,-4,-5,-4,-5,-5,-5,-5,-5,-5,-5