QRLabelで上付文字を表示するには？ (ID：29446)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

実装部

constructor TQRMetafileImage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FMetaFile := TMetafile.Create;
  FMetaCanvas := nil;
  Height := 80;
  Width := 80;
  FScale := 100;
end;

destructor TQRMetafileImage.Destroy;
begin
  if FMetaCanvas <> nil then FreeAndNil(FMetaCanvas);
  FMetaFile.Free;
  inherited Destroy;
end;

function TQRMetafileImage.GetCanvas: TCanvas;
begin
  if FMetaCanvas = nil then begin
    FMetaFile.Width  := Round(Width  * FScale / 100);
    FMetaFile.Height := Round(Height * FScale / 100);
    FMetaCanvas := TMetafileCanvas.Create(FMetaFile, 0);
  end;
  Result := FMetaCanvas;
end;

procedure TQRMetafileImage.SetMetaFile(aMetaFile: TMetaFile);
begin
  FMetaFile.Assign(aMetaFile);
end;

procedure TQRMetafileImage.SetScale(aScale: Word);
begin
  if aScale < 10 then aScale := 10;
  if FScale <> aScale then begin
    FScale := aScale;
    if FMetaCanvas = nil then FreeAndNil(FMetaCanvas);
  end;
end;

procedure TQRMetafileImage.Paint;
var
  dest	:TRect;
begin
  if csDesigning in ComponentState then begin
    with inherited Canvas do begin
      Pen.Style := psDash;
      Brush.Style := bsClear;
      Rectangle(0, 0, Width, Height);
    end;
  end;
  if Zoom <> 100 then begin
    dest.Right  := dest.Left + (dest.Right - dest.Left) * Zoom div 100;
    dest.Bottom := dest.Top + (dest.Bottom - dest.Top) * Zoom div 100;
  end;
  inherited Canvas.StretchDraw(dest, FMetaFile);
  Inherited Paint;
end;

procedure TQRMetafileImage.Print(OfsX,OfsY : Integer);
var
  dest :TRect;
  printDC, savedDC: THandle;
begin
  if FMetaCanvas <> nil then FreeAndNil(FMetaCanvas);

dest := Rect(QRPrinter.XPos(OfsX + Size.Left),
    QRPrinter.YPos(OfsY + Size.Top),
    QRPrinter.XPos(OfsX + Size.Width + Size.Left),
    QRPrinter.YPos(OfsY + Size.Height + Size.Top));

IntersectClipRect(QRPrinter.Canvas.Handle, dest.Left,
		    dest.Top, dest.Right, dest.Bottom);

printDC := GetDC(QRPrinter.Canvas.Handle);
  savedDC := SaveDC(printDC);

QRPrinter.Canvas.StretchDraw(dest, FMetaFile);

RestoreDC(printDC, savedDC);

SelectClipRgn(QRPrinter.Canvas.Handle, 0);

Transparent := True;
  inherited Print(OfsX,OfsY);
end;

function TQRMetafileImage.GetCanvasSize(aIndex: Integer): Integer;
begin
  if aIndex = 1 then
    Result := Height * FScale Div 100
  else
    Result := Width  * FScale Div 100;
end;

←解決時は質問者本人がここをチェックしてください。

戻る