この発言は
#00977　らせん企画      さんのQuickReport 用 斜線コンポーネント
に対するコメントです

この発言に対し以下のコメントが寄せられています

#01315　フレディ        さん　RE^2:QuickReport 用 斜線コンポーネント




#977 らせん企画 さん こんにちは らせん企画の佐々木です

  QuuckReport のコンポーネントを初めて作りました。
ソースがないとちょっとたいへんですね。なんとか出来
ました。これでどうでっしゃろかいな。

QuickReport で斜線を書くコンポーネントです。



unit QRDiagonal;

interface

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

type
  TLinePos = (lpLeftTop, lpRightTop, lpLeftBottom, lpRightBottom);
  TQRDiagonal = Class(TQRCustomLabel)
  Private
    Function SetPoint(pPos: TLinePos; pRect: TRect): TPoint;
  Protected
    FPixelX, FPixelY: Integer;
    FPos1, FPos2: TLinePos;
    Procedure SetPos1(pPos: TLinePos);
    Procedure SetPos2(pPos: TLinePos);
    Procedure Paint; Override;
    Procedure Print(OfsX, OfsY: Integer); Override;
  Published
    Property Pos1: TLinePos Read FPos1 Write SetPos1;
    Property Pos2: TLinePos Read FPos2 Write SetPos2;
  End;

procedure Register;

implementation

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

Procedure TQRDiagonal.Paint;
Var
  wPos1, wPos2: TPoint;
  wRect: TRect;
Begin
  Inherited;
  With Self.Canvas Do
  Begin
    wRect := Rect(0, 0, Width, Height);
    FillRect(wRect);
    wPos1 := SetPoint(FPos1, wRect);
    wPos2 := SetPoint(FPos2, wRect);
    MoveTo(wPos1.x, wPos1.y);
    LineTo(wPos2.x, wPos2.y);
  End;
End;

Procedure TQRDiagonal.Print(OfsX, OfsY: Integer);
Const
  CInch = 255.55;
Var
  wPos1, wPos2: TPoint;
  wRect: TRect;

  Function XPos(pPos: Extended): Integer;
  Begin
    If FPixelX = 0 Then
      FPixelX := GetDeviceCaps(QRPrinter.Canvas.Handle, LOGPIXELSX);
    Result := Trunc(pPos * FPixelX / CInch);
  End;
  Function YPos(pPos: Extended): Integer;
  Begin
    If FPixelY = 0 Then
      FPixelY := GetDeviceCaps(QRPrinter.Canvas.Handle, LOGPIXELSY);
    Result := Trunc(pPos * FPixelY / CInch);
  End;
Begin
  Inherited;
  wRect := Rect(XPos(OfsX + Size.Left) - 1
              , XPos(OfsY + Size.Top) - 1
              , XPos(OfsX + Size.Left) + Width
              , XPos(OfsY + Size.Top) + Height);
  With Self.QRPrinter.Canvas Do
  Begin
    FillRect(wRect);
    wPos1 := SetPoint(FPos1, wRect);
    wPos2 := SetPoint(FPos2, wRect);
    MoveTo(wPos1.x, wPos1.y);
    LineTo(wPos2.x, wPos2.y);
  End;
End;

Procedure TQRDiagonal.SetPos1(pPos: TLinePos);
Begin
  FPos1 := pPos;
  Paint;
End;

Procedure TQRDiagonal.SetPos2(pPos: TLinePos);
Begin
  FPos2 := pPos;
  Paint;
End;

Function TQRDiagonal.SetPoint(pPos: TLinePos; pRect: TRect): TPoint;
Begin
  Case pPos Of
   lpRightTop:
    Result := Point(pRect.Right - 1, pRect.Top);
   lpLeftBottom:
    Result := Point(pRect.Left, pRect.Bottom - 1);
   lpRightBottom:
    Result := Point(pRect.Right - 1, pRect.Bottom - 1);
   Else
    Result := Point(pRect.Left, pRect.Top);
  End;
End;

end.

             99/11/17(Wed) 02:16pm  BYQ05322 らせん企画の佐々木

Original document by らせん企画      氏 ID:(BYQ05322)

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