Мигание компонента

← →
Tundra (2002-12-04 06:44) [0]

У меня на форме несколько Labelов и при наведении курсора на любой из них он меняет свет и на другой, но при этом происходит непонятное мигание тех компонентов которые меняют цвет, как это убрать.
Спасибо.

← →
Дмитрий К.К. (2002-12-04 07:14) [1]

Код в студию!

← →
Tundra (2002-12-04 07:33) [2]

procedure TForm8.LabelMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var k,i:integer;
begin
k:=strtoint(Copy(tlabel(sender as tlabel).name, 6, 1));
for i:=1 to 7 do
if (i<>k) and
(tlabel(form8.FindComponent("Label" +inttostr(i))).color<>clYellow)
then
tlabel(form8.FindComponent("Label" +inttostr(i))).color:= clyellow ;
tlabel(sender as tlabel).color:=clinfobk;
end;
Эта процедура прописана для всех label по которым скользит курсор, и когда он уходит с одного ком-та тот меняет цвет на желтый, а тот на котором он установился должен стаить серым.
Все работает только если не мигание, можно ликак нибудь отключить пеперисовку экрана?

← →
Zergling (2002-12-04 07:49) [3]

Переделай свой класс TLabel
в разделе Private добавь:

FOnMouseLeave: TNotifyEvent; // Мыша выходит за пределы компонента
FOnMouseEnter: TNotifyEvent; // Мыша входит в область компонента
Procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
Procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;

в разделе Published

property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;

Обработка этих событий:
procedure TLabel.CMMouseEnter(var Message: TMessage);
begin
inherited;
if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
end;

procedure TLabel.CMMouseLeave(var Message: TMessage);
begin
inherited;
if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
end;

← →
Tundra (2002-12-04 07:58) [4]

>> to Zergling
спасибо, только
я не понял зачем мне все это - у меня все работает - компоненты меняют цвет. Просто нужно убрать мигание компонента при перемене цвета.

← →
Zergling (2002-12-04 08:23) [5]

Как я понял твоя задача такая: Когда курсор мыши входит в пределы лайбочки цвет изменяется. Когда курсор мыши выходит за пределы лайбочки цвет изменяется на другой. У меня есть класс производный от TLabel который поддерживает эти события. Если это, то что тебе нужно, то напиши. Кину полный этот класс сюда, тебе только понадобиться установить этот компонент. Если откровенно, то я не понимаю, зачем в LabelMouseMove перебирать все лайбы и менять их цвет. Не лишняя ли это обработка. Если, я не так понял твою задачу, то распиши ее подробнее.

← →
Zergling (2002-12-04 08:39) [6]

Не понял, что имеется ввиду под миганием лайбочек. Вставил твой код и у меня ни чего ни мигает (цвета меняются при наведении мыши), только не успевают обрабатываться некоторые лайбочки при быстром перемешении мыши (2-3 могут остаться с серым цветом).

← →
Tundra (2002-12-04 08:46) [7]

>> to Zergling
Просто в Label не определены события когда мыша начинает находится над сомпонентом и когда оставляет его, а определять это по местоположению мыши или определять эти события (как ты привел код выше) - лень. Поэтому самый простой метод перебрать все эти компоненты и кому надо установить какой надо цвет и сделать все это в одной процедуре.
Я уже писал, что все это работает только вот мигают компоненты которые меняют цвет, и я не знаю как это отключить.
Если же вышлешь мне класс - то большое спасибо - буду рад.

← →
Vad (2002-12-04 08:47) [8]

А так:

procedure TForm1.LabelMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var k,i:integer; begin k:=strtoint(Copy(tlabel(sender as tlabel).name, 6, 1)); if tlabel(sender as tlabel).color<>clinfobk then tlabel(sender as tlabel).color:=clinfobk; for i:=1 to 7 do if (i<>k) and (tlabel(form1.FindComponent("Label" +inttostr(i))).color<>clYellow) then if tlabel(form1.FindComponent("Label" +inttostr(i))).color<>clyellow then tlabel(form1.FindComponent("Label" +inttostr(i))).color:= clyellow ; end;

← →
Zergling (2002-12-04 08:55) [9]

Еще раз повторюсь. У меня с твоим кодом компоненты НЕ МИГАЮТ! Цвета меняются нормально. Посмотри внимательно свою программу, может еще чего с ними делаешь. То что я с перерисовкой написал выше - все работает (просто я на форму лайбочек кинул больше, чем у тебя в For крутится, потому и не изменяли цвет).

Вот полный модуль компонета. Будут проблемы с установкой компонента, пиши сюды!

