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 :D se los agradecería enormemente =)
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 :D 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


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)



...

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.


// 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í:


_ChangeSintaxis(FormSQL, 'Twilight', RichEdit1);