Página 2 de 2

Alguns ajustes em sistema Gaspro convertido

Enviado: 03 Mai 2012 16:37
por Pablo César
Creio que existe o fileattrib da hbCT. Mas de todas formas, você pode recriar tais funções (com esses nomes e caracteristicas) utilizando estas rotinas em C:

Código: Selecionar todos

#pragma BEGINDUMP

#include <windows.h>
#include "hbapi.h"
#include "hbapiitm.h"

HB_FUNC( SETFILEATTRIBUTES )
{
   hb_retl( SetFileAttributes( (LPCSTR) hb_parc( 1 ), (DWORD) hb_parnl( 2 ) ) ) ;
}

HB_FUNC( GETFILEATTRIBUTES )
{
   hb_retnl( (LONG) GetFileAttributes( (LPCSTR) hb_parc( 1 ) ) ) ;
}

#pragma ENDDUMP
E a sua utilização é:

Código: Selecionar todos

#define _FA_NORMAL		32
#define _FA_HIDDEN		39

IF GetFileAttributes(cFileName) # _FA_NORMAL
	SetFileAttributes(cFileName, _FA_NORMAL)
ENDIF
De acordo com este tópico: https://pctoledo.org/forum/viewto ... 022#p12022 que tem uma breve descrição do que faz essas funções:
  • t=FILEATTRIB(arq_log) // testa se existe/verif atributos
    RWRITE(arq_log) // torna o arquivo R/W
    SETRHS(arq_log) // coloca atrigutos rhs
Os valores para definir os atributos de acordo o fileio.ch são:

Código: Selecionar todos

/*
 * $Id: fileio.ch 15362 2010-08-14 18:25:13Z vszakats $
 */

/*
 * Harbour Project source code:
 * Header file for file management functions
 *
 * Copyright 1999 David G. Holm <dholm@jsd-llc.com>
 * www - http://harbour-project.org
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2, or (at your option)
 * any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this software; see the file COPYING.  If not, write to
 * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
 * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
 *
 * As a special exception, the Harbour Project gives permission for
 * additional uses of the text contained in its release of Harbour.
 *
 * The exception is that, if you link the Harbour libraries with other
 * files to produce an executable, this does not by itself cause the
 * resulting executable to be covered by the GNU General Public License.
 * Your use of that executable is in no way restricted on account of
 * linking the Harbour library code into it.
 *
 * This exception does not however invalidate any other reasons why
 * the executable file might be covered by the GNU General Public License.
 *
 * This exception applies only to the code released by the Harbour
 * Project under the name Harbour.  If you copy code from other
 * Harbour Project or Free Software Foundation releases into a copy of
 * Harbour, as the General Public License permits, the exception does
 * not apply to the code that you add in this way.  To avoid misleading
 * anyone as to the status of such modified files, you must delete
 * this exception notice from them.
 *
 * If you write modifications of your own for Harbour, it is your choice
 * whether to permit this exception to apply to your modifications.
 * If you do not wish that, delete this exception notice.
 *
 */

/* NOTE: This file is also used by C code. */

#ifndef _FILEIO_CH
#define _FILEIO_CH

/* File create flags */
#define FC_NORMAL          0           /* No file attributes are set      */
#define FC_READONLY        1           /* Read-only file attribute is set */
#define FC_HIDDEN          2           /* Hidden file attribute is set    */
#define FC_SYSTEM          4           /* System file attribute is set    */

/* File attributes flags */
#define HB_FA_ALL          0x00000000

#define HB_FA_READONLY     0x00000001  /* R */
#define HB_FA_HIDDEN       0x00000002  /* H */
#define HB_FA_SYSTEM       0x00000004  /* S */
#define HB_FA_LABEL        0x00000008  /* V */
#define HB_FA_DIRECTORY    0x00000010  /* D | S_ISDIR() */
#define HB_FA_ARCHIVE      0x00000020  /* A | S_ISREG() */
#define HB_FA_DEVICE       0x00000040  /* I | S_ISBLK() */
#define HB_FA_NORMAL       0x00000080  /*   */

#define HB_FA_TEMPORARY    0x00000100  /* T | S_ISFIFO()??? */
#define HB_FA_SPARSE       0x00000200  /* P | S_ISSOCK()??? */
#define HB_FA_REPARSE      0x00000400  /* L | S_ISLNK() */
#define HB_FA_COMPRESSED   0x00000800  /* C | S_ISCHR()??? */
#define HB_FA_OFFLINE      0x00001000  /* O */
#define HB_FA_NOTINDEXED   0x00002000  /* X */
#define HB_FA_ENCRYPTED    0x00004000  /* E */
#define HB_FA_VOLCOMP      0x00008000  /* M volume supports compression. */

