Знаете, смотрю я на этот мир своими красными, воспалёнными отсутствием сна и давлением идей глазами и с каждым днём понимаю всё больше – программистом быть стало модно. В самом плохом смысле слова. В программирование подались массы людей, абсолютно не приспособленных к этому делу, они стали писать море глючных программ, из-за которых породились массы абсолютно бессмысленных и несмешных анекдотов, скорей даже обидных (…Работает – ни в коем случае не трогай…).

Это всё дело меня естественно немного угнетает. И вот решил я немного продвинуть вас, начинающие программисты, ну и профессионалам, думаю, сей материал, тоже будет полезен и интересен.

Просторы интернета, касающиеся тем программирования, активно забиваются всякого рода компонентами и скинами «под ХР». Уверяю вас – в большинстве случаев, это совсем не нужно, предлагаю сделать нечто подобное самим. Никаких дополнительных компонентов, никаких скинов – будем юзать событие OnAdvancedCustomDrawButton у компонента TToolBar. Перед тем, как займёмся делом, хочу предупредить, что идея не нова, я взял у одного товарища, он ещё у другого, а я немного добавил, а сейчас всего лишь разложу всё по полочкам. Итак, начинаем.

Перво наперво, думаю нам хочется не просто так раскраситься, а под ХР, вот под него и будем косить. Для начала, в обработчике разместим такое дело –

if (cdsHot in State)and((Button.Style = tbsButton)or(Button.Style = tbsCheck)or 
(Button.Style = tbsDropDown)) and (Button.Enabled) and (not Button.Down)then
 with Sender.Canvas do
 begin
 r := Button.BoundsRect;
 DefaultDraw := false;
 Brush.Style := bsSolid;
 Brush.Color := clXPMenuSelection;
 Pen.Color := clBtnShadow;
 Pen.Style := psSolid;
 Rectangle(r);
 end
 else
 DefaultDraw := true;

 clXPMenuSelection я получаю так –

 clXPMenuSelection:=ColorAdjustLuma(ColorToRGB(clHighlight), 150, False);

clXPMenuSelection я получаю так –

clXPMenuSelection:=ColorAdjustLuma(ColorToRGB(clHighlight), 150, False);

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

 procedure DrawGlyph( ACanvas: TCanvas; ImageList: TCustomImageList; 
 ImageIndex: integer; GlyphRect: TRect; Hot: boolean);
 var
 lBmp: Graphics.TBitmap;
 X, Y, dx, dy: integer;
 begin
 if(ImageList=nil) or ( ImageIndex < 0 ) then
 exit;
 lBmp:=TBitmap.Create;
 with ACanvas do
 try
 lBmp.Width := ImageList.Width;
 lBmp.Height := ImageList.Height;
 X:=((GlyphRect.Right-GlyphRect.Left)-lBmp.Width)div 2;
 Y:=((GlyphRect.Bottom-GlyphRect.Top)-lBmp.Height)div 2;
 Brush.Color := clBtnShadow;
 if Hot then
 begin
 dx := 1;
 dy := -1;
 end
 else
 begin
 dx := 0;
 dy := 0;
 end;
 if ImageList.GetBitmap( ImageIndex, lBmp ) then
 begin
 Brush.Color := clBtnShadow;
 {$R-}
 DrawState(Handle,Brush.Handle,nil,lBmp.Handle,0,
 GlyphRect.Left+X+dx,GlyphRect.Top+Y,0,0,DST_BITMAP or DSS_MONO);
 {$R+}
 Brush.Color := clWindow;
 ImageList_DrawEx(ImageList.Handle,ImageIndex,Handle,
 GlyphRect.Left+X,GlyphRect.Top+Y+dy,0,0,clNone,clNone,ILD_TRANSPARENT);
 end;
 finally
 if assigned(lBmp)then
 freeandnil(lBmp);
 end;
 end;

Теперь добавим в наш обработчик после строчки Rectangle(r); вот эту строчку –

 DrawGlyph( Sender.Canvas, Sender.Images, Button.ImageIndex, r, true);

