//EXEMPLO: FUNCTION MAIN cAux :=DBF->Memo mMemo:=DBF->Memo @ 12,34 GET cAux VALID MemoWindow(13, 02, 19, 77, "Memo Exemplo:", @mMemo, .T.) .AND. ; ApagaMens() ; WHEN Mens("Digite '@@@@@@@@@@@@@@' no lugar do nmero do processo.", 12, .F., .F.) READ RETURN ****************************************************************************** FUNCTION MemoWindow(nTop, nLeft, nBottom, nRight, cTitle, cMemo, lEdita, nLineLen, cCor, nLinMax, lAcento) ****************************************************************************** *----------------------------------------------------------------------------* * Objetivo : Janela e tratamento para edicao de um campo memo * * Observacao : O campo pode ser editado com acentos agudo, circunflexo e * * til * * Sintaxe : MemoWindow(nTop, nLeft, nBottom, nRight, cTitle, cMemo, ; * * [lEdita], [nLineLen], [cCor], [nLinMax], ; * * [lAcento]) * * Parametros : - Coordenada superior esquerda * * - Coordenada superior direita * * - Coordenada inferior esquerda * * - Coordenada inferior direita * * - Titulo a ser exibido no box * * - Campo Memo exibido * * [] - .T. para editar o campo e .F. caso contrario * * (DEFAULT: .T.) * * [] - Tamanho maximo da linha exibida * * (DEFAULT: Limite da Janela) * * [] - Cor para da janela * * (DEFAULT p/Edicao : CorSBEntW, * * p/consulta: CorSBCDadoW) * * []- Limite maximo de linhas para edicao * * (DEFAULT: sem limite) * * []- Permite ou nao a edicao de caracteres espe- * * ciais (Ex.: ) * * (DEFAULT: .T. permite a edicao de caracteres * * especiais) * * Retorno : - .F. operacao abandonada e .T. operacao valida * * Fun. chamadas : Box() * * Arquivo fonte : Memo.prg * * Arq. de dados : * * Veja tambm : * ****************************************************************************** #include "memoedit.ch" #include "commands.ch" #include "inkey.ch" LOCAL cOldColor:= SETCOLOR(), cOldScreen,; nLen := nRight-nLeft-1,; lMoldura := .F.,; lValido, cAvisos, cTexto, nCursor, cTemp //MEMVAR CorSBMoldW, CorSBEntW, CorSBCMold, CorSBCDado (Cores, substituir pelas suas) PRIVATE lEdicao:=.F., nMaxLin:=0, lCaractere:=.T. PRIVATE lEdit:=.T., lFormat:=.F. DEFAULT lEdita TO .T. DEFAULT nLineLen TO (nRight-1)-(nLeft+1) IF lEdita DEFAULT cCor TO CorSBEntW ELSE DEFAULT cCor TO CorSBCDado ENDIF DEFAULT lAcento TO .T. nMaxLin := nLinMax lEdicao := lEdita lCaractere := lAcento cOldScreen := SAVESCREEN(nTop, nLeft, nBottom+2, nRight+2) //Mensagens na borda superior IF lEdita cAvisos := " Formata Grava janela" //Box(nTop, nLeft, nBottom, nRight, cCor, lMoldura) Coloque aqui sua // funo de box SETCOLOR(cCor) nCursor := SETCURSOR( 1 ) ELSE cAvisos := " Sai" //Box(nTop, nLeft, nBottom, nRight, CorSBCMold, lMoldura) SETCOLOR(cCor) nCursor := SETCURSOR( 0 ) ENDIF cTexto := " " + cTitle + SPACE((nRight-nLeft)-1-LEN(cAvisos)-LEN(cTitle)) + cAvisos + " " @ nTop, nLeft SAY cTexto COLOR "N/W" Position(1, nBottom, nRight-11, lEdicao) cTemp:=cMemo WHILE lEdit cTemp:=MEMOEDIT(cTemp, nTop+1, nLeft+1, nBottom-1, nRight-1, lEdita,; "UFUNC", nLineLen) IF lFormat FormatText(@cTemp, nLineLen+1) ENDIF END IF LASTKEY()==K_ESC //Desistiu KEYBOARD '' lValido := .F. ELSE //Pretende gravar cMemo:=cTemp lValido := .T. ENDIF SETCOLOR(cOldColor) RESTSCREEN(nTop, nLeft, nBottom+2, nRight+2, cOldScreen) SETCURSOR( nCursor ) RETURN lValido ****************************************************************************** FUNCTION UFunc(nMode, nRow, nCol) ****************************************************************************** *----------------------------------------------------------------------------* * Objetivo : Transforma caracteres especiais em ASCII para edicao * * Observacao : Funcao chamada por parametro pela funcao MEMOEDIT * * Sintaxe : UFunc(ME_INIT,10,20) * * Parametros : nMode ---> Nome da funcao de controle da memoedit * * nRow ---> Linha * * nCol ---> Coluna * * Retorno : acao a ser executada no memoedit * * Fun. chamadas : Position() * * Arquivo fonte : Memo.prg * * Arq. de dados : - * * Veja tambm : MemoWindow() * ****************************************************************************** LOCAL nLastRow, nLastCol,; nRet:=ME_DEFAULT, nTecla:=LASTKEY() MEMVAR lEdicao, nMaxLin, lCaractere IF nMode!=ME_INIT IF nMaxLin != NIL .AND. nRow > nMaxLin IF nTecla != K_CTRL_Y .AND. nTecla != K_UP Mens('Liminte mximo de linhas. Tecle ', 0, .F., .T.) KEYBOARD CHR(25) + CHR(5) ENDIF ELSE IF lCaractere DO CASE CASE nTecla == 39 && Acento Agudo INKEY(0) DO CASE CASE CHR(LASTKEY()) == 'a' KEYBOARD CHR(8) + CHR(160) CASE CHR(LASTKEY()) == 'e' KEYBOARD CHR(8) + CHR(130) CASE CHR(LASTKEY()) == 'i' KEYBOARD CHR(8) + CHR(161) CASE CHR(LASTKEY()) == 'o' KEYBOARD CHR(8) + CHR(162) CASE CHR(LASTKEY()) == 'u' KEYBOARD CHR(8) + CHR(163) CASE CHR(LASTKEY()) == 'E' KEYBOARD CHR(8) + CHR(144) CASE CHR(LASTKEY()) == 'c' KEYBOARD CHR(8) + CHR(135) CASE CHR(LASTKEY()) == 'C' KEYBOARD CHR(8) + CHR(128) ENDCASE CASE nTecla == 94 && Acento circunflexo INKEY(0) DO CASE CASE CHR(LASTKEY()) == 'a' KEYBOARD CHR(8) + CHR(131) CASE CHR(LASTKEY()) == 'e' KEYBOARD CHR(8) + CHR(136) CASE CHR(LASTKEY()) == 'o' KEYBOARD CHR(8) + CHR(147) ENDCASE CASE nTecla == 96 && Crase INKEY(0) IF CHR(LASTKEY()) == 'a' KEYBOARD CHR(8) + CHR(133) ENDIF CASE nTecla == 126 && Til INKEY(0) DO CASE CASE CHR(LASTKEY()) == 'a' KEYBOARD CHR(8) + CHR(132) CASE CHR(LASTKEY()) == 'o' KEYBOARD CHR(8) + CHR(148) CASE CHR(LASTKEY()) = 'A' KEYBOARD CHR(8) + CHR(142) CASE CHR(LASTKEY()) = 'O' KEYBOARD CHR(8) + CHR(153) ENDCASE ENDCASE ENDIF IF nTecla==K_F10 .OR.; //Salvar nTecla==K_ESC //Abortar nRet:=K_ALT_W lEdit:=.F. ELSEIF nTecla==K_F9 nRet:=K_ALT_W lFormat:=.T. ENDIF nLastRow:=ROW() nLastCol:=COL() Position(2, nRow, nCol+1, lEdicao) SETPOS(nLastRow, nLastCol) ENDIF ENDIF RETURN nRet ****************************************************************************** FUNCTION FormatText(cMemo, nLen) ****************************************************************************** *----------------------------------------------------------------------------* * Objetivo : Formata linhas do campo memo * * Observacao : * * Sintaxe : FormatText(@cMemo, nLen) * * Parametros : cMemo ----> texto memo a ser formatado * * nLen ----> tamanho de colunas por linha * * Retorno : NIL * * Fun. chamadas : CalcSpaces() * * Arquivo fonte : Memo.prg * * Arq. de dados : - * * Veja tambm : MemoWindow() * *----------------------------------------------------------------------------* LOCAL nLin, cLin, lInic, lFim, aWords:={}, cNovo:="", cWord, lContinua, nTotLin lInic:=.T. lFim:=.F. nTotLin:=MLCOUNT(cMemo, nLen) FOR nLin:=1 TO nTotLin cLin:=RTRIM(MEMOLINE(cMemo, nLen, nLin)) //recuperar IF EMPTY(cLin) //Uma linha em branco ->Considerar um pargrafo vazio IF lInic //Inicio de paragrafo aWords:={} //Limpar o vetor de palavras lInic:=.F. ELSE AADD(aWords, CHR(13)+CHR(10)) //Incluir quebra de linha ENDIF AADD(aWords, CHR(13)+CHR(10)) //Incluir quebra de linha lFim:=.T. ELSE IF lInic //Inicio de paragrafo aWords:={} //Limpar o vetor de palavras //Incluir a primeira palavra com os espacos que a antecedem cWord:="" WHILE SUBSTR(cLin, 1, 1)==" " cWord+=" " cLin:=SUBSTR(cLin, 2) END IF(nNext:=AT(SPACE(1), cLin))<>0 cWord+=SUBSTR(cLin, 1, nNext-1) ENDIF AADD(aWords, cWord) cLin:=SUBSTR(cLin, nNext+1) lInic:=.F. ENDIF //Retirar as demais palavras da linha WHILE(nNext:=AT(SPACE(1), cLin))<>0 IF !EMPTY(cWord:=SUBSTR(cLin, 1, nNext-1)) IF cWord=="," .AND. !EMPTY(aWords) aWords[LEN(aWords)]+=cWord ELSE AADD(aWords, cWord) ENDIF ENDIF cLin:=SUBSTR(cLin, nNext+1) END IF !EMPTY(cLin) //Incluir a ultima palavra IF cLin=="," .AND. !EMPTY(aWords) aWords[LEN(aWords)]+=cLin ELSE AADD(aWords, cLin) ENDIF ENDIF IF nLin==nTotLin //Foi a ultima linha -> Finalizar o paragrafo lFim:=.T. ELSEIF RIGHT(cLin, 1)=="." //Considerar que o 'ponto' finaliza paragrafo AADD(aWords, CHR(13)+CHR(10)) lFim:=.T. ENDIF ENDIF IF lFim IF LEN(aWords)>0 nNext:=1 nAuxLin:=1 WHILE nAuxLin<=LEN(aWords) //Montar uma linha formatada lContinua:=.T. nTot:=0 WHILE lContinua nTot+=(IF(nTot=0, 0, 1)+LEN(aWords[nNext])) IF nNext==LEN(aWords) lContinua:=.F. ELSEIF (nTot+1+LEN(aWords[nNext+1]))>=nLen lContinua:=.F. ELSE nNext++ ENDIF END IF nNext==LEN(aWords) //Ultima linha ->Nao formata FOR nAux:=nAuxLin TO nNext cNovo+=(IF(nAux==nAuxLin, "", " ")+aWords[nAux]) NEXT ELSE //Formatar FOR nAux:=nAuxLin TO nNext cNovo+=(CalcSpaces(nNext-nAuxLin, nLen-nTot-1, nAux-nAuxLin)+aWords[nAux]) NEXT cNovo+=" " ENDIF nNext++ nAuxLin:=nNext END ENDIF lFim:=.F. //Indicar que o fim do paragrafo foi processado lInic:=.T. //Forcar inicio de paragrafo ENDIF NEXT //Retirar linhas em branco no final WHILE LEN(cNovo)>2 .AND. (RIGHT(cNovo, 2)==CHR(13)+CHR(10)) cNovo:=LEFT(cNovo, LEN(cNovo)-2) END cMemo:=cNovo RETURN NIL ****************************************************************************** FUNCTION CalcSpaces(nQt, nTot, nPos) ****************************************************************************** *----------------------------------------------------------------------------* * Objetivo : Calcula espacos necessarios para completar a linha * * Observacao : * * Sintaxe : CalcSpaces(nQt, nTot, nPos) * * Parametros : nQt ---> quantidade de separacoes que devem existir * * nTot ---> total de caracteres em branco excedentes a serem * * distribuidos * * nPos ---> a posicao de uma separacao em particular * * (comecando do zero) * * Retorno : a separacao ja pronta de posicao nPos * * Fun. chamadas : - * * Arquivo fonte : Memo.prg * * Arq. de dados : - * * Veja tambm : MemoWindow() * *----------------------------------------------------------------------------* LOCAL cSpaces,; //Retorno de espacos nDist,; //Total de espacos excedentes a distribuir em cada separacao nLim //Ate que posicao devera conter o resto da divisao IF nPos==0 cSpaces:="" ELSE nDist:=INT(nTot/nQt) nLim:=nTot-(nQt*nDist) cSpaces:=REPL(SPACE(1), 1+nDist+IF(nPos<=nLim, 1, 0)) ENDIF RETURN cSpaces ****************************************************************************** STATIC FUNCTION Position(nMode, nRow, nCol, lEdicao) ****************************************************************************** *----------------------------------------------------------------------------* * Objetivo : Mostra linha e coluna na edicao do campo memo * * Observacao : * * Sintaxe : Position(nMode, nRow, nCol, lEdicao) * * Parametros : nMode ---> Nome da funcao de controle da memoedit * * nRow ---> Linha * * nCol ---> Coluna * * lEdicao -> .T. p/ edicao .F. p/ consulta de campo memo * * Retorno : NIL * * Fun. chamadas : FillString() * * Arquivo fonte : Memo.prg * * Arq. de dados : - * * Veja tambm : MemoWindow() * ****************************************************************************** STATIC nPictRow, nPictCol LOCAL cRow, cCol IF lEdicao IF nMode==1 nPictRow:=nRow nPictCol:=nCol FillString(nPictRow, nPictCol-5, " Lin ") FillString(nPictRow, nPictCol+3, " Col ") nRow:=0 nCol:=0 ENDIF FillString(nPictRow, nPictCol, PADR(ALLTRIM(STR(nRow)),3)) FillString(nPictRow, nPictCol+8, PADR(ALLTRIM(STR(nCol)),3)) ENDIF RETURN NIL ****************************************************************************** STATIC FUNCTION FillString(nRow, nCol, cString) ****************************************************************************** *----------------------------------------------------------------------------* * Objetivo : Imprime uma string na tela sem mudar a cor de fundo * * Observacao : * * Sintaxe : fillstring(a,b,c) * * Parametros : nRow ----> linha * * nCol ----> coluna * * cString --> string * * Retorno : NIL * * Fun. chamadas : - * * Arquivo fonte : Memo.prg * * Arq. de dados : - * * Veja tambm : MemoWindow() * ****************************************************************************** LOCAL cArea, cNewArea, nK, nLen nLen := LEN(cString) cArea := SAVESCREEN(nRow, nCol, nRow, nCol+nLen-1) cNewArea := "" FOR nK := 1 TO nLen cNewArea += SUBSTR(cString, nK, 1)+SUBSTR(cArea, 2*nK, 1) NEXT RESTSCREEN(nRow, nCol, nRow, nCol+nLen-1, cNewArea) RETURN NIL