質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

89.05%

継承したFontプロパティの文字サイズを大きくしてもサイズが大きくならない

解決済

回答 1

投稿 編集

  • 評価
  • クリップ 0
  • VIEW 568

dem0nmichik0

score 27

実現したいこと

四角形や円などの図形と文字列を同時に生成する自作コンポーネントを作成すること.

困っていること

CustomControlクラスを継承したクラスを作成し,CustomControlのプロパティであるFontを継承しました.ですが,テストアプリでFontのSizeプロパティを変更しても文字列のサイズが変更せずに困っています.


図1 文字列のサイズが変わらないインスタンス


図2 Sizeプロパティを16にした時の画面

実現方法

文字列のサイズを変更する方法はウィンドウメッセージのWM_SETFONTイベントを発生させる必要があるだろうと思っています.ですが,WM_SETFONTイベントの発生させ方が分からず困っています.どなたがご教授お願いいたします.

ソースコード

文字数が10,000文字以上になるため,各種メソッド部分をわざと消しています.

unit Door;
//  Delphi
interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes,
  Vcl.Controls, Vcl.Graphics, Vcl.Forms, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Dialogs;

type
  TDoor = class(TCustomControl)
  private
    { Private 宣言 }
    FCaption: UnicodeString;
    FShape: TShapeType;
    FShapeColor: TColor;
    FWidth_C: Integer;
    FHeight_C: Integer;

    procedure SetShape(Value: TShapeType);
    procedure SetShapeColor(Value: TColor);
    procedure SetCaption(Value: UnicodeString);
    procedure SetWidth_C(Value: Integer);
    procedure SetHeight_C(Value: Integer);
  protected
    { Protected 宣言 }
  public
    { Public 宣言 }
    left: Integer;
    top: Integer;

    //  コンストラクタ(オーバーライド)
    constructor Create( AOwner: TComponent ); override;
    procedure Paint; override;
  published
    { Published 宣言 }
    //  プロパティにdefaultを付けるとデフォルト値にできる
    property Shape: TShapeType read FShape write SetShape default stRectangle;
    property ShapeColor: TColor read FShapeColor write SetShapeColor;
    property Caption: UnicodeString read FCaption write SetCaption;
    property Width_C: Integer read FWidth_C write SetWidth_C;
    property Height_C: Integer read FHeight_C write SetHeight_C;
    //  継承プロパティ(再宣言するとオブジェクトインスペクタに表示できるようになる)
    property Anchors;
    property Color;
    property Enabled;
    property Font;
    property Name;
    property ParentColor;
    property Visible;
    property OnClick;
    property OnDblClick;
  end;

procedure Register;

//---------------------------------------------------------------------------
implementation

const
  DelphiWindows: array [1 .. 1] of PWideChar = ('TAppBuilder');

procedure Register;
begin
  //  「Samples」パレットにドアを登録
  RegisterComponents('Samples', [TDoor]);
end;

//  WM_PAINTメッセージで起動
//  クライアントエリアに更新領域が存在するときにコール
procedure TDoor.Paint;
var
  x1, y1: Integer;
  x2, y2: Integer;
  x_space, y_space: Integer;

begin
  //  四角形の場合
  if FShape = stRectangle then
  begin
    with Canvas do begin
      //  FSahpeColor色で塗りつぶし
      Brush.Color:= FShapeColor;
      Brush.Style:= bsSolid;
      FillRect(Rect(Left, Top, (Left+Width), (Top+Height)));
      //  黒色で太さ1で枠線描画
      Pen.Color:= clBlack;
      Pen.Style:= psSolid;
      Pen.Width:= 1;
      Rectangle(Rect(Left, Top, (Left+Width), (Top+Height)));

      //  文字列の描画
      TextOut(FWidth_C, FHeight_C, FCaption);
    end;
  end
  //  円の場合
  else if FShape = stCircle then
  begin
    with Canvas do begin
      //  Color色で塗りつぶし
      Brush.Color:= Color;
      Brush.Style:= bsSolid;
      FillRect(Rect(Left, Top, (Left+Width), (Top+Height)));

      if Width > Height then
      begin
        x_space:= Width - Height;
        x1:= Left + (x_space div 2);
        y1:= Top;
        x2:= x1 + Height;
        y2:= y1 + Height;
      end
      else
      begin
        y_space:= Height - Width;
        x1:= Left;
        y1:= Top + (y_space div 2);
        x2:= x1 + Width;
        y2:= y1 + Width;
      end;

      //  FSahpeColor色で塗りつぶし
      Brush.Color:= FShapeColor;
      Brush.Style:= bsSolid;
      //  黒色で太さ1で枠線描画
      Pen.Color:= clBlack;
      Pen.Style:= psSolid;
      Pen.Width:= 1;
      Ellipse(x1, y1, x2, y2);

      //  文字列の描画
      TextOut(FWidth_C, FHeight_C, FCaption);
    end;
  end
  //  楕円の場合
  else if FShape = stEllipse then
  begin
    with Canvas do begin
      //  Color色で塗りつぶし
      Brush.Color:= Color;
      Brush.Style:= bsSolid;
      FillRect(Rect(Left, Top, (Left+Width), (Top+Height)));
      //  FSahpeColor色で塗りつぶし
      Brush.Color:= FShapeColor;
      Brush.Style:= bsSolid;
      //  黒色で太さ1で枠線描画
      Pen.Color:= clBlack;
      Pen.Style:= psSolid;
      Pen.Width:= 1;
      Ellipse(Left, Top, (Left+Width), (Top+Height));

      //  文字列の描画
      TextOut(FWidth_C, FHeight_C, FCaption);
    end;
  end
  //  角の丸い四角形の場合
  else if FShape = stRoundRect then
  begin
    with Canvas do begin
      //  Color色で塗りつぶし
      Brush.Color:= Color;
      Brush.Style:= bsSolid;
      FillRect(Rect(Left, Top, (Left+Width), (Top+Height)));
      //  FSahpeColor色で塗りつぶし
      Brush.Color:= FShapeColor;
      Brush.Style:= bsSolid;
      //  黒色で太さ1で枠線描画
      Pen.Color:= clBlack;
      Pen.Style:= psSolid;
      Pen.Width:= 1;
      RoundRect(Left, Top, Width, Height, 10, 10);

      //  文字列の描画
      TextOut(FWidth_C, FHeight_C, FCaption);
    end;
  end
  //  角の丸い正方形の場合
  else if FShape = stRoundSquare then
  begin
    with Canvas do begin
      if Width > Height then
      begin
        x_space:= Width - Height;
        x1:= Left + (x_space div 2);
        y1:= Top;
        x2:= x1 + Height;
        y2:= y1 + Height;
      end
      else
      begin
        y_space:= Height - Width;
        x1:= Left;
        y1:= Top + (y_space div 2);
        x2:= x1 + Width;
        y2:= y1 + Width;
      end;

      //  Color色で塗りつぶし
      Brush.Color:= Color;
      Brush.Style:= bsSolid;
      FillRect(Rect(Left, Top, (Left+Width), (Top+Height)));
      //  FSahpeColor色で塗りつぶし
      Brush.Color:= FShapeColor;
      Brush.Style:= bsSolid;
      //  黒色で太さ1で枠線描画
      Pen.Color:= clBlack;
      Pen.Style:= psSolid;
      Pen.Width:= 1;
      RoundRect(x1, y1, x2, y2, 10, 10);

      //  文字列の描画
      TextOut(FWidth_C, FHeight_C, FCaption);
    end;
  end
  //  正方形の場合
  else if FShape = stSquare then
  begin
    with Canvas do begin
      //  Color色で塗りつぶし
      Brush.Color:= Color;
      Brush.Style:= bsSolid;
      FillRect(Rect(Left, Top, (Left+Width), (Top+Height)));

      if Width > Height then
      begin
        x_space:= Width - Height;
        x1:= Left + (x_space div 2);
        y1:= Top;
        x2:= x1 + Height;
        y2:= y1 + Height;
      end
      else
      begin
        y_space:= Height - Width;
        x1:= Left;
        y1:= Top + (y_space div 2);
        x2:= x1 + Width;
        y2:= y1 + Width;
      end;

      //  FSahpeColor色で塗りつぶし
      Brush.Color:= FShapeColor;
      Brush.Style:= bsSolid;
      //  黒色で太さ1で枠線描画
      Pen.Color:= clBlack;
      Pen.Style:= psSolid;
      Pen.Width:= 1;
      Rectangle(Rect(x1, y1, x2, y2));

      //  ためしにやってみたが,フォントサイズが変更しなかった.
      Font.Assign(Font);
      //  文字列の描画
      TextOut(FWidth_C, FHeight_C, FCaption);
    end;
  end;

