syntaxhi.pas

TxQuery is an SQL engine implemented in a TDataSet descendant component, that can parse SQL syntax,

  If FChanging Or Not Assigned( FEditor ) Then
    Exit;
  // calculate font family
  ControlCanvas := TControlCanvas.Create;
  Try
    ControlCanvas.Control := FEditor;
    ControlCanvas.Font.Assign( FEditor.Font );
    GetTextMetrics( ControlCanvas.Handle, FontInfo );
  Finally
    ControlCanvas.Free;
  End;

  {Get the font family}
  FFontFamily := 'swiss';
  Case ( FontInfo.tmPitchAndFamily And $F0 ) Of
    FF_DECORATIVE: FFontFamily := 'decor';
    FF_DONTCARE: FFontFamily := 'swiss'; // actually 'nil'
    FF_MODERN: FFontFamily := 'modern';
    FF_ROMAN: FFontFamily := 'roman';

    FF_SCRIPT: FFontFamily := 'script';
    FF_SWISS: FFontFamily := 'swiss';
  End;

  Execute;

End;

Procedure TSyntaxHighlighter.MyOnExit( Sender: TObject );
Begin
  If Not Assigned( FEditor ) Then
    Exit;
  If ( FUpdateMode = umLine ) And FInternalModified Then
  Begin
    Execute;
  End;
  If Assigned( FSaveOnExit ) Then
    FSaveOnExit( FEditor );
End;

// TColorConfig - class implementation

Constructor TColorConfig.Create;
Var
  ColorElement: PColorElement;
  i: Integer;
Begin
  Inherited Create;
  FColorSettings := TList.Create;
  // default values

  New( ColorElement );
  With ColorElement^ Do
  Begin
    Elements := TList.Create;
    Elements.Add( Pointer( _IDENTIFIER ) );
    Group := idIdentifier;
    ForeColor := clBlue;
    BackColor := clWhite;
    FontStyle := [];
  End;
  FColorSettings.Add( ColorElement );

  New( ColorElement );
  With ColorElement^ Do
  Begin
    Elements := TList.Create;
    Elements.Add( Pointer( _TABLE ) );
    Group := idTable;
    ForeColor := clFuchsia;
    BackColor := clWhite;
    FontStyle := [];
  End;
  FColorSettings.Add( ColorElement );

  New( ColorElement );
  With ColorElement^ Do
  Begin
    Elements := TList.Create;
    Elements.Add( Pointer( _FIELD ) );
    Group := idField;
    ForeColor := clTeal;
    BackColor := clWhite;
    FontStyle := [];
  End;
  FColorSettings.Add( ColorElement );

  New( ColorElement );
  With ColorElement^ Do
  Begin
    Elements := TList.Create;
    Elements.Add( Pointer( _SINTEGER ) );
    Elements.Add( Pointer( _UINTEGER ) );
    Elements.Add( Pointer( _NUMERIC ) );
    Group := idNumber;
    ForeColor := clFuchsia;
    BackColor := clWhite;
    FontStyle := [];
  End;
  FColorSettings.Add( ColorElement );

  New( ColorElement );
  With ColorElement^ Do
  Begin
    Elements := TList.Create;
    Elements.Add( Pointer( _STRING ) );
    Group := idString;
    ForeColor := clPurple;
    BackColor := clWhite;
    FontStyle := [];
  End;
  FColorSettings.Add( ColorElement );

  New( ColorElement );
  With ColorElement^ Do
  Begin
    Elements := TList.Create;
    Elements.Add( Pointer( _COMA ) );
    Group := idComma;
    ForeColor := clRed;
    BackColor := clWhite;
    FontStyle := [fsBold];
  End;
  FColorSettings.Add( ColorElement );

  New( ColorElement );
  With ColorElement^ Do
  Begin
    Elements := TList.Create;
    Elements.Add( Pointer( _LPAREN ) );
    Elements.Add( Pointer( _RPAREN ) );
    Group := idParenthesis;
    ForeColor := clRed;
    BackColor := clWhite;
    FontStyle := [];
  End;
  FColorSettings.Add( ColorElement );

  New( ColorElement );
  With ColorElement^ Do
  Begin
    Elements := TList.Create;
    With Elements Do
    Begin
      Add( Pointer( _GT ) );
      Add( Pointer( _LT ) );
      Add( Pointer( _EQ ) );
      Add( Pointer( _MULT ) );
      Add( Pointer( _PLUS ) );
      Add( Pointer( _SUB ) );
      Add( Pointer( _DIV ) );
      Add( Pointer( _NEQ ) );
      Add( Pointer( _GE ) );
      Add( Pointer( _LE ) );
    End;
    Group := idOperator;
    ForeColor := clRed;
    BackColor := clWhite;
    FontStyle := [];
  End;
  FColorSettings.Add( ColorElement );

  New( ColorElement );
  With ColorElement^ Do
  Begin
    Elements := TList.Create;
    Elements.Add( Pointer( _PERIOD ) );
    Group := idPeriod;
    ForeColor := clRed;
    BackColor := clWhite;
    FontStyle := [];
  End;
  FColorSettings.Add( ColorElement );

  New( ColorElement );
  With ColorElement^ Do
  Begin
    Elements := TList.Create;
    Elements.Add( Pointer( _SEMICOLON ) );
    Elements.Add( Pointer( _COLON ) );
    Group := idSemicolon;
    ForeColor := clFuchsia;
    BackColor := clWhite;
    FontStyle := [fsBold];
  End;
  FColorSettings.Add( ColorElement );

  New( ColorElement );
  With ColorElement^ Do
  Begin
    Elements := TList.Create;
    Elements.Add( Pointer( _COMMENT ) );
    Group := idComment;
    ForeColor := clGray;
    BackColor := clWhite;
    FontStyle := [fsItalic];
  End;
  FColorSettings.Add( ColorElement );

  New( ColorElement );
  With ColorElement^ Do
  Begin
    Elements := TList.Create;
    Elements.Add( Pointer( _BLANK ) );
    Elements.Add( Pointer( _TAB ) );
    Elements.Add( Pointer( _NEWLINE ) );
    Group := idWhiteSpace;
    ForeColor := clWhite;
    BackColor := clWhite;
    FontStyle := [];
  End;
  FColorSettings.Add( ColorElement );

  New( ColorElement );
  With ColorElement^ Do
  Begin
    Elements := TList.Create;
    For i := Low( rwords ) To High( rwords ) Do
      Elements.Add( Pointer( rwords[i].token ) );
    Group := idReservedWord;
    ForeColor := clGreen;
    BackColor := clBlack;
    FontStyle := [];
  End;
  FColorSettings.Add( ColorElement );

  FColorTable := TList.Create;

