この発言は
#01318　かつぼー        さんの斜線鎖線極細極太色付文字間隔LightReport1
に対するコメントです

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

#01320　かつぼー        さん　斜線鎖線極細極太色付文字間隔LightReport3




procedure TLineLeftStyleObject.
  DrawLine(ACanvas: TCanvas; ARect: TRect; APrintScale: Double);
var
  offset, startX, startY, endY: Integer;
  y, line, gap: Double;
begin
  if FWidth <= 0 then Exit;
  if (FLine > 0) and (FLine <= 0) then Exit;
  with ACanvas.Pen do
  begin
    Style := psSolid;
    Color := FColor;
    Width := RoundOff(APrintScale * FWidth);
  end;
  if (csDesigning in FParent.ComponentState) then
    offset := 0
  else
    offset := RoundOff(APrintScale);
  with ARect do
  begin
    startX := Left - offset;
    startY := Top - offset;
    endY := Bottom;
  end;
  with ACanvas do
  begin
    MoveTo(startX, startY);
    if FGap <= 0 then
      LineTo(startX, endY)
    else
    begin
      y := 0;
      line := FLine * APrintScale;
      gap := FGap * APrintScale;
      while (startY + y) < endY do
      begin
        y := y + line;
        LineTo(startX, Min(RoundOff(startY + y), endY));
        y := y + gap;
        MoveTo(startX, RoundOff(startY + y));
      end;
    end;
  end;
end;
procedure TLineRightStyleObject.
  DrawLine(ACanvas: TCanvas; ARect: TRect; APrintScale: Double);
var
  offset, startX, startY, endY: Integer;
  y, line, gap: Double;
begin
  if FWidth <= 0 then Exit;
  if (FLine > 0) and (FLine <= 0) then Exit;
  with ACanvas.Pen do
  begin
    Style := psSolid;
    Color := FColor;
    Width := RoundOff(APrintScale * FWidth);
  end;
  if (csDesigning in FParent.ComponentState) then
    offset := 0
  else
    offset := RoundOff(APrintScale);
  with ARect do
  begin
    startX := Right;
    startY := Top - offset;
    endY := Bottom;
  end;
  with ACanvas do
  begin
    MoveTo(startX, startY);
    if FGap <= 0 then
      LineTo(startX, endY)
    else
    begin
      y := 0;
      line := FLine * APrintScale;
      gap := FGap * APrintScale;
      while (startY + y) < endY do
      begin
        y := y + line;
        LineTo(startX, Min(RoundOff(startY + y), endY));
        y := y + gap;
        MoveTo(startX, RoundOff(startY + y));
      end;
    end;
  end;
end;
procedure TLineBottomStyleObject.
  DrawLine(ACanvas: TCanvas; ARect: TRect; APrintScale: Double);
var
  offset, startX, startY, endX: Integer;
  x, line, gap: Double;
begin
  if FWidth <= 0 then Exit;
  if (FLine > 0) and (FLine <= 0) then Exit;
  with ACanvas.Pen do
  begin
    Style := psSolid;
    Color := FColor;
    Width := RoundOff(APrintScale * FWidth);
  end;
  if (csDesigning in FParent.ComponentState) then
    offset := 0
  else
    offset := RoundOff(APrintScale);
  with ARect do
  begin
    startX := Left - offset;
    startY := Bottom;
    endX := Right;
  end;
  with ACanvas do
  begin
    MoveTo(startX, startY);
    if FGap <= 0 then
      LineTo(endX, startY)
    else
    begin
      x := 0;
      line := FLine * APrintScale;
      gap := FGap * APrintScale;
      while (startX + x) < endX do
      begin
        x := x + line;
        LineTo(Min(RoundOff(startX + x), endX), startY);
        x := x + gap;
        MoveTo(RoundOff(startX + x), startY);
      end;
    end;
  end;
end;
procedure TLineLeftTopToRightBottomStyleObject.
 DrawLine(ACanvas: TCanvas; ARect: TRect; APrintScale: Double);
var
  offset: Integer;
  startX, startY: Integer;
  endX, endY: Integer;
  x, y: Double;
  line, gap: Double;
  diagonalL: Double;
  parX, parY: Double;
