PC Toledo

Código: Selecionar todos

procedure ab_arqca      
parameters arq
private aarq
aarq = .f.
do while ! net_use ('&arq', .f., 1)
    if ! aarq
        do mensa with 'Aguarde ... Sistema bloqueado !'
        aarq = .t.
    endif
    inkey (2)
enddo
if aarq
    do mens with 'Aguarde ... '
endif
return

function ab_arqc        
parameters arq
if ! net_use ('&arq', .f., 1)
    do mensa with 'Sistema bloqueado !'
    inkey (2)
    return .f.
else 
    return .t.
endif

function ab_arqe        
parameters arq
if ! net_use ('&arq', .t., 1)
    do mensa with 'Sistema bloqueado !'
    inkey (2)
    return .f.
else 
    return .t.
endif

procedure ab_arqea      
parameters arq
private aarq
aarq = .f.
do while ! net_use ('&arq', .t., 1)
    if ! aarq
        do mensa with 'Aguarde ... Sistema bloqueado !'
        aarq = .t.
    endif
    inkey (2)
enddo
if aarq
    do mens with 'Aguarde ... '
endif
return
    
procedure telanome      
parameters mensa
cor ('m')
if len (mensa) < 25
    @ 24, 52 say mensa + space (24 - len (mensa)) 
else 
    mensa_1 = 'Tamanho excedeu 24 carac'
    @ 24, 52 say mensa + space (24 - len (mensa)) 
endif
return

procedure mens          
parameters mensagem
cor ('m')
if len (mensagem) <= 51
    @ 24, 0 say mensagem + space (51 - len (mensagem)) 
else 
    mensa_1 = ''
    @ 24, 0 say mensagem + space (51 - len (mensagem)) 
endif
return

procedure mud_cor       
private cor__i1, cor__i2, cor__i3, cor__i4
cor__i1 = cor11
cor__i2 = cor21
cor__i3 = cor31
cor__i4 = cor41
do case
    case colori1 .and. cor_i = 'cor1'
        set color to &cor__i1/n,n/w,n
    case colori1 .and. cor_i = 'cor2'
        set color to &cor__i2/n,n/w,n
    case colori1 .and. cor_i = 'cor3'
        set color to &cor__i3/n,n/&cor__i3,n
    case colori1 .and. cor_i = 'cor4*'
        &cor__i4 = &cor__i4 + '*'
        set color to &cor__i4/n,n/&cor__i4,n
    case colori1 .and. cor_i = 'cor4'
        set color to &cor__i4/n,n/&cor__i4,n
    case cor_i = 'cor1' .or. cor_i = 'cor2'
        set color to w/n,n/w,n
    case cor_i = 'cor4*'
        set color to w*+/n,n/w+,n
    case cor_i = 'cor3' .or. cor_i = 'cor4'
        set color to w+/n,n/w+,n
endcase
return
    
