rpmemo.pas

修改datamemo中报表分页时中文显示乱码问题

{*************************************************************************}
{ Rave Reports version 5.1                                                }
{ Copyright (c), 1995-2002, Nevrona Designs, all rights reserved          }
{*************************************************************************}
unit RpMemo;

interface

uses
  Messages, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls, ExtCtrls,
  SysUtils, Classes, RpDefine, RpBase;

type
  TMemoBuf = class(TBaseMemoBuf)
  protected
    FMaxHeight: double; { Maximum print height for PrintLines }
    FBufferInc: longint; { Minimum bytes to add each time buffer needs to be increased }
    FNoNewLine: boolean; { Should PrintMemo end with a NewLine? }
    FSaveBuffer: PCharArray; { Saved FBuffer }
    FSaveSize: longint; { Saved FBuffer size }
    FSaveRPTFList: TList; { Saved RPTF list }
    FBuffer: PCharArray; { Buffer of text }
    FSize: longint; { Size of FBuffer }
    FMaxSize: longint; { Maximum Size for FBuffer }
    FPos: longint; { Current position in FBuffer }
    FNewParagraph: boolean; { Did a new paragraph just begin? }
    NewLine: boolean; { Did a new line just begin? }
    FSearchText: TFormatString; { Text to search for }
    FSearchLen: longint; { Length of search text }
    FCaseMatters: boolean; { Does case matter during search? }
    FRPTFList: TList; { List of RPTF commands }
    FProcessRPTF: boolean; { Process RPTF commands when importing? }
    LastRPTF: string[60]; { Last piece of RPTF code }
    ReadRTF: boolean; { Should SetData or SetRTF be called? }
    ReplaceRPTF: boolean;
    NonSpacePos: longint;
    LeftIndent: double;
    RightIndent: double;

    SaveFPos: longint; { Holds FPos for SaveState/RestoreState }
    SaveNewParagraph: boolean; { Holds NewParagraph for SaveState/RestoreState }
    SaveNewLine: boolean; { Holds NewLine for SaveState/RestoreState }

    function GetText: string;
    procedure SetText(Value: string);
    procedure SetRTFText(Value: string);
    procedure SetPos(Value: longint);
    procedure SetMaxSize(Value: longint);
    procedure SetMemo(Value: TMemo);
    procedure SetRichEdit(Value: TRichEdit);
    procedure SetSize(Value: longint);
    procedure FreeBuffer;
    procedure ClearRPTFList(List: TList);
    procedure CopyRPTFList(FromList: TList;
                           ToList: TList);
    procedure AddRPTFString(RPTFStr: string; BufPos: longint);
    function FillRPTF(TextStr: string; StartPos: longint): string;
    function GetStateAtPos(Pos: longint): TFormatState;
    function GetLine(    Width: longint;
                     var Eol: boolean): string;

  public
    constructor Create;
    destructor Destroy; override;

    function HasRPTF: boolean;
    procedure Reset;
    procedure SaveState;
    procedure RestoreState;
    function GetWord: string;
    procedure SetData(var Buffer;
                          BufSize: longint);
    procedure SetRTF(var Buffer;
                         BufSize: longint);
    procedure SaveToStream(Stream: TStream);
    procedure LoadFromStream(Stream: TStream; BufSize: longint);
    procedure LoadFromFile(FileName: string);
    procedure RTFLoadFromStream(Stream: TStream;
                                BufSize: longint);
    procedure RTFLoadFromFile(FileName: string);
    procedure InsertMemoBuf(BufPos: longint; MemoBuf: TMemoBuf);
    procedure AppendMemoBuf(MemoBuf: TMemoBuf);
    function Empty: boolean;
    procedure Insert(BufPos: longint; Text: string);
    procedure Append(Text: string);
    procedure Delete(BufPos: longint;
                     DelLen: longint);
    function SearchFirst(SearchText: string;
                         CaseMatters: boolean): boolean;
    function SearchNext: boolean;
    procedure ReplaceAll(SearchText: string;
                         ReplaceText: string;
                         CaseMatters: boolean);
    procedure SaveBuffer;
    procedure RestoreBuffer;
    procedure FreeSaved;
    function GetNextLine(var Eol: boolean): string; override;
    function MemoLinesLeft: longint; override;
    function PrintLines(Lines: longint; PrintTabs: boolean): double; override;
    function PrintHeight(Height: double; PrintTabs: boolean): double;
    function MemoHeightLeft: double;
    function ConstrainHeightLeft(Constraint: double): double;

  { Internal use properties }
    property NewParagraph: boolean read FNewParagraph;

  { Public properties }
    property Text: string read GetText write SetText;
    property RTFText: string write SetRTFText;
    property Size: longint read FSize write SetSize;
    property MaxSize: longint read FMaxSize write SetMaxSize;
    property Pos: longint read FPos write SetPos;
    property Buffer: PCharArray read FBuffer;
    property NoCRLF: boolean read FNoNewLine write FNoNewLine;
    property NoNewLine: boolean read FNoNewLine write FNoNewLine;
    property BufferInc: longint read FBufferInc write FBufferInc;
    property Memo: TMemo write SetMemo;
    property RichEdit: TRichEdit write SetRichEdit;
    property ProcessRPTF: boolean read FProcessRPTF write FProcessRPTF;
  end; { TMemoBuf }

