Jump to content
thoga31

[Exercício] Input com highlight

Recommended Posts

thoga31

Na sequência do exercício do @nunopicado "só porque sim", eu proponho um exercício "só porque me deu na real gana" :D

Basicamente é suposto implementarem um procedimento ReadLight que lê uma String mas que faz highlight do input à medida que é escrito. Exemplo:

write('Introduza uma linha de codigo Pascal: ');
ReadLight(linha);
writeln('LINHA: ', linha);

https://dl.dropboxusercontent.com/u/30172141/P@P/T%C3%B3picos/exercicio_highlight.png

Como podem ver, há cores diferentes para coisas diferentes: palavras reservadas, símbolos, números... Usem cores à vossa escolha.

O procedimento ReadLight deverá funcionar como um ReadLn típico: por exemplo, deverá permitir backspace.

Ao que deverá fazer highlight? O que quiserem. Eu dei o exemplo do Pascal. Se quiserem fazer highlight de outra coisa qualquer, é à vontade do freguês.

Uma solução em Delphi utilizando Text Boxes ou Richtext Boxes também é muito bem-vinda ;)

Sejam criativos, adicionem coisas que vos passem pela cabeça, e venham daí esses códigos!


Knowledge is free!

Share this post


Link to post
Share on other sites
nunopicado

É naquela...

Eu não queria fazer batota, mas tu é que falaste em solução em Delphi, Text Boxes (TEdit e TMemo) e Richtext Boxes (TRichEdit)...

É naquela, dá para mostrar como isto em Delphi/Lazarus é uma linguagem atrasada que não dá para fazer nada:

unit uMain;

{$mode objfpc}{$H+}

interface

uses
 Classes, SysUtils, FileUtil, SynEdit, SynMemo, SynHighlighterPas,
 SynHighlighterCpp, SynHighlighterJava, SynHighlighterHTML, SynHighlighterXML,
 SynHighlighterSQL, SynHighlighterVB, Forms, Controls, Graphics, Dialogs,
 ExtCtrls, StdCtrls, Buttons, SynEditHighlighter;

type

 { TfMain }

 TfMain = class(TForm)
   bCpp: TSpeedButton;
   bBasic: TSpeedButton;
   bTerminar: TButton;
   bAbrir: TButton;
   bLimpar: TButton;
   bXML: TSpeedButton;
   bJava: TSpeedButton;
   bHTML: TSpeedButton;
   bSQL: TSpeedButton;
   dlgOpen: TOpenDialog;
   pnlCommand: TPanel;
   bPascal: TSpeedButton;
   synCpp: TSynCppSyn;
   synHTML: TSynHTMLSyn;
   synJava: TSynJavaSyn;
   SynMemo: TSynMemo;
   synPascal: TSynPasSyn;
   synSQL: TSynSQLSyn;
   synBasic: TSynVBSyn;
   synXML: TSynXMLSyn;
   procedure bAbrirClick(Sender: TObject);
   procedure bLimparClick(Sender: TObject);
   procedure bTerminarClick(Sender: TObject);
   procedure ChooseHighlighter(Sender: TObject);
 private
   { private declarations }
 public
   { public declarations }
 end;

var
 fMain: TfMain;

implementation

{$R *.lfm}

{ TfMain }

procedure TfMain.bTerminarClick(Sender: TObject);
begin
    Application.Terminate;
end;

procedure TfMain.bLimparClick(Sender: TObject);
begin
    SynMemo.Lines.Clear;
end;

procedure TfMain.bAbrirClick(Sender: TObject);
begin
    dlgOpen.Filter:=SynMemo.Highlighter.DefaultFilter;
    if dlgOpen.Execute
       then SynMemo.Lines.LoadFromFile(dlgOpen.FileName);
end;

procedure TfMain.ChooseHighlighter(Sender: TObject);
begin
    SynMemo.Highlighter:=FindComponent('syn'+(Sender AS TSpeedButton).Caption) AS TSynCustomHighlighter;
end;

end.

Claro que isto não mostra nada, e como tal, fica o link para a aplicação:

https://dl.dropboxusercontent.com/u/5146367/ReadLite.zip


"A humanidade está a perder os seus génios... Aristóteles morreu, Newton já lá está, Einstein finou-se, e eu hoje não me estou a sentir bem!"

> Não esclareço dúvidas por PM: Indica a tua dúvida no quadro correcto do forum.

