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

Вниз

Компонент Бегущая строка   Найти похожие ветки 

← →
WhiteBarin ©   (2006-05-10 11:46) [0]

Подскажите пожалуйста где можно взять компонент "Бегущая строка"

---

← →
TUser ©   (2006-05-10 12:03) [1]

TLabel + TTimer

---

← →
WhiteBarin ©   (2006-05-10 12:11) [2]

:) хотелось бы компонент, реализовывать времени нет, я помню был такой

---

← →
TUser ©   (2006-05-10 12:22) [3]

самому написать быстрее

---

← →
EvS ©   (2006-05-10 12:48) [4]

Пошарь в поиске, не так давно тут эта тема уже была.

---

← →
atruhin ©   (2006-05-10 13:38) [5]

Самому написать минут 5 нужно, для скроллинга по буквам, и минут 15 для плавного.

---

← →
Ega23 ©   (2006-05-10 13:55) [6]


unit ScrLabel;

interface

uses
 Windows, Classes,
 Controls, StdCtrls;

{$R TSCROLLABLELABEL.DCR}

type
 TCustomScrollableLabel=class(TLabel)
 private
   fCaptureX: Integer;
   fOffset: Integer;
   fScrolling: Boolean;
 protected
   procedure SetOffset(Value: Integer); virtual;
   procedure DoDrawText(var Rect: TRect; Flags: Longint); override;
   procedure DblClick; override;
   procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
   procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
   procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
 public
   constructor Create(AOwner: TComponent); override;
   property Offset: Integer read fOffset write SetOffset;
   property Scrolling: Boolean read fScrolling;
 end;

 TScrollableLabel=class(TCustomScrollableLabel);

procedure Register;

implementation

procedure Register;
begin
 RegisterComponents("Additional", [TScrollableLabel]);
end;

{ TCustomScrollableLabel }

constructor TCustomScrollableLabel.Create(AOwner: TComponent);
begin
 inherited;
 fOffset:=0;
 fScrolling:=False;
end;

procedure TCustomScrollableLabel.DblClick;
begin
 inherited;
 Offset:=0;
end;

procedure TCustomScrollableLabel.DoDrawText(var Rect: TRect; Flags: Integer);
begin
 Rect.Left:=Rect.Left+fOffset;
 inherited;
end;

procedure TCustomScrollableLabel.MouseDown(Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 inherited;
 fScrolling:=Button=mbLeft;
 fCaptureX:=X-Offset;
end;

procedure TCustomScrollableLabel.MouseMove(Shift: TShiftState; X,
 Y: Integer);
begin
 inherited;
 if not fScrolling then
   Exit;
 Offset:=X-fCaptureX;
end;

procedure TCustomScrollableLabel.MouseUp(Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 fScrolling:=False;
 inherited;
end;

procedure TCustomScrollableLabel.SetOffset(Value: Integer);
var
 CanvasLeft, CanvasWidth, CaptionLeft, CaptionWidth: Integer;
begin
 if Value=fOffset then
   Exit;
 with Canvas do
 begin
   CanvasLeft:=ClipRect.Left;
   CanvasWidth:=ClipRect.Right-CanvasLeft;
   CaptionWidth:=TextWidth(Caption);
 end;
 case Alignment of
   taRightJustify:
     CaptionLeft:=(CanvasWidth-CanvasLeft)-CaptionWidth;
   taCenter:
     CaptionLeft:=((CanvasWidth-CanvasLeft)-CaptionWidth) div 2;
   else
     CaptionLeft:=CanvasLeft;
 end;
 if Value<(CanvasLeft+CanvasWidth)-(CaptionLeft+CaptionWidth) then
   Value:=(CanvasLeft+CanvasWidth)-(CaptionLeft+CaptionWidth);
 if Value>CanvasLeft-CaptionLeft then
   Value:=CanvasLeft-CaptionLeft;
 fOffset:=Value;
 Repaint;
end;

end.

---

← →
Труп Васи Доброго ©   (2006-05-10 15:26) [7]

TSecretPanel из набора RXLib

---

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

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

Наверх

Память: 0.48 MB
Время: 0.054 c