|
|
|
|
Delphi 1
Кнопка с несколькими строчками текста II
Я создал удобный компонент, инкапсулирующий обычную кнопку, но с возможностью многострочного заголовка. В *действительности* - это TBitBtn, чей Glyph *нарисован* в виде заголовка с переносом текста. Реальный заголовок невидим. Это работает! Попробуйте с этим поэкспериментировать и сообщите мне о ваших новых находках. Я был удивлен, что это свойство оказалось легко *подавить*. Тем более, что это свойство public/published, а не какой-то кот в мешке. Все это так, но вы можете перекрыть свойство другим с таким же именем и с атрибутом READ ONLY. И вы можете ссылать на свойство предка, как, например, "Inherited Glyph". ООП!
- Neil Rubenking
|
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.
|
[000722]
|
|
|
|
|