Chip 2001 December/Chip_2001-12_cd1.bin/zkuste/delphi/kolekce/d3456/ALEXSOFT.ZIP/QRACTRLS.PAS

Pascal/Delphi Source File | 2001-09-29 | 27.1 KB | 1,007 lines

(*////////////////////////////////////////////////////////////////////////////
//   Part of AlexSoft VCL/DLL Library.                                      //
//   All rights reserved. (c) Copyright 1998.                               //
//   Created by: Alex Rabichooc                                             //
//**************************************************************************//
//  Users of this unit must accept this disclaimer of warranty:             //
//    "This unit is supplied as is. The author disclaims all warranties,    //
//    expressed or implied, including, without limitation, the warranties   //
//    of merchantability and of fitness for any purpose.                    //
//    The author assumes no liability for damages, direct or                //
//    consequential, which may result from the use of this unit."           //
//                                                                          //
//  This Unit is donated to the public as public domain.                    //
//                                                                          //
//  This Unit can be freely used and distributed in commercial and          //
//  private environments provided this notice is not modified in any way.   //
//                                                                          //
//  If you do find this Unit handy and you feel guilty for using such a     //
//  great product without paying someone - sorry :-)                        //
//                                                                          //
//  Please forward any comments or suggestions to Alex Rabichooc at:        //
//                                                                          //
//  [e-mail] or [e-mail]                         //
/////////////////////////////////////////////////////////////////////////////*)

unit QRaCtrls;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  QuickRpt, Qrctrls, StdCtrls, StdUtils{$IFNDEF VER100}, qrExpr{$ENDIF},
  db, qrPrntr,
 {$IFDEF VER140}
  DesignEditors, Designintf
 {$ELSE}
  Dsgnintf
 {$ENDIF};

type
  TQRaCustomLabel = class(TQRCustomLabel)
  private
    FLeftInChars: Integer;
    FWidthInChars: Integer;
    ParentChanged: boolean;
    function GetLeftInChars: Integer;
    function GetWidthInChars: Integer;
    procedure SetLeftInChars(const Value: Integer);
    function GetTopInChars: Integer;
    procedure SetTopInChars(const Value: Integer);
    procedure CMParentFontChanged(var Message: TMessage); message CM_PARENTFONTCHANGED;
    procedure SetWidthInChars(const Value: Integer);
    function GetAutoSizing: boolean;
    procedure SetAutoSizing(const Value: boolean);
    function GetHeightInChars: Integer;
  protected
    procedure FormatLines; override;
    procedure SetParent(AParent: TWinControl); override;
  public
    constructor Create(AOwner: TComponent); override;
    property AutoSizing: boolean read GetAutoSizing write SetAutoSizing stored True;
    property HeightInChars: Integer read GetHeightInChars;
  published
    property LeftInChars: Integer read GetLeftInChars write SetLeftInChars;
    property WidthInChars: Integer read GetWidthInChars write SetWidthInChars;
    property TopInChars: Integer read GetTopInChars write SetTopInChars;
  end;

  TQRaLabel = class(TQRaCustomLabel)
  published
    property Alignment;
    property Caption;
    property Color;
    property OnPrint;
    property Transparent;
    property AutoSizing;
  end;

  TQRaHLine = class(TQRaCustomLabel)
  private
    FCharacter: Char;
    procedure SetCharacter(const Value: Char);
    function GetLineText: String;
  protected
    procedure FormatLines; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Color;
    property OnPrint;
    property Transparent;
    property Character: Char read FCharacter write SetCharacter;
  end;

  TQRaSysData = class(TQRaCustomLabel)
  private
    FData : TQRSysDataType;
    FText : string;
    procedure SetData(Value : TQRSysDataType);
    procedure SetText(Value : string);
    procedure CreateCaption;
  protected
    procedure Print(OfsX, OfsY : integer); override;
  public
    constructor Create(AOwner : TComponent); override;
  published
    property Alignment;
    property AutoSizing;
    property Color;
    property Data : TQRSysDataType read FData write SetData;
    property OnPrint;
    property Text : string read FText write SetText;
    property Transparent;
  end;

  TQRaExpr = class(TQRaCustomLabel)
  private
    Evaluator : TQREvaluator;
    FExpression : string;
    FMask : string;
    FMaster : TComponent;
    FResetAfterPrint : boolean;
    function GetValue : TQREvResult;
    procedure SetExpression(Value : string);
    procedure SetMask(Value : string);
  protected
    procedure Prepare; override;
    procedure Unprepare; override;
    procedure QRNotification(Sender : TObject; Operation : TQRNotifyOperation); override;
    procedure Print(OfsX, OfsY : integer); override;
    procedure SetMaster(AComponent : TComponent);
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    procedure Reset;
    property Value : TQREvResult read GetValue;
  published
    property Alignment;
    property AutoSizing;
    property Color;
    property Master : TComponent read FMaster write SetMaster;
    property OnPrint;
    property ResetAfterPrint : boolean read FResetAfterPrint write FResetAfterPrint;
    property Transparent;
    property Expression : string read FExpression write SetExpression;
    property Mask : string read FMask write SetMask;
  end;

  TQRaDBText = class(TQRaCustomLabel)
  private
    Field : TField;
    FieldNo : integer;
    FieldOK : boolean;
    DataSourceName : string[30];
    FDataSet : TDataSet;
    FMask : string;
    FDataField: string;
    procedure SetDataSet(Value : TDataSet);
    procedure SetDataField(Value : string);
    procedure SetMask(Value : string);
  protected
    procedure DefineProperties(Filer: TFiler); override;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Prepare; override;
    procedure Print(OfsX, OfsY : integer); override;
    procedure ReadValues(Reader : TReader); virtual;
    procedure Unprepare; override;
    procedure WriteValues(Writer : TWriter); virtual;
  public
    constructor Create(AOwner : TComponent); override;
  published
    property Alignment;
    property AutoSizing;
    property Color;
    property DataSet : TDataSet read FDataSet write SetDataSet;
    property DataField: string read FDataField write SetDataField;
    property Mask : string read FMask write SetMask;
    property OnPrint;
    property Transparent;
  end;

  TQRaFieldsProperty = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValues(Proc: TGetStrProc); override;
  end;

  TQRaBand = class(TQRBand)
  private
    procedure CMParentFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  protected
    procedure Paint; override;
  end;

  TQRaSubDetail = class(TQRSubDetail)
  private
    procedure CMParentFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  protected
    procedure Paint; override;
  end;

  TQRaGroup = class(TQRGroup)
  private
    procedure CMParentFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  protected
    procedure Paint; override;
  end;

  { TQRaAsciiExportFilter }
  TQRaAsciiExportFilter = class(TQRExportFilter)
  private
    LineCount : integer;
    Lines : array[0..200] of string;
    aFile : text;
    XFactor,
    YFactor : extended;
    PageNo: Integer;
  protected
    function GetFilterName : string; override;
    function GetDescription : string; override;
    function GetExtension : string; override;
  public
    procedure Start(PaperWidth, PaperHeight : integer; Font : TFont); override;
    procedure EndPage; override;
    procedure Finish; override;
    procedure NewPage; override;
    procedure TextOut(X,Y : extended; Font : TFont; BGColor : TColor; Alignment : TAlignment; Text : string); override;
    function ConvertToCp866(Text: String): String;
  end;

implementation

uses {$IFNDEF VER100} qr3Const {$ELSE} qr2Const {$ENDIF};

const CharHSpace = 2;
      MatrixCharWidth = 9.6;

function CharWidth(ACanvas: TCanvas): Integer;
begin
   Result := ACanvas.TextWidth('-');
end;

function GetCharWidth(AControl: TQRCustomLabel): Double;
var ACanvas: TCanvas;
begin
   ACanvas := TCanvas.Create;
   ACanvas.Handle := GetDC(0);
   ACanvas.Font := AControl.Font;
   if (csDesigning in AControl.ComponentState) or (PrinterType = ptText) then
      Result := MatrixCharWidth
     else
      Result := CharWidth(ACanvas);
   ReleaseDC(0, ACanvas.Handle);
   ACanvas.Handle := 0;
   ACanvas.Free;
   if AControl.ParentReport <> nil then
     Result := Result*AControl.ParentReport.Zoom/100;
end;

function CharHeight(ACanvas: TCanvas): Integer;
begin
   Result := abs(ACanvas.Font.Height);
   Result := ((Result div 16)+ord((Result mod 16) <> 0))*16;
end;

function GetCharHeight(AControl: TQRCustomLabel): Integer;
var ACanvas: TCanvas;
begin
   ACanvas := TCanvas.Create;
   ACanvas.Handle := GetDC(0);
   ACanvas.Font := AControl.Font;
   Result := CharHeight(ACanvas);
   ReleaseDC(0, ACanvas.Handle);
   ACanvas.Handle := 0;
   ACanvas.Free;
   if AControl.ParentReport <> nil then
     Result := round(Result*AControl.ParentReport.Zoom/100);
end;

function TextWidth(AControl: TQRCustomLabel; NumChars: Integer): Integer;
begin
  Result := Round(NumChars*GetCharWidth(AControl));
end;

function TextHeight(AControl: TQRCustomLabel; NumChars: Integer): Integer;
begin
  Result := NumChars*GetCharHeight(AControl);
end;

function NumHorChars(AControl: TQRCustomLabel; Width: Integer): Integer;
begin
  Result := Round(Width / GetCharWidth(AControl));
end;

function NumVertChars(AControl: TQRCustomLabel; Height: Integer): Integer;
begin
  Result := Height div GetCharHeight(AControl);
end;

procedure DoResize(AControl: TQRCustomLabel; ATop, ALeft, AWidth: Integer);
begin
  with AControl do
  begin
    Left := TextWidth(AControl, ALeft);
    Top := TextHeight(AControl, ATop);
    Width := TextWidth(AControl, AWidth)+CharHSpace;
    Height := TextHeight(AControl, 1);
  end;
end;

procedure AdjustControlHeight(AControl: TWinControl; ACanvas: TCanvas);
var Value, AHeight, i : Integer;
begin
  with AControl do
  if (ControlCount <> 0) and (Parent <> nil) then
  begin
    Value := 0;
    for i := 0 to ControlCount-1 do
    with Controls[i] do
    begin
       if AControl.Controls[i] is TQRCustomLabel then
       begin
         AHeight := Top+TextHeight(AControl.Controls[i] as TQRCustomLabel, 1);
         if AHeight > Value then
              Value := AHeight;
       end
         else
           if (Top+Height) > Value then
              Value := Top+Height;
    end;
    if Value <> Height then
       Height := Value;
  end;
end;

{ TQRaCustomLabel }

function TQRaCustomLabel.GetLeftInChars: Integer;
begin
  if csDesigning in ComponentState then
  begin
     Result := NumHorChars(Self, Left);
     FLeftInChars := Result;
  end
    else
     Result := FLeftInChars;
  //Left := TextWidth(Self, Result);
end;

procedure TQRaCustomLabel.SetLeftInChars(const Value: Integer);
begin
  FLeftInChars := Value;
  Left := TextWidth(Self, FLeftInChars);
end;

function TQRaCustomLabel.GetWidthInChars: Integer;
begin
  if csDesigning in ComponentState then
  begin
     Result := NumHorChars(Self, Width);
     FWidthInChars := Result;
  end
    else
     Result := FWidthInChars;
  //Width := TextWidth(Self, Result);
end;

procedure TQRaCustomLabel.SetWidthInChars(const Value: Integer);
begin
  FWidthInChars := Value;
  Width := TextWidth(Self, FWidthInChars)+CharHSpace;
end;

function TQRaCustomLabel.GetTopInChars: Integer;
begin
  Result := NumVertChars(Self, Top);
  Top := TextHeight(Self, Result);
end;

procedure TQRaCustomLabel.SetTopInChars(const Value: Integer);
begin
  Top := TextHeight(Self, Value);
end;

procedure TQRaCustomLabel.SetAutoSizing(const Value: boolean);
begin
  if Value then
     DoResize(Self, TopInChars, LeftInChars, Length(Caption));
end;

procedure TQRaCustomLabel.CMParentFontChanged(var Message: TMessage);
var ATop, ALeft, AWidth: Integer;
    IsParentChanged: Boolean;
begin
  IsParentChanged := ParentChanged;
  ATop := TopInChars;
  ALeft := LeftInChars;
  AWidth := WidthInChars;
  Inherited;
  Application.ProcessMessages;
  if IsParentChanged then
  begin
    ATop := TopInChars;
    ALeft := LeftInChars;
  end;
  DoResize(Self, ATop, ALeft, AWidth);
  ParentChanged := False;
end;

procedure TQRaCustomLabel.SetParent(AParent: TWinControl);
begin
  if (AParent <> Parent) and (Parent = nil) then
    ParentChanged := True;
  inherited;
  if Parent <> nil then
     DoResize(Self, TopInChars, LeftInChars, Length(Caption));
end;

procedure TQRaCustomLabel.FormatLines;
var Value : Integer;
begin
  if (Parent <> nil) then
  begin
    if ParentReport <> nil then
      Value := longint(ParentReport.TextHeight(Font, 'W') * Zoom div 100) + 1
     else
      Value := abs(Font.Height);
    if Height <> Value then
       Height := Value;
    Value := TextWidth(Self, LeftInChars);
    if Value <> Left then
       Left := Value;
    Value := TextWidth(Self, WidthInChars)+CharHSpace;
    if Value <> Width then
       Width := Value;
  end;
  Inherited;
end;

function TQRaCustomLabel.GetAutoSizing: boolean;
begin
   Result := AutoSize;
end;

function TQRaCustomLabel.GetHeightInChars: Integer;
begin
  Result := 1;
end;

constructor TQRaCustomLabel.Create(AOwner: TComponent);
begin
   Inherited;
   AutoSize := False;
   ParentFont := True;
   Transparent := True;
end;

{ TQRaHLine }
constructor TQRaHLine.Create(AOwner: TComponent);
begin
   Inherited;
   FCharacter := '-';
   Caption := FCharacter;
end;

function TQRaHLine.GetLineText: String;
var i: Integer;
begin
   Result := FCharacter;
   for i := 1 to WidthInChars-1 do
      Result := Result + FCharacter;
   if csDesigning in ComponentState then
      while Canvas.TextWidth(Result) < Width do
         Result := Result + FCharacter;
end;

procedure TQRaHLine.FormatLines;
var ACaption: String;
begin
  if (Parent <> nil) then
  begin
   ACaption := GetLineText;
   if Caption <> ACaption then
     Caption := ACaption;
  end;
  Inherited;
end;

procedure TQRaHLine.SetCharacter(const Value: Char);
begin
  FCharacter := Value;
  Caption := GetLineText;
end;

{ TQRaSysData }

constructor TQRaSysData.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  FText := '';
  CreateCaption;
end;

procedure TQRaSysData.Print(OfsX,OfsY : integer);
begin
  case FData of
    qrsTime : Caption := FText+FormatDateTime('t',SysUtils.Time);
    qrsDate : Caption := FText+FormatDateTime('c',SysUtils.Date);
    qrsDateTime : Caption := FText+FormatDateTime('c',Now);
    qrsPageNumber : Caption := FText+IntToStr(ParentReport.PageNumber);
    qrsReportTitle: Caption := FText+ParentReport.ReportTitle;
    qrsDetailCount: Caption := FText+IntToStr(TQuickRep(ParentReport).RecordCount);
    qrsDetailNo : Caption := FText+IntToStr(TQuickRep(ParentReport).RecordNumber);
  end;
  inherited Print(OfsX,OfsY);
end;

procedure TQRaSysData.CreateCaption;
begin
  case FData of
  {$IFDEF VER100}
    qrsTime : Caption := FText+'('+LoadStr(SqrTime)+')';
    qrsDate : Caption := FText+'('+LoadStr(SqrDate)+')';
    qrsDateTime : Caption := FText+'('+LoadStr(SqrDateTime)+')';
    qrsPageNumber : Caption := FText+'('+LoadStr(SqrPageNum)+')';
    qrsReportTitle: Caption := FText+'('+LoadStr(SqrReportTitle)+')';
    qrsDetailCount: Caption := FText+'('+LoadStr(SqrDetailCount)+')';
    qrsDetailNo : Caption := Ftext+'('+LoadStr(SqrDetailNo)+')';
  {$ELSE}
    qrsTime : Caption := FText+'('+SqrTime+')';
    qrsDate : Caption := FText+'('+SqrDate+')';
    qrsDateTime : Caption := FText+'('+SqrDateTime+')';
    qrsPageNumber : Caption := FText+'('+SqrPageNum+')';
    qrsReportTitle: Caption := FText+'('+SqrReportTitle+')';
    qrsDetailCount: Caption := FText+'('+SqrDetailCount+')';
    qrsDetailNo : Caption := Ftext+'('+SqrDetailNo+')';
  {$ENDIF}
  end;
  Invalidate;
end;

procedure TQRaSysData.SetData(Value : TQRSysDataType);
begin
  FData := Value;
  CreateCaption;
end;

procedure TQRaSysData.SetText(Value : String);
begin
  FText := Value;
  CreateCaption;
end;

{ TQRaExpr }
constructor TQRaExpr.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  Evaluator := TQREvaluator.Create;
  FExpression := '';
  FMask := '';
end;

destructor TQRaExpr.Destroy;
begin
  Evaluator.Free;
  inherited Destroy;
end;

function TQRaExpr.GetValue : TQREvResult;
begin
  if Evaluator.Prepared then
    result := Evaluator.Value
  else
    result.Kind := resError;
  if result.Kind=resError then
    result.strResult := {$IFDEF VER100}
                            LoadStr(SqrErrorInExpr);
                        {$ELSE}
                            SqrErrorInExpr;
                        {$ENDIF}
end;

procedure TQRaExpr.Reset;
begin
   Evaluator.Reset;
end;

procedure TQRaExpr.SetMaster(AComponent : TComponent);
begin
  FMaster := AComponent;
end;

procedure TQRaExpr.QRNotification(Sender : TObject; Operation : TQRNotifyOperation);
begin
  inherited QRNotification(Sender, Operation);
  case Operation of
    qrMasterDataAdvance : begin
                            Evaluator.Aggregate := true;
                            Evaluator.Value;
                            Evaluator.Aggregate := false;
                          end;
  end;
end;

procedure TQRaExpr.Prepare;
begin
  inherited Prepare;
  Evaluator.DataSets := ParentReport.AllDataSets;
  Evaluator.Prepare(FExpression);
  if assigned(FMaster) then
  begin
    if Master is TQuickRep then
      TQuickRep(Master).AddNotifyClient(Self)
    else
      if Master is TQRSubDetail then
        TQRSubDetail(Master).AddNotifyClient(Self);
  end else
    if Evaluator.IsAggreg then ParentReport.AddNotifyClient(Self);
  Reset;
end;

procedure TQRaExpr.Unprepare;
begin
  Evaluator.DataSets := nil;
  Evaluator.Unprepare;
  inherited Unprepare;
  SetExpression(Expression);
end;

procedure TQRaExpr.Print(OfsX, OfsY : integer);
var
  aValue : TQREvResult;
begin
  if Enabled then
  begin
    aValue := Evaluator.Value;
    case aValue.Kind of
      resInt : Caption := FormatFloat(Mask, aValue.IntResult*1.0);
      resString : Caption := aValue.strResult;
      resDouble : Caption := FormatFloat(Mask,aValue.DblResult);
      resBool : if aValue.booResult then Caption := 'True' else Caption := 'False';
      resError : Caption := FExpression;
    end;
    inherited Print(OfsX, OfsY);
    if ResetAfterPrint then Reset;
  end;
end;

procedure TQRaExpr.SetExpression(Value : string);
begin
  FExpression := Value;
  if Value='' then
    Caption := '(' + {$IFDEF VER100}
                       LoadStr(SqrNone)
                     {$ELSE}
                       SqrNone
                     {$ENDIF} + ')'
  else
    Caption := Value;
  Invalidate;
end;

procedure TQRaExpr.SetMask(Value : string);
begin
  FMask := Value;
  SetExpression(Expression);
end;

{ TQRaDBText }

constructor TQRaDBText.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  DataSourceName := '';
end;

procedure TQRaDBText.SetDataSet(Value : TDataSet);
begin
  FDataSet := Value;
  if Value <> nil then
    Value.FreeNotification(self);
end;

procedure TQRaDBText.SetDataField(Value : string);
begin
  FDataField := Value;
  Caption := Value;
end;

procedure TQRaDBText.Loaded;
var
  aComponent : TComponent;
begin
  inherited Loaded;
  if DataSourceName<>'' then
  begin
    aComponent := Owner.FindComponent(DataSourceName);
    if (aComponent <> nil) and (aComponent is TDataSource) then
      DataSet:=TDataSource(aComponent).DataSet;
  end;
end;

procedure TQRaDBText.DefineProperties(Filer: TFiler);
begin
  Filer.DefineProperty('DataSource',ReadValues,WriteValues,false);
  inherited DefineProperties(Filer);
end;

procedure TQRaDBText.ReadValues(Reader : TReader);
begin
  DataSourceName := Reader.ReadIdent;
end;

procedure TQRaDBText.WriteValues(Writer : TWriter);
begin
end;

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

procedure TQRaDBText.SetMask(Value : string);
begin
  FMask := Value;
end;

procedure TQRaDBText.Prepare;
begin
  inherited Prepare;
  if assigned(FDataSet) then
  begin
    Field := FDataSet.FindField(FDataField);
    if Field <> nil then
    begin
      FieldNo := Field.Index;
      FieldOK := true;
      if (Field is TMemoField) or (Field is TBlobField) then
      begin
        Caption := '';
      end;
    end;
  end else
  begin
    Field := nil;
    FieldOK := false;
  end;
end;

procedure TQRaDBText.Print(OfsX, OfsY : integer);
begin
  if Enabled then
  begin
    if FieldOK then
    begin
      if FDataSet.DefaultFields then
        Field := FDataSet.Fields[FieldNo];
    end
    else
      Field := nil;
    if assigned(Field) then
    begin
      try
        if (Field is TMemoField) or
           (Field is TBlobField) then
        begin
          Lines.Text := TMemoField(Field).AsString;
        end else
          if (Mask = '') or (Field is TStringField) then
            if not (Field is TBlobField) then
              Caption := Field.DisplayText
            else
              Caption := Field.AsString
          else
          begin
            if (Field is TIntegerField) or
               (Field is TSmallIntField) or
               (Field is TWordField) then
               Caption := FormatFloat(Mask, TIntegerField(Field).Value * 1.0)
            else
              if (Field is TFloatField) or
                 (Field is TCurrencyField) or
                 (Field is TBCDField) then
                 Caption := FormatFloat(Mask,TFloatField(Field).Value)
              else
                if (Field is TDateTimeField) or
                   (Field is TDateField) or
                   (Field is TTimeField) then Caption := FormatDateTime(Mask,TDateTimeField(Field).Value);
          end;
      except
        Caption := '';
      end;
    end else
      Caption := '';
    //DoneFormat := false;
    inherited Print(OfsX,OfsY);
  end;
end;

procedure TQRaDBText.Unprepare;
begin
  Field := nil;
  inherited Unprepare;
  if DataField <> '' then
    SetDataField(DataField)
  else
    SetDataField(Name);
end;

{ TQRaFieldsProperty }

function TQRaFieldsProperty.GetAttributes: TPropertyAttributes;
begin
 Result := [paValueList];
end;

procedure TQRaFieldsProperty.GetValues(Proc: TGetStrProc);
var i: Integer;
    AField: TQRaDBText;
begin
   AField := GetComponent(0) as TQRaDBText;
   if AField <> nil then
   with AField do
   begin
    if (DataSet <> nil) then
      for i := 0 to DataSet.FieldCount-1 do
        Proc(DataSet.Fields[i].FieldName);
  end;
end;

{ TQRaBand }

procedure TQRaBand.CMParentFontChanged(var Message: TMessage);
begin
  AdjustControlHeight(Self, Canvas);
  Inherited;
end;

procedure TQRaBand.Paint;
begin
  AdjustControlHeight(Self, Canvas);
  Inherited;
end;

{ TQRaSubDetail }

procedure TQRaSubDetail.CMParentFontChanged(var Message: TMessage);
begin
  AdjustControlHeight(Self, Canvas);
  Inherited;
end;

procedure TQRaSubDetail.Paint;
begin
  AdjustControlHeight(Self, Canvas);
  Inherited;
end;

{ TQRaGroup }

procedure TQRaGroup.CMParentFontChanged(var Message: TMessage);
begin
  AdjustControlHeight(Self, Canvas);
  Inherited;
end;

procedure TQRaGroup.Paint;
begin
  AdjustControlHeight(Self, Canvas);
  Inherited;
end;

{ TQRaAsciiExportFilter }

function TQRaAsciiExportFilter.GetDescription : string;
begin
  result := {$IFDEF VER100}
               LoadStr(SqrAsciiFilterDescription);
            {$ELSE}
               SqrAsciiFilterDescription;
            {$ENDIF}
end;

function TQRaAsciiExportFilter.GetFilterName : string;
begin
  result := {$IFDEF VER100}
               LoadStr(SqrAsciiFilterName);
            {$ELSE}
               SqrAsciiFilterName;
            {$ENDIF}
end;

function TQRaAsciiExportFilter.GetExtension : string;
begin
  result := {$IFDEF VER100}
               LoadStr(SQrAsciiFilterExtension);
            {$ELSE}
               SQrAsciiFilterExtension;
            {$ENDIF}
end;

procedure TQRaAsciiExportFilter.Start(PaperWidth, PaperHeight : integer; Font : TFont);

  function GetChWidth: Double;
  var ACanvas: TCanvas;
      AWidth: Integer;
  begin
     ACanvas := TCanvas.Create;
     ACanvas.Handle := GetDC(0);
     ACanvas.Font := Font;
     AWidth := ACanvas.TextWidth('-');
     ReleaseDC(0, ACanvas.Handle);
     ACanvas.Handle := 0;
     ACanvas.Free;
     if PrinterType = ptText then
        Result := 25.4
      else
       Result := 25.4*AWidth/MatrixCharWidth;
  end;

begin
  AssignFile(aFile, Filename);
  Rewrite(aFile);
  XFactor := GetChWidth;
  YFactor := 25.4*16/MatrixCharWidth;
  LineCount:=round(PaperHeight / YFactor);
  PageNo := 0;
end;

procedure TQRaAsciiExportFilter.EndPage;
var
  I : integer;
begin
  if PageNo > 0 then
  begin
    Lines[LineCount-1] := Lines[LineCount-1]+ #12;
    for I := 0 to LineCount-1 do
      //if Length(Lines[I]) > 0 then
         Writeln(aFile, ConvertToCp866(Lines[I]));
  end;
  Inc(PageNo);
end;

procedure TQRaAsciiExportFilter.Finish;
begin
  CloseFile(aFile);
end;

procedure TQRaAsciiExportFilter.NewPage;
var
  I : integer;
begin
  for I := 0 to 200 do
    Lines[I] := '';
end;

procedure TQRaAsciiExportFilter.TextOut(X, Y : Extended; Font : TFont; BGColor : TColor; Alignment : TAlignment; Text : string);

  function dup(aChar : Char; Count : integer) : string;
  var
    I : integer;
  begin
    result := '';
    for I := 1 to Count do result := result + aChar;
  end;

var
  aLine: string;
  aY: Integer;
begin
  X := X / XFactor+1;
  aY := Trunc((Y-10) / YFactor);
  if aY >= 0 then
  begin
    if Alignment=taRightJustify then
      X := Trunc(X) - Length(Text)
     else
    if Alignment=taCenter then
      X := X - Length(Text)/2;
    aLine := Lines[aY];
    if length(aLine) < X then
      aLine:=aLine+dup(' ', round(X) - length(aLine));
    Delete(aLine, round(X), Length(Text));
    Insert(Text, aLine, round(X));
    Lines[aY] := aLine;
  end;
end;

function TQRaAsciiExportFilter.ConvertToCp866(Text: String): String;
var i: Integer;
begin
  Result := Text;
  for i := 1 to Length(Result) do
  begin
     case Result[i] of
      '≡'..' ': Result[i] := char(byte(Result[i])-$10);
      '└'..'∩': Result[i] := char(byte(Result[i])-$40);
     end;
  end;
end;

end.