Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Мультимедиа в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 26.02.2012, 14:28   #1
fed@n
Пользователь
 
Регистрация: 05.08.2010
Сообщений: 11
По умолчанию Градиент для item в popupmenu

Добрый день! Не получается залить градиентом каждый item в popupmenu. Заливает всю область меню градиентом.

Вот код процедуры:
procedure TForm1.GradientRect(FromRGB, ToRGB: TColor; ACanvas: TCanvas);
var
RGBFrom : array[0..2] of Byte; { from RGB values }
RGBDiff : array[0..2] of integer; { difference of from/to RGB values }
ColorBand : TRect; { color band rectangular coordinates }
I : Integer; { color band index }
R : Byte; { a color band's R value }
G : Byte; { a color band's G value }
B : Byte; { a color band's B value }
begin
{ extract from RGB values}
RGBFrom[0] := GetRValue (ColorToRGB (FromRGB));
RGBFrom[1] := GetGValue (ColorToRGB (FromRGB));
RGBFrom[2] := GetBValue (ColorToRGB (FromRGB));
{ calculate difference of from and to RGB values}
RGBDiff[0] := GetRValue (ColorToRGB (ToRGB)) - RGBFrom[0];
RGBDiff[1] := GetGValue (ColorToRGB (ToRGB)) - RGBFrom[1];
RGBDiff[2] := GetBValue (ColorToRGB (ToRGB)) - RGBFrom[2];

{ set pen sytle and mode}
ACanvas.Pen.Style := psSolid;
ACanvas.Pen.Mode := pmCopy;

{ set color band's left and right coordinates}
ColorBand.Left := 0;
ColorBand.Right:= Acanvas.ClipRect.Right-ACanvas.ClipRect.Left;

for I := 0 to $ff do
begin

{ calculate color band's top and bottom coordinates}
ColorBand.Top :=MulDiv (I, Acanvas.ClipRect.Bottom-ACanvas.ClipRect.Top, $100);
ColorBand.Bottom := MulDiv (I+1,Acanvas.ClipRect.Bottom-ACanvas.ClipRect.Top, $100);
{ calculate color band color}
R := RGBFrom[0] + MulDiv (I, RGBDiff[0], $ff);
G := RGBFrom[1] + MulDiv (I, RGBDiff[1], $ff);
B := RGBFrom[2] + MulDiv (I, RGBDiff[2], $ff);
{ select brush and paint color band}
ACanvas.Brush.Color := RGB (R, G, B);
ACanvas.FillRect (ColorBand);
end;
end;

На отрисовку item пишу следующее:
procedure TForm1.v1DrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
begin
PopupMenu1.OwnerDraw:=True;
with ACanvas do
begin
Font.Color:=clBlack;
if Selected then
begin
Font.Color:=clWhite;
GradientRect (RGB(51,187,238), RGB(52,155,222), ACanvas);
Pen.Color:=clblack;
end
else
begin

Font.Color:=clBlack;
Brush.Color:=clMenu;
Pen.Color:=clmenu;
end;
Rectangle(ARect);
TextOut(ARect.left+24,ARect.top+4,( Sender as TMenuItem).Caption);
end;
end;
Не могу понять, в чем ошибка. Что не так? Заранее благодарен!
fed@n вне форума Ответить с цитированием
Старый 26.02.2012, 17:37   #2
Прик
Форумчанин
 
Регистрация: 08.09.2010
Сообщений: 880
По умолчанию

Один из работающих вариантов:
Код:
const
  aR = 216; bR = 3;     //цвета градиента  (R, G, B): a - стартовый, b - конечный
  aG = 244; bG = 146;
  aB = 254; bB = 192;

procedure TForm1.N8DrawItem(Sender: TObject; ACanvas: TCanvas;
  ARect: TRect; Selected: Boolean);
var
  h, i : Integer;
  BM : TBitmap;
begin
  with ACanvas do begin
    Font.Color:=clBlack;
    Brush.Color:=clWhite;
    ACanvas.FillRect(ARect);
    if Selected then begin
      h := aRect.Bottom-aRect.Top;
      for i := 0 to h do begin
        Pen.Color := RGB(Round(aR-(aR-bR)/h*i), Round(aG-(aG-bG)/h*i), Round(aB-(aB-bB)/h*i));
        Rectangle(0, aRect.Top+I, aRect.Right, aRect.Top+I+1);
      end;

      BM := TBitmap.Create;
      try
        BM.Width := aRect.Right;
        BM.Height := aRect.Bottom;
        BM.TransparentColor := clWhite;
        BM.Transparent := true;
        BM.Canvas.TextOut(ARect.left+24,ARect.top+4,( Sender as TMenuItem).Caption);
        Draw(0, 0, BM);
      finally
        BM.Free;
      end;

      Pen.Color:=clblack;
    end else begin
      Font.Color:=clBlack;
      Brush.Color:=clMenu;
//      Pen.Color:=clmenu;
      TextOut(ARect.left+24,ARect.top+4,( Sender as TMenuItem).Caption);
    end;
  end;
end;
Прик вне форума Ответить с цитированием
Старый 26.02.2012, 21:03   #3
fed@n
Пользователь
 
Регистрация: 05.08.2010
Сообщений: 11
По умолчанию

спасибо! работает) но только не так как нужно) закрывает градиентом только надпись( а не все поле .
Я так думаю дело в этой строчке? BM.Canvas.TextOut(ARect.left+24,ARe ct.top+4,( Sender as TMenuItem).Caption);

Последний раз редактировалось fed@n; 26.02.2012 в 22:18.
fed@n вне форума Ответить с цитированием
Старый 26.02.2012, 21:55   #4
fed@n
Пользователь
 
Регистрация: 05.08.2010
Сообщений: 11
По умолчанию

! Может кто знает как победить это?))

Последний раз редактировалось fed@n; 26.02.2012 в 22:19.
fed@n вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Перемещать форму по клику на PopupMenu.Item Alex Cones Общие вопросы Delphi 2 26.08.2010 03:59
Задача переменным значений для разных Item-ов Combobox-а Stalker209 Общие вопросы C/C++ 0 24.03.2009 12:22
PopupMenu для формы свое, а для Edit - стандартное Виндоус yaver Общие вопросы Delphi 4 10.11.2008 15:03
Проблема с Caption PopUpMenu Item Comer_Jus Общие вопросы Delphi 3 16.05.2008 14:50
Как изменить высоту PopUpMenu Item Comer_Jus Общие вопросы Delphi 1 16.05.2008 14:26