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

← →
MsGuns © (2009-01-09 11:47) [0]

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

← →
DVM © (2009-01-09 12:07) [1]

> MsGuns © (09.01.09 11:47)

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

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

← →
{RASkov} © (2009-01-09 12:36) [2]

А так не подойдет:
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;

← →
{RASkov} © (2009-01-09 12:41) [3]

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

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

← →
{RASkov} © (2009-01-09 13:19) [4]

Или вот так:

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 14:00) [5]

> Вызов:
> 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 15:39) [6]

Вот нечто так наверное:
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.

← →
MsGuns © (2009-01-10 23:18) [7]

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

← →
{RASkov} © (2009-01-11 00:18) [8]

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

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

← →
Германн © (2009-01-11 01:14) [9]

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

← →
Германн © (2009-01-11 02:55) [10]

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

← →
{RASkov} © (2009-01-11 09:04) [11]

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

← →
KSergey © (2009-01-11 15:39) [12]

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

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

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

← →
KSergey © (2009-01-11 15:40) [13]

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

← →
Leonid Troyanovsky © (2009-01-11 17:22) [14]

> 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.

← →
Юрий Зотов © (2009-01-12 00:32) [15]

> 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;

← →
Германн © (2009-01-12 01:59) [16]

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

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

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

← →
KSergey © (2009-01-12 07:03) [17]

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

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

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

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

← →
oxffff © (2009-01-12 09:00) [18]

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

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

← →
KSergey © (2009-01-12 11:03) [19]

> 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 11:41) [20]

> KSergey © (12.01.09 11:03) [19]
> > oxffff © (12.01.09 09:00) [18]
> > Пропускать ему только сообщения, кроме WM_PAINT WM_NCPAINT
>
> > WM_ERASEBKGND, а эти сообщения слать по таймеру родной
> процедуре.
>
> А как это поможет мерцанию текста? Скоре тогда контрол не
> будет отрисовываться когда надо. Мерцание, конечно, получим,
> но какое-то странное :)
>

А вы внимательно читали суть вопроса?

универсальной процедурой, получающей указатель на произвольный контрол

Если контрол поддерживает нормальную обработку WM_PAINT WM_NCPAINT WM_ERASEBKGND, то все будет хоккей.
А если он перерисовывается произвольно, тогда будет некоторое перемигивание. :)

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

Для TgraphicControl тоже можно сделать.
Конечно c наследниками TgraphicControl придется химичить, однако при желании можно и их сделать при вышеупомянутом способе.
Отлавливаем WndpProc и проверяем на IntersecRect с искомой областью
TgraphicControl.
А кстати почему такой неширокий кругозор? Или кроме VCL ничего больше нет? ;)

← →
oxffff © (2009-01-12 15:26) [21]

> MsGuns © (09.01.09 11:47)

НА
Tshape
Tlabel
Timage
работает.

TFlashHandler=class
State:byte;
NativeHandler:TWndMethod;
Timer:TTimer;
Control:TGraphicControl;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure DefaultHandler(var Message);override;
procedure InterceptWndProc(var Message: TMessage);
procedure OnTimer(Sender: TObject);
constructor create(Control:TGraphicControl);
destructor destroy;override;
end;

{ TFlashHandler }

constructor TFlashHandler.create(Control: TGraphicControl);
begin
if not assigned(Control) then Raise Exception.Create("No control assigned");
Timer:=TTimer.Create(nil);
Timer.OnTimer:=ontimer;
self.Control:=Control;
NativeHandler:=Control.WindowProc;
Control.WindowProc:=InterceptWndProc;
end;

procedure TFlashHandler.DefaultHandler(var Message);
begin
NativeHandler(Tmessage(message));
end;

destructor TFlashHandler.destroy;
begin
Timer.Free;
end;

procedure TFlashHandler.InterceptWndProc(var Message: TMessage);
begin
Dispatch(message);
end;

procedure TFlashHandler.OnTimer(Sender: TObject);
var A:TWMPaint;
begin
ZeroMemory(@a,sizeof(a));
a.DC:=TCustomLabel(control).canvas.handle;
case state of
0:
begin
a.Msg:=WM_ERASEBKGND;
Control.Parent.WindowProc(Tmessage(a));
end;
1: begin
a.Msg:=WM_PAINT;
NativeHandler(Tmessage(A));
end;
else; //No No No!!!
end;
State:=1-state;
end;