Share this post


Link to post
Share on other sites
passarito

É impressão minha ou isto necessita de se introduzir todas as palavras/códigos que queiramos fazer highlight?

Share this post


Link to post
Share on other sites
nunopicado

É impressão minha ou isto necessita de se introduzir todas as palavras/códigos que queiramos fazer highlight?

Eu ia dizer que sim, mas...

Eu não introduzi nada! hehheheh

Só lá tenho 7 linguagens:

Pascal, C++, Java, HTML, XML, SQL e Basic

Se for preciso mais, arranjam-se!

Ainda tenho pr'aqui FreePascal, Perl, LFM, DIFF, Unix Shell, CSS, PHP, TEX, Python, Batch e INI, antes de ter de começar a escrever palavras à mão!

Edited by nunopicado

"A humanidade está a perder os seus génios... Aristóteles morreu, Newton já lá está, Einstein finou-se, e eu hoje não me estou a sentir bem!"

> Não esclareço dúvidas por PM: Indica a tua dúvida no quadro correcto do forum.

Share this post


Link to post
Share on other sites
thoga31

É impressão minha ou isto necessita de se introduzir todas as palavras/códigos que queiramos fazer highlight?

Não necessariamente. Se exemplificares com duas ou três palavras, chega e sobra. O objectivo não é fazer um sistema de highlight completo, é só mesmo fazer um código-base que faça o que é proposto.

Mas se te quiseres divertir à grande, faz um completo para COBOL.


Knowledge is free!

Share this post


Link to post
Share on other sites
nunopicado

Mas se te quiseres divertir à grande, faz um completo para COBOL.

lol :D que mau!


"A humanidade está a perder os seus génios... Aristóteles morreu, Newton já lá está, Einstein finou-se, e eu hoje não me estou a sentir bem!"

> Não esclareço dúvidas por PM: Indica a tua dúvida no quadro correcto do forum.

Share this post


Link to post
Share on other sites
thoga31

Este código ainda é rudimentar e já tem uns bons meses de existência. Foi ao vê-lo que me lembrei de propor o exercício.

Depois eu melhoro-o.

procedure ReadLight(var s : string);
const SymbolKeys : set of char = ['+','-','*','/','(',')','[',']','&','%','$','#',':',';',',','.','<','>','='];
     NumberKeys : set of char = ['0'..'9'];
     // LetterKeys : set of char = ['a'..'z','A'..'Z'];

var key : char;