End;

Destructor TColorConfig.Destroy;
Begin
  Clear;
  FColorSettings.Free;
  FColorTable.Free;
  Inherited Destroy;
End;

// color table used in creating an Rtf file

Procedure TColorConfig.CreateColorTable;
Var
  I, Index: Integer;
Begin
  FColorTable.Clear;
  For I := 0 To FColorSettings.Count - 1 Do
  Begin
    With PColorElement( FColorSettings[I] )^ Do
    Begin
      Index := FColorTable.IndexOf( Pointer( ForeColor ) );
      If Index = -1 Then
        FColorTable.Add( Pointer( ForeColor ) );
      Index := FColorTable.IndexOf( Pointer( BackColor ) );
      If Index = -1 Then
        FColorTable.Add( Pointer( BackColor ) );
    End;
  End;
End;

Function TColorConfig.IndexOfColor( Color: TColor ): Integer;
Begin
  Result := FColorTable.IndexOf( Pointer( Color ) );
End;

Procedure TColorConfig.Clear;
Var
  I: Integer;
  ColorElement: PColorElement;
Begin
  For I := 0 To FColorSettings.Count - 1 Do
  Begin
    ColorElement := PColorElement( FColorSettings[I] );
    ColorElement^.Elements.Free;
    Dispose( ColorElement );
  End;
  FColorSettings.Clear;
End;

Procedure TColorConfig.SaveToFile( Const FileName: String );
Var
  Stream: TStream;
  i, j, n, ne, e: Integer;
  ColorElement: PColorElement;
Begin
  Stream := TFileStream.Create( FileName, fmCreate );
  Try
    n := FColorSettings.Count;
    Stream.Write( n, sizeof( n ) );
    For I := 0 To n - 1 Do
    Begin
      ColorElement := PColorElement( FColorSettings[I] );
      Stream.Write( ColorElement^, SizeOf( TColorElement ) );
      ne := ColorElement^.Elements.Count;
      Stream.Write( ne, sizeof( ne ) );
      For j := 0 To ne - 1 Do
      Begin
        e := LongInt( ColorElement^.Elements[j] );
        Stream.Write( e, SizeOf( e ) );
      End;
    End;
  Finally
    Stream.Free;
  End;
