object Form1: TForm1
  Left = 241
  Top = 115
  BorderIcons = [biSystemMenu, biMinimize]
  BorderStyle = bsSingle
  Caption = 'Highlight with TMemo Impossible?  try this...'
  ClientHeight = 494
  ClientWidth = 682
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnClose = FormClose
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 649
    Top = 308
    Width = 24
    Height = 13
    Alignment = taRightJustify
    Caption = '(0,0)'
  end
  object Label2: TLabel
    Left = 276
    Top = 308
    Width = 89
    Height = 13
    Caption = 'Type F1 to update'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = 221
    Font.Height = -11
    Font.Name = 'Tahoma'
    Font.Style = []
    ParentFont = False
  end
  object Label3: TLabel
    Left = 10
    Top = 308
    Width = 80
    Height = 13
    Caption = 'Pascal Keywords'
  end
  object Label4: TLabel
    Left = 208
    Top = 356
    Width = 343
    Height = 26
    Caption =
      'This is a sample how to work with highlighting within TMemo comp' +
      'onent by using interjected class technique.'
    WordWrap = True
  end
  object Label5: TLabel
    Left = 208
    Top = 386
    Width = 357
    Height = 26
    Caption =
      'Of course, this code is still uncompleted but it works fine for ' +
      'my purposes, so, hope you can improve it and use it.'
    WordWrap = True
  end
  object Label6: TLabel
    Left = 388
    Top = 470
    Width = 285
    Height = 13
    Caption = 'The greater the difficulty, the greater the glory.  -- Cicero '
    Font.Charset = DEFAULT_CHARSET
    Font.Color = 13369344
    Font.Height = -11
    Font.Name = 'Tahoma'
    Font.Style = []
    ParentFont = False
  end
  object Label7: TLabel
    Left = 208
    Top = 420
    Width = 153
    Height = 13
    Caption = 'Gon Perez-Jimenez May'#39'04'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clBlack
    Font.Height = -11
    Font.Name = 'Tahoma'
    Font.Style = [fsBold]
    ParentFont = False
  end
  object Memo1: TMemo
    Left = 10
    Top = 4
    Width = 663
    Height = 300
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'Courier New'
    Font.Style = []
    Lines.Strings = (
     
        '// -------------------------------------------------------------' +
        '---------------'
      '// Windows utilities'
     
        '// -------------------------------------------------------------' +
        '---------------'
      ''
      'unit drzWinUtils;'
      ''
      'interface'
      ''
      'uses'
      '  Windows, SysUtils;'
      ''
      'type'
     
        '  TWindowsPlatform = (wpUnknown, wpWin32s, wp95, wp98, wpME, wpN' +
        'T, wp2K, wpXP,'
      '    wpDotNet);'
      '  '
     
        '  TWindowsProductType = (ptUnknown, ptWorkStation, ptHome, ptPro' +
        'fessional,'
     
        '    ptServer, ptAdvancedServer, ptEnterpriseServer, ptDataCenter' +
        'Server,'
     
        '    ptWebServer, ptSmallBusinessServer, ptSmallBusinessServerRes' +
        'tricted);'
      ''
      '  TWindowsExtraInfo = (eiBackOffice, eiDomainController,'
      '    eiTerminalServices);'
      '  TWindowsExtraInfos = set of TWindowsExtraInfo;'
      ''
      '  TWindowsVersion = record'
      '    PlatformID: TWindowsPlatform;'
      '    ProductType: TWindowsProductType;'
      '    MajorVersion: Integer;'
      '    MinorVersion: Integer;'
      '    Build: Integer;'
      '    ServicePack: String;'
      '    ServicePackMinorVersion: Integer;'
      '    ServicePackMajorVersion: Integer;'
      '    ExtraInfo: TWindowsExtraInfos;'
      '  end;'
      ''
      'function WindowsVersion: TWindowsVersion;'
      ''
      'type'
      '  POSVersionInfoExA = ^TOSVersionInfoExA;'
      '  POSVersionInfoEx = POSVersionInfoExA;'
      '  _OSVERSIONINFOEXA = record'
      '    dwOSVersionInfoSize: DWORD;'
      '    dwMajorVersion: DWORD;'
      '    dwMinorVersion: DWORD;'
      '    dwBuildNumber: DWORD;'
      '    dwPlatformId: DWORD;'
     
        '    szCSDVersion: array[0..127] of AnsiChar; { Maintenance strin' +
        'g for PSS usage }'
      '    wServicePackMajor: WORD;'
      '    wServicePackMinor: WORD;'
      '    wSuiteMask: WORD;'
      '    wProductType: Byte;'
      '    wReserved: Byte;'
      '  end;'
      '  {$EXTERNALSYM _OSVERSIONINFOEXA}'
      '  _OSVERSIONINFOEXW = record'
      '    dwOSVersionInfoSize: DWORD;'
      '    dwMajorVersion: DWORD;'
      '    dwMinorVersion: DWORD;'
      '    dwBuildNumber: DWORD;'
      '    dwPlatformId: DWORD;'
     
        '    szCSDVersion: array[0..127] of WideChar; { Maintenance strin' +
        'g for PSS usage }'
      '    wServicePackMajor: WORD;'
      '    wServicePackMinor: WORD;'
      '    wSuiteMask: WORD;'
      '    wProductType: Byte;'
      '    wReserved: Byte;'
      '  end;'
      '  {$EXTERNALSYM _OSVERSIONINFOEXW}'
      '  _OSVERSIONINFOEX = _OSVERSIONINFOEXA;'
      '  TOSVersionInfoExA = _OSVERSIONINFOEXA;'
      '  TOSVersionInfoExW = _OSVERSIONINFOEXW;'
      '  TOSVersionInfoEx = TOSVersionInfoExA;'
      '  OSVERSIONINFOEXA = _OSVERSIONINFOEXA;'
      '  {$EXTERNALSYM OSVERSIONINFOEXA}'
      '  {$EXTERNALSYM OSVERSIONINFOEX}'
      '  OSVERSIONINFOEXW = _OSVERSIONINFOEXW;'
      '  {$EXTERNALSYM OSVERSIONINFOEXW}'
      '  {$EXTERNALSYM OSVERSIONINFOEX}'
      '  OSVERSIONINFOEX = OSVERSIONINFOEXA;'
      ''
     
        'function GetVersionEx(var lpVersionInformation: TOSVersionInfoEx' +
        '): BOOL; stdcall;'
      '{$EXTERNALSYM GetVersionEx}'
     
        'function GetVersionExA(var lpVersionInformation: TOSVersionInfoE' +
        'x): BOOL; stdcall;'
      '{$EXTERNALSYM GetVersionExA}'
     
        'function GetVersionExW(var lpVersionInformation: TOSVersionInfoE' +
        'x): BOOL; stdcall;'
      '{$EXTERNALSYM GetVersionExW}'
      ''
      'const'
      '  { wProductType consts }'
      '  VER_NT_WORKSTATION = $0000001;'
      '  {$EXTERNALSYM VER_NT_WORKSTATION}'
      '  VER_NT_DOMAIN_CONTROLLER = $0000002;'
      '  {$EXTERNALSYM VER_NT_DOMAIN_CONTROLLER}'
      '  VER_NT_SERVER = $0000003;'
      '  {$EXTERNALSYM VER_NT_SERVER}'
      ''
      '  { wSuiteMask consts }'
      '  VER_SUITE_SMALLBUSINESS = $00000001;'
      '  {$EXTERNALSYM VER_SUITE_SMALLBUSINESS}'
      '  VER_SUITE_ENTERPRISE = $00000002;'
      '  {$EXTERNALSYM VER_SUITE_ENTERPRISE}'
      '  VER_SUITE_BACKOFFICE = $00000004;'
      '  {$EXTERNALSYM VER_SUITE_BACKOFFICE}'
      '  VER_SUITE_TERMINAL = $00000010;'
      '  {$EXTERNALSYM VER_SUITE_TERMINAL}'
      '  VER_SUITE_SMALLBUSINESS_RESTRICTED = $00000020;'
      '  {$EXTERNALSYM VER_SUITE_SMALLBUSINESS_RESTRICTED}'
      '  VER_SUITE_DATACENTER = $00000080;'
      '  {$EXTERNALSYM VER_SUITE_DATACENTER}'
      '  VER_SUITE_PERSONAL = $00000200;'
      '  {$EXTERNALSYM VER_SUITE_PERSONAL}'
      '  VER_SUITE_BLADE = $00000400;'
      '  {$EXTERNALSYM VER_SUITE_BLADE}'
      ''
      'implementation'
      ''
     
        'function GetVersionEx; external '#39'kernel32.dll'#39' name '#39'GetVersionE' +
        'xA'#39';'
     
        'function GetVersionExA; external '#39'kernel32.dll'#39' name '#39'GetVersion' +
        'ExA'#39';'
     
        'function GetVersionExW; external '#39'kernel32.dll'#39' name '#39'GetVersion' +
        'ExW'#39';'
      ''
      'function WindowsVersion: TWindowsVersion;'
      ''
      '  function GetProductTypeFromReg: String;'
      '  var'
      '    lHKEY: HKEY;'
      '    sPT: String;'
      '    dwBufLen: Integer;'
      '  begin'
      '    RegOpenKeyEx(HKEY_LOCAL_MACHINE,'
     
        '      '#39'SYSTEM\CurrentControlSet\Control\ProductOptions'#39', 0, KEY_' +
        'QUERY_VALUE,'
      '      lHKEY);'
     
        '    RegQueryValueEx(lHKEY, '#39'ProductType'#39', nil, nil, Pointer(sPT)' +
        ', @dwBufLen);'
      '    RegCloseKey(lHKEY);'
      '    SetLength(sPT, dwBufLen);'
      '    Result := sPT;'
      '  end;'
      ''
      'var'
      '  OSV: TOSVersionInfoEx;'
      '  bInfoEx: Boolean;'
      '  S: String;'
      'begin'
     
        '  { try calling GetVersionEx with new TOSVersionInfoEx structure' +
        '. If it'
      '    fails, use TOSVersionInfo. }'
      '  OSV.dwOSVersionInfoSize := SizeOf(TOSVersionInfoEx);'
      ''
      '  bInfoEx := GetVersionEx(OSV);'
      '  if not bInfoEx then'
      '  begin'
      '    OSV.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);'
      '    if not GetVersionEx(OSV) then Exit;'
      '  end;'
      ''
      '  case OSV.dwPlatformId of  '
      '    VER_PLATFORM_WIN32_NT:'
      '      begin'
     
        '        { If this is an NT version of Windows then it must be ei' +
        'ther WinNT,'
      '          Win2000, WinXP or one of the .NET servers. }'
      ''
      '        if OSV.dwMajorVersion <= 4 then'
      '          Result.PlatformID := wpNT;'
     
        '        if (OSV.dwMajorVersion = 5) and (OSV.dwMinorVersion = 0)' +
        ' then'
      '          Result.PlatformID := wp2K;'
      ''
      '        { Get the product type }'
      '        if bInfoEx then'
      '        begin'
      '          case OSV.wProductType of'
      '            VER_NT_WORKSTATION:'
      '              begin'
     
        '                if (OSV.dwMajorVersion = 5) and (OSV.dwMinorVers' +
        'ion = 1) then'
      '                  Result.PlatformID := wpXP;'
      ''
     
        '                if (OSV.wSuiteMask and VER_SUITE_PERSONAL) <> 0 ' +
        'then'
      '                begin'
      '                  case Result.PlatformID of'
      '                    wpXP: Result.ProductType := ptHome;'
      '                  else'
      '                    Result.ProductType := ptUnknown;'
      '                  end;'
      '                end else begin'
      '                  case Result.PlatformID of'
      '                    wpNT: Result.ProductType := ptWorkStation;'
     
        '                    wp2K, wpXP: Result.ProductType := ptProfessi' +
        'onal;'
      '                  else'
      '                    Result.ProductType := ptUnknown;'
      '                  end;'
      '                end;'
      '              end;'
      '            VER_NT_SERVER, VER_NT_DOMAIN_CONTROLLER:'
      '              begin'
     
        '                if (OSV.dwMajorVersion = 5) and (OSV.dwMinorVers' +
        'ion = 2) then'
      '                  Result.PlatformID := wpDotNet;'
      ''
     
        '                if (OSV.wSuiteMask and VER_SUITE_SMALLBUSINESS) ' +
        '<> 0 then'
      '                begin'
      '                  Result.ProductType := ptSmallBusinessServer;'
      '                end else begin'
     
        '                  if (OSV.wSuiteMask and VER_SUITE_SMALLBUSINESS' +
        '_RESTRICTED) <> 0 then'
      '                  begin'
     
        '                    Result.ProductType := ptSmallBusinessServerR' +
        'estricted;'
      '                  end else begin'
     
        '                    if (OSV.wSuiteMask and VER_SUITE_DATACENTER)' +
        ' <> 0 then'
      '                    begin'
      '                      Result.ProductType := ptDataCenterServer'
      '                    end else begin'
     
        '                      if (OSV.wSuiteMask and VER_SUITE_ENTERPRIS' +
        'E) <> 0 then'
      '                      begin'
      '                        case Result.PlatformID of'
     
        '                          wpDotNet: Result.ProductType := ptEnte' +
        'rpriseServer;'
      '                        else'
     
        '                          Result.ProductType := ptAdvancedServer' +
        ';'
      '                        end;'
      '                      end else begin'
     
        '                        if (OSV.wSuiteMask = VER_SUITE_BLADE) th' +
        'en'
      '                          Result.ProductType := ptWebServer'
      '                        else'
      '                          Result.ProductType := ptServer;'
      '                      end;'
      '                    end;'
      '                  end;'
      '                end;'
      ''
      ''
     
        '                if OSV.wProductType = VER_NT_DOMAIN_CONTROLLER t' +
        'hen'
      '                  Include(Result.ExtraInfo, eiDomainController);'
      '              end;'
      '          else'
      '            Result.ProductType := ptUnknown;'
      '          end;'
      '        end else begin'
      '          S := GetProductTypeFromReg;'
      '          if SameText(S, '#39'WINNT'#39') then'
      '            Result.ProductType := ptWorkStation;'
      '          if SameText(S, '#39'LANMANNT'#39') then'
      '            Result.ProductType := ptServer;'
      '          if SameText(S, '#39'SERVERNT'#39') then'
      '            Result.ProductType := ptAdvancedServer;'
      '        end;'
      '      end;'
      '    VER_PLATFORM_WIN32_WINDOWS:'
      '      begin'
     
        '        if (OSV.dwMajorVersion = 4) and (OSV.dwMinorVersion = 0)' +
        ' then'
      '        begin'
      '          Result.PlatformID := wp95;'
     
        '          if (OSV.szCSDVersion[1] = '#39'B'#39') or (OSV.szCSDVersion[1]' +
        ' = '#39'C'#39') then'
      '            Result.ServicePack := '#39'OSR2'#39';'
      '        end;'
      ''
     
        '        if (OSV.dwMajorVersion = 4) and (OSV.dwMinorVersion = 10' +
        ') then'
      '        begin'
      '          Result.PlatformID := wp98;'
     
        '          if (OSV.szCSDVersion[1] = '#39'A'#39') then Result.ServicePack' +
        ' := '#39'SE'#39';'
      '        end;'
      ''
     
        '        if (OSV.dwMajorVersion = 4) and (OSV.dwMinorVersion = 90' +
        ') then'
      '          Result.PlatformID := wpME;'
      '      end;'
      '    VER_PLATFORM_WIN32s: Result.PlatformID := wpWin32s;'
      '  end;'
      ''
      '  { Get major version, minor version, build number'
      '    and service pack if any. }'
      ''
      '  Result.MajorVersion := OSV.dwMajorVersion;'
      '  Result.MinorVersion := OSV.dwMinorVersion;'
      '  Result.ServicePack  := OSV.szCSDVersion;'
      '  Result.Build        := OSV.dwBuildNumber;'
      ''
      '  if bInfoEx then'
      '  begin'
      '    Result.ServicePackMajorVersion := OSV.wServicePackMajor;'
      '    Result.ServicePackMinorVersion := OSV.wServicePackMajor;'
      '    if (OSV.wSuiteMask and VER_SUITE_BACKOFFICE) <> 0 then'
      '      Include(Result.ExtraInfo, eiBackOffice);'
      '    if (OSV.wSuiteMask and VER_SUITE_TERMINAL) <> 0 then'
      '      Include(Result.ExtraInfo, eiTerminalServices);'
      '  end;'
      'end;'
      ''
      'end.')
    ParentFont = False
    ScrollBars = ssVertical
    TabOrder = 0
    OnKeyUp = Memo1KeyUp
  end
  object KeywordList: TListBox
    Left = 10
    Top = 322
    Width = 165
    Height = 161
    ItemHeight = 13
    Items.Strings = (
      'and'
      'array'
      'as'
      'asm'
      'begin'
      'case'
      'class'
      'const'
      'constructor'
      'destructor'
      'dispinterface'
      'div'
      'do'
      'downto'
      'else'
      'end'
      'except'
      'exports'
      'file'
      'finalization'
      'finally'
      'for'
      'function'
      'goto'
      'if'
      'implementation'
      'in'
      'inherited'
      'initialization'
      'inline'
      'interface'
      'is'
      'label'
      'library'
      'mod'
      'nil'
      'not'
      'object'
      'of'
      'or'
      'out'
      'overload'
      'override'
      'packed'
      'private'
      'procedure'
      'program'
      'property'
      'protected'
      'public'
      'raise'
      'record'
      'reintroduce'
      'repeat'
      'resourcestring'
      'set'
      'shl'
      'shr'
      'string'
      'then'
      'threadvar'
      'to'
      'try'
      'type'
      'unit'
      'until'
      'uses'
      'var'
      'while'
      'with'
      'xor')
    TabOrder = 1
  end
