如何在程序代码中实现 在quickrep中指定的两点之间画斜线?,请高手帮忙!!谢谢!

解决方案 »

  1.   

    呵呵,转自《Delphi之未经证实的葵花宝典version 2.7》
    安装一下自定义VCL,应该就可以用了。unit qrline;interfaceuses
      Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
      quickrpt;type
      TQRLineStyle = (QRLineH,QRLineV,QRLineC);  TQRLine = class(TQRPrintable)
      private
        FPen: TPen;
        FLineStyle: TQRLineStyle;
        procedure setPen(value: TPen);
        procedure setLineStyle(value: TQRLineStyle);
        procedure onPenChanged(Sendoer: TObject);
      protected
        { Protected declarations }
      public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;    procedure Paint; override;
        procedure Print(OfsX, OfsY : integer); override;
      published
        property Pen: TPen read FPen write setPen;
        property LineStyle: TQRLineStyle read FLineStyle write setLineStyle;
      end;procedure Register;implementationconstructor TQRLine.Create(AOwner: TComponent);
    begin
      inherited Create(AOwner);  ControlStyle := ControlStyle - [csOpaque];
      FPen := TPen.Create;
      FPen.OnChange := onPenChanged;
      width := 100;
      height := 100;
    end;destructor TQRLine.Destroy;
    begin
      FPen.Free;  inherited Destroy;
    end;procedure TQRLine.SetPen(Value: TPen);
    begin
      FPen.Assign(value);
      Invalidate;
    end;procedure TQRLine.setLineStyle(value: TQRLineStyle);
    begin
      if FLineStyle <> value then
      begin
        FLineStyle := value;
        Invalidate;
      end;
    end;procedure TQRLine.onPenChanged(Sendoer: TObject);
    begin
      Invalidate;
    end;procedure TQRLine.Paint;
    var
      calDiff: integer;
    begin
      with Canvas do
      begin
        Pen := FPen;
        calDiff := Pen.Width div 2;
        MoveTo(calDiff,calDiff);
        case LineStyle of
          QRLineH: LineTo(width, 0 + calDiff);
          QRLineV: LineTo(calDiff, Height);
          QRLineC: LineTo(width, Height);
        end;
      end;
    end;procedure TQRLine.Print(OfsX, OfsY : integer);
    var
      CalcLeft,
      CalcTop,
      CalcRight,
      CalcBottom: integer;
    begin
      with ParentReport.QRPrinter do
      begin
        Canvas.Pen := FPen;
        CalcLeft := XPos(OfsX + Size.Left);
        CalcTop := YPos(OfsY + Size.Top);
        CalcRight := XPos(OfsX + Size.Left + Size.Width);
        CalcBottom := YPos(OfsY + Size.Top + Size.Height);
        with Canvas do
        begin
          MoveTo(CalcLeft,CalcTop);
          case LineStyle of
            QRLineH:
              LineTo(CalcRight, CalcTop);
            QRLineV:
              LineTo(CalcLeft, CalcBottom);
            QRLineC:
              LineTo(CalcRight, CalcBottom);
          end;
        end;
      end;
    end;procedure Register;
    begin
      RegisterComponents('QReport', [TQRLine]);
    end;end.