procedure TFlashHandler.WMPaint(var Message: TWMPaint);
begin
//Do Nothing
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
{Эти объекты нужно удалить}
TFlashHandler.create(shape1);
TFlashHandler.create(label1);
TFlashHandler.create(image1);
end;

← →
oxffff © (2009-01-12 15:34) [22]

> oxffff © (12.01.09 15:26) [21]

Хочу отметить - работающий набросок. Идея доведена до реализации.
Большей задачи перед собой не ставил.
:)

← →
KSergey © (2009-01-12 16:44) [23]

> oxffff © (12.01.09 15:26) [21]

А где та самая супер-волшебная процедура?? (не метод!)
Да и зачем так сложно?? поменять цвет/вызвать Invalidate (хотя он и так вызовется) - много проще и волшебно. Тем более, что в WM_PAINT не только текст рисуется, стоит отметить. У того же упомянутого статус-бара к примеру.

← →
oxffff © (2009-01-12 17:19) [24]

> KSergey © (12.01.09 16:44) [23]

А что непонятно со статус-баром?

← →
oxffff © (2009-01-12 18:14) [25]

> KSergey © (12.01.09 16:44) [23]
> > oxffff © (12.01.09 15:26) [21]
>
> А где та самая супер-волшебная процедура?? (не метод!)

TFlashHandler.create на эту роль не подходит?
Если нет, то почему?

Насколько я понял задачу речь шла о именно невозможности вмешаться в исходный код контрола.

> поменять цвет/вызвать Invalidate (хотя он и так вызовется)
> - много проще и волшебно.

Поменять цвет pen у DC? А где гарантии что в WndProc он не будет сменен?
Если поменять свойство-цвета контрола, тогда идет привязка к конкретному контролу, и нет универсальности.
А речь шла именно о том, что контрол не известен.

> Тем более, что в WM_PAINT не только текст рисуется, стоит
> отметить.

Дык, у меня TImage тоже прекрасно заглатывается.

← →
Smile (2009-01-12 18:20) [26]

Я, что-то не до конца понял.
Что чат уже отменили (сам давно туда не заглядывал, тем более что без регистрации туда не пущают)?
А так бы предложил участникам ветки пообщаться там

← →
Leonid Troyanovsky © (2009-01-12 19:16) [27]

> Smile (12.01.09 18:20) [26]

> Я, что-то не до конца понял.

Меня раскручивают до "Идея доведена до реализации" :)

--
Regards, LVT.

← →
MsGuns © (2009-01-13 00:11) [28]

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

Типы котнролов могут весьма колебаться от TEdit до TStringGrid (т.е. нужен скорее всего TInplaceEdit). Т.к. приложений таких масса, а писать собственные компоненты нельзя, выход только в максимальной универсализации, т.е. опять же "внешняя" процедура и "передача параметрами".

← →
MsGuns © (2009-01-13 00:15) [29]

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

← →
oxffff © (2009-01-13 00:18) [30]

> MsGuns © (13.01.09 00:11) [28]

В [21] все моргает. Без необходимости править сам контрол, то есть в до какой то степени универсальна.
Я конечно знаю где могут быть проблемы, но это качестве рекомендацию по улучшению возможно необходимо использовать
WM_ERASEBKGND c RECT контрола,
либо Invalidate c Rect контрола(что менее выгодно поскольку будет послан WM_PAINT, который не будет обработан по причине неотрисовки на данном шаге моргания)

← →
oxffff © (2009-01-13 00:23) [31]

> MsGuns © (13.01.09 00:15) [29]

Для Twincontrol нужно слегка модицицировать.
Уверен, что догадаетесь как.

← →
MsGuns © (2009-01-13 00:38) [32]

Спасибо. Уже занимаюсь ;)

← →
KSergey © (2009-01-13 05:46) [33]

> MsGuns © (13.01.09 00:11) [28]
> сделать "моргающий" стиль в контролах, где пользователь
> допустил ошибку, а кроме того в некотором другом месте (например,
> статусбаре) отображать, например, бегущей строкой,

Моргающий бегущий текст?!! бедный пользователь, придется автору доплачивать всем пользователям на услуги офтальмолга...

← →
KSergey © (2009-01-13 05:52) [34]

> oxffff © (12.01.09 18:14) [25]
> Дык, у меня TImage тоже прекрасно заглатывается.

При чем тут только имидж?!
Нужно же понимать, что в WM_PAINT происходит отрисовка всего контрола, а не только текста на нем. Посмотрите внимательно на StatusBar, например.
Речь же шла только о мигающем тексте, неужели это не понятно??
Я уж не говорю про случаи (частые! см. всякие гриды, например), где в WM_ERASEBKGND заливается одним цветом, а в WM_PAINT - другим. Если пойти предложенным путем - получим ту еще цветомузыку.