Ну вот – теперь почти что красиво. Осталась пара мелких штрихов. Давайте добавим на тулбар ещё одну кнопку и поставим ей свойство Style в tbsDropDown. Такая кнопка у нас пока что отображается некорректно. Для того чтобы это исправить, необходимо добавить перед DrawGlyph(… этот код –

 if Button.Style = tbsDropDown then
 r.Right:=r.Left+23;

А после DrawGlyph(… вот этот –

 if Button.Style = tbsDropDown then
 begin
 Pen.Color:=clXPMenuSelection;
 r.Left:=r.Left+23;
 r.Right:=r.Right+12;
 Rectangle(r);
 Pen.Color:=clBlack;
 DrawArrow(Sender.Canvas,sdDown,Point(r.Left+4,r.Top+10),2);
 end;

Отлично работает. Лично мне нравится. Вот теперь пора приняться и за менюшки. Сделаем такого же типа обработчик для пунктов меню. Создадим попап-меню и в нём пару-тройку-четвёрку (кому как нравится) пунктов. Попап для начала лучше, потому что в TMainMenu мы столкнёмся с маленькой проблемой, о которой попозже. Итак, создали меню, пункты, теперь для любого из пунктов создайте обработчик события OnAdvancedDrawItem, а в нём такой текст –

 Txt:=TMenuItem(Sender).Caption;
 TxtRect := ARect;
 BannerRect := ARect;
 TxtRect.Left := ARect.Left + BannerWidth; // BannerWidth я принял равным 25
 BannerRect.Right := BannerREct.Left + BannerWidth;
 with ACanvas do
 begin
 Brush.Color := clBtnFace;
 FillRect(BannerRect);
 if TMenuItem( Sender ).Default then
 ACanvas.Font.Style := [fsBold]
 else
 ACanvas.Font.Style := [];
 if odDisabled in State then
 begin
 Brush.Color := clWindow;
 Font.Color := clGray;
 FillRect( TxtRect );
 end
 else
 if odSelected in State then
 begin
 Brush.Color := clXPMenuSelection;
 Font.Color := clBlack;
 Pen.Style := psSolid;
 Pen.Color := clBtnShadow;
 Rectangle( ARect );
 end
 else
 begin
 Brush.Color := clWindow;
 FillRect( TxtRect );
 end;
 TextOut( TxtRect.Left + 4, TxtRect.Top + 2, Txt );
 end;

А на уровне процедуры объявите следующие переменные –

 var
 Txt: TCaption;
 TxtRect, BannerRect, FrmRect : TRect;
 OldColor: TColor;

Некоторые пока что не нужны, но обязательно понадобятся попозже. Для удобства также назначьте всем пунктам меню этот обработчик события OnAdvancedDrawItem. Теперь если скомпилировать и запустить проект, то вызвав меню мы видим что оно немного преобразилось, но ещё не настолько чтобы нам понравилось. Для того чтобы могли выводиться назначенные изображения, добавьте после TextOut(… Такую строку –

DrawGlyph(ACanvas,TMenuItem(Sender).GetImageList,TMenuItem(Sender).ImageIndex, BannerRect,(not(odDisabled in State))and(odSelected in State));

Тут вроде всё понятно – это мы с помощью сделанной ранее процедуры отображаем ту или иную картинку из TImageList. Теперь, думаю, необходимо обрабатывать Checked у пунктов меню. Добавим такой код перед TextOut(… -

 OldColor:=Brush.Color;
 if TMenuItem( Sender ).Checked then
 begin
 FrmRect := BannerRect;
 Brush.Color := clXPMenuSelection;
 Pen.Color := clBtnShadow;
 Rectangle(FrmRect);
 Pen.Color := clBlack;
 if TMenuItem( Sender ).ImageIndex < 0 then
 DrawCheck(ACanvas,Point(BannerRect.Left+10,BannerRect.top+10),2);
 end;
 Brush.Color:=OldColor;

Таким образом, если у меню Checked=True, то оно будет помечаться соответствующей галочкой, а если ему назначена какая-нибудь иконка из TImageList, то она будет рисоваться немного по другому. Ну и финальный штрих – прорисовка разделителей. То есть тех пунктов меню, у которых Caption=’-‘. Их надо будет рисовать немного по другому, нежели обычные пункты меню. Давайте перед строкой OldColor:=Brush.Color; добавим следующий код –

 if Txt = '-' then
 begin
 Brush.Color := clBlack;
 Pen.Color := clBtnShadow;
 MoveTo(32,TxtRect.Top+(TxtRect.Bottom-TxtRect.Top)div 2);
 LineTo(TxtRect.Right,TxtRect.Top+(TxtRect.Bottom-TxtRect.Top)div 2);
 end
 else
 begin

Ну и соответственно, после DrawGlyph(… надо добавить ещё один end; чтобы закрыть блок if…then…else . Теперь всё готово и для меню тоже. Хотя нет, ещё не всё, ещё надо добавить обработчики события OnMeasureItem, в котором увеличивать ширину пункта меню. Я поставил так: Width := Width + BannerWidth + 2;
Теперь всё готово. Поиграв цветами и/или расположением иконок, размерами, и т.д., вы придёте как раз к тому варианту, который будет вас больше всего устраивать. Для удобства, я сохранил эти обработчики как процедуры в отдельный файл и всегда присоединяю его к каждому новому проекту, таким образом, например обработчик рисования кнопок тулбара у меня выглядит так –

 AdvancedCustomDrawButton(Sender,Button,State,Stage,Flags,DefaultDraw);

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

ЗЫ: Насчёт главного меню - присвойте полученный обработчик событию OnAdvancedDrawItem какому-нибудь главному пункту меню, тому из которого выпадают все остальные. Полученный результат, предполагаю вы теперь сможете легко переделать сами так, как вам покажется нужным, ну я а сделал... впрочем неважно как я сделал.

Получить ссылку на материал