VPF::Моргание кнопки - Форум программистов

MacTep

Дата 3.6.2005, 07:43 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1292
Регистрация: 4.8.2003
Где: г. Самара

Репутация: 4
Всего: 4

Здравствуйте! Как сделать, чтобы кнопка моргала несколько раз, как это бывает в панели задач? Спасибо...

--------------------

(A)bort, (R)etry, (I)gnore = Haфиг, Heфиг, Пoфиг ... :)

Yanis

Дата 3.6.2005, 08:26 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 2937
Регистрация: 9.2.2004
Где: Москва

Репутация: 72
Всего: 111

Код


var
  fi: TFlashWInfo;
begin
  fi.cbSize := Sizeof(TFlashWInfo);
  fi.hwnd := Application.Handle;
  fi.dwFlags := FLASHW_TRAY or FLASHW_TIMER;
  FlashWindowEx(fi);
end;

Хорошо бы всё это ещё и в OnTimer засунуть. Для разъяснений глянь здесь http://msdn.microsoft.com/library/default....ashwindowex.asp

Это сообщение отредактировал(а) Yanis - 3.6.2005, 08:27

--------------------

*щёлк*

X-Vlad

Дата 3.6.2005, 13:31 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 570
Регистрация: 10.4.2002
Где: Украина, Львов

Репутация: 1
Всего: 5

я делал вот так

Код


...
for i:=0 to 5 do
  begin
   application.ProcessMessages;
   FlashWindow(Application.Handle,true);
   sleep(50);
  end;
...

в результате кнопочка на панели задач мигала 5 раз ))) прикольно это выглядит )) ну и задержку поставил sleep(50); что бы медленней мигала smile

--------------------

Хорошая штука - комп..:)
www.x-vlad.com

MacTep

Дата 3.6.2005, 20:54 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1292
Регистрация: 4.8.2003
Где: г. Самара

Репутация: 4
Всего: 4

Yanis, X-Vlad - мне нужно чуть другое. Дело в том, что кнопка должна моргать не на панели задач, а именно на форме. Как этого добиться?

--------------------

(A)bort, (R)etry, (I)gnore = Haфиг, Heфиг, Пoфиг ... :)

ДЫМ

Дата 4.6.2005, 03:00 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 224
Регистрация: 6.1.2004

Репутация: 8
Всего: 8

MacTep, при помощи API ты этого ни фига не добьешься. Поэтому надо создавать потомка с возможностью смены цвета кнопки.
Набросал тут компонентик (за основу взят пример из DRKB), у него есть метод

Код


Flash(Count:Integer; DelayMSec:Longint);

, который заставляет кнопку мигать Count раз с задержкой DelayMSec. Надеюсь, я тебе помог. smile

Код


unit FlashBtn;

interface

uses

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

type 

  TFlashBtn = class(TButton)
  private
    FCanvas: TCanvas;
    IsFocused: Boolean;
    F3DFrame: boolean;
    FColor: TColor;
    procedure Set3DFrame(Value: boolean);
    procedure SetColor(Value: TColor);
    procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message
      WM_LBUTTONDBLCLK;
    procedure DrawButtonText(const Caption: string; TRC: TRect; State:
      TButtonState; BiDiFlags: Longint);
    procedure CalcuateTextPosition(const Caption: string; var TRC: TRect;
      BiDiFlags: Longint);
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure SetButtonStyle(ADefault: Boolean); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Flash(Count:Integer; DelayMSec:Longint);
  published
    property Color: TColor read FColor write SetColor default
      clBtnFace;
    property Frame3D: boolean read F3DFrame write Set3DFrame default False;
  end;

procedure Register;

implementation 

{ TFlashBtn } 

constructor TFlashBtn.Create(AOwner: TComponent); 
begin 
  inherited Create(AOwner);
  Height := 25;
  FCanvas := TCanvas.Create; 
  FColor := clBtnFace; 
  F3DFrame := False;
end;

destructor TFlashBtn.Destroy; 
begin 
  FCanvas.Free; 
  inherited Destroy;
end; 

procedure TFlashBtn.CreateParams(var Params: TCreateParams); 
begin 
  inherited CreateParams(Params);
  with Params do 
    Style := Style or BS_OWNERDRAW; 
