rpmemo.pas

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

  S2   :=   '';   
  StartState   :=   '';   
  Result   :=   '';   
  FirstLine   :=   NewParagraph;   
  AdjWidth   :=   Width;   
    
  repeat   
  SavePos   :=   FPos;   {   Save   off   current   position}   
  NewWord   :=   GetWord;   {   Get   next   word   }   
    
  if   StartPos   <   0   then   
  begin   {   Initial   run   through   }   
  StartPos   :=   NonSpacePos;   
  if   HasRPTF   then     
  begin   {   Get   state   of   line   start   }   
  FormatState   :=   GetStateAtPos(SavePos);   
  StartState   :=   StateToRPTF(FormatState);   
  if   FirstLine   then     
  begin   
  LeftIndent   :=   FormatState.Para.FirstIndent   +   FormatState.Para.LeftIndent;   
  end   
  else     
  begin   
  LeftIndent   :=   FormatState.Para.LeftIndent;   
  end;   {   else   }   
  RightIndent   :=   FormatState.Para.RightIndent;   
  AdjWidth   :=   Width   -   Round((LeftIndent   +   RightIndent)   *   BaseReport.XDPI);   
  if   AdjWidth   <   BaseReport.XDPI   then   
  begin   {   Don't   allow   width   less   than   1"   }   
  AdjWidth   :=   BaseReport.XDPI;   
  end;   {   if   }   
  end;   {   if   }   
  end;   {   if   }   
    
  if   (NewWord   =   #13)   or   (NewWord   =   '')   then   
  begin   {   Finish   off   line   }   
  EOL   :=   true;   
  if   Result   =   ''   then   
  begin   
  Result   :=   StartState;   
  end;   {   if   }   
  Break;   
  end   
  else   
  begin   {   Test   width   with   new   word   }   
  S2   :=   S2   +   NewWord;   
  S1   :=   StartState   +   FillRPTF(S2,StartPos);   
    
  if   System.Pos(RPTFPrefix,S1)   =   0   then   
  begin     
  TestWidth   :=   SimpleTextWidth(BaseReport,S1,0);   
  end   
  else   
  begin     
  TestWidth   :=   RPTFTextWidth(BaseReport,S1);   
  end;   {   else   }   
    
  if   TestWidth   <=   AdjWidth   then   
  begin   {   Add   new   word   }   
  Result   :=   S1;   
  end   
  else   
  begin     
  {   Reset   position   to   before   this   word}   
  FPos   :=   SavePos;   
  end;   {   else   }   
    
  if   TestWidth   >=   AdjWidth   then   
  begin   
  if   UnformatLen(Result)   =   0   then   
  begin   {   First   word   was   too   long,   cut   it   down   }   
  repeat   {   Add   on   characters   until   enough   width   }   
  S1   :=   Result;   
  while   FBuffer^[FPos]   =   RPTFPrefix   do     
  begin   {   Add   on   RPTF   stuff   }   
  repeat   
  S1   :=   S1   +   FBuffer^[FPos];   
  Inc(FPos);   
  until   FBuffer^[FPos]   =   RPTFSuffix;     
  S1   :=   S1   +   FBuffer^[FPos];   
  Inc(FPos);   
  end;   {   while   }   
  S1   :=   S1   +   FBuffer^[FPos];   
    
  if   System.Pos(RPTFPrefix,S1)   =   0   then     
  begin     
  TestWidth   :=   SimpleTextWidth(BaseReport,S1,0);   
  end   
  else   
  begin     
  TestWidth   :=   RPTFTextWidth(BaseReport,S1);   
  end;   {   else   }   
  if   TestWidth   <=   AdjWidth   then   
  begin   
  if   S1   =   '   '   then   
  begin   
  Result   :=   '';   
  end   
  else   
  begin   
  Result   :=   S1;   
  end;   {   else   }   
  Inc(FPos);   
  end;   {   if   }   
  until   (TestWidth   >=   AdjWidth)   or   (FPos   >=   FSize);   
  end;   {   if   }   
  Break;   
  end;   {   if   }   
  end;   {   else   }   
  until   false;   
    
  //zhj   **************   Start   **************
  If   CurLineEndHalfCHS(Result)   Then   
  Begin   
  System.Delete(Result,Length(Result),1);
  Dec(FPos);
  End;   
  //zhj  **************   End   **************
    
  end;   {   GetLine   }   



  function TMemoBuf.GetText: string;
  begin { GetText }
    if FSize >= MAXWORDLEN then begin { Only return the first MAXWORDLEN chars }
      SetLength(Result,MAXWORDLEN);
      Move(FBuffer^,Result[1],MAXWORDLEN);
    end else begin
      SetLength(Result,FSize);
      if FSize > 0 then begin
        Move(FBuffer^,Result[1],FSize);
      end; { if }
    end; { else }
  end;  { GetText }

  procedure TMemoBuf.SetText(Value: string);
  begin { SetText }
    if Value = '' then begin
      FreeBuffer;
    end else begin
      SetData(Value[1],Length(Value));
    end; { else }
  end;  { SetText }

  procedure TMemoBuf.SetRTFText(Value: string);
  begin { SetRTFText }
    ReadRTF := true;
    SetText(Value);
  end;  { SetRTFText }

  procedure TMemoBuf.FreeBuffer;
  begin { FreeBuffer }
    if Assigned(FBuffer) then begin
      FreeMem(FBuffer,FMaxSize);
    end; { if }
    ClearRPTFList(FRPTFList);
    FSize := 0;
    FMaxSize := 0;
    Reset;
    FBuffer := nil;
    LastRPTF := '';
  end;  { FreeBuffer }

  procedure TMemoBuf.SetPos(Value: longint);
  begin { SetPos }
    if Value >= FSize then begin
      FPos := FSize;
    end else begin
      FPos := Value;
    end; { else }
  end;  { SetPos }

  procedure TMemoBuf.SetData(var Buffer;
                                 BufSize: longint);
  var
    TextSize: longint;
    RPTFCh: PChar;
    RPTFStr: string;
    IsRPTF: boolean;
    BufPos: longint;
    TextCh: PChar;
    TextLen: longint;
  begin { SetData }
    if ReadRTF then begin
      ReadRTF := false;
      SetRTF(Buffer,BufSize);
      Exit;
    end; { if }
    FreeBuffer;
    if ProcessRPTF then begin
      TextSize := UnformatLenC(PChar(@Buffer),BufSize);
    end else begin
      TextSize := BufSize;
    end; { else }
    if BufSize = TextSize then begin { No formatting }
      FSize := BufSize;
      FMaxSize := BufSize;
      GetMem(FBuffer,FMaxSize);
      Move(Buffer,FBuffer^,FSize);
    end else begin { Process RPTF formatting }
      FSize := TextSize;
      FMaxSize := TextSize;
      GetMem(FBuffer,FMaxSize);
      RPTFCh := @Buffer;
      RPTFStr := '';
      IsRPTF := false;
      BufPos := 0;
      TextLen := 0;
      TextCh := RPTFCh;
      while BufSize > 0 do begin
        if IsRPTF then begin
          IsRPTF := RPTFCh^ <> RPTFSuffix;
          RPTFStr := RPTFStr + RPTFCh^;
        end else begin
          if RPTFCh^ = RPTFPrefix then begin
            if TextLen > 0 then begin { Write out TextStr and add RPTF item }
              AddRPTFString(RPTFStr,BufPos);
              RPTFStr := '';
              Move(TextCh^,FBuffer^[BufPos],TextLen);
              Inc(BufPos,TextLen);
              TextLen := 0;
            end; { if }
            IsRPTF := true;
            RPTFStr := RPTFStr + RPTFCh^;
          end else begin
            if TextLen = 0 then begin
              TextCh := RPTFCh;
            end; { if }
            Inc(TextLen);
          end; { else }
        end; { else }
        Inc(RPTFCh);
        Dec(BufSize);
      end; { while }

    { Copy any remaining data out }
      if (TextLen > 0) or (RPTFStr <> '') then begin
        AddRPTFString(RPTFStr,BufPos);
        Move(TextCh^,FBuffer^[BufPos],TextLen);
      end; { if }
    end; { else }
  end;  { SetData }

  procedure TMemoBuf.SetRTF(var Buffer;
                                BufSize: longint);
  var
    RPTFStream: TMemoryStream;
  begin { SetRTF }
    RPTFStream := TMemoryStream.Create;
    try
      RTFToRPTF(Buffer,BufSize,RPTFStream);
      RPTFStream.Position := 0;
      LoadFromStream(RPTFStream,RPTFStream.Size);
    finally
      RPTFStream.Free;
    end; { tryf }
  end;  { SetRTF }

  procedure TMemoBuf.SaveToStream(Stream: TStream);
  begin { SaveToStream }
    Stream.WriteBuffer(FBuffer^,FSize);
  end;  { SaveToStream }

  procedure TMemoBuf.LoadFromStream(Stream: TStream;
                                    BufSize: longint);
  var
    TempBuffer: pointer;
  begin { LoadFromStream }
    if Stream is TMemoryStream then begin
      SetData((Stream as TMemoryStream).Memory^,BufSize);
    end else begin
      if BufSize = 0 then begin
        BufSize := Stream.Size - Stream.Position;
      end; { if }
      GetMem(TempBuffer,BufSize);
      Stream.ReadBuffer(TempBuffer^,BufSize);
      SetData(TempBuffer^,BufSize);
      FreeMem(TempBuffer,BufSize);
    end; { else }
  end;  { LoadFromStream }

  procedure TMemoBuf.LoadFromFile(FileName: string);
  var
    Stream: TFileStream;
  begin { LoadFromFile }
    Stream := TFileStream.Create(FileName,fmOpenRead);
    try
      LoadFromStream(Stream,0);
    finally
      Stream.Free;
    end; { tryf }
  end;  { LoadFromFile }

  procedure TMemoBuf.RTFLoadFromStream(Stream: TStream; BufSize: longint);
  begin { RTFLoadFromStream }
    ReadRTF := true;
    LoadFromStream(Stream,BufSize);
  end;  { RTFLoadFromStream }

  procedure TMemoBuf.RTFLoadFromFile(FileName: string);
  begin { RTFLoadFromFile }
    ReadRTF := true;
    LoadFromFile(FileName);
  end;  { RTFLoadFromFile }

  procedure TMemoBuf.InsertMemoBuf(BufPos: longint; MemoBuf: TMemoBuf);
  var
    Needed: longint;
    NewBuffer: PCharArray;
    I1: integer;
    RPTFItem: TRPTFItem;
  begin { InsertMemoBuf }
  { Check for BufPos out of range }
    if BufPos < 0 then begin
      BufPos := 0; { Insert before first char }
    end else if BufPos > FSize then begin
      BufPos := FSize; { Insert after last char }
    end; { else }

  { Allocate more space in buffer if not enough already }
    Needed := FSize + MemoBuf.Size;
    if Needed > FMaxSize then begin { Allocate more space }
      Needed := ((Needed - 1) div FBufferInc + 1) * FBufferInc;
      GetMem(NewBuffer,Needed);
      Move(FBuffer^,NewBuffer^,BufPos);
    end else begin
      NewBuffer := FBuffer;
    end; { else }

  { Adjust existing RPTF commands }
    if HasRPTF then begin
      for I1 := 1 to FRPTFList.Count do begin
        RPTFItem := TRPTFItem(FRPTFList[I1 - 1]);
        if RPTFItem.Pos >= BufPos then begin { Move position }
          RPTFItem.Pos := RPTFItem.Pos + MemoBuf.Size;
        end; { if }
      end; { for }
    end; { if }

  { Copy over any RPTFItems in MemoBuf to FRPTFList }
    if MemoBuf.HasRPTF then begin
      AddRPTFString(StateToRPTF(GetStateAtPos(BufPos + MemoBuf.Size)),
       BufPos + MemoBuf.Size);
      for I1 := 1 to MemoBuf.FRPTFList.Count do begin
        RPTFItem := TRPTFItem(MemoBuf.FRPTFList[I1 - 1]);
        AddRPTFString(RPTFItem.Data,RPTFItem.Pos + BufPos);
      end; { for }
    end; { if }

  { Move any trailing data to make room for Text}
    Move(FBuffer^[BufPos],NewBuffer^[BufPos + MemoBuf.Size],FSize - BufPos);

  { Insert Text }
    Move(MemoBuf.Buffer^[0],NewBuffer^[BufPos],MemoBuf.Size);
    FSize := FSize + MemoBuf.Size;

  { Check to see if we created a new buffer or not }
    if NewBuffer <> FBuffer then begin
      FreeMem(FBuffer,FMaxSize);
      FBuffer := NewBuffer;
      FMaxSize := Needed;
    end; { if }
  end;  { InsertMemoBuf }

  procedure TMemoBuf.AppendMemoBuf(MemoBuf: TMemoBuf);
  begin { AppendMemoBuf }
    InsertMemoBuf(FSize,MemoBuf);
  end;  { AppendMemoBuf }

  function TMemoBuf.Empty: boolean;
  begin { Empty }
    Result := (FSize = 0) or (FPos >= FSize);
  end;  { Empty }

  procedure TMemoBuf.SetMaxSize(Value: longint);
  var
    Actual: longint;
    NewBuffer: PCharArray;
  begin { SetMaxSize }
    if Value <> FMaxSize then begin
    { Allocate buffer in increments of FBufferInc }
      Actual := ((Value - 1) div FBufferInc + 1) * FBufferInc;

    { Look for shrinking buffer }
      if FSize > Value then begin
        FSize := Value;
        if FPos > Value then begin
          FPos := Value;
        end; { if }
      end; { if }

    { Copy characters over }
      GetMem(NewBuffer,Actual);
      Move(FBuffer^,NewBuffer^,FSize);

    { Assign new buffer }
      FreeMem(FBuffer,FMaxSize);
      FBuffer := NewBuffer;
      FMaxSize := Actual;
    end; { if }
  end;  { SetMaxSize }

  procedure TMemoBuf.SetMemo(Value: TMemo);
  var
    PCharVar: PChar;
    Len: longint;
  begin { SetMemo }
    Len := Value.GetTextLen;
    PCharVar := StrAlloc(Len + 1);
    try
      Value.GetTextBuf(PCharVar,Len + 1);
      SetData(PCharVar^,Len);
    finally
      StrDispose(PCharVar);
    end; { tryf }
  end;  { SetMemo }

  procedure TMemoBuf.SetRichEdit(Value: TRichEdit);
  var
    Stream: TMemoryStream;
  begin { SetRichEdit }
    Stream := TMemoryStream.Create; { Create temporary stream }
    try
      Value.Lines.SaveToStream(Stream); { Save RichEdit to stream }
      SetRTF(Stream.Memory^,Stream.Size); { Set memo buffer data to stream }
    finally
      Stream.Free; { Free up temporary stream }
    end; { try }
  end;  { SetRichEdit }

  procedure TMemoBuf.SetSize(Value: longint);
  begin { SetSize }
    if Value > FSize then begin
      MaxSize := Value;
    end; { if }