縦書き文字列に対応するＶＣＬはあるでしょうか (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;