end

(**
  *  Highlight with TMemo Impossible?  try this...
  *                                                by Gon Perez-Jimenez May'04
  *
  *  This is a sample how to work with highlighting within TMemo component by
  *  using interjected class technique.
  *
  *  Of course, this code is still uncompleted but it works fine for my
  *  purposes, so, hope you can improve it and use it.
  *
  *)

unit Unit1;

interface

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

type
                // Interjected Class
    TMemo = class(stdctrls.TMemo)
    private
      procedure WMPaint(var Message: TWMPaint);    message WM_PAINT;
      procedure WMSize(var Message: TWMSize);      message WM_SIZE;
      procedure WMMove(var Message: TWMMove);      message WM_MOVE;
      procedure WMVScroll(var Message: TWMMove);    message WM_VSCROLL;
      procedure WMMousewheel(var Message: TWMMove); message WM_MOUSEWHEEL;
    protected
      procedure Change; override;
      procedure KeyDown(var Key: Word; Shift: TShiftState); override;
      procedure KeyUp(var Key: Word; Shift: TShiftState); override;
      procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
      procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    public
      PosLabel : TLabel;
      procedure Update_label;
      procedure GotoXY (mCol,mLine: Integer );
      function  Line : Integer;
      function  Col : Integer;
      function  TopLine : Integer;
      function  VisibleLines: Integer;
    end;


  TForm1 = class(TForm)
    Memo1: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    KeywordList: TListBox;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Memo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

// functions for managing keywords and numbers of each line of TMemo ///////////

function IsSeparator(Car:char):Boolean;
begin
Case Car of
'.', ';', ',', ':', '?', '!', '·', '"', '''', '^', '+', '-', '*', '/', '\', '?',' ',
'`', '[', ']', '(', ')', '?', '?', '{', '}', '?', '?', '%','=': result := true;
else
    result := false;
end;
end;

function NextWord ( var s: String; var PrevWord: String ): String;
begin
result := '';
PrevWord := '';
if s='' then Exit;
while(s<>'')and IsSeparator(s[1]) do begin
    PrevWord := PrevWord + s[1];
    delete(s,1,1);
end;
while(s<>'')and not IsSeparator(s[1]) do begin
    result := result+s[1];
    delete(s,1,1);
end;
end;

function IsKeyWord ( s: String ):Boolean;
begin
result := False;
if s='' then Exit;
result := Form1.KeywordList.Items.IndexOf( lowercase(s) ) <> -1;
end;

function IsNumber ( s: String ):Boolean;
var i: Integer;
begin
result := False;
for i:=1 to length(s) do
    Case s[i] of
    '0'..'9':;
    else Exit;
    end;
result := True;
end;

// New or overrided methods and properties for TMemo using Interjected Class ///
// Technique ///////////////////////////////////////////////////////////////////

function TMemo.VisibleLines: Integer;
begin
result := Height div ( Abs(Self.Font.Height)+2);
end;

procedure TMemo.GotoXY ( mCol,mLine: Integer );
begin
Dec(mLine);
SelStart:=0;
SelLength:=0;
SelStart := mCol+Self.Perform(EM_LINEINDEX, mLine, 0);
SelLength:=0;
SetFocus;
end;

procedure TMemo.Update_label;
begin
if PosLabel=nil then Exit;
PosLabel.Caption := '('+IntToStr(Line+1)+','+IntToStr(Col)+')';
end;

function TMemo.TopLine : Integer;
begin
Result := SendMessage(Self.Handle, EM_GETFIRSTVISIBLELINE, 0, 0);
end;

function TMemo.Line : Integer;
begin
  Result := SendMessage(Self.Handle, EM_LINEFROMCHAR, Self.SelStart, 0);
end;

function TMemo.Col : Integer;
begin
  Result := Self.SelStart - SendMessage(Self.Handle, EM_LINEINDEX, SendMessage(Self.Handle,
    EM_LINEFROMCHAR, Self.SelStart, 0), 0);
end;

procedure TMemo.WMVScroll(var Message: TWMMove);
begin
Update_label;
Invalidate;
inherited;
end;

procedure TMemo.WMSize(var Message: TWMSize);
begin
Invalidate;
inherited;
end;

procedure TMemo.WMMove(var Message: TWMMove);
begin
Invalidate;
inherited;
end;

procedure TMemo.WMMousewheel(var Message: TWMMove);
begin
Invalidate;
inherited;
end;

procedure TMemo.Change;
begin
Update_label;
Invalidate;
inherited Change;
end;

procedure TMemo.KeyDown(var Key: Word; Shift: TShiftState);
begin
Update_label;
inherited KeyDown(Key,Shift);
end;

procedure TMemo.KeyUp(var Key: Word; Shift: TShiftState);
begin
Update_label;
inherited KeyUp(Key,Shift);
end;

procedure TMemo.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
Update_label;
inherited MouseDown(Button,Shift,X,Y);
end;

procedure TMemo.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
Update_label;
inherited MouseUp(Button,Shift,X,Y);
end;

procedure TMemo.WMPaint(var Message: TWMPaint);
var
  PS          :TPaintStruct;
  DC          :HDC;
  Canvas      :TCanvas;
  i            :Integer;
  X,Y          :Integer;
  OldColor    :TColor;
  Size        :TSize;
  Max          :Integer;
  s, Palabra,
  PrevWord    : String;
begin
  DC := Message.DC;
  if DC = 0 then DC := BeginPaint(Handle, PS);
  Canvas:=TCanvas.Create;
  try
    OldColor := Font.Color;
    Canvas.Handle:=DC;
    Canvas.Font.Name :=Font.Name;
    Canvas.Font.Size := Font.Size;
    with Canvas do begin
      Max := TopLine+VisibleLines;
      if Max>Pred(Lines.Count)then Max := Pred(Lines.Count);

      //Limpio la seccion visible
      Brush.Color := Self.Color;
      FillRect( Self.ClientRect );
      Y:=1;
      for i:=TopLine to Max do begin
        X := 2;
        s:=Lines[i];

        //Detecto todas las palabras de esta linea
        Palabra := NextWord(s, PrevWord);
        while Palabra<>'' do begin
          Font.Color:=OldColor;
          TextOut(X,Y, PrevWord);
          GetTextExtentPoint32(DC, PChar(PrevWord), Length(PrevWord), Size);
          Inc(X, Size.cx);

          Font.Color:=clBlack;
          if IsKeyWord(Palabra) then begin
            Font.Color:=clHighlight;
            TextOut(X,Y, Palabra);
            {
            //Draw dot underline
            Pen.Color := clHighlight;
            Pen.Style := psDot;
            PolyLine([ Point(X,Y+13), Point(X+TextWidth(Palabra),Y+13)]);
            }
          end else
          if IsNumber(Palabra) then begin
            Font.Color:=$000000DD;
            TextOut(X,Y, Palabra);
          end else
            TextOut(X,Y, Palabra);

          GetTextExtentPoint32(DC, PChar(Palabra), Length(Palabra), Size);
          inc(X, Size.cx);

          Palabra := NextWord(s, PrevWord);
          if(s='')and(PrevWord<>'')then begin
            Font.Color:=OldColor;
            TextOut(X,Y, PrevWord);
          end;
        end;
        if(s='')and(PrevWord<>'')then begin
          Font.Color:=OldColor;
          TextOut(X,Y, PrevWord);
        end;

        s:='W';
        GetTextExtentPoint32(DC, PChar(s), Length(s), Size);
        Inc(Y, Size.cy);
      end;
    end;
  finally
    if Message.DC = 0 then EndPaint(Handle, PS);
  end;
  Canvas.Free;
  inherited;
end;

// Procedures for Form1 ////////////////////////////////////////////////////////

procedure TForm1.FormCreate(Sender: TObject);
begin
Memo1.PosLabel := Label1;
Memo1.Update_label;
end;

procedure TForm1.Memo1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
if Key=VK_F1 then Memo1.Invalidate;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
end;

end.