/* POSIX file permission */
#define HB_FA_SUID         0x08000000  /* 4000 set user ID on execution */
#define HB_FA_SGID         0x04000000  /* 2000 set group ID on execution */
#define HB_FA_SVTX         0x02000000  /* 1000 sticky bit */
#define HB_FA_RUSR         0x01000000  /* 0400 read by owner */
#define HB_FA_WUSR         0x00800000  /* 0200 write by owner */
#define HB_FA_XUSR         0x00400000  /* 0100 execute/search by owner */
#define HB_FA_RGRP         0x00200000  /* 0040 read by group */
#define HB_FA_WGRP         0x00100000  /* 0020 write by group */
#define HB_FA_XGRP         0x00080000  /* 0010 execute/search by group */
#define HB_FA_ROTH         0x00040000  /* 0004 read by others */
#define HB_FA_WOTH         0x00020000  /* 0002 write by others */
#define HB_FA_XOTH         0x00010000  /* 0001 execute/search by others */

/* File access flags */
#define FO_READ            0           /* File is opened for reading             */
#define FO_WRITE           1           /* File is opened for writing             */
#define FO_READWRITE       2           /* File is opened for reading and writing */

/* File open flags */
#define FO_CREAT           0x0100      /* create and open file */
#define FO_TRUNC           0x0200      /* open with truncation */
#define FO_EXCL            0x0400      /* create and open only if file doesn't exist */

/* File sharing flags */
#define FO_COMPAT          0           /* No sharing specified                               */
#define FO_EXCLUSIVE       16          /* Deny further attempts to open the file             */
#define FO_DENYWRITE       32          /* Deny further attempts to open the file for writing */
#define FO_DENYREAD        48          /* Deny further attempts to open the file for reading */
#define FO_DENYNONE        64          /* Do not deny any further attempts to open the file  */
#define FO_SHARED          FO_DENYNONE

/* File seek mode flags */
#define FS_SET             0           /* Seek from beginning of file    */
#define FS_RELATIVE        1           /* Seek from current file pointer */
#define FS_END             2           /* Seek from end of file          */

/* File mode flags */
#define FD_BINARY          1           /* Binary mode (raw)  */
#define FD_RAW             FD_BINARY
#define FD_TEXT            2           /* Text mode (cooked) */
#define FD_COOKED          FD_TEXT
#define FD_ASCII           FD_TEXT

/* File system error codes */
#define F_ERROR            ( -1 )      /* Unspecified error */

/* HB_DISKSPACE() types */
#define HB_DISK_AVAIL      0
#define HB_DISK_FREE       1
#define HB_DISK_USED       2
#define HB_DISK_TOTAL      3

#endif /* _FILEIO_CH */
Lembre que para obter atributos compostos, isto é, por exemplo: rhs você terá que somar cada atributo --> HB_FA_READONLY + HB_FA_HIDDEN + HB_FA_SYSTEM como é feito com o FILEATTRIB da CT.LIB

Alguns ajustes em sistema Gaspro convertido

Enviado: 04 Mai 2012 08:06
por marrari
Colega Pablo César,

Primeiramente, muito obrigado pela atenção e ajuda. É exatamente a rotina POE_NO_LOG() do tópico que você citou que utilizo no meu programa. Só que como sou inexperiente, preciso de um pouco mais de sua ajuda (e paciência) para implementar sua solução. Eu tinha em mente conseguir as rotinas que citei anteriormente, (FILEATTRIB, RWRITE, SETRHS) na linguagem clipper mesmo e adiconá-las ao LIBGAS.PRG (ou outro programa do projeto) e compliar novamente com o harbour. Se não for possível desta forma, teria como montar um passo à passo da sua solução? Fiquei meio perdido tendo que usar em "C".

Se puder ajudar, agradeço. Se não puder, mesmo assim muito obrigado por sua atenção.

Um abraço.

Marcelo.

Alguns ajustes em sistema Gaspro convertido

Enviado: 04 Mai 2012 10:04
por Pablo César
Quero fazer um correção.
Na mensagem anterior do Pablo César escreveu:Creio que existe o fileattrib da hbCT.
Existe mas com o nome de FileAttr(). Eu muitas vezes utilizo este magnifico help online sobre as funções do Harbour e suas contribs: Harbour Online Help ajuda muito na procura de funções equivalente e inclusive as descreve em código fonte (muito bom).

Bom Marcelo, vamos ao raciocínio. Eu gosto de ajudar mas sei que não devo entregar tudo de bandeja. Senão o interessado acaba implementando sem ao menos entender de como a coisa funciona. Você como todos nós, criamos softwares, então antes de tudo temos que entender o que pretendemos fazer, senão estaríamos "perdidos como cachorro em meio de tiroteio". Então o primeiro passo é você descobrir o que faz cada uma dessa funções. Verificar o resultado. Tendo em mente que você mesmo pode criar qualquer função com esses mesmos nomes e reproduzir a rotinas de cada um delas para que o resultado seja o mesmo. E assim você poderia implementá-las no LIBGAS.PRG.

