Scroll to fixed line in RichEidt in delphi

两个应用

1.当点击右边标题栏时，显示当前标题，且行置顶

 reContent.Perform(EM_LINESCROLL,0, -MaxLineCount);
 reContent.Perform(EM_LINESCROLL,0, FirstFindLine);

效果图：

2.查找输入的字符串，并用红色字体显示。

reContent.SelLength:=length(InSearch);
 reContent.SelAttributes.Color:=clRed;
 reContent.SelLength:=0; 

完整代码见附件。

unit helps;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Buttons, ComCtrls, wwriched,
  VirtualTrees;

type
  RecNode=Record
    Seq: String;
    Title: String;
    ImageIndex: Integer;
  end;
  PRecNode=^RecNode;
  Thelpsfrm = class(TForm)
    Panel1: TPanel;
    Splitter1: TSplitter;
    Label1: TLabel;
    eKey: TEdit;
    BitBtn1: TBitBtn;
    Panel2: TPanel;
    Splitter2: TSplitter;
    vst1: TVirtualStringTree;
    reContent: TRichEdit;
    Button1: TButton;
    procedure FormActivate(Sender: TObject);
    procedure vst1GetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; TextType: TVSTTextType;
      var CellText: WideString);
    procedure vst1FreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
    procedure BitBtn1Click(Sender: TObject);
    procedure vst1Change(Sender: TBaseVirtualTree; Node: PVirtualNode);
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDeactivate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private

    Procedure RearchTextInRich(InSearch: string; Mark:Boolean) ;
  public
   
  end;

var
  helpsfrm: Thelpsfrm;
const helpStr=
    '@@0100Introduction'+char(13)+char(10)+
    'CreateDate:'+char(13)+char(10)+
    'FinishedDate:'+char(13)+char(10)+
    'Creator infor:luohan 266 182338914@qq.com '+char(13)+char(10)+
    'Function:show the content for help.'+char(13)+char(10)+
    '@@0300Operation:'+char(13)+char(10)+
    ' click title in the virtaulstringtree, then show the content in richedit.'+char(13)+char(10)+
    '@@0301virtualstringtree:'+char(13)+char(10)+
    ' introdution1.'+char(13)+char(10)+
    ' indtorudtion2'+char(13)+char(10)+
    '@@0302RichEdit:'+char(13)+char(10)+
    ' a.perform'+char(13)+char(10)+
    ' b.selflength.'+char(13)+char(10)+
    '@@0700Attention:'+char(13)+char(10)+
    ' a.attention1.'+char(13)+char(10)+
    ' b.attention2.'+char(13)+char(10)+
    '@@0900History:'+char(13)+char(10)+
    ' 1>2015-07-01luohan add helps for this form.';


implementation



{$R *.dfm}

procedure Thelpsfrm.FormActivate(Sender: TObject);
var
  Data1: PRecNode;
  RootNode,Node1, ChildNode: PVirtualNode;
  vtsCol: TVirtualTreeColumn;
  st: TStrings;
  Count: Integer;
  SeqCount1, SeqCount2: Integer;
  Seq1, Seq2: String;
  lineStr, TotalStr: String;
