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

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

Как сделать мерцающий текст ?


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

MsGuns ©   (2009-01-09 11:47:00) 

Причем надо сделать это универсальной процедурой, получающей указатель на произвольный контрол и заставляющей его "мигать". Получается, что надо создать таймер и по его "тикам" то, прятать, то показывать текст. Но как "привязать" его к контролу, а потом еще и прибить, если учесть, что в общем случае "моргающих" контролов (например, меток или панелей статусбаров) может быть произвольное кол-во.
Процедура, напомню, внещняя, т.е. не является методом класса

KSergey   (2009-01-12 11:03:00) [41]

> oxffff ©   (12.01.09 09:00) [18]
> Пропускать ему только сообщения, кроме WM_PAINT WM_NCPAINT
>  WM_ERASEBKGND, а эти сообщения слать по таймеру родной процедуре.

А как это поможет мерцанию текста? Скоре тогда контрол не будет отрисовываться когда надо. Мерцание, конечно, получим, но какое-то странное :)

> oxffff ©   (12.01.09 09:00) [18]
> либо через SetWindowLong, если это неизвестный контрол либо если это
> наследник Tcontrol

SetWindowLong канает только для TWinControl, который уже Tcontrol по определению.

oxffff   (2009-01-12 09:00:00) [42]


> MsGuns ©   (09.01.09 11:47)  
> Причем надо сделать это универсальной процедурой, получающей
> указатель на произвольный контрол и заставляющей его "мигать".
>  


Есть идея перехватывать WndProc контрола либо через
SetWindowLong, если это неизвестный контрол либо если это наследник Tcontrol - прямым обращение к полю WndProc.
Пропускать ему только сообщения, кроме WM_PAINT WM_NCPAINT  WM_ERASEBKGND, а эти сообщения слать по таймеру родной процедуре.
+ возможно обрабатывать WM_ERASEBKGND самостоятельно.

KSergey   (2009-01-12 07:03:00) [43]

Как-то вот это

> MsGuns ©   (09.01.09 11:47)  
> Причем надо сделать это универсальной процедурой, получающей
> указатель на произвольный контроли заставляющей его "мигать".

не вяжется у меня с

> Юрий Зотов ©   (12.01.09 00:32) [15]
> procedure FlashControls(MyTimer: TMyTimer);
> begin
>  MyTimer.Flash := not MyTimer.Flash
> end;

Германн   (2009-01-12 01:59:00) [44]


> Leonid Troyanovsky ©   (11.01.09 17:22) [14]


> Юрий Зотов ©   (12.01.09 00:32) [15]

Имхо в RxLib нечто подобное сделано было уже очень давно. Именно это я и хотел сказать, после того как Ганз точно объяснит что ему нужно.

Юрий Зотов   (2009-01-12 00:32:00) [45]

> MsGuns ©   (09.01.09 11:47)  

1. Делаем компонент TMyTimer, как сказано в [14]. Добавляем ему свойство Flash:

public
 property Flash: boolean read GetFlash write SetFlash stored False;

function TMyTimer.GetFlash: boolean;
begin
 Result := Enabled
end;

procedure TMyTimer.SetFlash(Value: boolean);
begin
 Enabled := Value;
 if not Value then ... // восстановить исходные Caption'ы
end;


2. Делаем искомую универсальную процедуру, раз уж она так нужна. Что-то вроде этого:

procedure FlashControls(MyTimer: TMyTimer);
begin
 MyTimer.Flash := not MyTimer.Flash
end;

Leonid Troyanovsky   (2009-01-11 17:22:00) [46]


> MsGuns ©   (09.01.09 11:47)  

> Процедура, напомню, внещняя, т.е. не является методом класса

Вот глобальной процедурой такие вещи делать не надо.
Здесь нужен наследник TTimer, хранящий TList c примерно такими

TItemList = record
 AControl: TControl;
 AStrPropInfo: PPropInfo;
 Text1: String;
 Text2: String;
end;

Таймеру, как было замечено, еще нужна procedure Notification(..); override;
для получения уведомлений о разрушении контролов из списка.

Ну, а  изменять текст можно примерно так:
http://groups.google.com/group/fido7.ru.delphi/msg/24f3346411cb1b08

Если, конечно, у контролов есть соответсвующие published property.
Ну, а для лоска надо еще предусмотреть запрет перерисовки формы
на время прохода по списку.

--
Regards, LVT.

KSergey   (2009-01-11 15:40:00) [47]

PPS
т.е. ничего перекрывть не надо, инструментарий уже есть в VCL/
надеюсь, я понятно накорябал? :)

KSergey   (2009-01-11 15:39:00) [48]

