Текущий архив: 2004.05.02;
Скачать: CL | DM;

Вниз

Label с многоточием   Найти похожие ветки 

← →
Andre____   (2004-04-16 13:59) [0]

Здравствуйте, Мастера! Подскажите компанент наподобие TLabel, но функционирующий как в Opera, т.е если надпись не умещается, в конце ставится "...". Заранее благодарен.

---

← →
ZrenBy ©   (2004-04-16 14:35) [1]

DT_END_ELLIPSIS

---

← →
Andre____   (2004-04-16 16:03) [2]

2 ZrenBy ©   (16.04.04 14:35) [1]

Спасибо.

P.S: Привожу код - пожет кому понадобится.


unit myLabel;

interface

uses
 SysUtils, Classes, Controls, StdCtrls, Windows, Graphics;

type
 TmyLabel = class(TLabel)
 private
   { Private declarations }
 protected
   { Protected declarations }
   procedure DoDrawText(var Rect: TRect; Flags: Longint); override;
 public
   { Public declarations }
 published
   { Published declarations }
 end;

procedure Register;

implementation

procedure Register;
begin
 RegisterComponents("my", [TmyLabel]);
end;

procedure TmyLabel.DoDrawText(var Rect: TRect; Flags: Longint);
var
 Text: string;
begin
 Text := GetLabelText;
 if (Flags and DT_CALCRECT <> 0) and ((Text = "") or ShowAccelChar and
   (Text[1] = "&") and (Text[2] = #0)) then Text := Text + " ";
 if not ShowAccelChar then Flags := Flags or DT_NOPREFIX;
 Flags := DrawTextBiDiModeFlags(Flags+DT_END_ELLIPSIS);
 Canvas.Font := Font;
 if not Enabled then
 begin
   OffsetRect(Rect, 1, 1);
   Canvas.Font.Color := clBtnHighlight;
   DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
   OffsetRect(Rect, -1, -1);
   Canvas.Font.Color := clBtnShadow;
   DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
 end
 else
   DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
end;

end.


---

Страницы: 1 вся ветка

Текущий архив: 2004.05.02;
Скачать: CL | DM;

Наверх

Память: 0.47 MB
Время: 0.05 c