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

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

Вывод текста в собственном компоненте [D7, WinXP]

Страницы:   < 1 2 3 >

Max_005 ©   (2005-04-18 12:43:00) 

Пишу компонент. Приведу часть его кода:

type
TMyComp = class(TGraphicControl)
private
  function GetCanvas: TCanvas;
  ...
protected
  procedure Paint; override;
  ...
public
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;
  property Canvas: TCanvas read GetCanvas;
  ...


function TMSSkinUltraMenu.DestRect: TRect;
var
w, h, cw, ch: Integer;
xyaspect: Double;
begin
if FShowPictute = shwPictureUp then
  begin
  w := PictureUp.Width;
  h := PictureUp.Height;
  end;
if FShowPictute = shwPictureMove then
  begin
  w := PictureMove.Width;
  h := PictureMove.Height;
  end;
cw := ClientWidth;
ch := ClientHeight;
if Stretch or (Proportional and ((w > cw) or (h > ch))) then
begin
if Proportional and (w > 0) and (h > 0) then
begin
    xyaspect := w / h;
    if w > h then
    begin
      w := cw;
      h := Trunc(cw / xyaspect);
      if h > ch then  // woops, too big
      begin
        h := ch;
        w := Trunc(ch * xyaspect);
      end;
    end
    else
    begin
      h := ch;
      w := Trunc(ch * xyaspect);
      if w > cw then  // woops, too big
      begin
        w := cw;
        h := Trunc(cw / xyaspect);
      end;
    end;
  end
  else
  begin
    w := cw;
    h := ch;
  end;
end;

with Result do
begin
  Left := 0;
  Top := 0;
  Right := w;
  Bottom := h;
end;

if Center then
OffsetRect(Result, (cw - w) div 2, (ch - h) div 2);
end;

procedure TMyComp.Paint;
var
Save: Boolean;
begin
if csDesigning in ComponentState then
with inherited Canvas do
begin
Pen.Style := psDash;
Brush.Style := bsClear;
Rectangle(0, 0, Width, Height);
end;
Save := FDrawing;
FDrawing := True;
try
with inherited Canvas do
  begin
  if FShowPictute = shwPictureUp then
    begin
    StretchDraw(DestRect, PictureUp.Graphic);
    end;
  if FShowPictute = shwPictureMove then
    begin
    StretchDraw(DestRect, PictureMove.Graphic);
    end;
  end;

finally
FDrawing := Save;
end;
end;

function TMyComp.GetCanvas: TCanvas;
var
Bitmap: TBitmap;
begin
if FShowPictute = shwPictureUp then
  begin
    if PictureUp.Graphic = nil then
      begin
     Bitmap := TBitmap.Create;
       try
       Bitmap.Width := Width;
       Bitmap.Height := Height;
       PictureUp.Graphic := Bitmap;
       finally
       Bitmap.Free;
       end;
      end;
    if PictureUp.Graphic is TBitmap then
     Result := TBitmap(PictureUp.Graphic).Canvas
    else
     raise EInvalidOperation.Create(SImageCanvasNeedsBitmap);
  end;

if FShowPictute = shwPictureMove then
  begin
    if PictureMove.Graphic = nil then
      begin
     Bitmap := TBitmap.Create;
       try
       Bitmap.Width := Width;
       Bitmap.Height := Height;
       PictureMove.Graphic := Bitmap;
       finally
       Bitmap.Free;
       end;
      end;
    if PictureMove.Graphic is TBitmap then
     Result := TBitmap(PictureMove.Graphic).Canvas
    else
     raise EInvalidOperation.Create(SImageCanvasNeedsBitmap);
  end;
end;

Но у меня есть одна небольшая загвоздка... Как мне вывести текст в этом компоненте? И чтобы сам текст, цвет, шрифт текста задавались в свойствах? Помогите пожалуйста. Я в процедуре Paintнаписал:

Canvas.Font:=Font;
 Canvas.TextOut(Round((Width-Canvas.TextWidth(Caption))/2), Round((Height-Canvas.TextHeight(Caption))/2), Caption);

Но фон текста белый и перекрывает все... а еще он не по середине...

---

Max_005   (2005-04-18 17:15:00) [41]

