Форум программистов «Весельчак У»
  *
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
Вам не пришло письмо с кодом активации?

  • Рекомендуем проверить настройки временной зоны в вашем профиле (страница "Внешний вид форума", пункт "Часовой пояс:").
  • У нас больше нет рассылок. Если вам приходят письма от наших бывших рассылок mail.ru и subscribe.ru, то знайте, что это не мы рассылаем.
   Начало  
Наши сайты
Помощь Поиск Календарь Почта Войти Регистрация  
 
Страниц: [1]   Вниз
  Печать  
Автор Тема: Мигающий TLabel или TButton!  (Прочитано 12886 раз)
0 Пользователей и 1 Гость смотрят эту тему.
Sanprof
Гость
« : 29-02-2008 18:30 » 

Народ, подскажите как сделать так, чтобы после определенной процедуры TLabel или TButton начал мигать с какой-нибудь частотой???
Записан
Алексей++
глобальный и пушистый
Глобальный модератор

ru
Offline Offline
Сообщений: 13


WWW
« Ответ #1 : 29-02-2008 18:55 » 

Sanprof, запустить таймер в родительском для кнопки окне. По таймеру - инвертировать окно кнопки
Записан

Sanprof
Гость
« Ответ #2 : 29-02-2008 18:58 » 

Эт как??? Можно по-подробненько.
Записан
RXL
Технический
Администратор

ru
Offline Offline
Пол: Мужской

WWW
« Ответ #3 : 29-02-2008 19:20 » 

Sanprof, см. в хелпах класс TTimer. Кидаешь контрол с паллитры на форму (автоматом назначается имя Timer1), указываешь задержку в миллисекундах (поле Interval) и разрешаешь его (поле Enabled).
Добавляешь ему обработчик OnTimer (имя автоматом - Timer1Timer).
В нем проверяешь текущий цвет нужных контролов и меняешь на другой. лучше даже не цвет проверять, а использовать статические переменные внутри обработчика таймера. Короче, тут все в твоих руках.
Записан

... мы преодолеваем эту трудность без синтеза распределенных прототипов. (с) Жуков М.С.
zubr
Модератор

by
Offline Offline
Пол: Мужской

« Ответ #4 : 01-03-2008 07:24 » 

Хм... Тут не все так просто. Дело в том, что стандартный TButton не умеет менять цвета. Вариантов обхода данной ситуации несколько, но вот один из них, используя VCL:
Код:
unit ColorButton; 

interface 

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

type 
  TDrawButtonEvent = procedure(Control: TWinControl; 
    Rect: TRect; State: TOwnerDrawState) of object; 

  TColorButton = class(TButton) 
  private 
    FCanvas: TCanvas; 
    IsFocused: Boolean; 
    FOnDrawButton: TDrawButtonEvent; 
  protected 
    procedure CreateParams(var Params: TCreateParams); override; 
    procedure SetButtonStyle(ADefault: Boolean); override; 
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED; 
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED; 
    procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM; 
    procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM; 
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK; 
    procedure DrawButton(Rect: TRect; State: UINT); 
  public 
    constructor Create(AOwner: TComponent); override; 
    destructor Destroy; override; 
    property Canvas: TCanvas read FCanvas; 
  published 
    property OnDrawButton: TDrawButtonEvent read FOnDrawButton write FOnDrawButton; 
    property Color; 
  end; 

procedure Register; 

implementation 

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

constructor TColorButton.Create(AOwner: TComponent); 
begin 
  inherited Create(AOwner); 
  FCanvas := TCanvas.Create; 
end; 

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

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

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

procedure TColorButton.CNMeasureItem(var Message: TWMMeasureItem); 
begin 
  with Message.MeasureItemStruct^ do 
  begin 
    itemWidth  := Width; 
    itemHeight := Height; 
  end; 
end; 

procedure TColorButton.CNDrawItem(var Message: TWMDrawItem); 
var 
  SaveIndex: Integer; 
begin 
  with Message.DrawItemStruct^ do 
  begin 
    SaveIndex := SaveDC(hDC); 
    FCanvas.Lock; 
    try 
      FCanvas.Handle := hDC; 
      FCanvas.Font := Font; 
      FCanvas.Brush := Brush; 
      DrawButton(rcItem, itemState); 
    finally 
      FCanvas.Handle := 0; 
      FCanvas.Unlock; 
      RestoreDC(hDC, SaveIndex); 
    end; 
  end; 
  Message.Result := 1; 
end; 

procedure TColorButton.CMEnabledChanged(var Message: TMessage); 
begin 
  inherited; 
  Invalidate; 
end; 

procedure TColorButton.CMFontChanged(var Message: TMessage); 
begin 
  inherited; 
  Invalidate; 
end; 

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

procedure TColorButton.DrawButton(Rect: TRect; State: UINT); 
var 
  Flags, OldMode: Longint; 
  IsDown, IsDefault, IsDisabled: Boolean; 
  OldColor: TColor; 
  OrgRect: TRect; 
