#include <hmg.ch>
#define CR_LF CHR(13)+CHR(10)
    static i_quit := 0,;
           s_RTF  := '' ,;
           s_RTF_init :=;
'{\rtf1\ansi\ansicpg1250\deff0\deflang1045{\fonttbl{\f0\fswiss\fcharset238{\*\fname Arial;}Arial CE;}}';
+CR_LF+'{\colortbl ;\red255\green0\blue0;}';
+CR_LF+'{\*\generator Words_HMG 0.01;}\viewkind4\uc1\pard\f0\fs20 ',;             
           s_RTF_boldred_begin  := '\cf1\b ',;
           s_RTF_boldred_end    := '\cf0\b0',;
           s_RTF_new_line       := '\par'+CR_LF,;
           s_RTF_end            := '}' + CR_LF + CHR(0),;
           i_caret              := 0  ,;
           i_sort_order         := 1  ,;
           s_word_found   := ''      ,;
           s_word_trimmed := ''      ,;
           n_count        := 0 

Function Main
    PRIVATE aData     := {{'','',1}},; 
            aList     := {},; 
            aColOrder := {0,0,0},;                              //ARRAY( 3 ),;
            aHeaders  := {'Word','Word_Count'},;
            aImages   := { 'NatImg' , 'NatImg' },;
            nCurFRN   := 0,;                                    // Current Physical Row Number
            cDefInFN  := "MAgenda.ini",;   // Default .ini File Name
            cBegFoldr := GetCurrentFolder(),;
            cDataFNam := ''



  public len120      :=  77
  public len20       :=  20
  public i_line      :=   0
  public i_line_max  :=   0
  public l_form_v_visible  :=   .F.


*  DBCREATE("mem:test", {{"CODE", "C", 3, 0},{"NAME", "C", 50, 0},{"RESIDENTS", "N", 11, 0}},, .T., "memarea")  
  if !file("b1_memo.dbf")
    DBCREATE("b1_memo"  ,  { {"POSITION1"  , "N",     7   , 0},;
                             {"LINIA1"     , "C",len120   , 0}     },, .T., "")
  endif
  if !file("b2_all_w.dbf")
    DBCREATE("b2_all_w" ,  { {"WORD"       , "C", len20   , 0},;
                             {"LINE_NO"    , "N",     6   , 0},;
                             {"TXT_CURSOR" , "N",     3   , 0},;
                             {"LEN_WORD"   , "N",     3   , 0}     },, .T., "")

  
  endif
  if !file("b3_uniq.dbf")
    DBCREATE("b3_uniq",    { {"WORD"      , "C",  len20   , 0},;
                             {"WORD_COUNT", "N",      6   , 0},;
                             {"SORT_W_D"  , "N",      6   , 0},;
                             {"SORT_C_A"  , "N",      6   , 0},;
                             {"SORT_C_D"  , "N",      6   , 0}     },, .T., "")
  endif


  sele 1
  use b1_memo
  index on POSITION1 to ib1_pos 
  go bottom
  i_line_max := recno()
  sele 2
  use b2_all_w
  sele 3
  use b3_uniq

  
        Load Window Main
        Load Window form_import
        Load Window form_view

        Main.Center
        Activate Window All
        
*        Activate Window Main , form_import , form_view
  
  


*        Main.Activate
*        form_import.Activate
*        form_view.Activate

Return
*------------------------

proc p_quit()
  quit
Return
*------------------------
proc p_open2win()
* form_import.WindowType:=MODAL
  form_import.show
Return                   
*------------------------
proc p_close2win()
  form_import.hide
Return                   
*------------------------
proc p_open3win()

  sele 2
  set index to ib2_word
  sele 3
  set index to col1a
  
  l_form_v_visible  :=   .T.
  
  form_view.Grid_1.refresh
  form_view.Text_1.SetFocus  
  form_view.show
Return                   
*------------------------
proc p_close3win()
  l_form_v_visible  :=   .F.
  form_view.hide
Return                   

*=============================================

procedure p_txt_import_123()


  p1a_txt_import()
  p1b_select_words()
  p1c_unique_words()


*============= 1a ================================

procedure p1a_txt_import()
  i_line  :=   0
  sele 1
  zap
  appe blank
  
  cBuffer = SPACE(1)
  nHandle = FOPEN ("memo.txt")
  IF FERROR() != 0
    MsgInfo("File open error")
  ELSE
    lin    := ''
    
    do while FREAD(nHandle, @cBuffer,1) = 1
      asc_buf := ASC(cBuffer)
      if asc_buf <> 13
        if asc_buf = 10
          i_line++
          add_record(lin)
          lin := ''
        else
          if asc_buf>31
            if asc_buf<128
              lin:=lin+cBuffer
            else
              lin:=lin+'_'
            endif
          endif
        endif
      endif
    enddo
        
    add_record(lin)
    
    FCLOSE(nHandle)
  
  ENDIF
  
  MsgInfo ('1/3 :  txt import done.')
  
retu


*==============


