| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Создание кнопки с вертикальным текстом [D7, WinXP]

Destroyer ©   (2005-07-19 18:04:00) 

Хочу переделать стандартный 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. Видимо еще что-то надо добавить. Помогите плз.

---

Destroyer   (2005-07-25 01:28:00) [1]

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

---

Чапаев   (2005-07-22 14:17:00) [2]

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

---

Destroyer   (2005-07-22 12:40:00) [3]

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

---

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

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

---

Destroyer   (2005-07-20 21:09:00) [5]

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

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-20 12:23:00) [6]

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

---

Джо   (2005-07-20 04:35:00) [7]

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

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

---

Наверх