//  FCaption.
//  Font.Size
end;


//Createメソッド省略
//SetShapeメソッド省略
//SetShapeColorメソッド省略
//SetCaptionメソッド省略
//SetWidth_Cメソッド省略
//SetHeight_Cメソッド省略

end.
  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

質問への追記・修正、ベストアンサー選択の依頼

  • y_waiwai

    2019/08/30 21:48

    ソースもないことには答えようがないですが。

    キャンセル

  • dem0nmichik0

    2019/10/25 00:12

    y_waiwai様
    申し訳ありませんでした.遅くなりましたが,ただ今抜粋的にソースコードを記載いたしました.
    よろしくお願いいたします。

    キャンセル

回答 1

checkベストアンサー

+2

Paintメソッドの実装がないので予想ですが、テキストの描画はPaintメソッド内で実行しているのですよね。
であれば、テキストの描画をする前に下記のようにカンバスにフォントを設定してから描画すれば設定したフォントが反映されると思います。

paintメソッド
:
Canvas.Font.Assign(Font);
Canvas.TextOut(...);
:

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/10/30 22:57

    au2010様,回答ありがとうございます.
    Canvas.Font.Assign(Self.Font)でフォントサイズが変更しました.2点質問があります.
    1.Assignメソッドは「プロパティのコピー」とHPに記載されていますが,なぜ,プロパティをコピーすると実現できるのでしょうか?自分自身では,フォントサイズを変更したら何かしらのウィンドウメッセージが発生し,発生したウィンドウメッセージに対してフォントサイズの再描画処理を記述すると思っていました.
    2.Canvas.Font.Assign(Self.Font)とCanvas.Font.Assign(Self.Font)の違いは「Assign(Self.Font)」か「Assign(Font)」ですが,なぜ,「Assign(Font)」だとだめなのでしょうか?「Assign(Self.Font)」だとCanvasのFontで,「Assign(Font)」だとTCustomControlのFontなため,「Self」が必要なのでしょうか?
    回答お願いいたします.

    キャンセル

  • 2019/10/31 09:20

    1については、コントロールの描画を自作する場合、コントロールのFontプロパティと実際に描画を行うCanvasのFontプロパティは別で特にリンクしている訳ではないので自分で描画する時に設定する必要があるからです。これはPenとかBrushについても同じです。
    2については、コントロール自身とCanvasはそれぞれ個別にFontプロパティを持っています。Withブロック内で単にFontとした場合、どちらのFontと解釈されるかは判りませんがコピー元とコピー先が同じになるからダメだったのでしょう。作成しているコントールのFontプロパティをCanvasのFontにコピーする必要があるのです。

    キャンセル

  • 2019/10/31 12:27

    au2010様,回答ありがとうございます。
    1,2の説明により,「自作しようとしているコントロール(TCustomControl)」と「Canvas」のFontプロパティは別々なこと,オブジェクトインスペクタによって自作しようとしているコントロール(TCustomControl)のFontプロパティが変化するから,Canvas.Font.Assign(Self.Font)によって,自作しようとしているコントロール(TCustomControl)のFontプロパティをCanvasのFontプロパティにコピーする。そして,文字列の描画で反映されることが分かりました。

    丁寧なご教授ありがとうございました。

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 89.05%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る