Bom, continuando... você diz que precisa as funções: FILEATTRIB, RWRITE e SETRHS e que a rotina que você precisa é justamente ao tópico que mencionei. Então desde já, eu te digo que irá precisar também a função EMBARALHA que pela descrição diz que o que faz é encriptar uma string. Então resumindo... temos:
  1. FILEATTRIB(arq_log) // testa se existe/verif atributos
  2. RWRITE(arq_log) // torna o arquivo R/W
  3. SETRHS(arq_log) // coloca atrigutos rhs
  4. EMBARALHA(buff) // encripta os dados
Prosseguiremos para a criação de cada função então.

A. Function FileAttrib
1. Precisa passar parâmetro que será o nome do arquivo.
2. Você pode utilizar a função GETFILEATTRIBUTES em C que passei para obter o atributo de tal arquivo
3. Retorna o valor numérico da função GETFILEATTRIBUTES

Obs.: Essa função GETFILEATTRIBUTES, inclusive retorna -1 quando o arquivo é inexistente. Então irá funcionar de acordo a função do GAS.

B. Function RWrite
1. Precisa passar parâmetro que será o nome do arquivo.
2. Para mudar o atributo de tal arquivo, primeiramente você vai precisar saber se o arquivo existe. E nada melhor que utilizar a função GETFILEATTRIBUTES em lugar do IF FILE(), pois este retorna como inexistente quando o arquivo está oculto. Estranho o comportamento do FILE(), não é ? Mas é assim, ele apresenta falha quando estive com atributo oculto. Por isso recomendo que utilize a função GETFILEATTRIBUTES
3. Logo verifique se o atributo do arquivo está em ReadOnly, se estiver: mude para normal (sem atributo algum). Caso contrário mude de normal para ReaOnly
4. Você ainda pode retornar verdadeiro ou falso conforme o resultado obtido da função que muda o atributo, neste caso a função que disponibilizei SETFILEATTRIBUTES

C. Function SetRHS
1. Precisa passar parâmetro que será o nome do arquivo.
2. Quase a mesma situação da anterior, só que atributos diferentes, mas que de todas formas precisará saber se o arquivo existe. E nada melhor que utilizar a função GETFILEATTRIBUTES como fez na função anterior.
3. Após verificação de existência de arquivo pelo GETFILEATTRIBUTES, você terá que aplicar o atributo composto, como disse na minha mensagem anterior, você terá que somar os atributos. Neste caso seguindo a tabelinha do fileio.ch, você tem a tabela:
CA-Clipper Tools » Books 1-3 » Book2 » Disk Utilities » escreveu:Table 7-11: Coding the File Attribute
───────────────────────────────────────────
&nbspValue&nbsp&nbspSymb. constants&nbsp&nbspAssigned&nbsp&nbspAttribute&nbsp
&nbsp0&nbsp&nbspFA_NORMAL&nbsp&nbsp  &nbsp&nbsp  &nbsp
&nbsp1&nbsp&nbspFA_READONLY&nbsp&nbspREAD ONLY&nbsp&nbsp(Read-only)&nbsp
&nbsp3&nbsp&nbspFA_HIDDEN&nbsp&nbspHIDDEN&nbsp&nbsp(Hiden files)&nbsp
&nbsp4&nbsp&nbspFA_SYSTEM&nbsp&nbspSYSTEM&nbsp&nbsp(System files)&nbsp
&nbsp8&nbsp&nbspFA_VOLUME&nbsp&nbspVOLUME&nbsp&nbsp(Name of a floppy/hard disk)&nbsp
&nbsp16&nbsp&nbspFA_DIRECTORY&nbsp&nbspDIR&nbsp&nbsp(Directory)&nbsp
&nbsp32&nbsp&nbspFA_ARCHIVE&nbsp&nbspARCHIVE&nbsp&nbsp(Changes since last backup)&nbsp
───────────────────────────────────────────
Então seria FA_READONLY + FA_HIDDEN + FA_SYSTEM ou simplesmente o valor 7 que é a composição desses três atributos.
4. Uma vez em mãos do valor que você deve aplicar, você força o atributo utilizando a função em C que passei, SETFILEATTRIBUTES
5. Você ainda pode retornar verdadeiro ou falso conforme o resultado obtido da função que muda o atributo, neste caso a função que disponibilizei SETFILEATTRIBUTES

C. Function Embaralha
1. Ja nesta função, eu não tenho com precisão saber de que forma é feito este encriptado, pois imagino que esta foi uma função própria do autor, neste caso obtido daquela tópico, isto é, do colega C LEONAM, portanto se quiser enviar uma MP para perguntar-lhe se ele libera a função ou até mesmo postar uma mensagem naquele tópico em que ele disponibilizou o código-fonte, pode fazê-lo a vontade. Ou então faça uma própria sua. Existe a opção de utilizar HB_CRYPT do xHarbour, daí terá que incluir -lxHb na sua compilação, para que aceite essa função no Harbour. Também existe uma quarta opção, que é utilizar a função CRIPTOGRAFA que está disponibilizado no LIBGAS.PRG.
2. Seja qual for das quatro opções apresentadas, você terá que retornar sempre uma string.

