{*******************************************************}
{               RichEdit Syntax HighLight               }
{                     version 3.2                       }
{ Author:                                               }
{ Serhiy Perevoznyk                                     }
{ serge_perevoznyk@hotmail.com                          }
{                                                       }
{ Anderson Rodrigues Barbieri                           }
{                                                       }
{*******************************************************}
unit RichEditHighlight;

Interface

uses
 Windows,
 SysUtils,
 Messages,
 Classes,
 Controls,
 RichEdit,
 psvCPlusPlus,
 psvDFM,
 psvHTMLRTF,
 psvJScript,
 psvPas,
 psvPHPScript,
 psvRichSyntax,
 psvSQL,
 psvVB,
 psvVBScript,
 psvXML,
 comCtrls,
 graphics;

type

 TSyntaxType = (stCPlusPlus, stDFM, stJScript, stSQL, stVB, stVBScript, stXML, stDelphi);

 TpsvTokenType =
 (
   ttAsm,
   ttComment,
   ttIdentifier,
   ttKey,
   ttNull,
   ttNumber,
   ttSpace,
   ttString,
   ttSymbol,
   ttUnknown,
   ttDirective,
   ttChar,
   ttHex,
   ttOctal,
   ttFloat,
   ttInvalidSymbol,
   ttVariable,
   ttElement,
   ttAttribute,
   ttText,
   ttCDATA,
   ttEntityRef,
   ttProcessingInstruction,
   ttQuoteAttrValue,
   ttAposAttrValue,
   ttQuoteEntityRef,
   ttAposEntityRef,
   ttEqual,
   ttnsAttribute,
   ttnsQuoteAttrValue,
   ttnsAposAttrValue,
   ttnsQuoteEntityRef,
   ttnsAposEntityRef,
   ttnsEqual);

 TpsvTokenTypes = set of TpsvTokenType;

 TRichEditSyntax = class(TCustomRichEdit)
 private
   FLoading : boolean;
   FSyntax : TpsvRTFSyntax;
   FUseDefaultColors : boolean;
   FAsmColor,
   FCommentColor,
   FIdentifierColor,
   FKeyColor,
   FNullColor,
   FNumberColor,
   FSpaceColor,
   FStringColor,
   FSymbolColor,
   FUnknownColor,
   FDirectiveColor,
   FCharColor,
   FHexColor,
   FOctalColor,
   FFloatColor,
   FInvalidSymbolColor,
   FVariableColor,
   FElementColor,
   FAttributeColor,
   FTextColor,
   FCDATAColor,
   FEntityRefColor,
   FProcessingInstructionColor,
   FQuoteAttrValueColor,
   FAposAttrValueColor,
   FQuoteEntityRefColor,
   FAposEntityRefColor,
   FEqualColor,
   FnsAttributeColor,
   FnsQuoteAttrValueColor,
   FnsAposAttrValueColor,
   FnsQuoteEntityRefColor,
   FnsAposEntityRefColor,
   FnsEqualColor : TColor;
   FSyntaxType : TSyntaxType;
   procedure SetSyntaxType(AValue : TSyntaxType);
   procedure SetUseDefaultColors(const Value: boolean);
   procedure CreateColorTable;
 protected
   procedure Change; override;
 public
   constructor Create(AOwner : TComponent); override;
   destructor Destroy; override;
   function   GetTokenSet(ALanguage : TSyntaxType) : TpsvTokenTypes;
   procedure  LoadFromStream(AStream : TStream);
   procedure  LoadFromStreamToSelection(AStream: TStream);
   procedure  SaveToStream(AStream : TStream);
   procedure  LoadFromFile(AFileName : string);
   procedure  SaveToFile(AFileName : string);
   function   SelectLine(Index: Integer): boolean;
   procedure  UpdateSyntax; virtual;
   procedure  UpdateLineSyntax; virtual;
 published
   property SyntaxType : TSyntaxType read FSyntaxType write SetSyntaxType default stDelphi;
   property AsmColor : TColor read FasmColor write FAsmColor;
   property CommentColor : TColor read FCommentColor write FCommentColor;
   property IdentifierColor : TColor read FIdentifierColor write FIdentifierColor;
   property KeyColor    : TColor read FKeyColor write FKeyColor;
   property NullColor   : TColor read FNullColor write FNullColor;
   property NumberColor : TColor read FNumberColor write FNumberColor;
   property SpaceColor  : TColor read FSpaceColor write FSpaceColor;
   property StringColor : TColor read FStringColor write FStringColor;
   property SymbolColor : TColor read FSymbolColor write FSymbolColor;
   property UnknownColor: TColor read FUnknownColor write FUnknownColor;
   property DirectiveColor : TColor read FDirectiveColor write FDirectiveColor;
   property CharColor : TColor read FCharColor write FCharColor;
   property HexColor : TColor read FHexColor write FHexColor;
   property OctalColor : TColor read FOctalColor write foctalColor;
   property FloatColor : TColor read FFloatColor write FFloatColor;
   property InvalidSymbolColor : TColor read FInvalidSymbolColor write FInvalidSymbolColor;
   property VariableColor : TColor read FVariableColor write FVariableColor;
   property ElementColor : TColor read FElementColor write FElementColor;
   property AttributeColor : TColor read FAttributeColor write FAttributeColor;
   property TextColor : TColor read FTextColor write FTextColor;
   property CDATAColor : TColor read FCDATAColor write FCDATAColor;
   property EntityRefColor : TColor read FEntityRefColor write fEntityrefColor;
   property ProcessingInstructionColor : TColor read FProcessingInstructionColor write FProcessingInstructionColor;
   property QuoteAttrValueColor : TColor read FQuoteAttrValueColor write FQuoteAttrValueColor;
   property AposAttrValueColor : TColor read FAposAttrValueColor write FAposAttrValueColor;
   property QuoteEntityRefColor : TColor read FQuoteEntityRefColor write FQuoteEntityRefColor;
   property AposEntityRefColor : TColor read FAposEntityRefColor write FAposEntityRefColor;
   property EqualColor : TColor read FEqualColor write FEqualColor;
   property nsAttributeColor : TColor read FnsAttributeColor write FnsAttributeColor;
   property nsQuoteAttrValueColor : TColor read FnsQuoteAttrValueColor write FnsQuoteAttrValueColor;
   property nsAposAttrValueColor : TColor read FnsAposAttrValueColor write FnsAposAttrValueColor;
   property nsQuoteEntityRefColor  : TColor read FnsQuoteEntityRefColor write FnsQuoteEntityRefColor;
   property nsAposEntityRefColor : TColor read FnsAposEntityRefColor write FnsAposEntityRefColor;
   property nsEqualColor : TColor read FnsEqualColor write FnsEqualColor;
   property UseDefaultColors : boolean read FUseDefaultColors write SetUseDefaultColors default true;
   property Align;
   property Alignment;
   property Anchors;
   property BiDiMode;
   property BorderStyle;
   property BorderWidth;
   property Color;
   property Ctl3D;
   property DragCursor;
   property DragKind;
   property DragMode;
   property Enabled;
   property HideScrollBars;
   property ImeMode;
   property ImeName;
   property Constraints;
   property Lines;
   property MaxLength;
   property ParentBiDiMode;
   property ParentColor;
   property ParentCtl3D;
   property ParentShowHint;
   property PopupMenu;
   property ReadOnly;
   property ScrollBars;
   property ShowHint;
   property TabOrder;
   property TabStop default True;
   property Visible;
   property WantTabs;
   property WantReturns;
   property OnChange;
   property OnContextPopup;
   property OnDragDrop;
   property OnDragOver;
   property OnEndDock;
   property OnEndDrag;
   property OnEnter;
   property OnExit;
   property OnKeyDown;
   property OnKeyPress;
   property OnKeyUp;
   property OnMouseDown;
   property OnMouseMove;
   property OnMouseUp;
   property OnMouseWheel;
   property OnMouseWheelDown;
   property OnMouseWheelUp;
   property OnProtectChange;
   property OnResizeRequest;
   property OnSaveClipboard;
   property OnSelectionChange;
   property OnStartDock;
   property OnStartDrag;
 end;