End;

Procedure TColorConfig.LoadFromFile( Const FileName: String );
Var
  Stream: TStream;
  i, j, n, ne, e: Integer;
  ColorElement: PColorElement;
Begin
  If Not FileExists( FileName ) Then
    Exit;
  Clear;
  Stream := TFileStream.Create( FileName, fmOpenRead Or fmShareDenyNone );
  Try
    Stream.Read( n, sizeof( n ) );
    For I := 0 To n - 1 Do
    Begin
      New( ColorElement );
      Stream.Read( ColorElement^, SizeOf( TColorElement ) );
      ColorElement^.Elements := TList.Create;
      Stream.Read( ne, sizeof( ne ) );
      For j := 0 To ne - 1 Do
      Begin
        Stream.Read( e, SizeOf( e ) );
        ColorElement^.Elements.Add( Pointer( e ) );
      End;
      FColorSettings.Add( ColorElement );
    End;
  Finally
    Stream.Free;
  End;
End;

Procedure TColorConfig.SetColorElement( Group: TElementGroup; ForeColor, BackColor: TColor;
  FontStyle: TFontStyles );
Var
  i: Integer;
  ColorElement: PColorElement;
Begin
  For i := 0 To FColorSettings.Count - 1 Do
  Begin
    ColorElement := PColorElement( FColorSettings[i] );
    If ColorElement^.Group = Group Then
    Begin
      ColorElement^.ForeColor := ForeColor;
      ColorElement^.BackColor := BackColor;
      ColorElement^.FontStyle := FontStyle;
      Break;
    End;
  End;
End;

Function TColorConfig.FindConfig( Element: Integer; Var ForeColor, BackColor: TColor;
  Var FontStyle: TFontStyles ): Boolean;
Var
  i, j: Integer;
  ColorElement: PColorElement;
Begin
  Result := False;
  For i := 0 To FColorSettings.Count - 1 Do
  Begin
    ColorElement := PColorElement( FColorSettings[i] );
    For j := 0 To ColorElement^.Elements.Count - 1 Do
      If Longint( ColorElement^.Elements[j] ) = Element Then
      Begin
        ForeColor := ColorElement^.ForeColor;
        BackColor := ColorElement^.BackColor;
        FontStyle := ColorElement^.FontStyle;
        Result := True;
        Exit;
      End;
  End;
End;

{$IFNDEF BCB}

Procedure TColorConfig.EditColorSettings;
Begin
  With TfrmColorSettings.Create( Application ) Do
  Begin
    Try
      Enter( Self );
    Finally
      Free;
    End;
  End;
End;
{$ENDIF}

Function TColorConfig.Get( Index: Integer ): TColorElement;
Begin
  If ( Index < 0 ) Or ( Index > FColorSettings.Count - 1 ) Then
    Exit;
  Result := PColorElement( FColorSettings[Index] )^;
End;

Procedure TColorConfig.Put( Index: Integer; Const Value: TColorElement );
Begin
  If ( Index < 0 ) Or ( Index > FColorSettings.Count - 1 ) Then
    Exit;
  PColorElement( FColorSettings[Index] )^ := Value;
End;

Function TColorConfig.Count: Integer;
Begin
  Result := FColorSettings.Count;
End;

Procedure TColorConfig.Assign( Value: TColorConfig );
Var
  ColorElement: PColorElement;
  i, j: Integer;
  TmpList: TList;
Begin
  Clear;
  For i := 0 To Value.FColorSettings.Count - 1 Do
  Begin
    New( ColorElement );
    ColorElement^ := PColorElement( Value.FColorSettings[I] )^;
    TmpList := ColorElement^.Elements;
    ColorElement^.Elements := TList.Create;
    For j := 0 To TmpList.Count - 1 Do
      ColorElement^.Elements.Add( TmpList[j] );
    FColorSettings.Add( ColorElement );
  End;
End;

Function TColorConfig.IndexOfGroup( Group: TElementGroup ): Integer;
Var
  I: Integer;
Begin
  Result := -1;
  For I := 0 To FColorSettings.Count - 1 Do
    If PColorElement( FColorSettings[I] )^.Group = Group Then
    Begin
      Result := I;
      Exit;
    End;
End;

End.