Quanto ao código em C, é só copiar e inserir no final do seu prg principal. Marque bloco onde começa com #pragma BEGINDUMP e finalize bloco onde diz #pragma ENDDUMP e deixe que o Harbour faça a sua parte. Se houver erros durante a compilação, poste aqui.

O resto seria com você. Tente montar o seu código através do que eu apresentei de forma narrativa. Se houverem erros, poste aqui no fórum, neste tópico mesmo. Assim você irá contribuir mesmo que com suas dúvidas, irão com certeza servir para outros colegas no futuro.

Estou certo que você irá conseguir, mas você precisa fazer a sua parte. De todas formas eu já tenho meu código e irei lhe auxiliar para fechar estas funções para você.

Alguns ajustes em sistema Gaspro convertido

Enviado: 10 Mai 2012 14:27
por marrari
Boa tarde Colegas.

Meus agradecimentos a você, Pablo César, pela ajuda descrita no tópico anterior. Consegui utilizar as funções que precisava. Agora tem mais uma função que não está funcionando corretamente, pois depende de outra da Lib do Gas. Trata-se da função POE_GAUGE() que utiliza a função POKE() da lib. Já foi até comentado sobre essa função por outro colega, mas ele não tinha a solução. Alguém tem esse código da função POKE()? É que se tiver que usar alguma função similar para Gauge, terei que alterar todos os programas que utilizam a função original POE_GAUGE(). Seria bem mais prático então conseguir o código da função POKE().

Se puderem ajudar, fico mais uma vez agradecido.

Marcelo.

Alguns ajustes em sistema Gaspro convertido

Enviado: 10 Mai 2012 14:48
por Pablo César
É que se tiver que usar alguma função similar para Gauge, terei que alterar todos os programas que utilizam a função original POE_GAUGE().
Marcelo, não entendo a sua colocação. Está certo que seria o ideal você ter os fontes do Gas, mas isso quem tem são somente os proprietários do Gas. Eu fui usuário oficial do GAS, mandei um email pro suporte pedindo ajuda sobre os fontes, mas eles nem sequer responderam. É lamentável, mas também é de direito deles não fornecer os fontes, se bem que acho um absurdo e desnecessário a esta altura em que a linguagem xBase chegou e eles ainda possuírem outras versões em diferentes linguagens o que deixou a versão Gas Pro prá trás... Mas enfim, voltando a sua questão, não entendo porque mesmo que reproduzamos a mesma função (com mesmo nome e efeito) não tem por quê você dizer que precisaria mudar seu código. Bastaria apenas criar a função com o mesmo nome e funcionabilidade, como já disse várias vezes.
Consegui utilizar as funções que precisava.
Espero que sim, que tenhas realmente conseguido reproduzir as mesmas funções que precisavas. Se não for, exponha a sua dúvida, sem problemas. Ok ?

Alguns ajustes em sistema Gaspro convertido

Enviado: 10 Mai 2012 15:29
por marrari
Pablo,

Desculpe se não me fiz entender. O que acontece é que não sei como a função POKE() funciona. Por isso solicitei ajuda. Não tenho idéia de como desenvolvê-la para funcionar na outra função, POE_GAUGE(). Você substituiu essa função POE_GAUGE() em seus sistemas? Obrigado por sua atenção.

Marcelo.

Alguns ajustes em sistema Gaspro convertido

Enviado: 10 Mai 2012 15:43
por Pablo César
Você substituiu essa função POE_GAUGE() em seus sistemas?
Não, não lembro de ter usado. Mas você não poderia postar parte do código onde chama essa função ? Mas coloque o código não somente onde aparece o POE_GAUGE como também o que faz depois disso, se é atribuído a uma variável e onde ela é utilizado. Também os comentários com "//" ou "*" que são feitos no código fonte, também ajudam.

Alguns ajustes em sistema Gaspro convertido

Enviado: 10 Mai 2012 16:06
por Pablo César
Trata-se da função POE_GAUGE() que utiliza a função POKE() da lib. Já foi até comentado sobre essa função por outro colega, mas ele não tinha a solução.
Revisando que você disse, seria este o tópico em que abordava sobre o POE_GAUGE ?

Aí menciona a função POE_GAUGE e o POKE do GAS coloca um valor em uma posiçäo de memória, veja o que o Norton Guide diz:
POKE( <seg>, <off>, <valor> )