procedure Register;

Implementation

procedure Register;
begin
  RegisterComponents('Additional', [TRichEditSyntax]);
end;


function doStreamIn(dwCookie: Longint; pbBuff: PByte;
                    cb: Longint; var pcb: Longint): Longint; stdcall;
begin
  pcb := 0;
  try
    pcb := TStream(dwCookie).Read(pbBuff^, cb);
    Result := 0;
  except
    Result := 1;
  end;
end;


{ TRichEditSyntax }

constructor TRichEditSyntax.Create(AOwner: TComponent);
begin
  inherited;
  ControlStyle:= ControlStyle + [csOpaque];
  FLoading := False;
  FSyntaxType := stDelphi;
  FSyntax := TpsvPasRTF.Create;
  FAsmColor := clGreen;
  FCommentColor := clBlue;
  FIdentifierColor := clBlack;
  FKeyColor := clNavy;
  FNullColor := clBlack;
  FNumberColor := clBlack;
  FSpaceColor := clNavy;
  FStringColor := clBlack;
  FSymbolColor := clBlack;
  FUnknownColor := clBlack;
  FDirectiveColor := clBlack;
  FCharColor := clBlack;
  FHexColor := clBlack;
  FOctalColor := clBlack;
  FFloatColor := clBlack;
  FInvalidSymbolColor :=  clRed;
  FElementColor := clGreen;
  FAttributeColor := clMaroon;
  FTextColor := clBlack;
  FCDATAColor := clBlue;
  FEntityRefColor := clBlack;
  FProcessingInstructionColor := clGreen;
  FQuoteAttrValueColor := clBlue;
  FAposAttrValueColor := clBlack;
  FQuoteEntityRefColor := clRed;
  FAposEntityRefColor := clBlack;
  FEqualColor := clBlack;
  FnsAttributeColor := clGreen;
  FnsQuoteAttrValueColor := clMaroon;
  FnsAposAttrValueColor := clBlack;
  FnsQuoteEntityRefColor := clBlack;
  FnsAposEntityRefColor := clGreen;
  FnsEqualColor := clGreen;
  PlainText := true;