implementation

uses
  RpRPTF;

{ class TRPTFItem }

type
  TRPTFItem = class
    Data: string; { RPTF Formatting commands }
    Pos: longint; { Position in buffer that these commands apply to }

    procedure AddRPTF(RPTFStr: string);
    procedure SetRPTF(RPTFStr: string);
  end; { TRPTFItem }

  procedure TRPTFItem.AddRPTF(RPTFStr: string);
  begin { AddRPTF }
    // MBCS-SAFE
    Delete(Data,Length(Data),1);
    RPTFStr[1] := RPTFInFix;
    Data := Data + RPTFStr;
  end;  { AddRPTF }

  procedure TRPTFItem.SetRPTF(RPTFStr: string);
  begin { SetRPTF }
    Data := RPTFStr;
  end;  { SetRPTF }

{ class TMemoBuf }

  constructor TMemoBuf.Create;
  begin { Create }
    inherited Create;

    FNewParagraph := true;
    NewLine := true;
    FBuffer := nil;
    FSize := 0;
    FMaxSize := 0;
    FPos := 0;
    FPrintStart := 0.0;
    FPrintEnd := 0.0;
    FJustify := pjLeft;
    FNoNewLine := false;
    FBufferInc := 256;
    FSaveBuffer := nil;
    FSaveSize := 0;
    FRPTFList := TList.Create;
    FSaveRPTFList := TList.Create;
    FProcessRPTF := true;
    ReadRTF := false;
  end;  { Create }

  destructor TMemoBuf.Destroy;
  begin { Destroy }
    FreeBuffer;
    FreeAndNil(FRPTFList);
    FreeSaved;
    FreeAndNil(FSaveRPTFList);

    inherited Destroy;
  end;  { Destroy }

  procedure TMemoBuf.ClearRPTFList(List: TList);
  var
    I1: integer;
  begin { ClearRPTFList }
    for I1 := 1 to List.Count do begin
      TRPTFItem(List[I1 - 1]).Free;
    end; { for }
    List.Clear;
  end;  { ClearRPTFList }

  procedure TMemoBuf.CopyRPTFList(FromList: TList; ToList: TList);
  var
    I1: integer;
    RPTFItem: TRPTFItem;
  begin { CopyRPTFList }
    ClearRPTFList(ToList);

    for I1 := 1 to FromList.Count do begin
      RPTFItem := TRPTFItem.Create;
      with RPTFItem do begin
        Data := TRPTFItem(FromList[I1 - 1]).Data;
        Pos := TRPTFItem(FromList[I1 - 1]).Pos;
      end; { with }
      ToList.Add(RPTFItem);
    end; { for }
  end;  { CopyRPTFList }

  procedure TMemoBuf.AddRPTFString(RPTFStr: string; BufPos: longint);
  var
    I1: integer;
    RPTFItem: TRPTFItem;
    Found: boolean;
  begin { AddRPTFString }
    if RPTFStr = '' then Exit;

  { Search through list looking for right place to insert }
    Found := false;
    for I1 := 1 to FRPTFList.Count do begin
      RPTFItem := TRPTFItem(FRPTFList[I1 - 1]);
      if RPTFItem.Pos > BufPos then begin { Insert new RPTFItem }
        RPTFItem := TRPTFItem.Create;
        with RPTFItem do begin
          Data := RPTFStr;
          Pos := BufPos;
        end; { with }
        FRPTFList.Insert(I1 - 1,RPTFItem);
        Found := true;
        Break;
      end else if RPTFItem.Pos = BufPos then begin
        if ReplaceRPTF then begin
          RPTFItem.SetRPTF(RPTFStr);
        end else begin
          RPTFItem.AddRPTF(RPTFStr);
        end; { else }
        Found := true;
        Break;
      end; { else }
    end; { for }
    ReplaceRPTF := false;

    if not Found then begin
      RPTFItem := TRPTFItem.Create;
      with RPTFItem do begin
        Data := RPTFStr;
        Pos := BufPos;
      end; { with }
      FRPTFList.Add(RPTFItem);
    end; { if }
  end;  { AddRPTFString }

  procedure TMemoBuf.Reset;
  begin { Reset }
    FPos := 0;
    FNewParagraph := true;
    NewLine := true;
  end;  { Reset }

  procedure TMemoBuf.SaveState;
  begin { SaveState }
    SaveFPos := FPos;
    SaveNewParagraph := NewParagraph;
    SaveNewLine := NewLine;
  end;  { SaveState }

  procedure TMemoBuf.RestoreState;
  begin { RestoreState }
    FPos := SaveFPos;
    FNewParagraph := SaveNewParagraph;
    NewLine := SaveNewLine;
  end;  { RestoreState }

  function TMemoBuf.FillRPTF(TextStr: string; StartPos: longint): string;
  var
    I1: integer;
    EndPos: longint;
    CurrPos: longint;
    First: boolean;
    WSLen: longint;
  begin { FillRPTF }
  { Return TextStr inserted with any RPTF commands }
    Result := TextStr;
    if TextStr = '' then Exit;
    I1 := FRPTFList.Count - 1;

  { Calculate length of white space in front }
    WSLen := 0;
    repeat
      if Result[WSLen + 1] in [#9,#10,#13,' '] then begin
        Inc(WSLen);
      end else begin
        Break;
      end; { else }
    until WSLen >= Length(Result);

    EndPos := StartPos + Length(Result) - 1 - WSLen;
    First := true;
    while I1 >= 0 do begin
      CurrPos := TRPTFItem(FRPTFList[I1]).Pos;
      if CurrPos <= EndPos then begin
        if First then begin
          First := false;
          LastRPTF := TRPTFItem(FRPTFList[I1]).Data;
        end; { if }
        System.Insert(TRPTFItem(FRPTFList[I1]).Data,Result,CurrPos - StartPos + WSLen + 1);
      end; { if }
      if CurrPos <= StartPos then Break;
      Dec(I1);
    end; { while }
  end;  { FillRPTF }

  function TMemoBuf.GetStateAtPos(Pos: longint): TFormatState;
  var
    I1: integer;
    RPTFItem: TRPTFItem;
  begin { GetStateAtPos }
  { Find TFormatState for the current position }
    I1 := 0;
    RPTFItem := TRPTFItem(FRPTFList[I1]);
    Result := GetBaseRPTFState;
    while RPTFItem.Pos <= Pos do begin
      ApplyRPTFToState(Result,RPTFItem.Data);
      Inc(I1);
      if I1 < FRPTFList.Count then begin
        RPTFItem := TRPTFItem(FRPTFList[I1]);
      end else begin
        Break;
      end; { else }
    end; { while }
  end;  { GetStateAtPos }

  function TMemoBuf.HasRPTF: boolean;
  begin { HasRPTF }
    Result := (FRPTFList.Count > 0);
  end;  { HasRPTF }

  function TMemoBuf.GetWord: string;
  var
    StartPos: longint;
  begin { GetWord }
    if not Assigned(FBuffer) or (FPos >= Size) then begin
      Result := '';
      Exit;
    end; { if }

    StartPos := FPos;

  { Search for first non-whitespace character or end of buffer }
    while (FPos < FSize) and (FBuffer^[FPos] in [#9,' ']) and
     ((FPos - StartPos) < MAXWORDLEN) do begin
      Inc(FPos);
    end; { while }
    NonSpacePos := FPos;

    if NewLine then begin
      if not NewParagraph and not KeepSpaces then begin { Get rid of beginning white space }
        StartPos := FPos;
      end; { if }
      FNewParagraph := false;
      NewLine := false;
    end; { if }

  { Check to see if we are on a carriage return }
    if (FPos < FSize) and (FBuffer^[FPos] = #13) then begin
      FNewParagraph := true;
      Inc(FPos); { Skip #13 }
      if (FPos < FSize) and (FBuffer^[FPos] = #10) then begin
        Inc(FPos); { Skip #10 }
      end; { if }
      Result := #13; { Return carriage return only }
    end else if (FPos < FSize) and (FBuffer^[FPos] = #10) then begin
      FNewParagraph := true;
      Inc(FPos); { Skip #10 }
      Result := #13; { Return carriage return only }
    end else begin
    { Search for first whitespace character or end of buffer }
      while (FPos < FSize) and not (FBuffer^[FPos] in [#9,#10,#13,' ']) and
       ((FPos - StartPos) < MAXWORDLEN) do begin
        Inc(FPos);
      end; { while }

      SetLength(Result,FPos - StartPos);
      if FPos <> StartPos then begin
        Move(FBuffer^[StartPos],Result[1],FPos - StartPos);
      end; { if }
    end; { else }
  end;  { GetWord }



function   TMemoBuf.GetLine(   Width:   longint;   
  var   Eol:   boolean):   string;   
  var   
  TestWidth:   longint;   
  SavePos:   longint;   
  NewWord:   string;   
  S1:   string;   
  S2:   string;   
  StartPos:   longint;   
  FormatState:   TFormatState;   
  StartState:   string;   
  AdjWidth:   longint;   
  FirstLine:   boolean;   
    
  //zhj   **************   Start   **************
  Function   CurLineEndHalfCHS(Const   CurLineStr:String):Boolean;   
  Var   
  bIsDBCS:Boolean;   
  jLength,jFor:Integer;   
  Begin   
  bIsDBCS   :=   False;   
  jLength:=Length(CurLineStr);   
  for   jFor   :=   1   to   jLength   do   
  begin   
  if   bIsDBCS   then   
  bIsDBCS   :=   False   
  else   
  Begin   
  if   Windows.IsDBCSLeadByte(byte(CurLineStr[jFor]))   then   
  bIsDBCS   :=   True;   
  End;   
  end;   //end   of   for   
  Result:=bIsDBCS;   
  End;   
  //zhj   **************   End   **************   
    
  begin   {   GetLine   }   
  {   Get   a   line   of   text   that   will   fit   within   PrintStart   to   PrintEnd   }   
  EOL   :=   false;   
  NewLine   :=   true;   
  StartPos   :=   -1;   
  S1   :=   '';