begin 
  OrgRect := Rect; 
  Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT; 
  IsDown := State and ODS_SELECTED <> 0; 
  IsDefault := State and ODS_FOCUS <> 0; 
  IsDisabled := State and ODS_DISABLED <> 0; 

  if IsDown then Flags := Flags or DFCS_PUSHED; 
  if IsDisabled 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(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom); 
    InflateRect(Rect, - 1, - 1); 
  end; 

  if IsDown then 
  begin 
    FCanvas.Pen.Color := clBtnShadow; 
    FCanvas.Pen.Width := 1; 
    FCanvas.Brush.Color := clBtnFace; 
    FCanvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom); 
    InflateRect(Rect, - 1, - 1); 
  end 
  else 
    DrawFrameControl(FCanvas.Handle, Rect, DFC_BUTTON, Flags); 

  if IsDown then OffsetRect(Rect, 1, 1); 

  OldColor := FCanvas.Brush.Color; 
  FCanvas.Brush.Color := Color; 
  FCanvas.FillRect(Rect); 
  FCanvas.Brush.Color := OldColor; 
  OldMode := SetBkMode(FCanvas.Handle, TRANSPARENT); 
  FCanvas.Font.Color := clBtnText; 
  if IsDisabled then 
    DrawState(FCanvas.Handle, FCanvas.Brush.Handle, nil, Integer(Caption), 0, 
    ((Rect.Right - Rect.Left) - FCanvas.TextWidth(Caption)) div 2, 
    ((Rect.Bottom - Rect.Top) - FCanvas.TextHeight(Caption)) div 2, 
      0, 0, DST_TEXT or DSS_DISABLED) 
  else 
    DrawText(FCanvas.Handle, PChar(Caption), - 1, Rect, 
      DT_SINGLELINE or DT_CENTER or DT_VCENTER); 
  SetBkMode(FCanvas.Handle, OldMode); 

  if Assigned(FOnDrawButton) then 
    FOnDrawButton(Self, Rect, TOwnerDrawState(LongRec(State).Lo)); 

  if IsFocused and IsDefault then 
  begin 
    Rect := OrgRect; 
    InflateRect(Rect, - 4, - 4); 
    FCanvas.Pen.Color := clWindowFrame; 
    FCanvas.Brush.Color := clBtnFace; 
    DrawFocusRect(FCanvas.Handle, Rect); 
  end; 
end; 
end.
Код взят из Delphi Russian Knowledge Base http://www.drkb.ru/
Устанавливаешь компонент TColorButton и юзаешь его вместо TButton.
Записан
pupk1n
Гость
« Ответ #5 : 12-03-2008 11:39 » 

можно средствами win api :
function FlashWindow(Wnd: HWnd; Invert: Bool): Bool;
Записан
zubr
Модератор

by
Offline Offline
Пол: Мужской

« Ответ #6 : 12-03-2008 17:15 » 

pupk1n, ошибаешься. Функция FlashWindow заставляет мигать заголовок окна, то есть это годится для окон имеющих заголовок. Ни буттон, ни лэбел под это не подходят.
Записан
pupk1n
Гость
« Ответ #7 : 13-03-2008 17:00 » 

function FlashWindowEx(var pfwi: FLASHWINFO): BOOL; - вот=)

FLASHWINFO = record
cbSize: UINT;     // Размер структуры в байтах
hwnd: HWND;       // Идентификатоp окна или оpгана упpавления.
dwFlags: DWORD;   // один из следующих флагов:
    FLASHW_STOP = $0;      // Не мигать
    FLASHW_CAPTION = $1;   // Мигающий заголовок
    FLASHW_TRAY = $2;      // Мигающая кнопка
    FLASHW_ALL = FLASHW_CAPTION or FLASHW_TRAY; // Мигать
    FLASHW_TIMER = $4;     // Мигать пока не будет запущен СТОП
    FLASHW_TIMERNOFG = $C; // Мигать пока не станет верхним
uCount: UINT;     // Сколько раз мигать
dwTimeout: DWORD; // Интервал мигания
end;
Записан
zubr
Модератор

by
Offline Offline
Пол: Мужской

« Ответ #8 : 13-03-2008 17:52 » 

pupk1n, опять ты фигню говоришь.
Цитата
FLASHW_TRAY = $2;      // Мигающая кнопка
Из msdn FLASHW_TRAY - Flash the taskbar button.
Совет, прежде чем спорить, проверь информацию. Напиши рабочий код, с использованием данной функции, чтобы кнопка TButton на форме (а не на таскбаре!) мигала, тогда с меня будет ящик пива. Что, съел?
Записан
pupk1n
Гость
« Ответ #9 : 16-03-2008 10:23 » 

сорри если что не так=)
Записан
Страниц: [1]   Вверх
  Печать  
 

Powered by SMF 1.1.21 | SMF © 2015, Simple Machines