← →
KSergey © (2009-01-13 05:56) [35]

> oxffff © (13.01.09 00:18) [30]
> В [21] все моргает. Без необходимости править сам контрол,

Большенство предложенных методик так же обходились без правки контролов, не так ли?

> oxffff © (12.01.09 18:14) [25]
> > А где та самая супер-волшебная процедура?? (не метод!)
> TFlashHandler.create на эту роль не подходит?
> Если нет, то почему?

Разницу между процедурой и методом понимаем? У автора явно написано (и даже подчеркнуто): процедура, это необходимое условие! Читайте внимательно.

← →
MsGuns © (2009-01-13 08:18) [36]

>Моргающий бегущий текст?!!

Моргает только контрол, в котором ошибка (TEdit к примеру). "Бежит" текст с ошибкой, например, в статусбаре

>oxffff ©

Увы, не то :( см. [35]

← →
oxffff © (2009-01-13 08:44) [37]

> KSergey © (13.01.09 05:56) [35]
> > oxffff © (13.01.09 00:18) [30]
> > В [21] все моргает. Без необходимости править сам контрол,
>
>
> Большенство предложенных методик так же обходились без правки
> контролов, не так ли?
>
> > oxffff © (12.01.09 18:14) [25]
> > > А где та самая супер-волшебная процедура?? (не метод!
> )
> > TFlashHandler.create на эту роль не подходит?
> > Если нет, то почему?
>
> Разницу между процедурой и методом понимаем? У автора явно
> написано (и даже подчеркнуто): процедура, это необходимое
> условие! Читайте внимательно.

> KSergey © (13.01.09 05:56) [35]
> > oxffff © (13.01.09 00:18) [30]
> > В [21] все моргает. Без необходимости править сам контрол,
>
>
> Большенство предложенных методик так же обходились без правки
> контролов, не так ли?

Нет, не так. Читаем

KSergey © (11.01.09 15:39) [12]

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

Вы предлагаете удалять контрол?
Где мигание текста, я его в упор не вижу.

Читаем далее Юрий Зотов © (12.01.09 00:32) [15]

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

Это что за универсализм такой, вы привязываетесь к конкретным контролам.

>
> > oxffff © (12.01.09 18:14) [25]
> > > А где та самая супер-волшебная процедура?? (не метод!
> )
> > TFlashHandler.create на эту роль не подходит?
> > Если нет, то почему?
>
> Разницу между процедурой и методом понимаем? У автора явно
> написано (и даже подчеркнуто): процедура, это необходимое
> условие! Читайте внимательно.

Вы ее сами то хоть понимаете?
Это та же самая процедура(функция) с неявным параметром.
Механизм вызова идентичен.

Можете сделать процедуру, которая будет внутри вызывает конструктор.

> KSergey © (13.01.09 05:52) [34]
> > oxffff © (12.01.09 18:14) [25]
> Я уж не говорю про случаи (частые! см. всякие гриды, например),
> где в WM_ERASEBKGND заливается одним цветом, а в WM_PAINT
> - другим. Если пойти предложенным путем - получим ту еще
> цветомузыку.

C чего мы получим светомузыку? С того через 1 сек повляется фон, а еще через секунду контрол перересовывается?
Получим просто моргающий контрол.

← →
oxffff © (2009-01-13 08:56) [38]

> MsGuns © (13.01.09 08:18) [36]
> >Моргающий бегущий текст?!!
>
> Моргает только контрол, в котором ошибка (TEdit к примеру).
> "Бежит" текст с ошибкой, например, в статусбаре
>
> >oxffff ©
>
> Увы, не то :( см. [35]

Если используемые контролы не поддерживают данную функциональность
через уни-контракт(например IControlFlashText), тогда либо вы ее ручками
добавляете.
Либо делаете run-time идентификацию типа:
через is TTextControl then TTextControl(control).someTextProperty:=""
через статический или динамический паттерн Visitor.

Хотя у меня есть еще идея и универсальнее и сложнее.
Сказать? :)

← →
KSergey © (2009-01-13 09:10) [39]

> oxffff © (13.01.09 08:44) [37]
> Нет, не так. Читаем
>
> KSergey © (11.01.09 15:39) [12]
>
> Идеальным видится случай перекрыть классы для всех контролов
> и в деструкторе удалять(-ся) из общего списка (на манер
> освобождения ссылки из списка своего Owner-а), но на сколько
> это удобно в конкретном случае - вопрос.

А дальше почитать 12 - не судьба?

Вообще штука вот в чем: вы говорите о том, как сделать собственно моргание. Я (и многое другие) - как удобно уравлять морганием нескольких контролов на одном общем механизме, в ОДНОМ месте с учетом того, что моргающие контролы вообще-то иногда дестроятся и это должно коректно обрабатываться, а не создавая объекты моргания на каждый визуальный контрол. И автору ка краз интерсне было как это одно место организовать, если посмотреть вопрос.

Решить же универсально сам процесс моргания - не особо нужно на самом деле, тут лучше тоньше подойти, с учетом конкретных контролов, а не просто перекрыв WM_PAINT без разбора, я писал почему.

← →
KSergey © (2009-01-13 09:12) [40]

> oxffff © (13.01.09 08:56) [38]
> через статический или динамический паттерн Visitor.

Да, да
Как раз о его реализации стандартными средствами дельфи в основном и речь.

← →
oxffff © (2009-01-13 10:01) [41]

> KSergey © (13.01.09 09:10) [39]

Есть еще идея. Суть:

Делаем перехват API функций например DrawTextA, в моргающий момент подставляем пустышку, которая делает просто:
add esp,ParamsCleanUpSize
ret
В момент отрисовки подставляем родную реализацию.
от обработки WM_ERASEBKGND отказываемся.

В итоге код мой меняется на

a.Msg:=WM_PAINT;
case state of
0:
begin
NativeHandler(Tmessage(A));
end;
1: begin
PatchApi
NativeHandler(Tmessage(A));
RestoreApi
end;

А чем Visible:=not Visible; не подходит? Если контролы "неалигнутые"...
......если "алигнутые" то это понятно :)

