お知らせ

電子会議

ライブラリ

パレット

Delphi FAQ検索

Delphi FAQ一覧

サンプル蔵





FDelphi FAQ
16番会議室「玉石混淆みんなで作るSample蔵」に寄せられたサンプル

"斜線鎖線極細極太色付文字間隔LightReport3"

この発言は
#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蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。

Copyright 1996-2002 Delphi Users' Forum