end; 

procedure TFlashBtn.Set3DFrame(Value: boolean);
begin 
  if F3DFrame <> Value then 
    F3DFrame := Value; 
end; 

procedure TFlashBtn.SetColor(Value: TColor); 
begin 
  if FColor <> Value then 
  begin 
    FColor := Value;
    Invalidate; 
  end; 
end; 

procedure TFlashBtn.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin 
  Perform(WM_LBUTTONDOWN, Message.Keys, Longint(Message.Pos)); 
end; 

procedure TFlashBtn.SetButtonStyle(ADefault: Boolean);
begin 
  if IsFocused <> ADefault then 
    IsFocused := ADefault; 
end; 

procedure TFlashBtn.CNDrawItem(var Message: TWMDrawItem); 
var 
  RC: TRect; 
  Flags: Longint; 
  State: TButtonState;
  IsDown, IsDefault: Boolean; 
  DrawItemStruct: TDrawItemStruct; 
begin 
  DrawItemStruct := Message.DrawItemStruct^; 
  FCanvas.Handle := DrawItemStruct.HDC;
  RC := ClientRect; 
  with DrawItemStruct do 
  begin 
    IsDown := ItemState and ODS_SELECTED <> 0; 
    IsDefault := ItemState and ODS_FOCUS <> 0;
    if not Enabled then 
      State := bsDisabled 
    else if IsDown then 
      State := bsDown 
    else
      State := bsUp;
  end; 
  Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT; 
  if IsDown then 
    Flags := Flags or DFCS_PUSHED;
  if DrawItemStruct.ItemState and ODS_DISABLED <> 0 then 
    Flags := Flags or DFCS_INACTIVE; 
  if IsFocused or IsDefault then 
  begin 
    FCanvas.Pen.Color := clWindowFrame;
    FCanvas.Pen.Width := 1; 
    FCanvas.Brush.Style := bsClear; 
    FCanvas.Rectangle(RC.Left, RC.Top, RC.Right, RC.Bottom); 
    InflateRect(RC, -1, -1); 
  end;
  if IsDown then 
  begin 
    FCanvas.Pen.Color := clBtnShadow; 
    FCanvas.Pen.Width := 1; 
    FCanvas.Rectangle(RC.Left, RC.Top, RC.Right, RC.Bottom);
    InflateRect(RC, -1, -1); 
    if F3DFrame then 
    begin 
      FCanvas.Pen.Color := FColor; 
      FCanvas.Pen.Width := 1;
      DrawFrameControl(DrawItemStruct.HDC, RC, DFC_BUTTON, Flags); 
    end; 
  end 
  else 
    DrawFrameControl(DrawItemStruct.HDC, RC, DFC_BUTTON, Flags);
  FCanvas.Brush.Color := FColor;
  FCanvas.FillRect(RC); 
  InflateRect(RC, 1, 1); 
  if IsFocused then 
  begin
    RC := ClientRect; 
    InflateRect(RC, -1, -1); 
  end; 
  FCanvas.Font := Self.Font; 
  if IsDown then
    OffsetRect(RC, 1, 1); 
  DrawButtonText(Caption, RC, State, 0); 
  if IsFocused and IsDefault then 
  begin 
    RC := ClientRect;
    InflateRect(RC, -4, -4); 
    FCanvas.Pen.Color := clWindowFrame; 
    Windows.DrawFocusRect(FCanvas.Handle, RC); 
  end; 
  FCanvas.Handle := 0;
end; 

procedure TFlashBtn.CalcuateTextPosition(const Caption: string; var TRC: TRect;
  BiDiFlags: Integer); 
var
  TB: TRect; 
  TS, TP: TPoint; 
begin 
  with FCanvas do 
  begin
    TB := Rect(0, 0, TRC.Right + TRC.Left, TRC.Top + TRC.Bottom); 
    DrawText(Handle, PChar(Caption), Length(Caption), TB, DT_CALCRECT or 
      BiDiFlags); 
    TS := Point(TB.Right - TB.Left, TB.Bottom - TB.Top); 
    TP.X := ((TRC.Right - TRC.Left) - TS.X + 1) div 2;
    TP.Y := ((TRC.Bottom - TRC.Top) - TS.Y + 1) div 2; 
    OffsetRect(TB, TP.X + TRC.Left, TP.Y + TRC.Top); 
    TRC := TB; 
  end; 