procedure add_record(par_lin)
  if at('--',par_lin)>0
    par_lin := strtran(par_lin,'--','- ')  
  end
  
  last_space_pos := 0
  len_of_line    := len(par_lin)
  if len_of_line > len120
    do while len_of_line > len120
      substr_lin     := substr(par_lin,1,len120)
      last_space_pos := rat   (' ',substr_lin)

      substr_lin := substr(par_lin,1,last_space_pos)
      repl POSITION1 with i_line, LINIA1    with substr_lin

      appe blan    
      
      par_lin     := substr( par_lin, 1+last_space_pos, len_of_line)
      len_of_line := len_of_line - last_space_pos-1
    enddo
    if len_of_line>0
      repl POSITION1 with i_line, LINIA1    with par_lin
      appe blan
      i_line_max := i_line    
    endif
  else
    repl POSITION1 with i_line, LINIA1    with par_lin
    appe blan
    i_line_max := i_line    
  
  endif
retu   
  
*============== 1b ===============================

procedure p1b_select_words()

  sele 2
  zap

  sele 1
  go top
  linijka := ''

  
  do while !eof()
    i_pos     :=  POSITION1
    linijka   :=  rtrim(LINIA1)
    len_tmp   :=  len(linijka)
    

    i_caret_pos := 1
    sele 2
        
    do while len_tmp>0
      spac := at (' ', linijka)
      
      if spac = 1
        i_caret_pos++
        len_tmp--
        linijka := substr(linijka,      2, len_tmp )
      else      
        
        if spac>1
          p1a := substr(linijka,      1, spac-1 )
          p1b := substr(linijka, spac+1, len_tmp)
        else
          p1a := linijka
          p1b := ''
        endif

        i_word_len := len(p1a)
        p1c        := tnij_int(p1a)

        appe blan
        repl  WORD with p1c, LINE_NO with i_pos , TXT_CURSOR with i_caret_pos ,LEN_WORD with i_word_len
        i_caret_pos := i_caret_pos + i_word_len + 1  
      
        linijka := rtrim(p1b)
        len_tmp := len(linijka)
      end

    enddo

    sele 1
    skip
    
  enddo

  MsgInfo ('2/3 :  words search done.')
      
retu


*-------------------


function tnij_int(wej)

  wyj := alltrim(wej)          
  wyj := strtran(wyj ,'[','')  
  wyj := strtran(wyj ,'_','')  
  wyj := strtran(wyj ,']','')  
  wyj := strtran(wyj ,'"','')  
  wyj := strtran(wyj ,'.','')  
  wyj := strtran(wyj ,',','')  
  wyj := strtran(wyj ,':','')  
  wyj := strtran(wyj ,'?','')  
  wyj := strtran(wyj ,'!','')  
  wyj := strtran(wyj ,';','')  
  wyj := strtran(wyj ,'(','')  
  wyj := strtran(wyj ,')','')  
  wyj := strtran(wyj ,'*','')  
      
  i_len_word := len(alltrim(wyj))
  do while (at("'", wyj) == 1) .AND. (i_len_word>0)
    i_len_word--
    wyj := substr(wyj,2,i_len_word)
  enddo


  do while (at("'", wyj) == i_len_word) .AND. (i_len_word>0)
    i_len_word--
    wyj := substr(wyj,1,i_len_word)    
  enddo

  do while (at("-", wyj) == i_len_word) .AND. (i_len_word>0)
    i_len_word--
    wyj := substr(wyj,1,i_len_word)    
  enddo

  wyj_retu := lower(wyj)
  retu wyj_retu
  
*============= 1c ================================

procedure p1c_unique_words()
  *------copy to temporary table
  sele 2
  index on WORD to ib2_word unique
  copy fields WORD to words_bis for len(alltrim(WORD))>0
    close indexes
  erase ('ib2_word.ntx')

  index on WORD to ib2_word 
  close indexes
  

  
  *------append from temporary table  
  sele 3
  zap
  append from words_bis
  erase ('words_bis.dbf')
  
  
  *------calc count of words    
  sele 3
  index on WORD to col1a
  
  sele 2
  go top  
  do while !eof()
    w := WORD
    
    sele 3
    seek w 
    if found()
      i := 1 + WORD_COUNT
      repl WORD_COUNT with i
    endif  
  
    sele 2
    skip
  enddo
  close indexes 


  *----------- create additional bases, sorted
  sele 3

  copy fields WORD to bb1
  index on WORD to col1d descending
  copy fields WORD to bb2
  index on WORD_COUNT to col2a
  copy fields WORD to bb3
  index on WORD_COUNT to col2d descending
  copy fields WORD to bb4
  
  MsgInfo ('3/3 :  words unique done.')
        
retu

*=============================================
*=============================================
*=============================================

PROC MA_SortColumn(  nColumnNo )
                
  LOCAL aCurVal := form_view.Grid_1.Value        
  LOCAL nCurRow := aCurVal[ 1 ],;
        nCurCol := aCurVal[ 2 ]
  
        
  nOrder := aColOrder[ nColumnNo ]  // 0:  Ascend, 1: Descend  
  nOrder := IF( nOrder >0, 0, 1 ) 
  
  aColOrder[ nColumnNo ] := nOrder
  