end;

procedure TRichEditSyntax.CreateColorTable;
begin
  case FSyntaxType of
    stCPlusPlus :
      begin
        FSyntax.CreateColorTable([
          FAsmColor,
          FCommentColor,
          FDirectiveColor,
          FIdentifierColor,
          FKeyColor,
          FNumberColor,
          FFloatColor,
          FHexColor,
          FOctalColor,
          FSpaceColor,
          FStringColor,
          FCharColor,
          FSymbolColor,
          FUnknownColor,
          clBlack]);
      end;
    stDFM :
      begin
        FSyntax.CreateColorTable([
          FCommentColor,
          FIdentifierColor,
          FKeyColor,
          FNumberColor,
          FSpaceColor,
          FStringColor,
          FSymbolColor,
          FUnknownColor]);
     end;
    stJScript :
      begin
        FSyntax.CreateColorTable([
        FCommentColor,
        FIdentifierColor,
        FKeyColor,
        FNumberColor,
        FSpaceColor,
        FStringColor,
        FSymbolColor,
        FUnknownColor]);
      end;
    stSQL :
      begin
        FSyntax.CreateColorTable([
        FCommentColor,
        FIdentifierColor,
        FKeyColor,
        FNumberColor,
        FSymbolColor,
        FStringColor,
        FUnknownColor,
        clBlack]);
      end;
    stVB :
      begin
        FSyntax.CreateColorTable([
          FCommentColor,
          FIdentifierColor,
          FKeyColor,
          FNumberColor,
          FSpaceColor,
          FStringColor,
          FSymbolColor,
          FUnknownColor]);
      end;
    stVBScript :
      begin
        FSyntax.CreateColorTable([
          FCommentColor,
          FIdentifierColor,
          FKeyColor,
          FNumberColor,