begin

  st:=TStringList.Create;
  st.Text:=HelpStr;

  reContent.Clear;
  vst1.Clear;
  vst1.Header.Columns.Clear;
  vtsCol:=vst1.Header.Columns.Add;
  vtsCol.Text:='Title';
  vtsCol.Width:=200;
  vtsCol.Alignment:=taLeftJustify;

  vst1.NodeDataSize:=SizeOf(RecNode);
  TotalStr:='';
  SeqCount1:=0;
  SeqCount2:=0;
  if st.Count=0 then st.Free
  else
  begin
    for Count:=0 to st.Count-1 do
    begin
      Seq1:='';
      Seq2:='';
      lineStr:=Trim(st[Count]);
      if(Copy(lineStr,1,2)='@@') then
      begin
        Seq1:=copy(lineStr,3,2);
        Seq2:=copy(lineStr,5,2);
        lineStr:=copy(lineStr, 7, length(lineStr)-7);
        if Seq2='00' then
        begin
          SeqCount1:=SeqCount1+1;
          SeqCount2:=0;
          RootNode:=vst1.AddChild(Nil);
          Data1:=vst1.GetNodeData(RootNode);
          lineStr:=Trim(IntToStr(SeqCount1)+'>'+lineStr);
          Data1.Title:=lineStr;
          Data1.ImageIndex :=0;
        end
        else
        begin
          SeqCount2:=SeqCount2+1;
          Node1:=vst1.AddChild(RootNode);
          Data1:=vst1.GetNodeData(Node1);
          lineStr:=Trim(IntToStr(SeqCount2)+'>'+lineStr);
          Data1.Title:=lineStr;
          Data1.ImageIndex :=0;
          lineStr:=' '+lineStr;
        end;
      end
      else  lineStr:=''+''+Trim(lineStr);

      reContent.Lines.Add(lineStr);


      if (Seq2<>'') and (Seq2<>'00') then
      begin
        reContent.SelStart:=Length(reContent.Text)-(Length(reContent.Lines[Count])+2);
        reContent.SelLength:=Length(reContent.Lines[Count])+2;
        reContent.SelAttributes.Size :=8;
        reContent.SelAttributes.Style:=[fsBold];
      end
      else if (Seq1<>'') and (Seq2='00') then
      begin
        reContent.SelStart:=Length(reContent.Text)-(Length(reContent.Lines[Count])+2);
        reContent.SelLength:=Length(reContent.Lines[Count])+2;
        reContent.SelAttributes.Size :=8;
        reContent.SelAttributes.Style:=[fsBold];
      end
      else
      begin
        reContent.SelStart:=Length(reContent.Text)-(Length(reContent.Lines[Count])+2);
        reContent.SelLength:=Length(reContent.Lines[Count])+2;
        reContent.SelAttributes.Size :=8;
        reContent.SelAttributes.Style:=[];
      end;     
      TotalStr:=TotalStr+reContent.Lines[Count];
    end;
  end;
 
  st.Free;
  reContent.SelStart:=0;

end;

procedure Thelpsfrm.vst1GetText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: WideString);
var
    Data:PRecNode;
begin
  Data:=Sender.GetNodeData(Node);
  if Column<=0 then
      CellText:=Data^.Title
  else if Column=1 then
      CellText:=Data^.Seq;
end;

procedure Thelpsfrm.vst1FreeNode(Sender: TBaseVirtualTree;
  Node: PVirtualNode);
var
    Data:PRecNode;
begin
    Data:=Sender.GetNodeData(Node);
    Finalize(Data^);   
end;

procedure Thelpsfrm.RearchTextInRich(InSearch: string; Mark:Boolean) ;
const
  MaxLineCount=9999;
var
  oldCursor : TCursor;
  str: String;
  len, Count: integer;
  ilen,ixPos: integer;
  Find:boolean;
  FirstFindLine: integer;
begin
  Find:=False;
  oldCursor := Screen.Cursor;
  Screen.Cursor := crHourglass;
  //reContent.Perform(EM_LINESCROLL,0, FindFirstLineCount);
  len:=0;
  FirstFindLine:=0;
  for Count:=0 to reContent.lines.Count-1 do
  begin
    //Application.ProcessMessages;
    str:=reContent.Lines[Count];
    ixPos:=0;
    ilen:=0;
    //OUDD2eOOOa2eOO£gA¡ÑO.
    ixPos:=Pos(InSearch, str);
    ilen:=length(copy(str, 1, ixPos-1));
    While ixPos>0 do
    begin
      ixPos:=ixPos-1;
      reContent.SetFocus;
      reContent.SelStart:=len+ilen;
      if Mark then
      begin
        reContent.SelLength:=length(InSearch);
        reContent.SelAttributes.Color:=clRed;
        reContent.SelLength:=0;
      end;
      str:=copy(str,ixPos+length(InSearch)+1, length(str));
      ixPos:=Pos(InSearch, str);
      ilen:=ilen+length(InSearch)+Length(copy(str, 1, ixPos-1));
      Find:=True;
      if FirstFindLine=0 then FirstFindLine:=Count;
    end;
    len:=len+Length(reContent.Lines[Count])+2; //2: 换行及回车符
    if (Find) and (Mark=False) then break;     //点击ree中的标题时滚动到相应行
  end;

  if Find then
  begin
    //SendMessage(reContent.Handle, WM_VSCROLL, SB_LINEDOWN, FindFirstLineCount);
    reContent.Perform(EM_LINESCROLL,0, -MaxLineCount);
    reContent.Perform(EM_LINESCROLL,0, FirstFindLine);
  end;
  Screen.Cursor := oldCursor;

end;

procedure Thelpsfrm.BitBtn1Click(Sender: TObject);
begin
  RearchTextInRich(Trim(eKey.Text), True);
end;

procedure Thelpsfrm.vst1Change(Sender: TBaseVirtualTree;
  Node: PVirtualNode);
var
  Data: PRecNode;