begin
   s := '';
   repeat
       textcolor(15);
       key := ReadKey;
       if not(key = #8) then begin
           if not(key = #13) then begin
               GotoXY(WhereX, WhereY);
               if key in NumberKeys then textcolor(10)
               else if key in SymbolKeys then textcolor(12)
               else textcolor(15);

               write(char(key));
               s := s + char(key);

               if AnsiEndsText('DISP', s) then begin
                   GotoXY(WhereX - 4, WhereY);
                   textcolor(14);
                   write('DISP');
               end;

               if AnsiEndsText('PROGRAM', s) then begin
                   GotoXY(WhereX - 7, WhereY);
                   textcolor(14);
                   write('PROGRAM');
               end;

           end
       end else begin
           GotoXY(WhereX - 1, WhereY);
           write(' ');
           GotoXY(WhereX - 1, WhereY);
           Delete(s, length(s), 1);
       end;
   until key = #13;
   GotoXY(1, WhereY + 1);
   textcolor(7);
end;


Knowledge is free!

Share this post


Link to post
Share on other sites
nunopicado

Pronto, toma lá...

program Project1;

{$APPTYPE CONSOLE}

{$R *.res}

uses
 System.SysUtils, Classes, crt;

var
  s:String;

procedure WriteXY(Text:String;X,Y:Byte;Color:Byte=7);
begin
    GotoXY(X,Y);
    TextColor(Color);
    Write(Text);
    if Color<>7
       then TextColor(7);
end;

function ReadLite:String;
const
    Words=';program;begin;end;if;then;else;for;to;downto;do;repat;until;while;';
    Opers=';+;-;*;/;<;>;<=;>=;<>;div;mod;';
var
  ch:Char;
  i:Byte;
  Last:String;
  Number,Err:Integer;

begin
    Result:='';
    Last:='';
    repeat
          repeat
                ch:=ReadKey;
          until Ord(ch) in [8,13,27,32..255];

          case ch of
               #8:if (Result<>'') or (WhereX=1)
                     then begin
                               Delete(Result,Length(Result),1);
                               WriteXY(' ',WhereX-1,WhereY);
                               GotoXY(WhereX-1,WhereY);
                          end;
          else begin
                    Result:=Result+Ch;
                    if ch in [#13,#32]
                       then begin
                                 if Pos(';'+Last+';',Words)>0
                                    then WriteXY(Last,WhereX-Length(Last),WhereY,14);
                                 if Pos(';'+Last+';',Opers)>0
                                    then WriteXY(Last,WhereX-Length(Last),WhereY,12);
                                 if (Last[1]='''') and (Last[Length(Last)]='''')
                                    then WriteXY(Last,WhereX-Length(Last),WhereY,13);
                                 Val(Last,Number,Err);
                                 if Err=0
                                    then WriteXY(Last,WhereX-Length(Last),WhereY,10);
                                 Last:='';
                            end
                       else Last:=Last+Ch;
                    if ch=#13
                       then GotoXY(1,WhereY+1);

                    if ord(ch)>=32
                      then Write(ch);
               end;
          end;

    until ch in [#27];
{     if ch=#27          Já não é preciso...
       then Result:='';} 
end;



begin
    ReadLite;
end.

Não me dei foi ao trabalho de fazer um parser como deve ser... É preciso o espaço ou o enter para separar as palavras e fazer o highlight...

Edited by nunopicado

"A humanidade está a perder os seus génios... Aristóteles morreu, Newton já lá está, Einstein finou-se, e eu hoje não me estou a sentir bem!"

> Não esclareço dúvidas por PM: Indica a tua dúvida no quadro correcto do forum.

Share this post


Link to post
Share on other sites
thoga31

O teu código é mais difícil de ler, mas está aí tudo o que é preciso, excepto o facto de ReadLite não ser um procedimento que recebe por referência uma String (achei que estava implícito quando disse que devia funcionar como o readln e com o exemplo que dei). :)


Knowledge is free!

Share this post


Link to post
Share on other sites
nunopicado

Explicito estava...

Mas olha, foi naquela!

É que sendo função, posso usar directamente (stand alone), ou recolhendo o resultado.

O facto de ser multi-linha ajudou a complicar!

Edited by nunopicado

"A humanidade está a perder os seus génios... Aristóteles morreu, Newton já lá está, Einstein finou-se, e eu hoje não me estou a sentir bem!"

> Não esclareço dúvidas por PM: Indica a tua dúvida no quadro correcto do forum.

Share this post


Link to post
Share on other sites
thoga31

O teu último If é redundante: se o ciclo só interrompe com ESC, não precisas de verificar se foi premido um ESC :P


Knowledge is free!

Share this post


Link to post
Share on other sites
nunopicado

O teu último If é redundante: se o ciclo só interrompe com ESC, não precisas de verificar se foi premido um ESC :P

Pois é... Ao inicio tinha o ciclo a terminar com #27 e #13, e aí o IF era necessário. Mas depois meti o #13 a fazer o multilinha, e não tirei aquilo de lá! bem notado.


"A humanidade está a perder os seus génios... Aristóteles morreu, Newton já lá está, Einstein finou-se, e eu hoje não me estou a sentir bem!"

> Não esclareço dúvidas por PM: Indica a tua dúvida no quadro correcto do forum.

Share this post


Link to post
Share on other sites
thoga31

Pensas que eu não analiso os códigos? Ai não... :D

Aprende-se imenso assim, vêem-se técnicas que nunca antes nos tinham passado pela cabeça... muito eu tenho aprendido convosco aqui, boa parte desta forma. In fact, a esmagadora maioria dos meus conhecimentos em Object Pascal e em boas práticas de programação e técnicas vem de vocês, guys. :)

Edited by thoga31

Knowledge is free!

Share this post


Link to post
Share on other sites
nunopicado

Uiiii... Tenho de ter mais cuidado com o que escrevo! hehehehe


"A humanidade está a perder os seus génios... Aristóteles morreu, Newton já lá está, Einstein finou-se, e eu hoje não me estou a sentir bem!"

> Não esclareço dúvidas por PM: Indica a tua dúvida no quadro correcto do forum.

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×
×
  • Create New...

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.