begin
  if FWidth <= 0 then Exit;
  if (FLine > 0) and (FLine <= 0) then Exit;
  with ACanvas.Pen do
  begin
    Style := psSolid;
    Color := FColor;
    Width := RoundOff(APrintScale * FWidth);
  end;
  if (csDesigning in FParent.ComponentState) then
    offset := 0
  else
    offset := RoundOff(APrintScale);
  with ARect do
  begin
    startX := Left - offset;
    startY := Top - offset;
    endX := Right;
    endY := Bottom;
  end;
  diagonalL := Sqrt(Sqr(endX - startX) + Sqr(endY - startY));
  parX := (endX - startX) / diagonalL;
  parY := (endY - startY) / diagonalL;
  with ACanvas do
  begin
    MoveTo(startX, startY);
    if FGap <= 0 then
      LineTo(endX, startY)
    else
    begin
      x := 0;
      y := 0;
      line := FLine * APrintScale;
      gap := FGap * APrintScale;
      while ((startX + x * parX) < endX) and
            ((startY + y * parY) < endY) do
      begin
        x := x + line;
        y := y + line;
        LineTo(Min(RoundOff(startX + x * parX), endX), Min(RoundOff(startY + y
 * parY), endY));
        x := x + gap;
        y := y + gap;
        MoveTo(RoundOff(startX + x * parX), RoundOff(startY + y * parY));
      end;
    end;
  end;
end;
procedure TLineRightTopToLeftBottomStyleObject.
 DrawLine(ACanvas: TCanvas; ARect: TRect; APrintScale: Double);
var
  offset: Integer;
  startX, startY: Integer;
  endX, endY: Integer;
  x, y: Double;
  line, gap: Double;
  diagonalL: Double;
  parX, parY: Double;
begin
  if FWidth <= 0 then Exit;
  if (FLine > 0) and (FLine <= 0) then Exit;
  with ACanvas.Pen do
  begin
    Style := psSolid;
    Color := FColor;
    Width := RoundOff(APrintScale * FWidth);
  end;
  if (csDesigning in FParent.ComponentState) then
    offset := 0
  else
    offset := RoundOff(APrintScale);
  with ARect do
  begin
    startX := Left - offset;
    startY := Bottom;
    endX := Right;
    endY := Top - offset;
  end;
  diagonalL := Sqrt(Sqr(endX - startX) + Sqr(endY - startY));
  parX := (endX - startX) / diagonalL;
  parY := (endY - startY) / diagonalL;
  with ACanvas do
  begin
    MoveTo(startX, startY);
    if FGap <= 0 then
      LineTo(endX, startY)
    else
    begin
      x := 0;
      y := 0;
      line := FLine * APrintScale;
      gap := FGap * APrintScale;
      while ((startX + x * parX) < endX) and
            ((startY + y * parY) > endY) do
      begin
        x := x + line;
        y := y + line;
        LineTo(Min(RoundOff(startX + x * parX), endX), Max(RoundOff(startY + y
 * parY), endY));
        x := x + gap;
        y := y + gap;
        MoveTo(RoundOff(startX + x * parX), RoundOff(startY + y * parY));
      end;
    end;
  end;
end;
{ TLRItemExt }
constructor TLRItemExt.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FLineTopStyle := TLineTopStyleObject.Create(Self);
  FLineRightStyle := TLineRightStyleObject.Create(Self);
  FLineLeftStyle := TLineLeftStyleObject.Create(Self);
  FLineBottomStyle := TLineBottomStyleObject.Create(Self);
  FLineLeftTopToRightBottomStyle :=
    TLineLeftTopToRightBottomStyleObject.Create(Self);
  FLineRightTopToLeftBottomStyle :=
    TLineRightTopToLeftBottomStyleObject.Create(Self);
  FHMargin := 2;
  FVMargin := 2;
  FTransparent := True;
  FIsDrawText := True;
  FIsDrawLine := True;
  Color := clWhite;
end;
destructor TLRItemExt.Destroy;
begin
  FLineTopStyle.Free;
  FLineRightStyle.Free;
  FLineLeftStyle.Free;
  FLineBottomStyle.Free;
  FLineLeftTopToRightBottomStyle.Free;
  FLineRightTopToLeftBottomStyle.Free;
  inherited Destroy;
end;
procedure TLRItemExt.CMTextChanged(var Message: TMessage);
begin
  Invalidate;
end;
 


Original document by かつぼー        氏 ID:(CQU00157)

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