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



procedure TLRItemExt.SetLineTopStyle(ALineStyle: TLineStyleObject);
begin
  FLineTopStyle.Assign(ALineStyle);
end;
procedure TLRItemExt.SetLineRightStyle(ALineStyle: TLineStyleObject);
begin
  FLineRightStyle.Assign(ALineStyle);
end;
procedure TLRItemExt.SetLineLeftStyle(ALineStyle: TLineStyleObject);
begin
  FLineLeftStyle.Assign(ALineStyle);
end;
procedure TLRItemExt.SetLineBottomStyle(ALineStyle: TLineStyleObject);
begin
  FLineBottomStyle.Assign(ALineStyle);
end;
procedure TLRItemExt.
  SetLineLeftTopToRightBottomStyle(ALineStyle: TLineStyleObject);
begin
  LineLeftTopToRightBottomStyle.Assign(ALineStyle);
end;
procedure TLRItemExt.
  SetLineRightTopToLeftBottomStyle(ALineStyle: TLineStyleObject);
begin
  LineRightTopToLeftBottomStyle.Assign(ALineStyle);
end;
procedure TLRItemExt.SetCharSpace(const Value: Double);
begin
  if FCharSpace <> Value then
  begin
    FCharSpace := Value;
    Invalidate;
  end;
end;
procedure TLRItemExt.SetIsDrawText(const Value: Boolean);
begin
  if FIsDrawText <> Value then
  begin
    FIsDrawText := Value;
    Invalidate;
  end;
end;
procedure TLRItemExt.SetIsDrawLine(const Value: Boolean);
begin
  if FIsDrawLine <> Value then
  begin
    FIsDrawLine := Value;
    Invalidate;
  end;
end;
procedure TLRItemExt.SetAlignment(const Value: TAlignment);
begin
  if FAlignment <> Value then
  begin
    FAlignment := Value;
    Invalidate;
  end;
end;
procedure TLRItemExt.SetTransparent(const Value: boolean);
begin
  if FTransParent <> Value then
  begin
    FTransParent := Value;
    Invalidate;
  end;
end;
procedure TLRItemExt.SetLayout(const Value: TTextLayout);
begin
  if FLayout <> Value then
  begin
    FLayout := Value;
    Invalidate;
  end;
end;
procedure TLRItemExt.SetHMargin(const Value: Double);
begin
  if (FHMargin <> Value) and (Value < 256) and (Value > -256) then
  begin
    FHMargin := Value;
    Invalidate;
  end;
end;
procedure TLRItemExt.SetVMargin(const Value: Double);
begin
  if (FVMargin <> Value) and (Value < 256) and (Value > -256) then
  begin
    FVMargin := Value;
    Invalidate;
  end;
end;
procedure TLRItemExt.SetEditMask(const Value: string);
begin
  if FEditMask <> Value then
  begin
    FEditMask := Value;
    Invalidate;
  end;
end;
procedure TLRItemExt.SetWordWrap(const Value: Boolean);
begin
  if FWordWrap <> Value then
  begin
    FWordWrap := Value;
    Invalidate;
  end;
end;
procedure TLRItemExt.SetText(const Value: string);
begin
  if Caption <> Value then
    Caption := Value;
end;
function TLRItemExt.GetDiaplayText: string;
var
  s: string;
  i: integer;
  flg: boolean;
begin
  // マスクが指定されていたら
  if (FEditMask <> '') and (Caption <> '') then
  begin
    s := Caption;
    flg := True;
    for i := 1 to Length(s) do
      if not (s[i] in ['0'..'9', '.', '-', '+']) then
      begin
        flg := False;
        Break;
      end;
    // 数字に変換できる場合はFormatFloatを使う
    if flg then
      Result := FormatFloat(FEditMask, StrToFloat(s))
    else
      // 数字以外の場合はFormatMuskTextを使う
      Result := FormatMaskText(FEditMask, s);
  end
  else
    Result := Caption;
