縦書き文字列に対応するＶＣＬはあるでしょうか (ID:35533)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

既に解決済ですが．．．
以前どこからか貰ったものに少し手を加えたもので
シンプルなソースになっていますので不要かも知れませんが
良ければどうぞ。

先にフォームに PaintBoxを貼ります。

TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    SpeedButton1: TSpeedButton;

//---------------------------------------------
type
  Canvas_P  = ^TCanvas ;

VFStrOut_ = record
    FAngle  :integer ;   // 角度  2700=縦書
    FCol    :integer ;   // 文字色
    FColBK  :integer ;   // 文字背景色
    FStyle  :integer ;   // 1=BOLD    0=Normal
    FItalic :integer ;   // 1=Italic
    Fsize   :integer ;   // 9-99
    Fname   :string ;    // フォント名
    Pcvas   :Canvas_P ;  // canvas
    FposX   :integer ;   // 座標
    FposY   :integer ;   //
    outstr  :string ;    // 出力文字
  end ;

//---------------------------------------------
// Canvas上に文字縦書きルーティン
procedure CVStrOut(VFStrOutX:VFStrOut_) ;
var
  LogFont1 : TLogFont ;
begin
  with VFStrOutX do begin
    with LogFont1 do begin
      lfHeight       := Fsize ;
      lfWidth        := 0 ;
      lfEscapement   := FAngle ;
      lfOrientation  := 0 ;
      lfWeight       := FW_NORMAL ; // FW_BOLD ;  FW_NORMAL
      lfItalic       := 0 ;   // 1=on  0=off
      if FStyle=1  then lfWeight := FW_BOLD ;
      if FItalic=1 then lfItalic := 1 ;
      lfUnderline    := 0 ;
      lfStrikeOut    := 0 ;
      lfCharSet        := DEFAULT_CHARSET ;
      lfOutPrecision   := OUT_DEFAULT_PRECIS ;
      lfClipPrecision  := CLIP_DEFAULT_PRECIS ;
      lfQuality        := DEFAULT_QUALITY ;
      lfPitchAndFamily := DEFAULT_PITCH ;
      StrPCopy(lfFaceName,Fname) ;  // '@ＭＳ ゴシック'
    end;
    with Pcvas^ do begin
      Font.Handle   := CreateFontIndirect(LogFont1) ;
      Font.Color    := clBlue ;
      Brush.Style   := bsClear ;
      TextOut(FposX,FposY, outstr ) ;
    end;
  end;
end;

//------------------------------------------
procedure TForm1.SpeedButton1Click(Sender: TObject);
var
  VFStrOut : VFStrOut_ ;
begin
  with VFStrOut do begin
    FAngle  :=2700 ;   // 角度
    FCol    :=clBlue ; // 色
    FStyle  :=1 ;
    FItalic :=0 ;
    Fsize   :=26 ;
    Pcvas   :=@PaintBox1.canvas ;
    Fname   :='@ＭＳ ゴシック' ;
    FposX   := 100 ;
    FposY   := 10 ;
    outstr  :='東京都港区123１２３４５' ;
  end ;
  CVStrOut(VFStrOut) ;
end;

←解決時は質問者本人がここをチェックしてください。

戻る