end;

procedure TFlashBtn.DrawButtonText(const Caption: string; TRC: TRect; State: 
  TButtonState; BiDiFlags: Integer); 
begin 
  with FCanvas do
  begin 
    CalcuateTextPosition(Caption, TRC, BiDiFlags); 
    Brush.Style := bsClear; 
    if State = bsDisabled then 
    begin
      OffsetRect(TRC, 1, 1); 
      Font.Color := clBtnHighlight; 
      DrawText(Handle, PChar(Caption), Length(Caption), TRC, 
        DT_CENTER or DT_VCENTER or BiDiFlags); 
      OffsetRect(TRC, -1, -1);
      Font.Color := clBtnShadow; 
      DrawText(Handle, PChar(Caption), Length(Caption), TRC, 
        DT_CENTER or DT_VCENTER or BiDiFlags); 
    end 
    else
      DrawText(Handle, PChar(Caption), Length(Caption), TRC, 
        DT_CENTER or DT_VCENTER or BiDiFlags); 
  end;
end;

//**********************
//
// Çàñòàâëÿåò ìèãàòü êíîïêó Count ðàç
// ñ çàäåðæêîé DelayMSec
//
//
//
procedure TFlashBtn.Flash(Count:Integer; DelayMSec:Longint);
var TempColorBtn,TempColorText:TColor;
    i:Integer;

 //*******************
 //  Çàäåðæêà âûïîëíåíèÿ ïðîãðàììû íà MSecs ìèëëèñåêóíä
 //
 procedure Delay(MSecs: Longint);
 var
   FirstTickCount, Now: Longint;
 begin
   FirstTickCount := GetTickCount;
   repeat
     Application.ProcessMessages;
     if Application.Terminated then Exit;
      Now := GetTickCount;
   until (Now - FirstTickCount >= MSecs) or (Now < FirstTickCount);
 end;
begin
 TempColorBtn:=FColor;
 TempColorText:=Font.Color;

 for i:=1 to Count*2 do
 begin
  if i mod 2<>0 then
   begin
    Color:=clHighlight;
    Font.Color:=clWhite;
   end
  else
   begin
    Color:=TempColorBtn;
    Font.Color:=TempColorText;
   end;
  Delay(DelayMSec);
 end;//for

end;


procedure Register;
begin
  RegisterComponents('Samples', [TFlashBtn]);
end;

end.

Rrader

Дата 4.6.2005, 13:12 (ссылка)

(нет голосов)

Загрузка ...

Inspired =)

Профиль
Группа: Экс. модератор
Сообщений: 1535
Регистрация: 7.5.2005

Репутация: 70
Всего: 191

Цитата

MacTep, при помощи API ты этого ни фига не добьешься.

Неправда.

Код


procedure FlashingWindow(wnd:hwnd); // Передай сюда дескриптор кнопки
var i:integer;
    rc:TRect;
    my_hdc:HDC;
    cr:TColor;
    pen,OldPen:HPen;
    OldBrush:HBrush;
begin
  GetWindowRect (wnd,rc);
  my_hdc:=GetDC(0);

  cr:=clBlack;
  SetROP2(my_hdc,R2_NOT);
  Pen:=CreatePen(PS_INSIDEFRAME, 0, cr);
  OldPen:=SelectObject(my_hdc, Pen);
  OldBrush:= SelectObject(my_hdc, GetStockObject(NULL_BRUSH));
  SelectObject(my_hdc, GetStockObject(BLACK_BRUSH));

  for i:=1 to 3 do
   begin
    Windows.Rectangle(my_hdc,rc.Left,rc.Top,rc.Right,rc.Bottom);
    sleep(100);
    Windows.Rectangle(my_hdc,rc.Left,rc.Top,rc.Right,rc.Bottom);
    sleep(100);
   end;
  SelectObject(my_hdc, OldBrush);
  SelectObject(my_hdc, OldPen);

  ReleaseDC(wnd, my_hdc);
  DeleteObject(Pen);
