Club Delphi  
    Paypal   FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Varios
Registrarse FAQ Miembros Calendario Guía de estilo Buscar Temas de Hoy Marcar Foros Como Leídos

Coloboración Paypal con ClubDelphi

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 05-06-2007
Avatar de ariefez
ariefez ariefez is offline
Miembro
 
Registrado: sep 2005
Ubicación: Perú - Lima
Posts: 63
Poder: 21
ariefez Va por buen camino
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;

Última edición por ariefez fecha: 05-06-2007 a las 05:36:37.
Responder Con Cita
  #2  
Antiguo 05-06-2007
Avatar de Neftali [Germán.Estévez]
Neftali [Germán.Estévez] Neftali [Germán.Estévez] is offline
[becario]
 
Registrado: jul 2004
Ubicación: Barcelona - España
Posts: 19.449
Poder: 10
Neftali [Germán.Estévez] Es un diamante en brutoNeftali [Germán.Estévez] Es un diamante en brutoNeftali [Germán.Estévez] Es un diamante en bruto
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);
__________________
Germán Estévez => Web/Blog
Guía de estilo, Guía alternativa
Utiliza TAG's en tus mensajes.
Contactar con el Clubdelphi

P.D: Más tiempo dedicado a la pregunta=Mejores respuestas.
Responder Con Cita
Respuesta


Herramientas Buscar en Tema
Buscar en Tema:

Búsqueda Avanzada
Desplegado

Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
necesito ayuda para terminar un detalle vixente Conexión con bases de datos 0 01-06-2006 11:36:50
añadir texto a un RichEdit aranel OOP 1 12-11-2005 20:15:18
Guardar texto de un RichEdit aranel Varios 4 11-11-2005 18:36:49
Limitar texto en RichEdit dim OOP 1 15-09-2005 13:21:50
Editor Texto Richedit cesar_picazo Varios 1 27-04-2004 18:34:59


La franja horaria es GMT +2. Ahora son las 23:41:23.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2026, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi