delphisyntax-highlightinghl7edisynedit

Synedit syntax-highlighter for HL7 v2.x messages


I am looking at contributing to the Delphi SynEdit project with a syntax-highlighter for the Health Level 7 (HL7) v2 messaging Standard. I have no experience of creating a highlighter from scratch and there are two quirks that I have stumbled upon that differ from existing highlighters:

Is there anyone out there who has any SynEdit experice with HL7 or similar syntaxes e.g. Edifact, X12?

Prototype

I've created a crude prototype using the OnPaintTransient event-handler which in fact works better than I anticipated :-) Basically it does the following:

Below is a screen-dump of the results when inserting the example message found at Wikipedia http://en.wikipedia.org/wiki/Health_Level_7 into a TSynMemo component.

Screen-dump SynEdit HL7 syntax-highlighting

Code OnPaintTransient

procedure TFormMain.SynMemoMsgPaintTransient(Sender: TObject; Canvas: TCanvas;
  TransientType: TTransientType);
var
  i, j: Integer;

  DP: TDisplayCoord;
  SelStartCoord, SelEndCoord, BC : TBufferCoord;
  Pt: TPoint;

  FieldDelimiter : char;  // MSH|
  Delimiters : string;    // All message delimiters (including field delimiter)
  IsSelected : boolean;
begin
  //Avoid drawing twice - Only enter if TransientType = ttAfter.
  if TransientType = ttBefore then exit;

  //Exit if no text
  if SynMemoMsg.Lines.Count = 0 then exit;

  //Exit if message does not start with MSH (Message header segment)
  if not AnsiStartsText('MSH', SynMemoMsg.Lines[0]) then exit;

  //Get the message's delimiters specified as the characters directly after MSH
  FieldDelimiter := Copy(SynMemoMsg.Lines[0], 4, 1)[1];
  Delimiters :=  Copy(SynMemoMsg.Lines[0], 4, 5);

  //Find out if any text is selected by the user - we will exclude this text from highlighting
  SelStartCoord := SynMemoMsg.CharIndexToRowCol(SynMemoMsg.SelStart);
  SelEndCoord := SynMemoMsg.CharIndexToRowCol(SynMemoMsg.SelEnd);

  //parse evry visible line
  for i := SynMemoMsg.TopLine to ((SynMemoMsg.TopLine + SynMemoMsg.LinesInWindow )-1) do
  begin
    //Highlight Segment ID, i.e. in this implementation the first 3 chars in each line
    BC.Char := 1;
    BC.Line := i;

    //If whole line is selected then continue to next line without highlighting current
    if (SelStartCoord.Line < BC.Line) and (SelEndCoord.Line > BC.Line) then continue;

    DP := SynMemoMsg.BufferToDisplayPos(BC);
    Pt := SynMemoMsg.RowColumnToPixels(DP);

    if ((SelStartCoord.Line = BC.Line) and (SelStartCoord.Char > 3))
       or ((SelStartCoord.Line <> BC.Line) and (SelEndCoord.Line <> BC.Line))
       or (SynMemoMsg.SelLength = 0) then
    begin
      Canvas.Font.Color := clNavy;
      Canvas.Font.Style := [fsBold];
      Canvas.TextOut (Pt.X - 1, Pt.Y, Copy(SynMemoMsg.Lines[i - 1], 1, 3)); //Move the Bold text one pixel left to get space i.e. Pt.X - 1)
    end;

    //Highlight Delimiters - parse each charachter and check if delimiter and not selected
    for j := 4 to Length(SynMemoMsg.Lines[i - 1]) do
    begin
      if IsDelimiter(Delimiters, SynMemoMsg.Lines[i - 1], j) then
      begin
        BC.Char := j;
        BC.Line := i;

        //Don't highlight delimiter if selected
        if (SynMemoMsg.SelLength > 0) and ((SelStartCoord.Line = BC.Line)or (SelEndCoord.Line = BC.Line)) then
        begin

          if (SelStartCoord.Line = BC.Line) and (SelEndCoord.Line = BC.Line) then
            IsSelected := (SelStartCoord.Char <= BC.Char) and (SelEndCoord.Char > BC.Char)
          else if (SelStartCoord.Line = BC.Line) then
            IsSelected := SelStartCoord.Char <= BC.Char
          else if (SelEndCoord.Line = BC.Line) then
            IsSelected := SelEndCoord.Char > BC.Char;
        end
        else
          IsSelected := false;

        if not IsSelected then begin
          DP := SynMemoMsg.BufferToDisplayPos(BC);
          Pt := SynMemoMsg.RowColumnToPixels(DP);

          if FieldDelimiter = SynMemoMsg.Lines[i - 1][j] then
            Canvas.Font.Color := clGray
          else
            Canvas.Font.Color := clBlue;

          Canvas.TextOut (Pt.X, Pt.Y, Copy(SynMemoMsg.Lines[i - 1], j, 1));
        end;
      end;
    end;
  end;
end;

Solution

  • Well I ended up making my own SynEdit syntax-highlighter for HL7 v2.x messaging. It may not have all the bells and whistles but it’s a good start. My implementation uses Delphi XE3.

    Usage:

    1. Copy the SynHighlighterHL7.pas unit found below to your synedit project source folder.
    2. Add SynHighlighterHL7.pas to your project and to the Uses clause.
    3. Add a TSynEdit or TSynMemo component to a form
    4. Add the following code to the form's OnCreate event handler:

    Code:

    fSynHL7Syn := TSynHL7Syn.Create(Self);
    SynMemoMsg.Highlighter := fSynHL7Syn;
    

    SynHighlighterHL7.pas unit:

    unit SynHighlighterHL7;
    
    {$I SynEdit.inc}
    
    interface
    
    uses
        Classes,
        Graphics,
        StrUtils,
        SynEditTypes,
        SynEditHighlighter,
        SynUnicode;
    
    const
      DEF_FIELD_DELIM   = '|'; //Filed seperator
      DEF_COMP_DELIM    = '^'; //Component seperator
      DEF_SUBCOMP_DELIM = '&'; //Sub-component seperator
      DEF_ESC_DELIM     = '\'; //Escape seperator
      DEF_REP_DELIM     = '~'; //Repetition seperator
    
    type
      TtkTokenKind = (tkSegmentID, tkFieldDelim, tkCompDelim, tkSubCompDelim,
                      tkEscDelim, tkRepDelim, tkText, tkSpace, tkNull, tkUnknown);
    
      //Keeps track if we're in a message with properly defined delimiters
      TRangeState = (rsUnknown, rsMshDelim, rsDefDelim);
    
    type
      TSynHL7Syn = class(TSynCustomHighlighter)
      private
        fRange : TRangeState;
        fFieldDelim : char;
        fCompDelim : char;
        fSubCompDelim : char;
        fEscDelim : char;
        fRepDelim : char;
    
        FTokenID: TtkTokenKind;
    
        fSegmentIDAttri: TSynHighlighterAttributes;
        fFieldDelimAttri: TSynHighlighterAttributes;
        fCompDelimAttri: TSynHighlighterAttributes;
        fSubCompDelimAttri: TSynHighlighterAttributes;
        fEscDelimAttri: TSynHighlighterAttributes;
        fRepDelimAttri: TSynHighlighterAttributes;
        fUnknownAttri: TSynHighlighterAttributes;
        fSpaceAttri : TSynHighlighterAttributes;
        fTextAttri: TSynHighlighterAttributes;
        procedure SegmentIDProc;
        procedure UnknownProc;
    
        procedure CRProc;
        procedure TextProc;
        procedure LFProc;
        procedure NullProc;
        procedure SpaceProc;
        procedure FieldDelimProc;
        procedure CompDelimProc;
        procedure EscDelimProc;
        procedure RepDelimProc;
        procedure SubCompDelimProc;
        procedure SetRangeState(const Line: string);
      protected
        function GetSampleSource: UnicodeString; override;
        function IsFilterStored: Boolean; override;
      public
        function GetRange: Pointer; override;
        procedure ResetRange; override;
        procedure SetRange(Value: Pointer); override;
    
        class function GetLanguageName: string; override;
        class function GetFriendlyLanguageName: UnicodeString; override;
      public
        constructor Create(AOwner: TComponent); override;
        function GetDefaultAttribute(Index: integer): TSynHighlighterAttributes;
          override;
        function GetEol: Boolean; override;
        function GetTokenID: TtkTokenKind;
        function GetTokenAttribute: TSynHighlighterAttributes; override;
        function GetTokenKind: integer; override;
        procedure Next; override;
      published
        property SegmentIDAttri: TSynHighlighterAttributes read fSegmentIDAttri
          write fSegmentIDAttri;
        property TextAttri: TSynHighlighterAttributes read fTextAttri
          write fTextAttri;
    
      end;
    
    implementation
    
    uses
      SynEditStrConst;
    
    constructor TSynHL7Syn.Create(AOwner: TComponent);
    begin
      inherited Create(AOwner);
    
      fCaseSensitive := true;
    
      fSegmentIDAttri := TSynHighlighterAttributes.Create('Seg ID', 'Segment ID');
      fSegmentIDAttri.Style := [fsBold];
      fSegmentIDAttri.Foreground := clNavy;
      AddAttribute(fSegmentIDAttri);
    
    
      fFieldDelimAttri := TSynHighlighterAttributes.Create('Field Sep', 'Field Seperator (|)');
      fFieldDelimAttri.Foreground := clGray;
      AddAttribute(fFieldDelimAttri);
    
      fCompDelimAttri := TSynHighlighterAttributes.Create('Comp Sep', 'Component Seperator (^)');
      fCompDelimAttri.Foreground := clBlue;
      AddAttribute(fCompDelimAttri);
    
      fSubCompDelimAttri := TSynHighlighterAttributes.Create('Sub-Comp Sep', 'Sub-Component Seperator (&)');
      fSubCompDelimAttri.Foreground := clBlue;
      AddAttribute(fSubCompDelimAttri);
    
      fRepDelimAttri := TSynHighlighterAttributes.Create('Rep Sep', 'Repeat Seperator (&)');
      fRepDelimAttri.Foreground := clBlue;
      AddAttribute(fRepDelimAttri);
    
      fEscDelimAttri := TSynHighlighterAttributes.Create('Esc Sep', 'Escape Seperator (\)');
      fEscDelimAttri.Style := [fsBold];
      fEscDelimAttri.Foreground := clGreen;
      AddAttribute(fEscDelimAttri);
    
      fUnknownAttri := TSynHighlighterAttributes.Create('Unknown', 'Non HL7 message i.e arbitary text');
      fUnknownAttri.Style := [fsItalic];
      fUnknownAttri.Foreground := clRed;
      AddAttribute(fUnknownAttri);
    
      fTextAttri := TSynHighlighterAttributes.Create(SYNS_AttrText, SYNS_FriendlyAttrText);
      AddAttribute(fTextAttri);
    
      fSpaceAttri := TSynHighlighterAttributes.Create(SYNS_AttrSpace, SYNS_FriendlyAttrSpace);
      AddAttribute(fSpaceAttri);
      SetAttributesOnChange(DefHighlightChange);
    
      fDefaultFilter := SYNS_FilterINI;
    end; { Create }
    
    procedure TSynHL7Syn.FieldDelimProc;
    begin
      inc(Run);
      fTokenID := tkFieldDelim;
    end;
    
    procedure TSynHL7Syn.CompDelimProc;
    begin
      inc(Run);
      fTokenID := tkCompDelim;
    end;
    
    procedure TSynHL7Syn.SubCompDelimProc;
    begin
      inc(Run);
      fTokenID := tkSubCompDelim;
    end;
    
    procedure TSynHL7Syn.EscDelimProc;
    begin
      fTokenID := tkEscDelim;
    
      //If current position is not the first MSH field then expand token untill
      //closing Escape delimiter is found on current line
      if not((Run = 6) and StartsStr('MSH', fLine)) then begin
         inc(run);
         while (FLine[Run] <> fEscDelim) and (FLine[Run] <> #0) do
           inc(Run);
    
      end;
      if FLine[Run] <> #0 then
         inc(Run);
    
    end;
    
    procedure TSynHL7Syn.RepDelimProc;
    begin
      inc(Run);
      fTokenID := tkRepDelim;
    end;
    
    procedure TSynHL7Syn.SetRangeState(const Line : string);
      function IsValidSegmentIDChar(c : char): Boolean;
      begin
        case c of
          'A'..'Z', '0'..'9':
            Result := True;
          else
            Result := False;
        end;
      end;
    var SegID : string;
        OK : boolean;
        i : integer;
    begin
      //Decide if valid segment or arbitary text
      if AnsiStartsStr('MSH', Line) and (Length(Line) > 8) then begin
        fRange := rsMshDelim;
    
        fFieldDelim   := Line[4];
        fCompDelim    := Line[5];
        fRepDelim     := Line[6];
    
        //If no escape characters are used in a message, this character may be omitted.
        //However, it must be present if subcomponents are used in the message.
        if Line[7] <> fFieldDelim then
           fEscDelim     := Line[7]
        else
           fEscDelim := DEF_ESC_DELIM;
    
        //If there are no subcomponents in message then this seperator may not be present (use default then)
        if Line[8] <> fFieldDelim then
           fSubCompDelim     := Line[8]
        else
           fEscDelim := DEF_SUBCOMP_DELIM;
      end
      else begin
    
        SegID := Copy(FLine, run + 1, 3);
        OK := Length(SegID) = 3;
        for i := 1 to Length(SegID) do
            OK := OK and IsValidSegmentIDChar(SegID[i]);
    
        if OK then begin
           case fRange of
              rsUnknown : if (Copy(Line, 4, 1) = '|') then fRange := rsDefDelim;
              rsMshDelim : if (Copy(Line, 4, 1) <> fFieldDelim) then fRange := rsUnknown;
              rsDefDelim : if (Copy(Line, 4, 1) <> '|') then fRange := rsUnknown;
           end;
        end
        else
          fRange := rsUnknown;
      end;
    end;
    
    procedure TSynHL7Syn.ResetRange;
    begin
      fRange:= rsUnknown;
    end;
    
    procedure TSynHL7Syn.SegmentIDProc;
      function IsValidSegmentIDChar(c : char): Boolean;
      begin
        case c of
          'A'..'Z', '0'..'9':
            Result := True;
          else
            Result := False;
        end;
      end;
    
    var OK : boolean;
        SegID : String;
        i : integer;
    begin
      // if it is not column 0-2 mark as tkText and get out of here
      if Run > 0 then
      begin
        fTokenID := tkText;
        inc(Run);
        Exit;
      end;
    
      case fRange of
        rsMshDelim, rsDefDelim : begin
                                   fTokenID := tkSegmentID;
                                   Run := 3;
                                 end;
        rsUnknown : begin
                      fTokenID := tkUnknown;
                      Inc(Run);
                    end;
      end;
    end;
    
    procedure TSynHL7Syn.CRProc;
    begin
      fTokenID := tkSpace;
      case FLine[Run + 1] of
        #10: inc(Run, 2);
        else inc(Run);
      end;
    end;
    
    procedure TSynHL7Syn.TextProc;
    
      function IsTextChar: Boolean;
      begin
        case fLine[Run] of
          'a'..'z', 'A'..'Z', '0'..'9':
            Result := True;
          else
            Result := False;
        end;
      end;
    
    begin
      if Run = 0 then
        SegmentIDProc
      else
      begin
        fTokenID := tkText;
        inc(Run);
        while FLine[Run] <> #0 do
          if IsTextChar then
            inc(Run)
          else
            break;
      end;
    end;
    
    procedure TSynHL7Syn.UnknownProc;
    begin
      if Run = 0 then
        Self.SetRangeState(fLine);
    
      // this is column 0 ok it is a comment
      fTokenID := tkUnknown;
      inc(Run);
      while FLine[Run] <> #0 do
        case FLine[Run] of
          #10: break;
          #13: break;
          else inc(Run);
        end;
    end;
    
    procedure TSynHL7Syn.LFProc;
    begin
      fTokenID := tkSpace;
      inc(Run);
    end;
    
    
    procedure TSynHL7Syn.SetRange(Value: Pointer);
    begin
      fRange := TRangeState(Value);
    end;
    
    procedure TSynHL7Syn.SpaceProc;
    begin
      inc(Run);
      fTokenID := tkSpace;
      while (FLine[Run] <= #32) and not IsLineEnd(Run) do inc(Run);
    end;
    
    procedure TSynHL7Syn.Next;
    begin
      //Decide range state by checking first char in line
      fTokenPos := Run;
      if Run = 0 then SetRangeState(fLine);
    
      case fRange of
        rsUnknown :  case fLine[Run] of
                        #0: NullProc;
                        #10: LFProc;
                        #13: CRProc;
                     else
                        UnknownProc;
                     end;
    
        rsMshDelim : begin
                       if fLine[Run] = Self.fFieldDelim then
                          FieldDelimProc
                       else if fLine[Run] = Self.fCompDelim then
                          CompDelimProc
                       else if fLine[Run] = Self.fSubCompDelim then
                          SubCompDelimProc
                       else if fLine[Run] = Self.fEscDelim then
                          EscDelimProc
                       else if fLine[Run] = Self.fRepDelim then
                          RepDelimProc
                       else begin
    
                          case fLine[Run] of
                                          #0: NullProc;
                                          #10: LFProc;
                                          #13: CRProc;
                                          #1..#9, #11, #12, #14..#32: SpaceProc;
                                          else TextProc;
                                        end;
                        end
                      end;
        rsDefDelim : case fLine[Run] of
                            #0: NullProc;
                            #10: LFProc;
                            #13: CRProc;
                            #1..#9, #11, #12, #14..#32: SpaceProc;
                            DEF_FIELD_DELIM : FieldDelimProc;
                            DEF_COMP_DELIM : CompDelimProc;
                            DEF_SUBCOMP_DELIM : SubCompDelimProc;
                            DEF_ESC_DELIM : EscDelimProc;
                            DEF_REP_DELIM : RepDelimProc;
                            else TextProc;
                          end;
      end;
      inherited;
    end;
    
    procedure TSynHL7Syn.NullProc;
    begin
      fTokenID := tkNull;
      inc(Run);
    end;
    
    function TSynHL7Syn.GetDefaultAttribute(Index: integer): TSynHighlighterAttributes;
    begin
      case Index of
        SYN_ATTR_WHITESPACE: Result := fSpaceAttri;
      else
        Result := nil;
      end;
    end;
    
    function TSynHL7Syn.GetEol: Boolean;
    begin
      Result := Run = fLineLen + 1;
    end;
    
    function TSynHL7Syn.GetTokenID: TtkTokenKind;
    begin
      Result := fTokenId;
    end;
    
    function TSynHL7Syn.GetTokenAttribute: TSynHighlighterAttributes;
    begin
      case fTokenID of
        tkSegmentID: Result := fSegmentIDAttri;
        tkFieldDelim: Result := fFieldDelimAttri;
        tkCompDelim: Result := fCompDelimAttri;
        tkSubCompDelim: Result := fSubCompDelimAttri;
        tkRepDelim: Result := fRepDelimAttri;
        tkEscDelim: Result := fEscDelimAttri;
    
        tkText: Result := fTextAttri;
        tkSpace: Result := fSpaceAttri;
        tkUnknown: Result := fUnknownAttri;
        else Result := nil;
      end;
    end;
    
    function TSynHL7Syn.GetTokenKind: integer;
    begin
      Result := Ord(fTokenId);
    end;
    
    function TSynHL7Syn.IsFilterStored: Boolean;
    begin
      Result := fDefaultFilter <> SYNS_FilterINI;
    end;
    
    class function TSynHL7Syn.GetLanguageName: string;
    begin
      Result := SYNS_LangINI;
    end;
    
    function TSynHL7Syn.GetRange: Pointer;
    begin
      Result := Pointer(fRange);
    end;
    
    function TSynHL7Syn.GetSampleSource: UnicodeString;
    begin
      Result := 'MSH|^&\~|123|123'#13#10+
                'PID|123|1234'
    end;
    
    {$IFNDEF SYN_CPPB_1}
    class function TSynHL7Syn.GetFriendlyLanguageName: UnicodeString;
    begin
      Result := SYNS_FriendlyLangINI;
    end;
    
    initialization
      RegisterPlaceableHighlighter(TSynHL7Syn);
    {$ENDIF}
    end.