*  form_view.Text_1.Visible := .F.
  
  sele 3
  if nColumnNo=1
    if nOrder=0
      set index to col1a
      form_view.Label_2.Value  := 'Sort: Word ascending'
      form_view.Text_1.Visible := .T.
      i_sort_order := 1        
    else    
      set index to col1d
      form_view.Label_2.Value  := 'Sort: Word descending'         
      i_sort_order := 2        
    endif
  else
    if nOrder=0
      set index to col2a
      form_view.Label_2.Value  := 'Sort: Count ascending'                
      i_sort_order := 3        
    else    
      set index to col2d
      form_view.Label_2.Value  := 'Sort: Count descending'                
      i_sort_order := 4        
    endif
  endif
  
  go top
  form_view.Grid_1.refresh
  
RETURN // MA_SortColumn()

*============================================
*=============================================
*=============================================

procedure P_text1_change(cSStr)

  
  sele 3
  if     i_sort_order >1
    set index to col1a
  endif
  
  SEEK cSStr SOFTSEEK
  rrecno := recno() 
  
  if     i_sort_order = 2
    set index to col1d
  elseif i_sort_order = 3
    set index to col2a
  elseif i_sort_order = 4
    set index to col2d
  end
* form_view.Grid_1.Value := { 5, 1 }     
       
  form_view.Grid_1.Value := { rrecno, 1 }     
*  form_view.Grid_1.Refresh
retu



*================================

proc p_grid1_change(par_cell_val)

  LOCAL aCurVal := form_view.Grid_1.Value        
  LOCAL nCurRow := aCurVal[ 1 ],;
        nCurCol := aCurVal[ 2 ]
  if l_form_v_visible

    sele 3
    goto nCurRow
   
    if     i_sort_order = 2
      nBaseRow := SORT_W_D  
      goto nBaseRow
    elseif i_sort_order = 3
      nBaseRow := SORT_C_A  
      goto nBaseRow
    elseif i_sort_order = 4
      nBaseRow := SORT_C_D  
      goto nBaseRow
    else
      nBaseRow := nCurRow   
    end  
    
    form_view.Label_3.value := str(nCurRow,4) + str(nBaseRow,5) + str(i_sort_order,2) 

    s_word_found   := WORD
    s_word_trimmed := rtrim(s_word_found)
    n_count        := WORD_COUNT 

    form_view.Text_2.value := s_word_trimmed    

*   ---- par_cell_val      

    form_view.Text_1.SetFocus   
    GuiKeyboard(VK_END, 0, 0, 0)
  endif
  
retu

*================================

#pragma BEGINDUMP
#include <windows.h>
#include "hbapi.h"
HB_FUNC( GUIKEYBOARD )
{
   keybd_event( hb_parni(1), hb_parni(2), hb_parni(3), hb_parni(4) );  
}
#pragma ENDDUMP

*=============================================
*=============================================
*=============================================

procedure P_text2_change(cSStr)
  
  
  s_RTF := s_RTF_init
  sele 2
  SEEK s_word_found
  
  ii:=0
  DO WHILE ii<n_count
    i_line      := LINE_NO
    i_bold_from := TXT_CURSOR
    i_bold_len  := LEN_WORD    
    proc1_copy_line ( s_word_trimmed, .F., i_line-1,           0,          0 )
    proc1_copy_line ( s_word_trimmed, .T., i_line  , i_bold_from, i_bold_len )    
    proc1_copy_line ( s_word_trimmed, .F., i_line+1,           0,          0 )
    proc2_insert_border(ii)                                       
    sele 2
    skip   
    ii++
  ENDDO
  
  form_view.RichEdit_1.Value := s_RTF + s_RTF_end


retu
*---------1-------------------------------

proc proc1_copy_line ( par_word, par_subst, par_line,par_from,par_len )
  if (par_line>=1) .AND. (par_line<=i_line_max)
    sele 1
    seek par_line
 
    s_line := LINIA1  
    i_pos  := POSITION1
    
    s_RTF   := s_RTF + str(i_pos,4)+'  '
    if par_subst    
*     -----part 1---- 
      if par_from>1
        s_line1 := substr(s_line,1,par_from-1)
        s_RTF   := s_RTF + s_line1        
      endif
*     -----part 2----       
      s_line2 := ' '+substr(s_line,par_from,par_len)+'  '
      s_RTF   := s_RTF + s_RTF_boldred_begin + s_line2 + s_RTF_boldred_end
*     -----part 3----      
      i_c1 := par_from+par_len
      i_c2 := len(rtrim(s_line))
      if (i_c1 < i_c2)
        s_line3 := substr( s_line, i_c1, i_c2-i_c1+1 )
        s_RTF   := s_RTF + s_line3
      endif
            
    else    
      s_RTF := s_RTF + s_line    
    endif
    
    s_RTF := s_RTF + s_RTF_new_line
  
  
  endif
retu

*---------2-------------------------------

proc proc2_insert_border(par_i)
  s_str := repl('-', int(len120 / 2))+Str(par_i+1,5)  
  s_RTF := s_RTF + s_str + s_RTF_new_line 
retu

*==========================================
*==========================================
*==========================================
*