function cor            
parameters parCor
parCor = upper (parCor)
do case
    case ! colori1 .and. parCor $ 'GD' .and. isolado1
        cor__i = 'w+/n,n/w,,,w+/n'
    case ! colori1 .and. parCor $ 'GD'
        cor__i = 'w+/n,w+/n,,,w+/n'
    case ! colori1 .and. parCor $ 'TLC'
        cor__i = 'w/n,w+/n,,,w+/n'
    case ! colori1 .and. parCor = 'T*'
        cor__i = 'w*/n,w+/n,,,w+/n'
    case ! colori1 .and. parCor $ 'AM'
        cor__i = 'n/w,w+/n,,,w+/n'
    case ! colori1 .and. parCor = 'W'
        cor__i = 'w/n,n/w,,,n/w'
    case parCor $ 'LC'
        cor__i = cor11 + '/' + cor51 + ',' + cor31 + '/' + cor41 + ',' + cor51 + ',,' + cor31 + '/' + cor41
    case parCor = 'T'
        cor__i = cor21 + '/' + cor51 + ',' + cor31 + '/' + cor41 + ',' + cor51 + ',,' + cor31 + '/' + cor41
    case parCor = 'T*'
        cor__i = cor21 + '*/' + cor51 + ',' + cor31 + '/' + cor41 + ',' + cor51 + ',,' + cor31 + '/' + cor41
    case parCor $ 'GD' .and. isolado1
        cor__i = cor21 + '/' + cor51 + ',' + cor31 + '/' + cor41 + ',' + cor51 + ',,' + cor31 + '/' + cor51
    case parCor $ 'GD'
        cor__i = cor31 + '/' + cor51 + ',' + cor31 + '/' + cor41 + ',' + cor51 + ',,' + cor31 + '/' + cor41
    case parCor = 'M'
        cor__i = cor71 + '/' + cor81 + ',' + cor31 + '/' + cor41 + ',' + cor51 + ',,' + cor31 + '/' + cor41
    case parCor = 'A'
        cor__i = cor61 + '/' + cor81 + ',' + cor31 + '/' + cor41 + ',' + cor51 + ',,' + cor31 + '/' + cor41
    case parCor $ 'W'
        cor__i = cor31 + '/' + cor51 + ',' + cor31 + '/' + cor81 + ',' + cor51 + ',,' + cor31 + '/' + cor41
endcase
set color to &cor__i
return .t.

procedure mensa         
parameters p_mensagem
set cursor off
tone (2500, 10)
cor ('a')
if len (p_mensagem) <= 51
    @ 24, 0 say p_mensagem + space (51 - len (p_mensagem)) 
else 
    p_mensagem = ''
    @ 24, 0 say p_mensagem + space (51 - len (p_mensagem)) 
endif
tone (2500, 2)
return

procedure mensagem      
private mens_agem, c_or1, c_or2
parameters mens_agem, c_or1, c_or2
cor_i = c_or1
do mud_cor
@ 24, 0 say mens_agem + space (75 - len (mens_agem)) 
cor_i = 'cor2'
do mud_cor
@ 24, 79 say '-' 
cor_i = c_or2
do mud_cor
return

procedure confimp       
keyboard ''
do mens with 'Impressora/Formulario Ok - Imprimir  (S/N) ?'
cor ('w')
do while .t.
    set cursor on
    @ 24, 45 get confimp picture '!'
    read
    clear gets 
    set cursor off
    do case
        case lastkey () = 27 .or. confimp = 'N'
            confimp = 'N'
            return
        case ! confimp $ 'SN' .or. lastkey () != 13
            tone (70, 1)
            loop
    endcase
    exit
enddo
if ! espoim1 .and. confimp = 'S'
    do mensa with 'Esta��o com impress�o n�o autorizada ! Tecle algo'
    inkey (0)
    confimp = 'N'
endif
return
    
function strzero        
parameters cl_num, cl_len, cl_dec
private cl_str
do case
    case pcount () = 3
        cl_str = str (cl_num, cl_len, cl_dec)
    case pcount () = 2
        cl_str = str (cl_num, cl_len)
    otherwise
        cl_str = str (cl_num)
endcase
if '-' $ cl_str
    return '-' + replicate ('0', len (cl_str) - len (ltrim (cl_str))) + substr (cl_str, at ('-', cl_str) + 1)
else 
    return replicate ('0', len (cl_str) - len (ltrim (cl_str))) + ltrim (cl_str)
endif
    
function net_use        
parameters file, ex_use, wait
private forever
forever = wait = 0
do while forever .or. wait > 0
    if ex_use
        use &file exclusive
    else 
        use &file
    endif
    if ! neterr ()
        return .t.
    endif
    inkey (1)
    wait = wait - 1
enddo
return .f.
function net_use        
parameters file, ex_use, wait
private forever
forever = wait = 0
do while forever .or. wait > 0
    if ex_use
        use &file exclusive
    else 
        use &file
    endif
    if ! neterr ()
        return .t.
    endif
    inkey (1)
    wait = wait - 1
enddo
return .f.