> MsGuns ©   (09.01.09 11:47)  
>  Но как "привязать" его к
> контролу, а потом еще и прибить, если учесть, что в общем
> случае "моргающих" контролов (например, меток или панелей
> статусбаров) может быть произвольное кол-во.

Идеальным видится случай перекрыть классы для всех контролов и в деструкторе удалять(-ся) из общего списка (на манер освобождения ссылки из списка своего Owner-а), но на сколько это удобно в конкретном случае - вопрос.

PS
Посмотрел, точно, помню ж ЮЗ говорил про что-то такое: надо зарегистрировать таймер (или спец. компонент, используемый для хранения ссылок на подписавшихся на "моргание" компонент), вызвав метод TComponent.FreeNotification(AComponent: TComponent) для регистрирующегося компонента. Тогда при удалении компонент с мигающим текстом будет вызван метод Notification со значение opRemove (см. destructor TComponent.Destroy)

{RASkov}   (2009-01-11 09:04:00) [49]

Удалено модератором

Германн   (2009-01-11 02:55:00) [50]

Удалено модератором

Германн   (2009-01-11 01:14:00) [51]

Удалено модератором

{RASkov}   (2009-01-11 00:18:00) [52]

> [7] MsGuns ©   (10.01.09 23:18)

Странно :)
И никак нельзя переделать [6]?)
Можно, тогда, более подробней о том как нужно мыргать?)

MsGuns   (2009-01-10 23:18:00) [53]

Спасибо за помощь.. Но это не то :(

{RASkov}   (2009-01-09 15:39:00) [54]

Вот нечто так наверное:
unit FlashCtrls;
interface
uses Classes, Controls, ExtCtrls, Graphics, SysUtils;

procedure FlashControl(ACtrl: TControl; ATxt: String; AClr: TColor; ACount, APause: Integer);

implementation

type
 TMyCtrl = class(TControl);
 TFlashCtrl = class(TTimer)
 private
   Count: Integer;
   Pause: Integer;
   Step: Integer;
   Txt, OldTxt: String;
   Clr, OldClr: TColor;
   Ctrl: TMyCtrl;
 protected
   procedure Flashing(Sender: TObject);
 public
   constructor Create(AOwner: TComponent); override;
   constructor CreateFlash(ACtrl: TControl; ATxt: String; AClr: TColor; ACount, APause: Integer);
 end;
//-------------------
var LstCtrl: TList;

constructor TFlashCtrl.Create(AOwner: TComponent);
begin
 raise Exception.Create('Ошибка, нужно вызывать CreateFlash конструктор!');
 //eee CreateFlash(nil, '', clBlack, 0, 0);
end;

constructor TFlashCtrl.CreateFlash(ACtrl: TControl; ATxt: String; AClr: TColor; ACount, APause: Integer);
begin
 inherited Create(nil);
 Enabled:=False;
 Interval:=APause;
 Count:=ACount;
 Pause:=APause;
 Step:=0;
 Ctrl:=TMyCtrl(ACtrl);
 OldTxt:=Ctrl.Text;
 Txt:=ATxt;
 OldClr:=Ctrl.Font.Color;
 Clr:=AClr;
 OnTimer:=Flashing;
 Enabled:=True;
 Flashing(Self);
end;

procedure TFlashCtrl.Flashing(Sender: TObject);
begin
 if Step>=Count then begin
  Ctrl.Font.Color:=OldClr;
  Ctrl.Text:=OldTxt;
  LstCtrl.Delete(LstCtrl.IndexOf(Ctrl));
  Free; Exit;
 end;
 if Odd(Step) then begin
  Ctrl.Font.Color:=Clr;
  Ctrl.Text:=Txt;
  Interval:=Pause;
 end else begin
  Ctrl.Font.Color:=OldClr;
  Ctrl.Text:=OldTxt;
  Interval:=Pause div 2;
 end;
 INC(Step);
end;

procedure FlashControl(ACtrl: TControl; ATxt: String; AClr: TColor; ACount, APause: Integer);
begin
 if LstCtrl.IndexOf(ACtrl)<0 then begin
  TFlashCtrl.Createflash(ACtrl, ATxt, AClr, ACount, APause);
  LstCtrl.Add(ACtrl);
 end;
end;

initialization
 LstCtrl:=TList.Create;
finalization
 LstCtrl.Free;
end.

{RASkov}   (2009-01-09 14:00:00) [55]

> Вызов:
> TFlashCtrl.Createflash(Label1, 'Внимание!!!', clRed, 3,
> 350);


Можно чтоб все это более культурно выглядело, то в отдельный юнит, в раздел интерфеса только описание функции
procedure FlashCtrl(ACtrl: TControl; ATxt: String; AClr: TColor; ACount, APause: Integer);
begin
 TFlashCtrl.Createflash(ACtrl, ATxt, AClr, ACount, APause);
end;
Все остальное скрыть в implementation

{RASkov}   (2009-01-09 13:19:00) [56]

Или вот так:

type
 TMyCtrl = class(TControl);
 TFlashCtrl = class(TTimer)
 private
   Count: Integer;
   Pause: Integer;
   Step: Integer;
   Txt, OldTxt: String;
   Clr, OldClr: TColor;
   Ctrl: TMyCtrl;
 protected
   procedure Flashing(Sender: TObject);
 public
   constructor Create(AOwner: TComponent); override;
   constructor CreateFlash(ACtrl: TControl; ATxt: String; AClr: TColor; ACount, APause: Integer);
 end;
..................
constructor TFlashCtrl.Create(AOwner: TComponent);
begin
 raise Exception.Create('Ошибка, Нужно вызывать CreateFlash конструктор!');
 //или CreateFlash(nil, '', clBlack, 0, 0);
end;

constructor TFlashCtrl.CreateFlash(ACtrl: TControl; ATxt: String; AClr: TColor; ACount, APause: Integer);
begin
 inherited Create(nil);
 Enabled:=False;
 Interval:=APause;
 Count:=ACount;
 Pause:=APause;
 Step:=0;
 Ctrl:=TMyCtrl(ACtrl);
 OldTxt:=Ctrl.Text;
 Txt:=ATxt;
 OldClr:=Ctrl.Font.Color;
 Clr:=AClr;
 OnTimer:=Flashing;
 Enabled:=True;
end;

procedure TFlashCtrl.Flashing(Sender: TObject);
begin
 if Step>=Count then begin
  Ctrl.Font.Color:=OldClr;
  Ctrl.Text:=OldTxt;
  Free; Exit;
 end;
 if Odd(Step) then begin
  Ctrl.Font.Color:=Clr;
  Ctrl.Text:=Txt;
  Interval:=Pause;
 end else begin
  Ctrl.Font.Color:=OldClr;
  Ctrl.Text:=OldTxt;
  Interval:=Pause div 2;
 end;
 INC(Step);
end;

Вызов:
TFlashCtrl.Createflash(Label1, 'Внимание!!!', clRed, 3, 350);
------------------------------------------------------------------------
Ну или в таком духе:)

{RASkov}   (2009-01-09 12:41:00) [57]

> моргающих" контролов (например, меток или панелей статусбаров)
> может быть произвольное кол-во.

А, нет.... у меня только по одному контролу мыргает... Сорри, невнимательно прочитал...

{RASkov}   (2009-01-09 12:36:00) [58]

А так не подойдет:
type TMyCtrl = class(TControl);
var Flashing: Boolean;
procedure FlashCtrl(Ctrl: TControl; Txt: String; Clr: TColor; ACount, APause: Integer);
procedure Delay(Ms: Word);
var Tm: Cardinal;
begin
  Tm:=GetTickCount+Ms;
  while (Tm>GetTickCount) and not Application.Terminated do Application.ProcessMessages;
end;
var S: String; N: Integer; OldClr: TColor;
begin
 if Flashing then Exit else Flashing:=True;
 S:=TMyCtrl(Ctrl).Text; OldClr:=TMyCtrl(Ctrl).Font.Color;
 if ACount<1 then ACount:=1 else if not Odd(ACount) then DEC(ACount);
 try
  for N:=1 to ACount do begin
   Application.ProcessMessages;
   if Odd(N) then begin
    TMyCtrl(Ctrl).Font.Color:=Clr;
    TMyCtrl(Ctrl).Text:=Txt;
    Delay(APause);
   end else begin
    TMyCtrl(Ctrl).Font.Color:=OldClr;
    TMyCtrl(Ctrl).Text:=S;
    Delay(APause div 2);
   end;
  end;
 finally
  Application.ProcessMessages;
  TMyCtrl(Ctrl).Font.Color:=OldClr;
  TMyCtrl(Ctrl).Text:=S;
  Flashing:=False;
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 FlashCtrl(Label1, 'Внимание!!!', clBlue, 3, 350);
 FlashCtrl(Edit1, '(Sorry, Не найдено)', clRed, 5, 350);
end;

DVM   (2009-01-09 12:07:00) [59]


> MsGuns ©   (09.01.09 11:47)  

лучше менять цвет текста контрола, опираясь на его имя.

А в чем сложность то?

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

Наверх

Титульная страница Поиск, карта сайта Написать письмо