Esta funçäo recebe três parâmetros, os dois primeiros correspondentes
ao endereço na forma segmento:offset e o último o valor que se deseja
colocar no endereço. Os argumentos podem ser passados na forma intei-
ra (decimal) ou hexadecimal (na forma de string). Os três têm de ser
ser passados na mesma forma.

POKE("B800","00","41") // poe um "A" na 1a. posiçäo do vídeo
POKE("B800","01","1F") // e poe atributo branco sobre azul.

IMPORTANTE!

A utilizaçäo desta funçäo só é recomendada para programadores que
tenham alguma experiência com a linguagem Assembler. Resultados im-
previsíveis poderäo ocorrer se for utilizada inadequadamente.
Na minha opinião, você pode tirar fora onde diz:

Código: Selecionar todos

IF so_conta                            // gauge em contador
   IF INT(ct_g/30)=ct_g/30             // mostra em 30 em 30
      x=RIGHT(SPACE(8)+STR(ct_g),8)    // coloca qtde na tela sem
      FOR i=1 TO 8                     // usar o SAY (pode estar imprimindo)
         POKE(-18432,(l_g*160)+((c_g+i)*2),ASC(SUBS(x,i+1,1)))
      NEXT
   ENDI
ELSE                                   // gauge com percentual
   @ l_g,c_g SAY REPL("█",MIN(ct_g,20))     // coloca na msg
END IF
Substitua por:
@ l_g,c_g SAY REPL("█",MIN(ct_g,20)) // coloca na msg

Esse poke é muito utilizado para ver se o seu sistema está registrado e guarda uma chave em algum lugar da memória quando é executado o seu sistema. Portanto, na minha opinião, isso é dispensável. Se você quiser outra forma de controlar o seu sistema, faça um próprio.

Alguns ajustes em sistema Gaspro convertido

Enviado: 10 Mai 2012 16:20
por marrari
Mas se eu fizer a substituição do código, o contador de registros (de 30 em 30) não vai funcionar. E uso isso em vários relatórios.

Segue código completo de um relatório. A função POE_GAUGE() é chamada nas linhas 45 e 56.

Código: Selecionar todos

/*
 \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
 \ Programa: KAR_R004.PRG
 \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
*/

#include "MeuProj.ch"     // inicializa constantes manifestas

PRIV dele_atu, cur_atual
PARA lin_menu, col_menu
nucop=1

#ifdef COM_REDE
   IF !USEARQ("DESCPROD",.f.,10,1)                           // se falhou a abertura do arq
      RETU                                                   // volta ao menu anterior
   ENDI
#else
   USEARQ("DESCPROD")                                        // abre o dbf e seus indices
#endi

PTAB(coduni_id,"UNIDPROD",1,.t.)                             // abre arquivo p/ o relacionamento
PTAB(codgru_id,"GRUPOPRD",1,.t.)
SET RELA TO coduni_id INTO UNIDPROD,;                        // relacionamento dos arquivos
         TO codgru_id INTO GRUPOPRD
titrel:=criterio := ""                                       // inicializa variaveis
cpord="despro_id"
chv_rela:=chv_1:=chv_2 := ""
tps:=op_x:=ccop := 1
fil_ini=""
IF !opcoes_rel(lin_menu,col_menu,23,11,fil_ini)              // nao quis configurar...
   CLOS ALL                                                  // fecha arquivos e
   RETU                                                      // volta ao menu
ENDI
IF tps=2                                                     // se vai para arquivo/video
   arq_=ARQGER()                                             // entao pega nome do arquivo
   IF EMPTY(arq_)                                            // se cancelou ou nao informou
      RETU                                                   // retorna
   ENDI
ELSE
   arq_=drvporta                                             // porta de saida configurada
ENDI
SET PRINTER TO (arq_)                                        // redireciona saida
cur_atual=SETCURSOR(0)
dele_atu:=SET(_SET_DELETED,.t.)                              // os excluidos nao servem...
POE_GAUGE("[ESC] Interrompe","AGUARDE...","Emitidos:")
SET DEVI TO PRIN                                             // inicia a impressao
maxli=60                                                     // maximo de linhas no relatorio
BEGIN SEQUENCE
   DO WHIL ccop<=nucop                                       // imprime qde copias pedida
      pg_=1; cl=50000
      INI_ARQ()                                              // acha 1o. reg valido do arquivo
      IF EOF()
         EXIT
      ENDI
      ccop++                                                 // incrementa contador de copias
      DO WHIL !EOF().AND.POE_GAUGE()
         IF IN_KEY()=K_ESC                                   // se quer cancelar
            IF canc()                                        // pede confirmacao
               BREAK                                         // confirmou...
            ENDI
         ENDI
         REL_CAB(2)                                          // soma cl/imprime cabecalho
         @ cl,001 SAY "Grupo.................:"
         @ cl,027 SAY TRAN(codgru_id,"999")                  // Cod. do Grupo
         @ cl,031 SAY TRAN(GRUPOPRD->desgru_id,"@!")         // Descricao do Grupo
         REL_CAB(1)                                          // soma cl/imprime cabecalho
         @ cl,001 SAY "Compl. do Codigo......:"
         @ cl,027 SAY TRAN(comple_id,"999")                  // Compl. do Codigo
         REL_CAB(1)                                          // soma cl/imprime cabecalho
         IMPAC("C¢digo do Item........:",cl,001)
         @ cl,027 SAY TRAN(codpro_id,"999999")               // Codigo do Item
         REL_CAB(1)                                          // soma cl/imprime cabecalho
         @ cl,001 SAY "Descricao do Item.....:"
         @ cl,027 SAY TRAN(despro_id,"@!")                   // Descricao do Item
         REL_CAB(1)                                          // soma cl/imprime cabecalho
         @ cl,001 SAY "Tipo de Item..........:"
         @ cl,027 SAY TRAN(IF(tipo='MP','MATERIA-PRIMA  ',IF(tipo='PA','PRODUTO ACABADO','OUTROS      ')),"@!")// Tipo de Item
         REL_CAB(1)                                          // soma cl/imprime cabecalho
         @ cl,001 SAY "Caracteristica........:"
         @ cl,027 SAY TRAN(IF(qualmp='C','COMUM  ','INCOMUM'),"@!")// Caracteristica
         REL_CAB(1)                                          // soma cl/imprime cabecalho
         @ cl,001 SAY "Unidade de Medida.....:"
         @ cl,027 SAY TRAN(coduni_id,"@!")                   // Cod. da Unidade de Med
         @ cl,030 SAY TRAN(UNIDPROD->desuni_id,"@!")         // Descricao da Unidade
         REL_CAB(1)                                          // soma cl/imprime cabecalho
         @ cl,001 SAY "Estoque Minimo........:"
         @ cl,027 SAY TRAN(estmin,"@E 99,999.999")           // Estoque Minimo
         REL_CAB(1)                                          // soma cl/imprime cabecalho
         @ cl,001 SAY "Estoque Maximo........:"
         @ cl,027 SAY TRAN(estmax,"@E 9,999,999.999")        // Estoque Maximo
         REL_CAB(1)                                          // soma cl/imprime cabecalho
         @ cl,001 SAY "Quantidade em Est.....:"
         @ cl,027 SAY TRAN(quantest,"@E 999,999.999")        // Quantidade em Est.
         REL_CAB(1)                                          // soma cl/imprime cabecalho
         @ cl,001 SAY "Preco de Custo........:"
         @ cl,027 SAY TRAN(precus,"@E 99,999.99")            // Pre‡o de Custo
         REL_CAB(1)                                          // soma cl/imprime cabecalho
         @ cl,001 SAY "Local de Estoque......:"
         @ cl,027 SAY TRAN(local,"@!")                       // Local de Estoque
         SKIP                                                // pega proximo registro
         IF !EOF()                                           // se nao atingiu o final do dbf
            REL_CAB(1)                                       // espacejamento duplo
         ENDI
      ENDD
   ENDD ccop
   EJEC                                                      // salta pagina
END SEQUENCE
SETCURSOR(cur_atual)
SET PRINTER TO (drvporta)                                    // fecha arquivo gerado (se houver)
SET DEVI TO SCRE                                             // direciona saida p/ video
IF tps=2                                                     // se vai para arquivo/video
   BROWSE_REL(arq_,2,3,MAXROW()-2,78,.f.)
ENDI              // mostra o arquivo gravado
GRELA(23)                                                    // grava variacao do relatorio
SELE DESCPROD                                                // seleciona arquivo
SET RELA TO                                                  // retira os relacionamentos
SET(_SET_DELETED,dele_atu)                                   // os excluidos serao vistos
RETU

STATIC PROC REL_CAB(qt)                                      // cabecalho do relatorio
IF qt>0                                                      // se parametro maior que 0
   cl=cl+qt                                                  // soma no contador de linhas
ENDI
IF cl>maxli .OR. qt=0                                        // quebra de pagina
   IMPAC(nemp,0,001)                                         // nome da empresa
   @ 0,070 SAY "PAG"
   @ 0,074 SAY TRAN(pg_,'9999')                              // n£mero da p gina
   IMPAC(nsis,1,001)                                         // t¡tulo aplica‡„o
   @ 2,001 SAY titrel                                        // t¡tulo a definir
   @ 2,062 SAY NSEM(DATE())                                  // dia da semana
   @ 2,070 SAY DTOC(DATE())                                  // data do sistema
   @ 3,001 SAY "ITENS DE ESTOQUE                                CCF-CONSULTORIA E INFORMATICA"
   @ 4,001 SAY REPL("-",77)
   cl=qt+4 ; pg_++
ENDI
RETU

* \\ Final de KAR_R004.PRG
E esta é a função POE_GAUGE() que precisa da função POKE() da lib do GAS. A chamada é na linha 25.