>KSergey © (13.01.09 09:10) [39]
>Вообще штука вот в чем: вы говорите о том, как сделать собственно моргание. Я (и многое другие) - как удобно уравлять морганием нескольких контролов на одном общем механизме, в ОДНОМ месте с учетом того, что моргающие контролы вообще-то иногда дестроятся и это должно коректно обрабатываться, а не создавая объекты моргания на каждый визуальный контрол. И автору ка краз интерсне было как это одно место организовать, если посмотреть вопрос.

Ты верно уловил суть задачи :)
При этом "моргающие" ("бегущие") контролы могут принадлежать к разным формам, которые, кстати, могут еще и перекрывать друг друга. Вот почему нельзя привязываться к конкретным классам

> MsGuns © (13.01.09 12:33) [43]
> Ты верно уловил суть задачи :)

Так оно ж явно написано.

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

Это не мешает.
Достаточно вынести "диспетчер моргания" в отдельный юнит, создавая единственный экземпляр "менеджера морганий" в initialization.
А без класса все равно нам не обойтись: все обработчики событий"того же таймера) - только методами могут быть. Так что максимум что можно - это обернуть объект и обращение к нему в некую функцию, но по сути это не избавит нас от объектов, так что смысла упираться особого не вижу.

Желание oxffff сделать еще и процессморгания супер универсальным - как бы хорошее с виду, но нереализуемое ввиду кучи нюансов, спасибо, я уже наступал на похожие грабли в желании "сейчас быстренько все сообщения перехватим и как надо обработаем". Слишком много нюансов выползает, ну нафик

> KSergey © (13.01.09 13:16) [45]
> Желание oxffff сделать еще и процессморгания супер универсальным
> - как бы хорошее с виду, но нереализуемое ввиду кучи нюансов,
> спасибо, я уже наступал на похожие грабли в желании "сейчас
> быстренько все сообщения перехватим и как надо обработаем".
> Слишком много нюансов выползает, ну нафик

Отвечу честно, нами для автора темы было расмотрено несколько вариантов решения возникшей перед ним задачи.
Автор темы человек с интелектом(я уверен!!!).
И сделает все самостоятельно, если уже не сделал. :)
А поскольку мы все с вами не стараемся раскрыть все свои карты,
поэтому ждать от меня "полного" решения напрасно.

> oxffff © (13.01.09 21:43) [46]
> А поскольку мы все с вами не стараемся раскрыть все свои карты,
> поэтому ждать от меня "полного" решения напрасно.

ну про карты - это не правда какая-то, вроде никто ничего не скрывает, другое дело что полностью делать готовую реализацию всем лень, да и не надо автору, он сам не дурак :)

