Создание кнопки с вертикальным текстом

← →
Destroyer © (2005-07-19 18:04) [0]

Хочу переделать стандартный Button так, чтобы Caption был написан вертикально ( как бы повернут на 90 градусов налево). Для начала хочу создать своё свойство, такое чтобы просто выводился Caption как и в стандартном Button-е. Делаю так:

unit VertCaptBut; interface uses SysUtils, Classes, Controls, StdCtrls, Windows, Graphics, CommCtrl ; type TButtonState = (bsUp, bsDisabled, bsDown, bsExclusive); TVertCaptBut = class(TButton) private VertText : string; procedure DrawButtonText(Canvas: TCanvas; const VertText: string; TextBounds: TRect; State: TButtonState; BiDiFlags: Longint); { Private declarations } protected { Protected declarations } public { Public declarations } published constructor Create(aowner:Tcomponent); override; property VertCaption: string read VertText write VertText; { Published declarations } end; procedure Register; implementation procedure Register; begin RegisterComponents("MyComponents", [TVertCaptBut]); end; constructor TVertCaptBut.Create(aowner:Tcomponent); begin inherited create(Aowner); end; procedure TVertCaptBut.DrawButtonText(Canvas: TCanvas; const VertText: string; TextBounds: TRect; State: TButtonState; BiDiFlags: LongInt); begin with Canvas do begin Brush.Style := bsClear; if State = bsDisabled then begin OffsetRect(TextBounds, 1, 1); Font.Color := clBtnHighlight; DrawText(Handle, PChar(VertText), Length(VertText), TextBounds, DT_CENTER or DT_VCENTER or BiDiFlags); OffsetRect(TextBounds, -1, -1); Font.Color := clBtnShadow; DrawText(Handle, PChar(VertText), Length(VertText), TextBounds, DT_CENTER or DT_VCENTER or BiDiFlags); end else DrawText(Handle, PChar(VertText), Length(VertText), TextBounds, DT_CENTER or DT_VCENTER or BiDiFlags); end; end; end.

Но ничего не получается. Процедуру DrawButtonText брал из Buttons.pas. Видимо еще что-то надо добавить. Помогите плз.

← →
Джо © (2005-07-20 04:35) [1]

> Но ничего не получается

А с какого такого бодуна метод DrawButtonText (скопированный из другого компонента, но это даже не важно) должен вызываться?

← →
Destroyer © (2005-07-20 12:23) [2]

Точно, он нигде не вызывается. В Buttons.pas он вызывается только в function TButtonGlyph.Draw. Никак не могу понять где же тот вызов этой функции, который отвечает за рисование caption на кнопке. Draw вызывается много где, и походу все события где он вызывается происходят в run time (типа назначения картинки на speedbutton и т.д.). Но где надо вызвать этот метод, чтобы VertText рисовался в Design Time и в Run time?

← →
Destroyer © (2005-07-20 21:09) [3]

Разобрался с вызовом.
Теперь проблема с вертикальным текстом. Всё хорошо рисуется, но текст на кнопке располгается не в центре. Делаю так:

procedure TVertTextBut.Paint;
...
TextWidth := Canvas.TextWidth(Cap);
TextHeight := Canvas.TextHeight(Cap);
...
Canvas.TextOut(Width div 2 - TextHeight div 2,Height div 2+TextWidth div 2,Cap);
...
end;

procedure TVertTextBut.Click;
begin
inherited Click;
Paint;
...
end;

procedure TVertTextBut.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var TextWidth, TextHeight : Longint;
begin
inherited MouseDown(Button, Shift, X, Y);
TextWidth := Canvas.TextWidth(Cap);
TextHeight := Canvas.TextHeight(Cap);
...
Canvas.TextOut(Width div 2 -TextHeight div 2+2,Height div 2+TextWidth div 2+2,Cap);
end;

procedure TVertTextBut.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited MouseUp(Button, Shift, X, Y);
if (Button = mbLeft) and Enab then
begin
if Assigned (MUp) then
MUp(Self, Button, Shift, X, Y);
if (X>0) and (Y>0) and (X<=Width) and (Y<=Height) then
Paint;
end;
end;

procedure TVertTextBut.MouseLeave(var Message: TMessage);
begin
Paint;
end;

В когда кладу кнопку на форму текст чуть ниже чем должен быть. В Run Time после клика по кнопке текст встаёт в середину, но после того, как мышь уходит с кнопки (MouseLeave) текст опять сдвигается вниз и чуть влево. Как его удержать в середине?

← →
Destroyer © (2005-07-21 00:16) [4]

Ещё параллельный вопрос:
Как уменьшить прямоугольник вокруг текста, который появляется при использовании TextOut(x,t,text). Его надо свести к минимуму, а то он выходит за текст пиксела на три, это мешает при создании маленьких кнопок.

← →
Destroyer © (2005-07-22 12:40) [5]

Со всем разобрался. Но остаётся две проблемы:
1)Пытаюсь создать такие кнопки динамически, но при присвоении свойств (в данном случае caption) получаю ошибку:
Control "" has no parent window.
Если сначала задать parent, а потом caption, то всё нормально. Но когда создаю динамически обычные кнопки и задаю сначала все свойства, а потом parent, то всё нормально. Как это исправить?
2)Если объявление массива с типа VertTextBut есть в одном юните, а обращаться к этому массиву из другого, то этот массив не видится (из другого юнита), хотя также объявлено много других массивов и они видятся (из другог юнита). Что надо дописать, чтобы он массив типа VertTextBut виделся из другого юнита?

> Если сначала задать parent, а потом caption, то всё нормально.
Ещё бы. У тебя наверняка смена Caption"а вызывает перерисовку. А если Parent"а нету, то и рисоваться негде...

Точно, спасибо.

Создание кнопки с вертикальным текстом Найти похожие ветки