Código: Selecionar todos

FUNC POE_GAUGE(msg_,tit_,tit_reg)  // coloca gauge na tela
STATIC l_g, c_g, ct_g:=0, so_conta         // linha e coluna do inicio gauge
LOCAL x, defa_dev, i
IF msg_!=NIL                              // mensagem da dbox
   so_conta=(tit_reg!=NIL)                // vai contar ou colocar %
   ct_g=0                                 // contador de registro ja processados
   IF so_conta                            // se vai contar concatena msg que
      msg_+="|*|"+tit_reg+"       0"      // vamos mostrar qtde de reg processados
   ELSE                                   // processo em todo o arq
      msg_+="|*|"+REPL("°",20)            // concatena gauge no final
   ENDI
   x=DBOX(msg_,,,,NAO_APAGA,tit_)         // coloca msg na tela
   SETCOLOR(drvtitbox)                    // cor do titulo para gauge
   l_g = VAL(PARSE(@x,"|"))               // linha e
   c_g = VAL(x)                           // coluna de inicio do gauge
   IF so_conta                            // vai contar registro
      c_g+=LEN(tit_reg)+1                 // posiciona cursor apos msg de proc
   ENDI
ELSE                                      // coloca o gauge
   ct_g++                                 // conta quantos ja foi feito
   IF so_conta                            // gauge em contador
      IF INT(ct_g/30)=ct_g/30             // mostra em 30 em 30
         x=RIGHT(SPACE(8)+STR(ct_g),8)    // coloca qtde na tela sem
         FOR i=1 TO 8                     // usar o SAY (pode estar imprimindo)
            POKE(-18432,(l_g*160)+((c_g+i)*2),ASC(SUBS(x,i+1,1)))
         NEXT
      ENDI
   ELSE                                   // gauge com percentual
      @ l_g,c_g SAY REPL("Û",MIN(ct_g,20))     // coloca na msg
   END IF
ENDI
RETURN .t.                              // sempre retorna verdadeiro
Marcelo.

Alguns ajustes em sistema Gaspro convertido

Enviado: 10 Mai 2012 16:45
por Pablo César
Mas se eu fizer a substituição do código, o contador de registros (de 30 em 30) não vai funcionar
Talvez não funcionará como antes mas irá exibir o termômetro. Mas isso é muito importante ? Experimentou como ficaria ?

Não vai ser fácil encontrar um equivalente ao POKE, pois este é feito em linguagem Assembler. E até mesmo não sei se seria conveniente acessar a memória desse jeito, sendo que a tecnologia atual difere muito da antiga com respeito a acessoa a memória.

Alguns ajustes em sistema Gaspro convertido

Enviado: 11 Mai 2012 08:31
por marrari
Pablo,

Fiz o teste com sua dica, mas não funcionou. A rotina acaba imprimindo o termômetro, ou seja, não fica na tela para o usuário ter noção do tempo de impressão e sim direciona para a impressora. Observei que no prórpio código que você sugeriu a substituição, tem o comentário: "coloca qtde na tela sem usar o SAY (pode estar imprimindo)". Mais alguma dica ou função que possa subsitituir então esse POE_GAUGE() para que o usuário tenha uma noção do andamento de impressão? É que se deixar a tela sem informação, dependendo do volume a ser impresso ou processado, pode dar a entender que o sistema travou.

Obrigado pela atenção.

Marcelo.

Alguns ajustes em sistema Gaspro convertido

Enviado: 11 Mai 2012 10:31
por Pablo César
A rotina acaba imprimindo o termômetro, ou seja, não fica na tela para o usuário ter noção do tempo de impressão e sim direciona para a impressora.
Isso é fácil de resolver Marcelo. Observe no código do POE_GAUGE que indiquei na mensagem anterior (linha 9) onde diz:

@ l_g,c_g SAY REPL("█",MIN(ct_g,20)) // coloca na msg

Coloque uma linha antes disso: SET DEVICE TO SCREEN
E depois do @ say, uma linha abaixo, coloque: SET DEVICE TO PRINTER

Então ficando assim:

Código: Selecionar todos

SET DEVICE TO SCREEN
@ l_g,c_g SAY REPL("█",MIN(ct_g,20))     // coloca na msg
SET DEVICE TO PRINTER
Experimente, tenha paciência. As coisas bem elaboradas conseguem-se com muito esforço. Não adianta pensar em obter o código em Assambler e coloca-lo junto com Harbour. Ainda se houvesse alguém que domina Assambler podia descrever o que essa função POKE faz exatamente. Veja que nós estamos aprendendo a identificar o que essa função faz na prática. Veja se funciona e retorne.

Alguns ajustes em sistema Gaspro convertido