Я просто о том, что предложенный вами путь видится мне тупиковой: на простых примерах идея вроде рабочая, но потом нюансы разгребать замаешься.

> Я просто о том, что предложенный вами путь видится мне тупиковой:
> на простых примерах идея вроде рабочая, но потом нюансы
> разгребать замаешься.

Это ваше мнение, которое является только вашим не более и не менее. :)

> oxffff © (14.01.09 19:51) [48]
> Это ваше мнение, которое является только вашим не более и не менее. :)

Безусловно, но оно подкреплено шишками от граблей :)

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

Сроки я, как обычно, срываю.

Вот тут только исходники http://ifolder.ru/10086718
Вот тут исходники вместе с exe-файлом http://ifolder.ru/10086733
D7

Что сделал: простой классик, внутри содержит таймер, переключает по таймеру флажек. В конструктор классу передается TConponent, текстом хоторого хотелось бы мигать.
Для простоты под каждый мигаемый компонент отдельный экземпляр класса-мигателя, экземпляры класса-мигателя не удаляются, фик с ними, не в том пока суть.

Надо сказать, что споткнулся даже реньше чем ожидал, но рыть надоело.
Как воспроизвести траблу: запускаем, начинаем поверх окна приложения вошкать другим окном, через секунду (интервал таймера) изображения всех компонент пропадают (замечу: даже фон от TLabel, что не правильно и чего я и ожидал, но это фигня в сравнении с). Но, теперь процессор загружен на 100%, таймер более не срабатывает (судя по точкам остановки), явно у приложения не доходят "руки" до этих глупых WM_TIMER. Чем оноболее важным занято - не понял, предлагаю побеждать.

Суда выложу классик мигателя:

unit Migalka; interface uses Windows, Messages, Controls, ExtCtrls, StdCtrls, SysUtils; type TMigalka = class(TObject) private FTimer: TTimer; FControl: TControl; FOldWndProc: TWndMethod; FIsPaint: Boolean; procedure NewWndProc(var Message: TMessage); procedure DoFlash(Sender: TObject); public constructor Create(ACtrl: TControl); destructor Destroy; override; end; implementation type TFreindGraphicControl = class(TGraphicControl); { TMigalka } constructor TMigalka.Create(ACtrl: TControl); begin FControl := ACtrl; FOldWndProc := FControl.WindowProc; FControl.WindowProc := NewWndProc; // FIsPaint := True; // Set Timer FTimer := TTimer.Create(nil); FTimer.OnTimer := DoFlash; FTimer.Interval := 1000; FTimer.Enabled := True; end; destructor TMigalka.Destroy; begin FTimer.Free; inherited; end; procedure TMigalka.DoFlash(Sender: TObject); begin FIsPaint := not FIsPaint; end; procedure TMigalka.NewWndProc(var Message: TMessage); function GetHDC: HDC; begin if FControl is TGraphicControl then Result := TFreindGraphicControl(FControl).Canvas.Handle else if FControl is TWinControl then Result := GetDC(TWinControl(FControl).Handle) else Result := 0; end; begin if (Message.Msg = WM_PAINT) AND (NOT FIsPaint) then begin if NOT FIsPaint then begin Message.WParam := LongInt(GetHDC()); if Message.WParam <> 0 then begin Message.Msg := WM_ERASEBKGND; FOldWndProc(Message); Message.Result := 0; end; end; end else FOldWndProc(Message); end; end.

Я решил завязать с этим форумом.
Но ваш вопрос отвечу, чуть позже. :)

> KSergey © (18.01.09 12:21) [51]
> Но, теперь процессор загружен на 100%,
> таймер более не срабатывает (судя по точкам остановки),
> явно у приложения не доходят "руки" до этих глупых WM_TIMER.
> Чем оноболее важным занято - не понял, предлагаю побеждать.

Да, замечу: оно не зацикливается в коде приложения. На крестик, например, нормально реагирует, закрывается.
Видимо беда в подмене WM_PAINT на WM_ERASEBKGND, видимо система не ожидает такого подвоха, а может в обработчике WM_ERASEBKGND вызывается что-то, что недопустимо по приходу WM_PAINT - оно ж особенное. Может его надо было все ж просто маскировать и все?
К стати, если его тупо сразу маскировать - то ексепшн типа "OS error" чего-то тама, не записал и не запомнил, сорри. Легко воспроизвести, если в конструкторе мигателя изначально FIsPaint присвоить False.

