PC Toledo

Em homenagem a Paulo Cesar Toledo
https://pctoledo.org/

Memo Colorido

https://pctoledo.org/viewtopic.php?t=17178

Página 1 de 1

Memo Colorido

Enviado: 24 Mai 2016 00:21
por Claudio Soto
Buscando en mis archivos encontré otro de mis dinosaurios, una rutina que hice en Clipper 5 para mostrar texto colorido dentro del MemoEdit.

Código: Selecionar todos

/*
PROGRAMA: Memo Colorinche
AUTOR: Claudio Soto
FECHA: Diciembre 1999
LENGUAJE: Clipper 5.01
*/

#include "box.ch"


   // Linea:  del MemoEdit a colorear
   // Inicio: caracter de inicio de la Linea a colorear
   // Final:  caracter final de la Linea a colorear
   // Color:  color de los caracteres que se encuentran entre Inicio y Final
 
   //                   Linea  Inicio  Final    Color

   PRIVATE matriz := {{     1,    21,    43,   " gr/b+"},;
                      {     3,    37,    47,   " g/b+ "},;
                      {     4,     1,    29,   " g/b+ "},;
                      {     5,    41,    51,   " g/b+ "},;
                      {    11,     0,     0,   " r/w  "},;
                      {    13,     1,    15,   " b/w  "},;
                      {    24,     1,    33,   " b/w  "},;
                      {    48,     0,     0,   " w/b+ "},;
                      {    49,     1,    19,   " w/b+ "},;
                      {    49,    21,    68,   " g/b+ "},;
                      {    50,     0,     0,   " g/b+ "},;
                      {    52,     0,     0,   " w/b+ "},;
                      {    53,     0,     0,   " w/b+ "},;
                      {    54,    38,    56,   " r/b+ "},;
                      {     0,     0,     0,   "      "}}


   // PRIVATE Texto := memoread ("msg.txt")
   PRIVATE Texto := CrearTexto()

   cls
   set color to GR/B+
   dispbox (3,0,22,79,B_SINGLE+chr (32))

   // edita el texto con el color especificado
   set color to BG/B+
   // PARAMETROS  texto   Y1   X1   Y2   X2   largo  columnas    colores
   Memo_Colorido( Texto,  5,   2,   20,  77,  90,    .T.,        matriz )



PROCEDURE Memo_Colorido( var, p_y1, p_x1, p_y2, p_x2, tam_lin, fl, m )
   private pos_y1,pos_x1,pos_y2,pos_x2, flag
   flag = fl
   mat := aclone (m)
   pos_y1 = p_y1
   pos_x1 = p_x1
   pos_y2 = p_y2
   pos_x2 = p_x2
   ancho = pos_x2-pos_x1+1
   largo = pos_y2-pos_y1+1
   tot_lin = mlcount (var)
   keyboard chr(10)+chr(10)
   inkey (0)
   memoedit (var,pos_y1,pos_x1,pos_y2,pos_x2,.f.,"ind_cursor", tam_lin)
RETURN


FUNCTION ind_cursor( mode, line, col )

   set cursor off
   if lastkey() = 13
      set cursor on
      keyboard chr(27)
   endif

   xxx = col ()
   yyy = row ()

   colorido = setcolor ()

   x_xi = col-(col () - pos_x1)
   x_xf = col+(pos_x2 - col ())+1

   xxx = col ()
   yyy = row ()

   // top_y1 = line -(row () - pos_y1)
   // top_y2 = line +(pos_y2 - row ())

   for z = 1 to len (mat)
      for i = line to line+largo-1
         if i <= tot_lin
            if i = mat [z,1]                 // linea del texto
               ss = x_xi
               for k = pos_x1 to pos_x2
                  y_y = (i - line) + pos_y1
                  ss = ss + 1

                  ini_col = mat [z,2]-1     // columna inicial
                  if mat [z,2] = 0
                     ini_col = x_xi
                  endif

                  fin_col = mat [z,3]+1     // columna final
                  if mat [z,3] = 0
                     fin_col = x_xf + 1
                  endif

                  if ini_col < ss .and. ss < fin_col
                     @ y_y, k say getchar (y_y,k) color mat [z,4] // color del texto
                  endif
               next
            endif
         endif
      next
   next

   setpos (yyy,xxx)
   setcolor (colorido)

   if mode = 0 .and. flag = .T.
      @ 0,30 say line  picture " linea:99999 "  color "r/w"
      @ 0,55 say col+1  picture " columna:99999 " color "r/w"
   endif
   set cursor on

 RETURN (0)



FUNCTION getchar (Y,X)
   local fondo
   fondo := savescreen (Y,X,Y,X)
RETURN (substr(fondo,1,1))


