VARR : TRect;N : Integer;Buff : ARRAY[0..255] OF Char;... WITH BitBtn1 DOBEGINGlyph.Canvas.Font := Self.Font;Glyph.Width := Width-6;Glyph.Height := Height-6;R := Bounds(0,0,Glyph.Width,0);StrPCopy(Buff, Caption);Caption := '';DrawText(Glyph.Canvas.Handle, Buff, StrLen(Buff), R,DT_CENTER OR DT_WORDBREAK OR DT_CALCRECT);OffsetRect(R, (Glyph.Width-R.Right) DIV 2,(Glyph.Height - R.Bottom) DIV 2);DrawText(Glyph.Canvas.Handle, Buff, StrLen(Buff), R,DT_CENTER OR DT_WORDBREAK);END; |
Теперь у вас есть замечательная кнопка, которая научилась переносить текст!
- Neil [000636]
- Neil Rubenking
unit C_wrapb; interface usesSysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,Forms, Dialogs, StdCtrls, Buttons; typeTWrapBtn = 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;VARGP : TBitmap;R : TRect;Buff: ARRAY[0..255] OF Char;beginGP := TBitmap.Create;tryWITH GP DOBEGINCanvas.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;finallyGP.Free;end;end; FUNCTION TWrapBtn.GetGlyph: String;BEGINResult := '(Н/Д)';END; procedure TWrapBtn.CMTextChanged(var Message: TMessage);beginInherited;CaptionGlyph;end; procedure TWrapBtn.CMFontChanged(var Message: TMessage);beginInherited;CaptionGlyph;end; procedure TWrapBtn.WMSize(var Msg: TWMSize);beginInherited;CaptionGlyph;end; function TWrapBtn.GetMargin: Integer;beginResult := 0;end; function TWrapBtn.GetSpacing: Integer;begin{$IFDEF Win32}Result := 12;{$ELSE}Result := 6;{$ENDIF}end; function TWrapBtn.GetKind: TBitBtnKind;BEGINResult := bkCustom;END; function TWrapBtn.GetLayout: TButtonLayout;beginResult := blGlyphLeft;end; function TWrapBtn.GetNumGlyphs: TNumGlyphs;beginResult := 1;end; procedure Register;beginRegisterComponents('FAQ', [TWrapBtn]);end; end. |
[000722]