Enviado: 18 Mai 2012 10:57
por marrari
Bom dia.
Pablo César escreveu:
Isso é fácil de resolver Marcelo. Observe no código do POE_GAUGE que indiquei na mensagem anterior (linha 9) onde diz:

@ l_g,c_g SAY REPL("█",MIN(ct_g,20)) // coloca na msg

Coloque uma linha antes disso: SET DEVICE TO SCREEN
E depois do @ say, uma linha abaixo, coloque: SET DEVICE TO PRINTER

Então ficando assim:

Código: Selecionar todos

SET DEVICE TO SCREEN
@ l_g,c_g SAY REPL("█",MIN(ct_g,20)) // coloca na msg
SET DEVICE TO PRINTER
Pablo, fiz confome sua dica, mas ainda não funcionou adequadamente. Existem chamadas à essa função que podem estar imprimindo ou não. Por exemplo, a rotina que faz a eliminação dos registros apagados (COMPACTA()), ela primeiro conta os registros e mostra na tela essa contagem e depois faz a reindexação dos mesmos mostrando a barra de progresso. Aí, se deixar o SET DEVICE TO PRINTER, acaba jogando prá impressora a barra de progresso e não para a tela. Sendo assim, fiz algumas alterações no código original da função POE_GAUGE() e estou disponibilizando abaixo:

Código: Selecionar todos

FUNC POE_GAUGE(msg_,tit_,tit_reg)  // coloca gauge na tela
STATIC l_g, c_g, ct_g:=0, so_conta         // linha e coluna do inicio gauge
LOCAL x, defa_dev, i
defa_dev:=SET(_SET_DEVICE)
IF msg_!=NIL                              // mensagem da dbox
   so_conta=(tit_reg!=NIL)                // vai contar ou colocar %
   ct_g=0                                 // contador de registro ja processados
   IF so_conta                            // se vai contar concatena msg que
      msg_+="|*|"+tit_reg+"       0"      // vamos mostrar qtde de reg processados
   ELSE                                   // processo em todo o arq
      msg_+="|*|"+REPL("°",20)            // concatena gauge no final
   ENDI
   x=DBOX(msg_,,,,NAO_APAGA,tit_)         // coloca msg na tela
   SETCOLOR(drvtitbox)                    // cor do titulo para gauge
   l_g = VAL(PARSE(@x,"|"))               // linha e
   c_g = VAL(x)                           // coluna de inicio do gauge
   IF so_conta                            // vai contar registro
      c_g+=LEN(tit_reg)+1                 // posiciona cursor apos msg de proc
   ENDI
ELSE                                      // coloca o gauge
   ct_g++                                 // conta quantos ja foi feito
   IF so_conta                            // gauge em contador
      IF INT(ct_g/30)=ct_g/30             // mostra em 30 em 30
         x=RIGHT(SPACE(8)+STR(ct_g),8)    // coloca qtde na tela sem
         IF defa_dev="PRINTER"
            SET DEVICE TO SCREEN
         ENDI
         @ l_g,c_g SAY x
         IF defa_dev="PRINTER"
            SET DEVICE TO PRINTER
         ENDI
      ENDI
   ELSE                
      @ l_g,c_g SAY REPL("Û",MIN(ct_g,20))     // coloca na msg
   END IF
ENDI
RETURN .t.
Pelos testes que fiz até agora, está funcioanando exatamente como a original, sem precisar da função POKE(). Mas se os colegas puderem testar, melhor ainda.
Pablo César escreveu:Experimente, tenha paciência. As coisas bem elaboradas conseguem-se com muito esforço. Não adianta pensar em obter o código em Assambler e coloca-lo junto com Harbour. Ainda se houvesse alguém que domina Assambler podia descrever o que essa função POKE faz exatamente. Veja que nós estamos aprendendo a identificar o que essa função faz na prática. Veja se funciona e retorne.
Pablo, a linguagem escrita muitas vezes pode distorcer o que estamos querendo dizer. Uma vírgula já muda muita coisa. Desculpe se lhe pareceu eu estar sem paciência, não foi esse o caso. É que a dúvida foi surgindo e fui tentar achar a solução neste fórum, que, diga-se de passagem, é um ótimo fórum, com nível excelente e de mútua ajuda (tanto que estou retribuindo no que já fui ajudado disponibilizando o código acima). Na verdade, eu imaginei que a função POKE() já teria algum código disponível em Clipper por algum colega. Foi só isso.

Agradeço mais uma vez à você e os colegas que tentaram ajudar.

Um abraço.

Marcelo.

Alguns ajustes em sistema Gaspro convertido

Enviado: 18 Mai 2012 11:21
por Pablo César
Perfeito Marcel, parabéns ! Gostei do defa_dev:=SET(_SET_DEVICE), aliás enquanto eu estava lendo a sua colocação eu estava imaginando justamente isso para poder condicionar os SET DEVICEs... mas que bom que você conseguiu, isso demostra que com esforço todos chegamos lá...