sourcegrid.pas

DelphiDoc is a program for automatic generation of documentation on a Delphi-Project. At the momen

{  JADD - Just Another DelphiDoc: Documentation from Delphi Source Code

Copyright (C) 2005-2008   Gerold Veith

This file is part of JADD - Just Another DelphiDoc.

DelphiDoc is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License version 3 as
published by the Free Software Foundation.

DelphiDoc is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.
}


unit SourceGrid;

{Contains a component to show the pascal code of a parsed file with syntax
 highlighting. It's only a worse alternative replacement for
 ~[linkClass PascalMemo.TPascalMemo], but that only works under Win32, so it is
 thought for Kylix. }

interface

{$IFNDEF LINUX}
//!ERROR!
//This file was created to be compiled and used with Kylix under Linux(/Unix)!
//    At least mainly as an alternative for TPascalMemo, that only works
//    under Win32, ... so that would be the only reason to use this one.
{$ENDIF}

uses Windows, Classes,
{$IFNDEF LINUX}
     Forms, Controls, Grids, Messages,
{$ELSE}
     QForms, QControls, QGrids,
{$ENDIF}
     UBaseIdents;


type

   { * * *  ***  * * *  ***   TSourceGrid   ***  * * *  ***  * * *  }


  {The component to show pascal code of a parsed file with syntax highlighting.
   It's only a worse alternative replacement for
   ~[linkClass PascalMemo.TPascalMemo], but that only works under Win32, so
   this is thought for Kylix. }
  TSourceGrid = class(TCustomGrid)
  private
    //the file, whose content should be shown
    FTheFile: TPascalFile;
    //width of one/each character
    FCharWidth: Integer;

    //Sets the file whose content should be shown.
    procedure SetTheFile(Value: TPascalFile);
    //Sets the position of the caret (selected line).
    procedure SetCaretPos(Value: TPoint);

{$IFNDEF LINUX}
    //Updates the internal data about the font when it is changed.
    procedure CMFontChanged(var Msg: TMessage); message CM_FONTCHANGED;
{$ENDIF}
  protected
{$IFDEF LINUX}
    //Updates the internal data about the font when it is changed.
    procedure FontChanged; override;
{$ENDIF}

    //Draws the text of each line (cell) with syntax highlighting.
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
                       AState: TGridDrawState); override;
  public
    //Creates the component and initializes it.
    constructor Create(AOwner: TComponent); override;




    property TheFile: TPascalFile read FTheFile write SetTheFile;

    //Sets the current selected line. It only exists to make the class more
    //similar to ~[linkClass PascalMemo.TPascalMemo].
    property CaretPos: TPoint write SetCaretPos;

    property Font default nil;
  published
  end;


implementation

uses SysUtils, Math,
{$IFNDEF LINUX}
     StdCtrls, Graphics,
{$ELSE}
     QStdCtrls, QGraphics,
{$ENDIF}
     SourceFormat;




   { * * *  ***  * * *  ***   TSourceGrid   ***  * * *  ***  * * *  }



{Creates the component and initializes it.
~param AOwner the owner of the component }
constructor TSourceGrid.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);                 //create the component

 if AOwner is TWinControl then             //need a parent to access the canvas
  Parent := TWinControl(AOwner);

// DefaultDrawing := False;
 ScrollBars := ssBoth;                     //want to scroll
 Options := [goDrawFocusSelected, goThumbTracking]; //show selection, scroll
 BorderStyle := bsNone;                    //no border

{$IFNDEF LINUX}
 Font.Name := 'Courier New';               //the font of the Delphi editor
 Font.Size := 10;
 DefaultRowHeight := abs(Font.Height) + 4;
{$ELSE}
 Font.Name := 'Terminal';                  //the font of the Kylix editor
 Font.Height := 14;
 DefaultRowHeight := Font.Height + 3;
{$ENDIF}

 ColCount := 1;                            //one column is a whole line
 RowCount := 0;                            //no content so far
 Canvas.Font := Font;                      //use the font
 FCharWidth := Canvas.TextWidth('W');      //get size of characters
 DefaultColWidth := 1024 * FCharWidth;
end;





{Sets the file whose content should be shown.
~param Value the file whose content should be shown}
procedure TSourceGrid.SetTheFile(Value: TPascalFile);
begin
 FTheFile := Value;                        //save the file

 if assigned(Value) then                   //set available number of lines
  RowCount := Value.Lines.Count
 else
  RowCount := 0;
end;


{Sets the position of the caret (selected line).
~param Value the new position of the caret (selected line) }
procedure TSourceGrid.SetCaretPos(Value: TPoint);
begin
 if Value.y < 0 then                       //make sure it's valid
  Value.y := 0
 else
  if Value.y >= RowCount then
   Value.y := RowCount - 1;
 MoveColRow(0, Value.y, True, True);       //select line and make it visible
end;


{$IFNDEF LINUX}

{Updates the internal data about the font when it is changed.
~param Msg the notification tat the font has been changed }
procedure TSourceGrid.CMFontChanged(var Msg: TMessage);

{$ELSE}

{Updates the internal data about the font when it is changed. }
procedure TSourceGrid.FontChanged;

{$ENDIF}
begin
 inherited;                                //handle the changing of the font
 Canvas.Font := Font;                      //use the font
 FCharWidth := Canvas.TextWidth('W');      //get size of characters
 DefaultColWidth := 1024 * FCharWidth;
end;






{Draws the text of each line (cell) with syntax highlighting.
~param ACol   always 0
~param ARow   the line to draw
~param ARect  position where to draw the line
~param AState state of the cell (mainly, if it is selected) }
procedure TSourceGrid.DrawCell(ACol, ARow: Longint; ARect: TRect;
                               AState: TGridDrawState);
var       Line       :String;          //the text of the line to draw
          Start      :Integer;         //first character of the line to draw
          SEnd       :Integer;         //last character of the line to draw
          State      :TTextState;      //state of each part of the text
          TextPart   :String;          //each part of the text
begin
 if assigned(FTheFile) then                  //has content to display?
  begin
   assert(ARect.Right - ARect.Left = 1024 * FCharWidth);
   Line := FTheFile.Lines[ARow];               //get the text to write
   Start := 1;                                 //assume write the whole line
   SEnd := Length(Line) + 1;
   if ARect.Left <= -FCharWidth then           //horizontally scrolled?
    begin
     dec(Start, ARect.Left div FCharWidth);      //get first visible character
     inc(ARect.Left, (Start - 1) * FCharWidth);
    end;
   if Start < SEnd then                        //some characters to write?
    begin
     if ARect.Right > ClientWidth then           //don't write not visible text
      ARect.Right := ClientWidth;
     SEnd := Min(SEnd,                           //get last visible character
                 (ARect.Right - ARect.Left + FCharWidth - 1) div FCharWidth +
                 Start);
     if Start < SEnd then                        //some characters to write?
      begin
       //get state at the beginning of the visible text
       State := SkipString(copy(Line, 1, Start - 1),
                           FTheFile.LineStartComment[ARow]);
       Line := copy(Line, Start, SEnd - Start);    //the visible text
       while Line <> '' do                         //write the whole text
        begin
         TextPart := GetTextOfOneState(Line, State);  //get a part of the text
         DrawTextInState(Canvas, ARect.Left, ARect.Top, //and write it
                         TextPart, State, gdSelected in AState);
         inc(ARect.Left, Canvas.TextWidth(TextPart)); //resume writing after it

         State := tsNormal;                           //resume at normal state
        end; //while Line <> ''
      end; //if Start < SEnd
    end; //if Start < SEnd
  end; //if assigned(FTheFile)
end;



end.