begin
  if Node<>Nil then
  begin
    Data:=Sender.GetNodeData(Node);
    RearchTextInRich(Trim(Data.Title), False);
  end;
end;

procedure Thelpsfrm.Button1Click(Sender: TObject);
begin
  reContent.SetFocus;
  reContent.SelStart:=0;
  reContent.SelLength:=Length(reContent.Text);
  reContent.SelAttributes.Color:=clBlack;
  reContent.SelLength:=0;
end;

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

procedure Thelpsfrm.FormDeactivate(Sender: TObject);
begin
  recontent.Clear;
  vst1.Clear;
  self.Caption :='Help';
end;

procedure Thelpsfrm.FormDestroy(Sender: TObject);
begin
  helpsfrm:=Nil;
end;

end.

// the follow  is the components

object helpsfrm: Thelpsfrm
  Left = 281
  Top = 202
  BorderStyle = bsDialog
  Caption = 'helps'
  ClientHeight = 466
  ClientWidth = 742
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  Position = poMainFormCenter
  Scaled = False
  Visible = True
  OnActivate = FormActivate
  OnClose = FormClose
  OnDestroy = FormDestroy
  OnDeactivate = FormDeactivate
  OnHide = FormDeactivate
  PixelsPerInch = 96
  TextHeight = 13
  object Splitter1: TSplitter
    Left = 0
    Top = 39
    Width = 742
    Height = 3
    Cursor = crVSplit
    Align = alTop
  end
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 742
    Height = 39
    Align = alTop
    TabOrder = 0
    object Label1: TLabel
      Left = 8
      Top = 16
      Width = 73
      Height = 13
      AutoSize = False
      Caption = ':'
    end
    object eKey: TEdit
      Left = 89
      Top = 10
      Width = 232
      Height = 21
      TabOrder = 0
    end
    object BitBtn1: TBitBtn
      Left = 336
      Top = 8
      Width = 97
      Height = 25
      Caption = '查找'
      TabOrder = 1
      OnClick = BitBtn1Click
      Glyph.Data = {
        F6000000424DF600000000000000760000002800000010000000100000000100
        0400000000008000000000000000000000001000000000000000000000000000
        8000008000000080800080000000800080008080000080808000C0C0C0000000
        FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00FFFFFFFFFFFF
        00FFFFFFFFFFFFF4EC0FFFFFFFFFFF4ECC0FF000000004ECC0FF733333334ECC
        330F7FB870078CC3B30F7F878E80733B830F7F7FE8E803B8B30F7F7EFE8E038B
        830F7F7FEFE807B8B30F7F87FEF07B8B830F7FB87707B8B8B30F7FFFFFFFFFFF
        F30F78B8B8B8777777FFF78B8B87FFFFFFFFFF77777FFFFFFFFF}
    end
    object Button1: TButton
      Left = 447
      Top = 8
      Width = 98
      Height = 25
      Caption = '清除红色标记’'
      TabOrder = 2
      OnClick = Button1Click
    end
  end
  object Panel2: TPanel
    Left = 0
    Top = 42
    Width = 742
    Height = 424
    Align = alClient
    Caption = 'Panel2'
    TabOrder = 1
    object Splitter2: TSplitter
      Left = 538
      Top = 1
      Height = 422
      Align = alRight
    end
    object vst1: TVirtualStringTree
      Left = 541
      Top = 1
      Width = 200
      Height = 422
      Align = alRight
      Header.AutoSizeIndex = 0
      Header.Font.Charset = DEFAULT_CHARSET
      Header.Font.Color = clWindowText
      Header.Font.Height = -11
      Header.Font.Name = 'MS Sans Serif'
      Header.Font.Style = []
      Header.MainColumn = -1
      Header.Options = [hoColumnResize, hoDrag]
      TabOrder = 0
      TreeOptions.AutoOptions = [toAutoDropExpand, toAutoExpand, toAutoScrollOnExpand, toAutoTristateTracking, toAutoDeleteMovedNodes]
      OnChange = vst1Change
      OnFreeNode = vst1FreeNode
      OnGetText = vst1GetText
      Columns = <>
    end
    object reContent: TRichEdit
      Left = 1
      Top = 1
      Width = 537
      Height = 422
      Align = alClient
      Font.Charset = GB2312_CHARSET
      Font.Color = clWindowText
      Font.Height = -11
      Font.Name = 'MS Sans Serif'
      Font.Style = []
      ParentFont = False
      ScrollBars = ssBoth
      TabOrder = 1
      WordWrap = False
    end
  end
end