AYUDA! no puedo terminar un algoritmo de resalto de texto en un RichEdit!

[Black_Ocean]

Hola amigos!

he recurrido a ustedes porque realmente no he podido terminar un algoritmo que trata lo siguiente:

En un componente RichEdit quiero resaltar en colores las palabras reservadas del lenguaje SQL cuando el usuario escriba una consulta. El método lo tengo puesto en OnChange del RichEdit. Las palabras reservadas las metí en un arreglo de strings.

El procedimiento funciona bien mientras el usuario escribe sin retroceder con Backspace, sin poner pegar texto y sin modificar una palabra de mas atrás. Justamente aquí necesito ayuda. Que cuando el usuario retoceda o ponga pegar texto o modifique una palabra que se encuentre mas atrás en el RichEdit también me resalte en colores las palabras reservadas, y no que se vuelvan a negras :S ya que me falla :S no he podido solucionarlo

Aquí dejo mi actual código por si me pueden echar una manito se los agradecería enormemente =)

Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    RichEditSQLConsulta: TRichEdit;
    Button1: TButton;
    procedure RichEditSQLConsultaChange(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

const
  //Arreglo de algunas palabras reservadas del lenguaje SQL
  SQLPalabrasReservadas: array [0..15] of string = ('SELECT',
                                                   'DISTINC',
                                                   'TOP',
                                                   'PERCENT',
                                                   'AS',
                                                   'FROM',
                                                   'WHERE',
                                                   'LIKE',
                                                   'BETWEEN',
                                                   'AND',
                                                   'OR',
                                                   'LEFT',
                                                   'RIGHT',
                                                   'ORDER',
                                                   'GROUP',
                                                   'BY');

{$R *.dfm}

procedure TForm1.RichEditSQLConsultaChange(Sender: TObject);
var
  i, j, k: integer;
  Encontrada: boolean;
  SubCadena: string;
  ActualPosicionCursor: integer;
begin
  if RichEditSQLConsulta.Text = '' then
  begin
    RichEditSQLConsulta.SelAttributes.Color := clWindowText;
    RichEditSQLConsulta.SelAttributes.Style := [];
  end;
  for i := 0 to RichEditSQLConsulta.SelStart - 1 do
    for j := i + 1 to Length(RichEditSQLConsulta.Text) do
    begin
      for k := Low(SQLPalabrasReservadas) to High(SQLPalabrasReservadas) do
      begin
        SubCadena := Copy(RichEditSQLConsulta.Text, i, j);
        if UpperCase(SubCadena) = SQLPalabrasReservadas[k] then
        begin
          Encontrada := true;
          Break;
        end
        else
          Encontrada := false;
      end;
      if Encontrada = true then
      begin
        ActualPosicionCursor := RichEditSQLConsulta.SelStart;
        RichEditSQLConsulta.SelStart := i - 1;
        RichEditSQLConsulta.SelLength := Length(SubCadena);
        RichEditSQLConsulta.SelAttributes.Color := clBlue;
        RichEditSQLConsulta.SelAttributes.Style := [fsBold];
        RichEditSQLConsulta.SelStart := ActualPosicionCursor;
        RichEditSQLConsulta.SelAttributes.Color := clWIndowText;
        RichEditSQLConsulta.SelAttributes.Style := [];
        break;
      end;
    end;
end;

end.

Realmente necesito una ayudita estoy trancado en esto

De antemano gracias

Saludos.

[ariefez]

Hola... Espero no te moleste pero cambie un poquito tu codigo. No lo he probado mucho pero ahi tienes la idea

Código Delphi [-]
 unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    RichEditSQLConsulta: TRichEdit;
    procedure RichEditSQLConsultaChange(Sender: TObject);
  private
    procedure SetTextFormat(SelStart, SelLength: Integer;
      Color: TColor; Style: TFontStyles);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  //Palabras reservadas del lenguaje SQL
  SQL_RESERVED_WORDS =
    '|SELECT|DISTINC|TOP|PERCENT|AS|FROM|WHERE|LIKE|BETWEEN|AND|OR|LEFT|RIGHT|ORDER|GROUP|BY|';

  //Caracter q separa cada palabra
  SQL_SEPARATOR_CHAR = [' ', #13, #10];
  
  procedure TForm1.SetTextFormat(SelStart, SelLength: Integer;
    Color: TColor; Style: TFontStyles);
  begin
    RichEditSQLConsulta.SelStart := SelStart;
    RichEditSQLConsulta.SelLength := SelLength;
    RichEditSQLConsulta.SelAttributes.Color := Color;
    RichEditSQLConsulta.SelAttributes.Style := Style;
  end;


procedure TForm1.RichEditSQLConsultaChange(Sender: TObject);
var
  TmpSelStart: Integer;
  P, SelStart, SelFinish, SelLength: Integer;
  WordIn: string;
  I: Integer;
begin
  TmpSelStart := RichEditSQLConsulta.SelStart;

  { Busco un caracter separador a partir de SelStart - Hacia atras) }
  SelStart := 0; //Valor por defecto, si SelStart es el inicio
  for I := RichEditSQLConsulta.SelStart downto 1 do
    if RichEditSQLConsulta.Text[i] in SQL_SEPARATOR_CHAR then
    begin // Si lo encuentro almaceno la posicion y termino el bucle
      SelStart := I;
      Break;
    end;

  { Busco un caracter separador a partir de SelStart - Hacia adelante}
  SelFinish := RichEditSQLConsulta.SelStart; //Valor por defecto, si SelStart es el final
  for I := RichEditSQLConsulta.SelStart + 1 to RichEditSQLConsulta.GetTextLen do
    if RichEditSQLConsulta.Text[i] in SQL_SEPARATOR_CHAR then
      Break // Si lo encuentro termino el bucle
    else
      SelFinish := I; // Sino almaceno la posicion

  { Longitud de la palabra encontrada }
  SelLength := SelFinish - (SelStart + 1) + 1; // (SelStart + 1) Es xq SelStart inicia de 0
  { Palabra encontrada }
  WordIn := Copy(RichEditSQLConsulta.Text, SelStart + 1, SelLength);
  { Compruebo si la palabra es reservada}
  P := Pos('|' + UpperCase(WordIn) + '|', SQL_RESERVED_WORDS);
  if 0 < P then
    SetTextFormat(SelStart, SelLength, clBlue, [fsBold]) // Cambio el formato
  else
    SetTextFormat(SelStart, SelLength, clWIndowText, []);

  RichEditSQLConsulta.SelStart := TmpSelStart;
end;

end.

Me olvidaba sobre controlar el portapapeles (esta ultima parte no la probe pero ahi ta como deberia de implementarse)

Código Delphi [-]

...

  private
    procedure WMDrawClipboard (var message : TMessage); message WM_DRAWCLIPBOARD;
    procedure WMChangeCBCHain (var message : TMessage); message WM_CHANGECBCHAIN;

...


var
  Form1: TForm1;

  hClipboardViewer : THandle;

...

  procedure TForm1.WMDrawClipboard (var message : TMessage);
  begin
    message.Result := SendMessage(WM_DRAWCLIPBOARD, hClipboardViewer, 0, 0);
    {Esto se ejecutará cuando haya un cambio en el contenido del portapapeles}
    if Clipboard.HasFormat(CF_TEXT) then
    begin
      { Solo quedaria dale el formato a Clipboard.AsText y despues insertarlo 
        en la posicion SelStart del RichEditSQLConsulta, teniendo cuidado a la hora 
        de la insercion }
    end;
  end;

  procedure TForm1.WMChangeCBCHain (var message : TMessage);
  begin
    if message.wParam = Integer(hClipboardViewer) then
    begin
      hClipboardViewer := message.lParam;
      message.Result := 0;
    end else
    begin
      message.Result := SendMessage(hClipboardViewer, WM_CHANGECBCHAIN,
        message.wParam, message.lParam);
    end;
  end;

[Neftali [Germán.Estévez]]

Te paso una rutinilla que encontré por internet hace tiempo, que aplica un estilo a un richedit cuando el texto ya está.
A ver si te es útil.

Código Delphi [-]
// Resaltar Sintaxis
procedure TFormSQL._ChangeSintaxis(Form:TForm; vStyle:String;
                                     RichE:TRichedit; InVisible:Boolean=True);
const
  // symbols...
  CodeC1: array[0..20] of String = ('#','$','(',')','*',',',
          '.','/',':',';','[',']','{','}','<','>',
          '-','=','+','''','@');
//  // reserved words...
//  CodeC2: array[0..44] of String = ('and','as','begin',
//          'case','char','class','const','downto',
//          'else','end','except','finally','for',
//          'forward','function','if','implementation','interface',
//          'is','nil','or','private','procedure','public','raise',
//          'repeat','string','to','try','type','unit','uses','var',
//          'while','external','stdcall','do','until','array','of',
//          'in','shr','shl','cos','div');

  // reserved words...  SQL
  CodeC2: array[0..209] of String = (
    'ACTION','ADD','ALL', 'ALTER', 'AND', 'ANY', 'AS', 'ASC', 'AUTHORIZATION', 'AVG',
    'BACKUP', 'BEGIN', 'BETWEEN', 'BREAK', 'BROWSE', 'BULK', 'BY',
    'CASCADE', 'CASE', 'CHECK', 'CHECKPOINT', 'CLOSE', 'CLUSTERED', 'COALESCE',
    'COLLATE', 'COLUMN', 'COMMIT', 'COMMITTED', 'COMPUTE', 'CONFIRM', 'CONSTRAINT', 'CONTAINS', 'CONTAINSTABLE', 'CONTINUE', 'CONTROLROW', 'CONVERT', 'COUNT',
    'CREATE', 'CROSS', 'CURRENT', 'CURRENT_DATE', 'CURRENT_TIME', 'CURRENT_TIMESTAMP', 'CURRENT_USER', 'CURSOR',
    'DATABASE', 'DBCC', 'DEALLOCATE', 'DECLARE', 'DEFAULT', 'DELETE', 'DENY', 'DESC', 'DISABLE', 'DISK', 'DISTINCT', 'DISTRIBUTED', 'DOUBLE', 'DROP', 'DUMMY', 'DUMP',
    'ELSE', 'ENABLE', 'END', 'ERRLVL', 'ERROREXIT', 'ESCAPE', 'EXCEPT', 'EXEC', 'EXECUTE', 'EXISTS', 'EXIT',
    'FETCH', 'FILE', 'FILLFACTOR', 'FLOPPY', 'FOR', 'FOREIGN', 'FORWARD_ONLY', 'FREETEXT', 'FREETEXTTABLE', 'FROM', 'FULL', 'FUNCTION',
    'GO', 'GOTO', 'GRANT', 'GROUP',
    'HAVING', 'HOLDLOCK',
    'IDENTITY', 'IDENTITY_INSERT', 'IDENTITYCOL', 'IF', 'IN', 'INDEX', 'INNER', 'INSERT', 'INTERSECT', 'INTO', 'IS', 'ISOLATION',
    'JOIN',
    'KEY', 'KILL',
    'LEFT', 'LEVEL', 'LIKE', 'LINENO', 'LOAD',
    'MIRROREXIT', 'MOVE',
    'NATIONAL', 'NO', 'NOCHECK', 'NONCLUSTERED', 'NOT', 'NOUNLOAD', 'NULL', 'NULLIF',
    'OF', 'OFF', 'OFFSETS', 'ON', 'ONCE', 'ONLY', 'OPEN', 'OPENDATASOURCE', 'OPENQUERY', 'OPENROWSET', 'OPTION', 'OR', 'ORDER', 'OUTER', 'OVER',
    'PERCENT', 'PERM', 'PERMANENT', 'PIPE', 'PLAN', 'PRECISION', 'PREPARE', 'PRIMARY', 'PRINT', 'PRIVILEGES', 'PROC', 'PROCEDURE', 'PROCESSEXIT', 'PUBLIC',
    'RAISERROR', 'READ', 'READTEXT', 'READ_ONLY', 'RECONFIGURE', 'RECOVERY', 'REFERENCES', 'REPEATABLE', 'REPLICATION', 'RESTORE', 'RESTRICT', 'RETURN', 'RETURNS', 'REVOKE', 'RIGHT', 'ROLLBACK', 'ROWCOUNT', 'ROWGUIDCOL', 'RULE',
    'SAVE', 'SCHEMA', 'SELECT', 'SERIALIZABLE', 'SESSION_USER', 'SET', 'SETUSER', 'SHUTDOWN', 'SOME', 'STATISTICS', 'STATS', 'SYSTEM_USER',
    'TABLE', 'TAPE', 'TEMP', 'TEMPORARY', 'TEXTSIZE', 'THEN', 'TO', 'TOP', 'TRAN', 'TRANSACTION', 'TRIGGER', 'TRUNCATE', 'TSEQUAL',
    'UNCOMMITTED', 'UNION', 'UNIQUE', 'UPDATE', 'UPDATETEXT', 'USE', 'USER',
    'VALUES', 'VARYING', 'VIEW',
    'WAITFOR', 'WHEN', 'WHERE', 'WHILE', 'WITH', 'WORK', 'WRITETEXT');

var
  FoundAt : LongInt;
  StartPos, ToEnd, i : integer;
  OldCap,T : String;
  FontC, BackC, C1, C2 ,C3 ,strC, strC1 : TColor;
begin
  OldCap := Form.Caption;
  Self.FStyle := vStyle;
  with RichE do
  begin
//    Font.Name := 'Courier New';
//    Font.Size := 10;
    Font.Name := RichE.Font.Name;
    Font.Size := RichE.Font.Size;

    if InVisible then
    begin
      Visible := False;
      Form.Caption := 'Executing Code Coloring...';
    end;

    if WordWrap then WordWrap := false;
    SelectAll;
    SelAttributes.color := clBlack;
    SelAttributes.Style := [];
    SelStart := 0;

  end;

  BackC := clWhite; FontC := clBlack;
  C1 := clBlack; C2 := clBlack; C3 := clBlack;
  strC := clBlue; strC1 := clSilver;

  if vStyle = 'Twilight' then
  begin
    BackC := clBlack; FontC := clWhite;
    C1 := clLime; C2 := clSilver; C3 := clAqua;
    strC := clYellow; strC1 := clRed;
  end
  else
  if vStyle = 'Default' then
  begin
    BackC := clWhite; FontC := clBlack;
    C1 := clTeal; C2 := clMaroon; C3 := clBlue;
    strC := clMaroon; strC1 := clSilver;
  end
  else
  if vStyle = 'Ocean' then
  begin
    BackC := $00FFFF80; FontC := clBlack;
    C1 := clMaroon; C2 := clBlack; C3 := clBlue;
    strC := clTeal; strC1 := clBlack;
  end
  else
  if vStyle = 'Classic' then
  begin
    BackC := clNavy; FontC := clYellow;
    C1 := clLime; C2 := clSilver; C3 := clWhite;
    strC := clAqua; strC1 := clSilver;
  end
  else
  begin
    with RichE do
    begin
      T := '{'+vStyle+' = Invalid Style [Default,Classic,Twilight,Ocean] ONLY! }';
      Lines.Insert(0,T);
      StartPos := 0;
      ToEnd := Length(Text) - StartPos;
      FoundAt := FindText(T, StartPos, ToEnd, [stWholeWord]);
      SelStart := FoundAt;
      SelLength := Length(T);
      SelAttributes.Color := clRed;
      SelAttributes.Style := [fsBold];
      StartPos := 0;
      ToEnd := Length(Text) - StartPos;
      FoundAt := FindText('ONLY!', StartPos, ToEnd, [stWholeWord]);
      SelStart := FoundAt;
      SelLength := 4;
      SelAttributes.Color := clRed;
      SelAttributes.Style := [fsBold,fsUnderLine];
    end;
  end;

  RichE.SelectAll;
  RichE.color := BackC;
  RichE.SelAttributes.color := FontC;

  for i := 0 to 100 do
  begin
    with RichE do
    begin
      StartPos := 0;
      ToEnd := Length(Text) - StartPos;
      FoundAt := FindText(IntToStr(i), StartPos, ToEnd, [stWholeWord]);
      while (FoundAt <> -1) do
      begin
        SelStart := FoundAt;
        SelLength := Length(IntToStr(i));
        SelAttributes.Color := C1;
        SelAttributes.Style := [];
        StartPos := FoundAt + Length(IntToStr(i));
        FoundAt := FindText(IntToStr(i), StartPos, ToEnd, [stWholeWord]);
      end;
    end;
  end;
  for i := 0 to {20}(Length(CodeC1) - 1) do
  begin
    with RichE do
    begin
      StartPos := 0;
      ToEnd := Length(Text) - StartPos;
      FoundAt := FindText(CodeC1[i], StartPos, ToEnd, []);
      while (FoundAt <> -1) do
      begin
        SelStart := FoundAt;
        SelLength := Length(CodeC1[i]);
        SelAttributes.Color := C2;
        StartPos := FoundAt + Length(CodeC1[i]);
        FoundAt := FindText(CodeC1[i], StartPos, ToEnd, []);
      end;
    end;
  end;
  for i := 0 to {44}(Length(CodeC2) - 1) do
  begin
    with RichE do
    begin
      StartPos := 0;
      ToEnd := Length(Text) - StartPos;
      FoundAt := FindText(CodeC2[i], StartPos, ToEnd, [stWholeWord]);
      while (FoundAt <> -1) do begin
        SelStart := FoundAt;
        SelLength := Length(CodeC2[i]);
        SelAttributes.Color := C3;
        SelAttributes.Style := [fsBold];
        StartPos := FoundAt + Length(CodeC2[i]);
        FoundAt := FindText(CodeC2[i], StartPos, ToEnd, [stWholeWord]);
      end;
    end;
  end;
  Startpos := 0;
  with RichE do
  begin
    FoundAt := FindText('''', StartPos, Length(Text), []);
    while FoundAt <> -1 do
    begin
      SelStart := FoundAt;
      Startpos := FoundAt+1;
      FoundAt := FindText('''', StartPos, Length(Text), []);
      if FoundAt <> -1 then
      begin
        SelLength := (FoundAt - selstart)+1;
        SelAttributes.Style := [];
        SelAttributes.Color := strC;
        StartPos := FoundAt+1;
        FoundAt := FindText('''', StartPos, Length(Text), []);
      end;
    end;
  end;

  Startpos := 0;
  with RichE do
  begin
    FoundAt := FindText('{', StartPos, Length(Text), []);
    while FoundAt <> -1 do
    begin
      SelStart := FoundAt;
      Startpos := FoundAt+1;
      FoundAt := FindText('}', StartPos, Length(Text), []);
      if FoundAt <> -1 then
      begin
        SelLength := (FoundAt - selstart)+1;
        SelAttributes.Style := [];
        SelAttributes.Color := strC1;
        StartPos := FoundAt+1;
        FoundAt := FindText('{', StartPos, Length(Text), []);
      end;
    end;
  end;

  if InVisible then
  begin
    RichE.Visible := True;
    Form.Caption := OldCap;
  end;

  RichE.SelStart := 0;
end;

Los estilos son:
// tipos ('Twilight', 'Default', 'Ocean', 'Classic')

Y para llamada puedes utilizar algo así:

Código Delphi [-]
  _ChangeSintaxis(FormSQL, 'Twilight', RichEdit1);