FUNCTION CrearTexto
   #define CR chr(13)+chr(10)
   text = ""
   text = text + "                    MEMO colorinche Ver 1.0                                    "+CR
   text = text + CR
   text = text + "Esto es un ejemplo de una rutina en Clipper 5.0 en la cual se puden            "+CR
   text = text + "mostrar de diferentes colores las palabras de un campo memo o de una           "+CR
   text = text + "variable de texto empleando la funcion  MEMOEDIT () del Clipper.               "+CR
   text = text + CR
   text = text + "Como no tengo ganas de andar escribiendo te encajo a seguir un                 "+CR
   text = text + "pedazo de una monografia que tuve que realizar:                                "+CR
   text = text + CR
   text = text + CR
   text = text + "                   ABSCESO Y/O FLEMON CORONARIO.                               "+CR
   text = text + CR
   text = text + " INTRODUCCION.                                                                 "+CR
   text = text + "El absceso y/o flemon coronario es una patologia septica inflamatoria          "+CR
   text = text + "que afecta al pie equino, tiene asiento en la region de la corona              "+CR
   text = text + "provocando dolor lo cual se manifiesta por claudicaciones, con el              "+CR
   text = text + "evidente trastorno funcional.                                                  "+CR
   text = text + "Es una enfermedad a la cual no se le deberia permitir una evolucion,           "+CR
   text = text + "tendria que ser  diagnosticada y tratada lo antes posible con medidas          "+CR
   text = text + "adecuadas para obtener una rapida curacion  evitandose complicaciones          "+CR
   text = text + "posteriores.                                                                   "+CR
   text = text + CR
   text = text + CR
   text = text + " RECORDATORIO ANATOMICO DEL PIE.                                               "+CR
   text = text + "El pie equino es un complejo aparato constituido por elementos                 "+CR
   text = text + "internos armonicamente dispuestos, encerrados en una caja cornea,              "+CR
   text = text + "solida, flexible y elastica. Las principales estructuras                       "+CR
   text = text + "anatomicas del pie son: casco, membrana queratogenica                          "+CR
   text = text + "(corion del casco), aparato fibroelastico, primera, segunda y                  "+CR
   text = text + "tercera falange, fibrocartilagos alares de la tercera falange,                 "+CR
   text = text + "hueso navicular, aparato podosesamoideo, articulacion interfalangiana          "+CR
   text = text + "distal,  venas, arterias, nervios y linfaticos del pie.                        "+CR
   text = text + "El absceso o flemon coronario se localiza en la region de la corona            "+CR
   text = text + "del pie equino.                                                                "+CR
   text = text + "La region de la corona externamente esta comprendida por el rodete             "+CR
   text = text + "coronario y sus estructuras vecinas inmediatas hacia distal y                  "+CR
   text = text + "proximal, que circundan el contorno del casco.                                 "+CR
   text = text + "El rodete coronario es la combinacion del corion perioplico, el                "+CR
   text = text + "corion coronario y  la almohadilla coronaria (porcion elastica del             "+CR
   text = text + "corion coronario).                                                             "+CR
   text = text + "La protusion del rodete coronario se debe a la presencia de la                 "+CR
   text = text + "almohadilla coronaria  que es un tejido pobremente vascularizado,              "+CR
   text = text + "es una modificacion del tejido subcutaneo a tejido elastico.......             "+CR
   text = text + "..................................................................             "+CR
   text = text + "..................                                                             "+CR
   text = text + CR
   text = text + CR
   text = text + "Espero que sea util, aunque sea para que en tus sistemas muestres              "+CR
   text = text + "mensajes como este: Si no estas conforme usuario con este programa,            "+CR
   text = text + "andate a la ......, afectuosamente YO tu programador.                          "+CR
   text = text + CR
   text = text + "Cree esta rutina el 18/12/1999, probablemente sea lo unico util que            "+CR
   text = text + "hice en todo este siglo....                                                    "+CR
   text = text + "                                           Claudio Soto.                       "+CR
   text = text + CR
 RETURN text
PD: no probé si funciona en Harbour

Memo Colorido

Enviado: 24 Mai 2016 07:02
por ANDRIL
Muito legal e criativa sua idéia, parabéns! Um memoedit com destaque de texto é fantástico.
Até+

Memo Colorido

Enviado: 24 Mai 2016 14:45
por JoséQuintas
A primeira coisa que me veio à cabeça foi um visualizador de fontes (PRGs), destacando palavras chave.
Que pode até ser um mini-editor.
Muito interessante.

Memo Colorido

Enviado: 24 Mai 2016 17:30
por asimoes
O mesmo exemplo usando ScreenMark (compilado com harbour)
Screen Shot 05-24-16 at 05.29 PM.PNG

Código: Selecionar todos

   ScreenMark("MEMO colorinche Ver 1.0",        "GR/B+", .F., .T.)
   ScreenMark("MEMOEDIT ()",                    "G/B+", .F., .T.)
   ScreenMark("mostrar de diferentes colores", "G/B+", .F., .T.)
   ScreenMark("ABSCESO Y/O FLEMON CORONARIO.", "R/W", .F., .T.)
   ScreenMark(" INTRODUCCION. ", "B/W", .F., .T.)

Memo Colorido

Enviado: 25 Mai 2016 06:18
por asimoes
Para quem não conhece ScreenMark:

Lib Ct
ScreenMark()
Searches strings on the screen and changes their color.
Syntax
ScreenMark( <cSearch>, ;
<xColor> , ;
<lCase> , ;
[<lAll>] , ;
[<cPre>] , ;
[<cPost>] ) --> lFound

Arguments
<cSearch>
This is a character string that is searched for on the screen.
<xColor>
This is either a single color value (see SetColor()), or its numeric color attribute (see ColorToN()). It defines the color for marking the search string.
<lCase>
A logical value must be passed. When <lCase> is .T. (true), the function performs a case sensitive search. With .F. (false), the search is case insensitive.
<lAll>
This parameter defaults to .F. (false) so that only the first occurance of <cSearch> is color marked. Passing .T. (true) marks all occurrances.

Return
The function returns .T. (true) when at lease one occurrance of the search string is color marked. Otherwise, .F. (false) is returned.
Note: the function leaves the cursor position unchanged.

Código: Selecionar todos

// The example displays a string and marks words in it

   PROCEDURE Main
      LOCAL cDelim := Chr( GetClearB() )
      CLS

      @ 10,10 SAY "This is the Harbour compiler"

      ScreenMark( "is", "W+/R", .F., .T., cDelim, cDelim )

      ScreenMark( "Harbour", "W+/B", .F. )
   RETURN
Todos os horários são UTC-03:00
Página 1 de 1

Powered by phpBB® Forum Software © phpBB Limited

Traduzido por: Suporte phpBB