может еще гдето реализовано? в другом событии? ткните мне на это, а то я так не разберусь...:(

---

Max_005   (2005-04-18 16:55:00) [42]

Я прежде чем задать этот вопрос, посмотрел уже как сделан Label, если честно что-то я не понял как... Вот прорисовка Label-а:

procedure TCustomLabel.Paint;
const
 Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
 WordWraps: array[Boolean] of Word = (0, DT_WORDBREAK);
var
 Rect, CalcRect: TRect;
 DrawStyle: Longint;
begin
 with Canvas do
 begin
   if not Transparent then
   begin
     Brush.Color := Self.Color;
     Brush.Style := bsSolid;
     FillRect(ClientRect);
   end;
   Brush.Style := bsClear;
   Rect := ClientRect;
   { DoDrawText takes care of BiDi alignments }
   DrawStyle := DT_EXPANDTABS or WordWraps[FWordWrap] or Alignments[FAlignment];
   { Calculate vertical layout }
   if FLayout <> tlTop then
   begin
     CalcRect := Rect;
     DoDrawText(CalcRect, DrawStyle or DT_CALCRECT);
     if FLayout = tlBottom then OffsetRect(Rect, 0, Height - CalcRect.Bottom)
     else OffsetRect(Rect, 0, (Height - CalcRect.Bottom) div 2);
   end;
   DoDrawText(Rect, DrawStyle);
 end;
end;

Вот там есть если Transporent не true, а если true ничего нету...:(

---

Юрий Зотов   (2005-04-18 16:19:00) [43]

> Max_005   (18.04.05 16:01) [6]

А разве в справке ничего про Brush не написано?

Сделать фон прозрачным - посмотрите, как сделана прозрачность у TLabel.

---

Max_005   (2005-04-18 16:01:00) [44]

Юрий Зотов извени за надоедливость... Я теперь не понимаю зачем тогда свойство "Brush"? что оно определяет? а еще как мне сделать фон текста прозрачным? Помоги пожалуйста

---

Юрий Зотов   (2005-04-18 15:54:00) [45]

Свойства пера. Если надо будет рисовать какие-то линии и т.п. - вот тут-то оно и пригодится.

---

Max_005   (2005-04-18 15:50:00) [46]

Спасибо Юрий Зотов! Вроде я разобрался... только одно мне не понятно, зачем свойство "Pen"? что оно определяет?

---

Юрий Зотов   (2005-04-18 15:03:00) [47]

Похоже, Вам нужно что-то типа этого. Во всяком случае, это пример того, как выводится текст и как выносятся в свойства параметры его вывода.


type
 TMyComp = class(TGraphicControl)
 private
   function GetBrush: TBrush;
   function GetFont: TFont;
   function GetPen: TPen;
   procedure SetBrush(const Value: TBrush);
   procedure SetFont(const Value: TFont);
   procedure SetPen(const Value: TPen);
   procedure CMTextChanged(var Messsage: TMessage); message CM_TEXTCHANGED;
 protected
   procedure Paint; override;
   procedure GraphicsObjectChanged(Sender: TObject);
 public
   constructor Create(AOwner: TComponent); override;
 published
   property Brush: TBrush read GetBrush write SetBrush;
   property Pen: TPen read GetPen write SetPen;
   property Font: TFont read GetFont write SetFont;
   property Text;
 end;

implementation

{ TMyComp }

procedure TMyComp.CMTextChanged(var Messsage: TMessage);
begin
 inherited;
 Invalidate
end;

constructor TMyComp.Create(AOwner: TComponent);
begin
 inherited;
 Brush.OnChange := GraphicsObjectChanged;
 Pen.OnChange := GraphicsObjectChanged;
 Font.OnChange := GraphicsObjectChanged
end;

function TMyComp.GetBrush: TBrush;
begin
 Result := Canvas.Brush
end;

function TMyComp.GetFont: TFont;
begin
 Result := Canvas.Font
end;

function TMyComp.GetPen: TPen;
begin
 Result := Canvas.Pen
end;

procedure TMyComp.GraphicsObjectChanged(Sender: TObject);
begin
 Invalidate
end;

procedure TMyComp.Paint;
begin
 inherited;
 with Canvas do
   TextOut((Width - TextWidth(Text)) div 2, (Height - TextHeight(Text)) div 2, Text)
end;

procedure TMyComp.SetBrush(const Value: TBrush);
begin
 Canvas.Brush.Assign(Value)
end;

procedure TMyComp.SetFont(const Value: TFont);
begin
 Canvas.Font.Assign(Value)
end;

procedure TMyComp.SetPen(const Value: TPen);
begin
 Canvas.Pen.Assign(Value)
end;


---

MBo   (2005-04-18 14:30:00) [48]

хм... Я уже отвечал в эту ветку, но, видно, форум глюкнул...

>Но фон текста белый и перекрывает все
SetBkMode или Brush.Style

>еще он не по середине
убери round, деление замени на div 2 - вещественная арифметика здесь ни к чему, хотя на результат это не влияет. А расчет положения - вообще-то правильный, должно примерно по центру компонента рисоваться.
DrawText с фланами центрирования можно еще попробовать

---

Max_005   (2005-04-18 13:59:00) [49]

???

---

Страницы:   < 1 2 3 >

Наверх