end;
function TLRItemExt.GetText: string;
begin
  Result := Caption;
end;
procedure TLRItemExt.Paint;
var
  TmpPrintScale: Double;
begin
  TmpPrintScale := 1;
  Print(Canvas, GetClientRect, TmpPrintScale, psNormal);
end;
procedure TLRItemExt.
  DrawText(ACanvas: TCanvas; ARect: TRect; APrintScale: Double);
var
  txt: string;
  SV_TextHeight: Integer;
  Flags: Cardinal;
  tmpRect,CalcRect: TRect;
begin
  ACanvas.Font := Self.Font;
  txt := GetDiaplayText;
  SV_TextHeight := ACanvas.TextHeight('|');
  // フラグのセット
  Flags := 0;
  if FWordWrap then
    Flags := Flags or DT_WORDBREAK
  else
    Flags := Flags or DT_SINGLELINE;
  case FAlignment of
    taLeftJustify: Flags := Flags or DT_LEFT;
    taRightJustify: Flags := Flags or DT_RIGHT;
    else
      Flags := Flags or DT_CENTER;
  end;
  // 位置の計算
  TmpRect := ARect;
  with CalcRect do
  begin
    Top := 0;
    Bottom := SV_TextHeight;
    Left := 0;
    Right := RoundOff(TmpRect.Right - TmpRect.Left - HMargin * APrintScale);
  end;
  Windows.DrawText(
    ACanvas.Handle, PChar(txt), -1, CalcRect, Flags or DT_CALCRECT);
  SV_TextHeight := CalcRect.Bottom;
  // 横位置調整
  with TmpRect do
    case FAlignment of
      taLeftJustify: Left := RoundOff(Left + HMargin * APrintScale);
      taRightJustify: Right := RoundOff(Right - HMargin * APrintScale);
    end;
  // 縦位置調整
  with TmpRect do
    case FLayout of
      tlTop: Top := RoundOff(Top + VMargin * APrintScale);
      tlBottom: Top := RoundOff(Bottom - VMargin * APrintScale - SV_TEXTHEIGHT
);
      else
        Top := Top + (ARect.Bottom - ARect.Top - SV_TEXTHEIGHT) div 2;
    end;
  // 文字列の描写
  SetTextCharacterExtra(ACanvas.Handle, RoundOff(FCharSpace * APrintScale));
  Windows.DrawText(ACanvas.Handle, PChar(txt), -1, TmpRect, Flags);
end;
procedure TLRItemExt.Print(ACanvas: TCanvas; ARect: TRect;
      APrintScale: Double; APrintStatus: TPrintStatus);
var
  PrintRect: TRect;
begin
  ACanvas.Brush.Color := Color;
  if FTransParent then
    ACanvas.Brush.Style := bsClear;
  // TmpRectを印刷面のスケールに変換する
  with ARect do
    PrintRect :=
      PrintScaleRect(Rect(Left, Top, Right-1, Bottom-1), APrintScale);
  ACanvas.FillRect(PrintRect);
  //ACanvas.ClipRect := PrintRect;
  
  if FIsDrawText and (APrintStatus = psNormal) then
    DrawText(ACanvas, PrintRect, APrintScale);
  if FIsDrawLine and
    ((APrintStatus = psNormal) or (APrintStatus = psLineOnly)) then
  begin
    FLineTopStyle.DrawLine(ACanvas, PrintRect, APrintScale);
    FLineRightStyle.DrawLine(ACanvas, PrintRect, APrintScale);
    FLineLeftStyle.DrawLine(ACanvas, PrintRect, APrintScale);
    FLineBottomStyle.DrawLine(ACanvas, PrintRect, APrintScale);
    FLineRightTopToLeftBottomStyle.DrawLine(ACanvas, PrintRect, APrintScale);
    FLineLeftTopToRightBottomStyle.DrawLine(ACanvas, PrintRect, APrintScale);
  end;
end;
end.
 


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

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

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