Labelに縦書きフォントを表示するには？ (ID：10071)

名前

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

本文

前出のコードを参考に，制限付きですが，コンポーネントにしてみました．
もし，後で縦書きを使用する予定があるなら，Canvasへのコードや改行コー
ドを挿入するよりは，楽かも知れません．
Delhian Worldにも同様のコンポーネントがあるかも知れませんが...

以下のコードをplLabel.pasの名前で保存し，plLabel.pasをコンポーネント
としてインストールしてみて下さい．
必要であれば，コンポーネント名などを変更して下さい．

{$WARNINGS OFF}
//====================================================================
//  縦書き横書き両用ラベルコンポーネント
//
//  TLabelを継承したラベル
//  縦書きの場合，ShowAccelCharの設定は無効(常にFalseと同じ)
//  WordWrapも無効
//  当然英数字も縦書きになるので注意
//
//  追加プロパティ
//  Vertical  Trueで縦書き，FalseならTLabelそのもの
//
//                            2004.07.25  Ver.1.0   
//                            HGH03072@nifty.ne.jp Mr.XRAY
//                            http://homepage2.nifty.com/Mr_XRAY/
//====================================================================
unit plLabel;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,StdCtrls;

type
  TplLabel = class(TLabel)
  private
    { Private 宣言 }
    FVertical : Boolean;
    procedure SetVertical(const Value: Boolean);
  protected
    { Protected 宣言 }
    procedure Paint; override;
  public
    { Public 宣言 }
    constructor Create(AOwner: TComponent); override;
  published
    { Published 宣言 }
    property Vertical : Boolean read FVertical write SetVertical;
  end;

//====================================================================
//  コンポーネント登録情報
//====================================================================
procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('plXRAY', [TplLabel]);
end;

{ TplLabel }

//====================================================================
//  Create処理
//====================================================================
constructor TplLabel.Create(AOwner: TComponent);
begin
     inherited Create(AOwner);
end;
//====================================================================
//  横書きか縦書きの設定
//====================================================================
procedure TplLabel.SetVertical(const Value: Boolean);
begin
     if Value<>FVertical then begin
       FVertical:=Value;
       Invalidate;
     end;
end;
//====================================================================
//  描画処理
//  DrawTextではなくTextOutを使用して描画しているための制限はあるが，
//  通常の用途には十分と考える
//====================================================================
procedure TplLabel.Paint;
var
     fMode: Integer;
     LF: TLogFont;
     PosX,PosY: Integer;
begin
     {縦書きの時の処理}
     if FVertical then begin
       with Canvas do begin
         {背景色}
         if not Transparent then begin
           Brush.Color := Self.Color;
           Brush.Style := bsSolid;
           FillRect(ClientRect);
         end;
         Brush.Style := bsClear;

{縦書きフォント作成}
         Font.Assign(Self.Font);
         Font.Name :='@'+Self.Font.Name;
         GetObject(Font.Handle,SizeOf(LF),@LF);
         LF.lfEscapement := -900;
         Font.Handle := CreateFontIndirect(LF);

{AutoSizeがTrueの場合}
         if AutoSize then begin
           SetBounds(Self.Left,Self.Top,TextHeight(Caption),TextWidth(Caption));
         end;

fMode:=0;
         PosX:=0;
         PosY:=0;
         {横方向の位置揃え}
         if Alignment=taLeftJustify  then fMode:=fMode or VTA_LEFT;
         if Alignment=taCenter       then PosX:=(Width+TextHeight(Caption)) div 2;
         if Alignment=taRightJustify then begin
           PosX:=Width;
           fMode:=fMode or VTA_RIGHT;
         end;
         {縦方向の位置揃え}
         if Layout=tlCenter then PosY:=(Height-TextWidth(Caption)) div 2;
         if Layout=tlTop    then fMode:=fMode or VTA_TOP;
         if Layout=tlBottom then begin
           PosY:=Height;
           fMode:=fMode or VTA_BOTTOM;
         end;
         {アライメントの設定}
         SetTextAlign(Canvas.Handle,fMode);

if not Enabled then begin
           Font.Color := clBtnHighlight;
           TextOut(PosX+1,PosY+1,Caption);
           Font.Color := clBtnShadow;
         end;
         TextOut(PosX,PosY,Caption);
       end;
     {横書きの時は継承元の処理を実行}
     end else begin
       {AutoSizeがTrueの場合}
       if AutoSize then begin
         SetBounds(Self.Left,Self.Top,Canvas.TextWidth(Caption),Canvas.TextHeight(Caption));
       end;
       inherited;
     end;
end;

end.

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

戻る