Shape:=qrsVertLine

Inherited Paint

end

end

end

procedure TMyQRShape.Print(OfsX,OfsY : Integer);

begin

with QRPrinter do

begin

case LineType of

BottomTop:

begin

Canvas.MoveTo(XPos(OfsX + Size.Left), YPos(OfsY + Size.Top)+Height)

Canvas.LineTo(XPos(OfsX + Size.Left)+width,YPos(OfsY + Size.Top) )

end

TopBottom:

begin

Canvas.MoveTo(XPos(OfsX + Size.Left), YPos(OfsY + Size.Top))

Canvas.LineTo(XPos(OfsX + Size.Left)+Width,YPos(OfsY + Size.Top)+Height )

end

None:

Inherited Print(OfsX,OfsY )

end

end

end;

unit MyQRShape;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics,

Controls, Forms, Dialogs,

QuickRpt, Qrctrls;

type

TLines = ( None,TopBottom,BottomTop )

TMyQRShape = class(TQRShape)

private

FLineType:TLines

procedure SetFLineType(value:TLines)

protected

procedure Print(OfsX, OfsY : integer); override;

procedure Paint Override

public

published

property LineType:TLines Read FLineType Write SetFLineType

end;

procedure Register;

implementation

procedure

TMyQRShape.SetFLineType(value:TLines);

begin

if value<>FLineType then

begin

FLineType:=value

Invalidate

end

end

procedure TMyQRShape.Paint

begin

case LineType of

BottomTop:

begin

Canvas.MoveTo(0,Height)

Canvas.LineTo(width,0 )

end

TopBottom:

begin

Canvas.MoveTo(0,0)

Canvas.LineTo(width,Height )

end

None:

begin

Height := Parent.Height

Top:=0

Width:=4

Shape:=qrsVertLine

Inherited Paint

end

end

end

procedure TMyQRShape.Print(OfsX,OfsY : Integer);

begin

with QRPrinter do

begin

case LineType of

BottomTop:

begin

Canvas.MoveTo(XPos(OfsX + Size.Left), YPos(OfsY + Size.Top)+Height)

Canvas.LineTo(XPos(OfsX + Size.Left)+width,YPos(OfsY + Size.Top) )

end

TopBottom:

begin

Canvas.MoveTo(XPos(OfsX + Size.Left), YPos(OfsY + Size.Top))

Canvas.LineTo(XPos(OfsX + Size.Left)+Width,YPos(OfsY + Size.Top)+Height )

end

None:

Inherited Print(OfsX,OfsY )

end

end

end;

procedure Register;

begin

RegisterComponents(‘QReport', [TMyQRShape]);

end;

end.