unit MyLabel;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
TMyLabel = class(TLabel)
private
{ Private declarations }
FOnMouseLeave: TNotifyEvent; // Мыша выходит за пределы компонента
FOnMouseEnter: TNotifyEvent; // Мыша входит в область компонента
Procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
Procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
protected
{ Protected declarations }
public
{ Public declarations }
published
{ Published declarations }
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents("Demo", [TMyLabel]);
end;

{ TMyLabel }

procedure TMyLabel.CMMouseEnter(var Message: TMessage);
begin
inherited;
if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
end;

procedure TMyLabel.CMMouseLeave(var Message: TMessage);
begin
inherited;
if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
end;

end.

← →
Tundra (2002-12-04 09:18) [10]

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

procedure TForm8.LabelMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var k,i:integer;
lbl:tlabel;
begin

k:=strtoint(Copy(tlabel(sender as tlabel).name, 6, 1));
for i:=1 to 7 do
if (i<>k) and
(tlabel(form8.FindComponent("Label" +inttostr(i))).color<>clYellow)
then
begin
lbl:= tlabel(form8.FindComponent("Label" +inttostr(i)));
labela.Width:=lbl.Width+100;
labela.height:=lbl.height;
labela.Color:=clyellow;
labela.Left:=lbl.Left;
labela.top:=lbl.top;
labela.Visible:=true;
lbl.Color:=clyellow;
labela.Visible:=false;
end ;
if tlabel(sender as tlabel).color<>clinfobk then
begin
lbl:= tlabel(sender as tlabel);
labela.Width:=lbl.Width;
labela.height:=lbl.height;
labela.Color:=clyellow;
labela.Left:=lbl.Left;
labela.top:=lbl.top;
labela.Visible:=true;
lbl.Color:=clinfobk;
labela.Visible:=false;
end
end;

← →
Zergling (2002-12-04 09:40) [11]

Попробуй каждой лайбе сказать: Label1.BringToFront (тоже можешь проделать в среде разработке). Пусть будет поверх рисунка. A фоновый рисунок на чем рисуещь и как. Знаю одного гражданина, который картинки любил перерисовывать с помощью таймера. Так у него все лайбы на форме сразу перетирались (исчезали). После вставки перерисовки формы в событие OnPaint все стало нормально.
Напиши на чем рисуещь и как (интересно разобрать твой феномен).

← →
Tundra (2002-12-04 09:52) [12]

Рисунок вставлен в Timage который растянут на форме (alClient можно и не растягивать все то же), вставляется рисунок во время загрузки LoadFromFile (Имяфайла из БД)
Все Лайбы стоят поверх рисунка и если даже под лайбу поместить Shape с цветом, то при перерисовке все будет все равно мигать - перерисоввывается сначала image (он проглядывает) потом все остальное и потому мигает.

← →
Zergling (2002-12-04 09:53) [13]

Попробовал фоновый рисунок на TImage и просто на форме. НЕ МИГАЕТ! Может у тебя проект сильно загружен чем нибудь и машина тормозит? Пеши о своих результатах!

← →
Tundra (2002-12-04 10:25) [14]

Пробовал на разных компах - мигает, мигают только те лайблы которые меняют цвет остальные нормально.

← →
Tundra (2002-12-04 10:34) [15]

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

← →
Zergling (2002-12-04 10:52) [16]

>> Tundra (04.12.02 09:52)
перерисовке все будет все равно мигать - перерисоввывается сначала image (он проглядывает) потом все остальное и потому мигает.

А у тебя, что, при смене цвета у лайбы идет перерисовка рисунка полностью по новой??? Кинь код, как рисунок выводищь. Еще варинат, может глючная версия Delphi у тебя.

← →
Dimosha (2002-12-04 11:40) [17]

Попробуй так:
...
Lockwindowupdate(label1.handle);
// тут меняем свойства лабла а-ля цвет, шрифт и пр.
Lockwindowupdate(0);
...

← →
Tundra (2002-12-04 12:48) [18]

>>Zergling
image1.Picture.LoadFromFile(getcurrentdir+"/images/1111.JPG");
>> Dimosha
на Lockwindowupdate(label1.handle) ошибка вылетает
Undeclared identifier "handle"

← →
Tundra (2002-12-04 14:10) [19]

Yes - все проблемы решены тем, что вместо дурацких Tlabel (зачем они вообще нужны) поставил Tpanel - элементы ;
Всем спасибо.

← →
monstrische (2002-12-04 16:18) [20]

Правильное решение:
Form.Doublebuffered := true;
Всего делов-то :)

← →
Tano (2002-12-04 23:33) [21]

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

← →
apay (2002-12-05 00:00) [22]

на самом деле правильное решение:
(TWinControl на котором висят Labelы).Doublebuffered := true;

>monstrische
идея правильная, но это не обязательно форма.

Мигание компонента Найти похожие ветки