QuickReportの中抜き文字のラベルのコンポーネントです。

フレディさんのQRrectを参考にしました。

unit QRHollowLabel;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  QuickRpt, Qrctrls;

type
  TQRHollowLabel = class(TQRLabel)
  private
    FColorOutLine: TColor;
    procedure SetColorOutLine(const Value: TColor);
  protected
    { Protected 宣言 }
    procedure Draw( Canvas : TCanvas; offx, offy, yoko, takasa : integer );
  public
    { Public 宣言 }
    constructor Create( AOwner : TComponent ); override;
    procedure Paint; override;
    procedure Print( OfsX, OfsY : integer ); override;
  published
    { Published 宣言 }
    property ColorOutLine : TColor read FColorOutLine write SetColorOutLine de
fault clBlack;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('QReport', [TQRHollowLabel]);
end;

{ TQRHollowLabel }

constructor TQRHollowLabel.Create(AOwner: TComponent);
begin
  inherited;

  Font.Color := clWhite;
  FColorOutLine := clBlack;
end;



procedure TQRHollowLabel.Draw(Canvas: TCanvas; offx, offy, yoko, takasa: integ
er);
var
  x, y : integer;
  wrect : TRect;
begin
  if not Enabled then exit;

  with Canvas do
  begin
    if TransParent = false then
    begin
      wRect := Rect( offx, offy, yoko, takasa );
      FillRect( wRect );
    end;

    x := offx + 2;
    y := offy + 2;
    Brush.Style := bsClear;
    Font.Color := FColorOutLine;
    Font.Size  := Self.Font.Size;
    Font.Pitch := Self.FOnt.Pitch;
    Font.Style := Self.Font.Style;
    Font.Name  := Self.Font.Name;

    TextOut( x-1, y, Caption );
    TextOut( x+1, y, Caption );
    TextOut( x, y-1, Caption );
    TextOut( x, y+1, Caption );

    Font.Color := Self.Font.Color;
    TextOut( x, y, Caption );
  end;
end;



procedure TQRHollowLabel.Paint;
var
  wRect : TRect;
begin
  draw( Canvas, 0, 0, Width, Height );
end;

procedure TQRHollowLabel.Print(OfsX, OfsY: integer);
var
  offx, offy, yoko, takasa : integer;
begin
  with ParentReport.QRPrinter do
  begin
    offx := XPos( OfsX + Size.Left - 1 );
    offy := XPos( OfsY + Size.Top - 1 );

    yoko := XPos( OfsX + Size.Left + Size.Width );
    takasa := YPos( OfsY + Size.Top + Size.Height );

    Draw( Canvas, offx, offy, yoko, takasa );
  end;
end;

procedure TQRHollowLabel.SetColorOutLine(const Value: TColor);
begin
  if FColorOutLine = Value then exit;
  FColorOutLine := Value;
  Invalidate;
end;

end.

 


- FDELPHI  MES(16):玉石混淆みんなで作るSample蔵【見本蓄積】 01/04/23 -

Original document by 青井　勝茂　　　氏 ID:(JBD00012)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。