end;

Это сообщение отредактировал(а) Rrader - 4.6.2005, 13:16

--------------------

Let's do this quickly!
Rest in peace, Vit!

ДЫМ

Дата 5.6.2005, 01:41 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 224
Регистрация: 6.1.2004

Репутация: 8
Всего: 8

Цитата

MacTep, при помощи API ты этого ни фига не добьешься.

Неправда.

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

Rrader

Дата 5.6.2005, 10:30 (ссылка)

(нет голосов)

Загрузка ...

Inspired =)

Профиль
Группа: Экс. модератор
Сообщений: 1535
Регистрация: 7.5.2005

Репутация: 70
Всего: 191

Цитата

Я вообще-то имел ввиду, что нет специализированной функции, которая заставит моргать кнопку.

Я тебя тогда понял. Просто решил, что мой код MacTep меньше будет приспосабливать.

Цитата

Ну и несколько замечаний: во-первых, используя sleep, ты лишаешь возможности нажать на кнопку, пока та не закончила мигать

Это легко исправимо через SetTimer. smile

--------------------

Let's do this quickly!
Rest in peace, Vit!

Yanis

Дата 5.6.2005, 21:22 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 2937
Регистрация: 9.2.2004
Где: Москва

Репутация: 72
Всего: 111

Цитата(MacTep @ 3.6.2005, 20:54)

Yanis, X-Vlad - мне нужно чуть другое. Дело в том, что кнопка должна моргать не на панели задач, а именно на форме. Как этого добиться?

Тогда с меньшими затратами сил и кода можно сделать так (если я правильно понял smile

Код


procedure TForm1.Timer1Timer(Sender: TObject);
begin
  InvertRect(GetWindowDC(Button1.Handle), Button1.ClientRect);
end;

--------------------

*щёлк*

Marriage

Дата 5.6.2005, 22:06 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 842
Регистрация: 4.5.2004
Где: Таганрог

Репутация: нет
Всего: 2

Код


procedure TForm1.Timer1Timer(Sender: TObject);
begin

If button1.Tag > 0 then  //TAg - количество мерцаний???
 Button1.Visible:= not Button1.Visible;
 Button1.Tag:=Button1.Tag-1;

 If Button1.Tag = 0 then
  Begin
   Timer1.Enabled:=False; //вырубаем таймер
   Button1.Tag:=12;//количество морганий :)
   Button1.Visible:= True;
  End;

end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Timer1.Enabled:= not False
end;

--------------------

Praemonitus, praemunitus

MacTep

Дата 5.6.2005, 22:33 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1292
Регистрация: 4.8.2003
Где: г. Самара

Репутация: 4
Всего: 4

Благодарю всех тех, кто не оставил без внимания мой пост! smile

Не дали умереть! smile

Thanks!

--------------------

(A)bort, (R)etry, (I)gnore = Haфиг, Heфиг, Пoфиг ... :)

ДЫМ

Дата 6.6.2005, 02:26 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 224
Регистрация: 6.1.2004

Репутация: 8
Всего: 8

Ну вот, еще и таймер вешать.
А как избавиться от черного цвета при мигании?

Yanis

Дата 6.6.2005, 09:24 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 2937
Регистрация: 9.2.2004
Где: Москва

Репутация: 72
Всего: 111

Цитата

А как избавиться от черного цвета при мигании?

Что ты имеешь ввиду?

--------------------

*щёлк*

ДЫМ

Дата 7.6.2005, 00:28 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 224
Регистрация: 6.1.2004

Репутация: 8
Всего: 8

Ну, кнопка закрашивается черным цветом, потом серым и т. д., а надо, чтобы закрашивалась clHighlight

Dimannn

Дата 9.6.2005, 00:06 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 318
Регистрация: 14.4.2005
Где: Владимир

Репутация: нет
Всего: 1

В JVCL где-то в конце есть специальная кнопка, у каторой можно менять цвет. Можно её и применить.

--------------------

Хотите быстро и без проблем опубликовать вашу программу в сети за 5 минут?
Тогда потратьте пару минут чтобы посмотреть, что предлагает OpenProject.org.ru

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »