qm_prichtext.pas

一个管理系统

{*******************************************************}
{                                                       }
{                   QReportMaker 2.0                    }
{              TQMPrintRichText Component               }
{                                                       }
{            Copyright (c) 2003,2004 by Zwm.            }
{                                                       }
{*******************************************************}

unit QM_PRichText;

interface


uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, ComCtrls, RichEdit,
  QM_RConsole;

type

  { TRichEditStrings }
  TRichEditStrings = class(TStrings)
  private
    RichEdit: TRichEdit;
    FPlainText: Boolean;
    FConverter: TConversion;
    procedure EnableChange(const Value: Boolean);
  protected
    function Get(Index: Integer): string; override;
    function GetCount: Integer; override;
    procedure Put(Index: Integer; const S: string); override;
    procedure SetUpdateState(Updating: Boolean); override;
    procedure SetTextStr(const Value: string); override;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear; override;
    procedure AddStrings(Strings: TStrings); override;
    procedure Delete(Index: Integer); override;
    procedure Insert(Index: Integer; const S: string); override;
    procedure LoadFromFile(const FileName: string); override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToFile(const FileName: string); override;
    procedure SaveToStream(Stream: TStream); override;
    property PlainText: Boolean read FPlainText write FPlainText;
  end;

  { TQMPrintRichText }
  TQMPrintRichText = class(TQMReportConsole)
  private
    FRichEdit: TRichEdit;
    FRichText: TStrings;
    FFitToPageWidth: Boolean;
    procedure ReadRichText(Stream: TStream);
    procedure WriteRichText(Stream: TStream);
    procedure SetRichEdit(const Value: TRichEdit);
    function GetRichText: TStrings;
    procedure SetRichText(const Value: TStrings);
  protected
    procedure DefineProperties(Filer: TFiler); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure DrawReport; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure LoadRichText(app: Boolean);
    procedure ApplyParams;
  published
    property RichEdit: TRichEdit read FRichEdit write SetRichEdit;
    property RichText: TStrings read GetRichText write SetRichText;
    property FitToPageWidth: Boolean read FFitToPageWidth write FFitToPageWidth default False;
  end;

implementation

uses QuickRpt, QRCtrls, QRPrntr, QM_Utils, QM_QRFuns;

{ TQMPrintRichText }

procedure TQMPrintRichText.ApplyParams;
var
  i: Integer;
  ps1,ps2,sstart,pcnt,linePos: Integer;
  bWordWrap: Boolean;
  tmpStr, linestr: string;
begin
  if RichEdit=nil then exit;
  sstart := 0;                                
  bWordWrap := RichEdit.WordWrap;
  RichEdit.WordWrap := False;
  RichEdit.Lines.BeginUpdate;
  //if not (csDesigning in self.ComponentState) then
  //  try RichEdit.SetFocus except end;
  for i := 0 to RichEdit.Lines.Count-1 do
  begin
    linestr := RichEdit.Lines[i];
    linePos := 0;
    ps1 := pos('{', linestr);
    ps2 := pos('}', linestr);
    pcnt := 0;
    while (ps1 > 0) and (ps2 > 0) and (pcnt < 100) do
    begin
      if ps2 > ps1 then
      begin
        if copy(linestr, ps1 + 1, 1) = '*' then
        begin
          delete(linestr, 1, ps2);
          with RichEdit do
          begin
            SelStart := ps1 + sstart + linePos;
            SelLength := 1;
            SelText := '';
            RichEdit.clearselection;
          end;
          Inc(linePos, ps2 - 1);
          inc(pcnt);
        end else
        begin
          tmpStr := QM_GetParaValue(self, copy(linestr, ps1+1, ps2-ps1-1));
          delete(linestr, 1, ps2);
          with RichEdit do
          begin
            SelStart := ps1 + sstart + linePos - 1;
            SelLength := ps2 - ps1 + 1;
            SelText := tmpStr;
            RichEdit.clearselection;
          end;
          Inc(linePos, ps1 - 1 + Length(tmpStr));
          inc(pcnt);
        end;
      end else
      begin
        delete(linestr, 1, ps1 - 1);
        Inc(linePos, ps1 - 1);
      end;
      ps1 := pos('{', linestr);
      ps2 := pos('}', linestr);
    end;
    inc(sstart, length(RichEdit.Lines[i]) + 2);
  end;
  RichEdit.Lines.EndUpdate;
  RichEdit.WordWrap := bWordWrap;
end;

constructor TQMPrintRichText.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FRichText := TStringList.Create;
end;

procedure TQMPrintRichText.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineBinaryProperty('RichText_Data', ReadRichText,
    WriteRichText, RichText.Count > 0);
end;

destructor TQMPrintRichText.Destroy;
begin
  FRichText.Free;
  inherited Destroy;
end;

procedure TQMPrintRichText.DrawReport;
var
  RepWidth: Integer;
  QRRichText: TQRRichText;
  QRBand: TQRBand;
begin
  if Assigned(OnBeforeDraw) then OnBeforeDraw(self);
  if FitToPageWidth or (RichEdit = nil) then RepWidth := 0
  else RepWidth := RichEdit.Width;
  FormatReport(RepWidth);
  inherited DrawReport;
  if RichEdit = nil then exit;
  QRBand := QM_FindBand(rbTitle, BGColor);
  if QRBand.Tag = 1 then
    QRBand.Height := 20
  else QRBand.Height := QRBand.Height+20;
  QRRichText := TQRRichText.Create(QROwner);
  QRRichText.Parent := QRBand;
  with QRRichText do
  begin
    AutoStretch := True;
    //Alignment := RichEdit.Alignment;
    //Color := QM_PrintColor(RichEdit.Color);
    Left := LftMargin;
    Top := QRBand.Height - 20;
    Height := 20;
    if FitToPageWidth then Width := QRBand.Width
    else Width := RichEdit.Width;
    Width := Round(Width * ScaleWL);
    ParentRichEdit := RichEdit;
    if NeedName then
      Name := QM_UniqueName(QROwner,'QRRichText');
  end;
end;

function TQMPrintRichText.GetRichText: TStrings;
begin
  if FRichText = nil then
    FRichText := TRichEditStrings.Create;
  Result := FRichText;
end;

procedure TQMPrintRichText.LoadRichText(app: Boolean);
var
  Stream: TStringStream;
begin
  if RichEdit = nil then exit;
  Stream := TStringStream.Create('');
  try
    RichText.SaveToStream(Stream);
    Stream.Position := 0;
    RichEdit.Lines.LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
  //if not (csDesigning in ComponentState) then
  if app then ApplyParams();
end;

procedure TQMPrintRichText.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FRichEdit) then FRichEdit := nil;
end;

procedure TQMPrintRichText.ReadRichText(Stream: TStream);
begin
  RichText.LoadFromStream(Stream);
end;

procedure TQMPrintRichText.SetRichEdit(const Value: TRichEdit);
begin
  FRichEdit := Value;
  if Value <> nil then Value.FreeNotification(Self);
end;

procedure TQMPrintRichText.SetRichText(const Value: TStrings);
var
  Stream: TStringStream;
begin
  Stream := TStringStream.Create('');
  try
    Value.SaveToStream(Stream);
    Stream.Position := 0;
    FRichText.LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TQMPrintRichText.WriteRichText(Stream: TStream);
begin
  RichText.SaveToStream(Stream);
end;


{ TRichEditStrings, from VCL ComCtrls.pas }

const
  ReadError = $0001;
  WriteError = $0002;
  NoError = $0000;

constructor TRichEditStrings.Create;
begin
  inherited Create;
  RichEdit := TRichEdit.Create(nil);
  RichEdit.Visible := False;
  //Application.CreateHandle;
  RichEdit.ParentWindow := GetDesktopWindow;
end;

destructor TRichEditStrings.Destroy;
begin
  FConverter.Free;
  RichEdit.Free;
  inherited Destroy;
end;

procedure TRichEditStrings.AddStrings(Strings: TStrings);
var
  SelChange: TNotifyEvent;
begin
  SelChange := RichEdit.OnSelectionChange;
  RichEdit.OnSelectionChange := nil;
  try