unit1.pas

罗小平<<delphi精要>>一书源码

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    Label1: TLabel;
    lbCharPos: TLabel;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure RichEdit1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure RichEdit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private     
    KeyWords: TStrings;
    procedure BoldKeyWords(KeyWord: String);
    procedure BlueString;
    procedure ItalicNoteText;
    procedure ShowLineAndCharPos;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  KeyWords := TStringList.Create;
  with KeyWords do
  begin
    Add('unit');
    Add('interface');
    Add('uses');
    Add('type');
    Add('function');
    Add('stdcall');
    Add('class');
    Add('procedure');
    Add('private');
    Add('public');
    Add('end');
    Add('end;');
    Add('end.');
    Add('var');
    Add('implementation');
    Add('begin');
    Add('initialization');
    Add('if');
    Add('then');
    Add('finalization');
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  KeyWords.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  C: Integer;
begin
  RichEdit1.Lines.LoadFromFile(ExtractFilePath(ParamStr(0))
    + 'Content.pas');
  for C := 0 to KeyWords.Count-1 do
    BoldKeyWords(KeyWords[C]);

  ItalicNoteText;
  BlueString;
end;

procedure TForm1.BoldKeyWords(KeyWord: String);
var
  StartPos, FoundAt, SrcLen: Integer;
begin
  StartPos := 0;
  
  with RichEdit1 do
  repeat
    SrcLen := Length(Text) - StartPos;
    FoundAt := FindText(KeyWord, StartPos, SrcLen, [stWholeWord]);
    StartPos := FoundAt + Length(KeyWord);
    
    SelStart := FoundAt;
    SelLength := Length(KeyWord);
    SelAttributes.Style := [fsBold];
  until FoundAt = -1;
end;

procedure TForm1.ItalicNoteText;
var
  StartPos, FoundAt, LastFoundAt, SrcLen: Integer;
const
  NoteKey1 = '{';
  NoteKey2 = '}';
begin
  StartPos := 0;

  with RichEdit1 do
  repeat
    SrcLen := Length(Text) - StartPos;
    LastFoundAt := FindText(NoteKey1, StartPos, SrcLen, []);
    if LastFoundAt <> -1 then
    begin
      StartPos := LastFoundAt + Length(NoteKey1);
      SrcLen := Length(Text) - StartPos;
      FoundAt := FindText(NoteKey2, StartPos, SrcLen, []);

      SelStart := LastFoundAt;
      SelLength := FoundAt - LastFoundAt + 1;
      SelAttributes.Style := [fsItalic];
      SelAttributes.Color := clBlue;
      StartPos := FoundAt + Length(NoteKey1)+1;

    end;
  until LastFoundAt = -1;
end;

procedure TForm1.BlueString;
var
  StartPos, FoundAt, LastFoundAt, SrcLen: Integer;
const
  KeyWord = '''';
begin
  StartPos := 0;

  with RichEdit1 do
  repeat
    SrcLen := Length(Text) - StartPos;
    LastFoundAt := FindText(KeyWord, StartPos, SrcLen, []);
    if LastFoundAt <> -1 then
    begin
      StartPos := LastFoundAt + Length(KeyWord);
      SrcLen := Length(Text) - StartPos;
      FoundAt := FindText(KeyWord, StartPos, SrcLen, []);
      SelStart := LastFoundAt;
      
      SelLength := FoundAt - LastFoundAt + 1;
      SelAttributes.Color := clBlue;
      StartPos := FoundAt + Length(KeyWord)+1;
    end;
  until LastFoundAt = -1;
end;

procedure TForm1.RichEdit1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ShowLineAndCharPos;
end;

procedure TForm1.RichEdit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  ShowLineAndCharPos;
end;

procedure TForm1.ShowLineAndCharPos;
var
  LinePos, CharPos: Integer;
begin
  with RichEdit1 do
  begin
    LinePos := SendMessage(Handle,EM_LINEFROMCHAR,SelStart,0);
    CharPos := SendMessage(Handle,EM_LINEINDEX,LinePos,0);
    CharPos := SelStart - CharPos;
  end;
  lbCharPos.Caption := IntToStr(LinePos+1) + ':' + IntToStr(CharPos+1);
end;   


end.