Собственно это все и ожидалось: подменять сообщения - это не просто, надо знать чего-то много, а иногда и просто невозможно (подозреваю, что не зря в MSDN написано "приложение само не должно посылать WM_PAINT"), при этом, как известно, обработчик WM_PAINT - оно несколько особенный в плане используемых функций для получения HDC. Видать система сама чего-то взводит перед его посылкой.

Но мне разбираться лень, сколько я пытался когда-то шаманить с подменой сообщений типа WM_PAINT - получал фигу, от того и считаю, что путь этот - гиблый.

> Но мне разбираться лень, сколько я пытался когда-то шаманить
> с подменой сообщений типа WM_PAINT - получал фигу, от того
> и считаю, что путь этот - гиблый

Вы не читаете свою почту. :(
У меня все работает. Пишите мне на почту.

TDynaHandler=function (var handle:HWND;var Rect:TRect):PRect of object;

TFlashHandler=class
State:byte;
NativeHandler:TWndMethod;
Timer:TTimer;
Control:TControl;
GetParams:TDynaHandler;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure DefaultHandler(var Message);override;
procedure InterceptWndProc(var Message: TMessage);
procedure OnTimer(Sender: TObject);
function GetParams_WinControl(var handle:HWND;var Rect:TRect):PRect;
function GetParams_GraphicControl(var handle:HWND;var Rect:TRect):PRect;
constructor create(Control:TControl);
destructor destroy;override;
end;

{ TFlashHandler }

constructor TFlashHandler.create(Control: TControl);
begin
if not assigned(Control) then Raise Exception.Create("No control assigned");
if Control Is TWinControl then GetParams:=GetParams_WinControl
else GetParams:=GetParams_GraphicControl;
Timer:=TTimer.Create(nil);
Timer.OnTimer:=ontimer;
self.Control:=Control;
NativeHandler:=Control.WindowProc;
Control.WindowProc:=InterceptWndProc;
end;

procedure TFlashHandler.DefaultHandler(var Message);
begin
NativeHandler(Tmessage(message));
end;

destructor TFlashHandler.destroy;
begin
Timer.Free;
end;

function TFlashHandler.GetParams_GraphicControl(var handle:HWND;var Rect: TRect): PRect;
begin
rect:=Control.BoundsRect;
Handle:=TCustomLabel(control).parent.Handle;
result:=@Rect;
end;

function TFlashHandler.GetParams_WinControl(var handle:HWND;var Rect: TRect): PRect;
begin
Handle:=TWinControl(control).handle;
result:=nil;
end;

procedure TFlashHandler.InterceptWndProc(var Message: TMessage);
begin
Dispatch(message);
end;

procedure TFlashHandler.OnTimer(Sender: TObject);
var Handle:HWND;
prectA:prect;
RectA:Trect;
begin
State:=1-state;
pRectA:=GetParams(handle,RectA);
IF state=0 then
begin
InvalidateRect(handle,pRectA,false);
end
else
begin
InvalidateRect(Handle,pRectA,True);
end;
end;

procedure TFlashHandler.WMPaint(var Message: TWMPaint);
var Handle:HWND;
prectA:prect;
RectA:Trect;
EraseMessage:TWmEraseBkgnd;
begin
If state=1 then
begin
NativeHandler(Tmessage(Message));
end
else
begin
pRectA:=GetParams(handle,RectA);
EraseMessage.Msg:=WM_ERASEBKGND;
EraseMessage.DC:=GetDC(Handle);
Control.Parent.Dispatch(EraseMessage);
ValidateRect(Handle,pRectA);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
{Ýòè îáúåêòû íóæíî óäàëèòü}
TFlashHandler.create(shape1);
TFlashHandler.create(label1);
TFlashHandler.create(image1);
TFlashHandler.create(memo1);
TFlashHandler.create(edit1);
TFlashHandler.create(button1);
TFlashHandler.create(statusbar1);
end;

Заметим, что у контролов рисующих в WM_NCPAINT все рисуется, то есть по факту мигает только текст(см. memo).
Что касаемо мигания только текста в общем виде.
То и здесь у меня есть соображения.

Перекройте dll метод отрисовки текста на канву.
И все.

может написать компонент на основе таймера с свойством "Объкты" типа TObjectList.
в объекты накидать нужное и мигать на событие таймера

← →
имя (2009-03-31 11:18) [58]

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

← →
имя (2009-03-31 11:19) [59]

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

Как сделать мерцающий текст ? Найти похожие ветки