Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Многострочный заголовок у TBitBtn 2

Я создал удобный компонент, инкапсулирующий обычную кнопку, но с возможностью многострочного заголовка. В *действительности* - это TBitBtn, чей Glyph *нарисован* в виде заголовка с переносом текста. Реальный заголовок невидим. Это работает! Попробуйте с этим поэкспериментировать и сообщите мне о ваших новых находках. Я был удивлен, что это свойство оказалось легко *подавить*. Тем более, что это свойство public/published, а не какой-то кот в мешке. Все это так, но вы можете перекрыть свойство другим с таким же именем и с атрибутом READ ONLY. И вы можете ссылать на свойство предка, как, например, "Inherited Glyph". ООП!


unit C_wrapb;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Buttons;

type
  TWrapBtn = class(TBitBtn)
  private
    { Private declarations }
    function GetGlyph: string;
    function GetMargin: Integer;
    function GetSpacing: Integer;
    function GetKind: TBitBtnKind;
    function GetLayout: TButtonLayout;
    function GetNumGlyphs: TNumGlyphs;
    procedure CMTextChanged(var Message: TMessage);
      message CM_TEXTCHANGED;
    procedure CMFontChanged(var Message: TMessage);
      message CM_FONTCHANGED;
    procedure WMSize(var Msg: TWMSize);
      message WM_SIZE;
    procedure CaptionGlyph;
  protected
    { Protected declarations }
  public
    { Public declarations }
  published
    { Published declarations }
    property Glyph: string read GetGlyph;
    property Margin: Integer read GetMargin;
    property Spacing: Integer read GetSpacing;
    property Kind: TBitBtnKind read GetKind;
    property Layout: TButtonLayout read GetLayout;
    property NumGlyphs: TNumGlyphs read GetNumGlyphs;
  end;

procedure Register;

implementation

procedure TWrapBtn.CaptionGlyph;
var
  GP: TBitmap;
  R: TRect;
  Buff: array[0..255] of Char;
begin
  GP := TBitmap.Create;
  try
    with GP do
    begin
      Canvas.Font := Self.Font;
      StrPCopy(Buff, Caption);
      inherited Margin := 0;
      inherited Spacing := GetSpacing;
      Width := Self.Width - GetSpacing;
      Height := Self.Height - GetSpacing;
      R := Bounds(0, 0, Width, 0);
      DrawText(Canvas.Handle, Buff, StrLen(Buff), R,
        DT_CENTER or DT_WORDBREAK or DT_CALCRECT);
      OffsetRect(R, (Width - R.Right) div 2,
        (Height - R.Bottom) div 2);
      DrawText(Canvas.Handle, Buff, StrLen(Buff), R,
        DT_CENTER or DT_WORDBREAK);
    end;
    inherited Glyph := GP;
    inherited NumGlyphs := 1;
  finally
    GP.Free;
  end;
end;

function TWrapBtn.GetGlyph: string;
begin
  Result := '(Н/Д)';
end;

procedure TWrapBtn.CMTextChanged(var Message: TMessage);
begin
  inherited;
  CaptionGlyph;
end;

procedure TWrapBtn.CMFontChanged(var Message: TMessage);
begin
  inherited;
  CaptionGlyph;
end;

procedure TWrapBtn.WMSize(var Msg: TWMSize);
begin
  inherited;
  CaptionGlyph;
end;

function TWrapBtn.GetMargin: Integer;
begin
  Result := 0;
end;

function TWrapBtn.GetSpacing: Integer;
begin
{$IFDEF Win32}
  Result := 12;
{$ELSE}
  Result := 6;
{$ENDIF}
end;

function TWrapBtn.GetKind: TBitBtnKind;
begin
  Result := bkCustom;
end;

function TWrapBtn.GetLayout: TButtonLayout;
begin
  Result := blGlyphLeft;
end;

function TWrapBtn.GetNumGlyphs: TNumGlyphs;
begin
  Result := 1;
end;

procedure Register;
begin
  RegisterComponents('FAQ', [TWrapBtn]);
end;

end.

Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.