Советы по Delphi. Версия 1.4.3 от 1.1.2001

Озеров Валентин

Листинг был изменен для того, чтобы помещать иконки в «чЕкнутое» состояние меню (просто это делает Win95). Это позволяет вам иметь «чЕкнутое» и «нечЕкнутое» состояние.

unit Unit1;

interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Menus,ShellAPI;

type TForm1 = class(TForm)

 MainMenu1: TMainMenu;

 File1: TMenuItem;

 Open1: TMenuItem;

 procedure FormCreate(Sender: TObject);

 procedure FormShow(Sender: TObject);

private

 { Private declarations }

public

 { Public declarations }

 Icn, MnuItm : TBitmap;

end;

var Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

var

 R: TRect;

 HIcn: HIcon;

 Ic: TIcon;

 Index: Word;

begin

 { /**

Получаем иконку некоторого приложения **/ }

 Index := 0;

 { 11-я иконка в файле }

 Ic:=TIcon.Create;

 Ic.Handle:=ExtractAssociatedIcon(Hinstance, 'c:\win95\system\shell32.dll', Index);

 { /** Копируем иконку в bitmap для изменения его размера. Вы не можете менять размер иконки **/ }

 Icn:=TBitmap.Create;

 with Icn do begin

Width:=32;

Height:=32;

Canvas.Brush.Color := clbtnface;

Canvas.Draw(0,0,Ic);

 end;

 { /** Создаем окончательное изображение, куда мы помещаем иконку и текст **/ }

 MnuItm:=TBitmap.Create;

 with MnuItm do begin

Width :=18;

Height:=18;

with Canvas do begin

Brush.Color:=clbtnface;

Pen.Color:=clbtnface;

CopyMode:=cmSrcAnd;

StretchDraw(Rect(0,0,16,16), Icn);

end;

 end;

end;

procedure TForm1.FormShow(Sender: TObject);

var

 ItemInfo: TMenuItemInfo;

 hBmp1 : THandle;

begin

 HBmp1:=MnuItm.Handle;

 with ItemInfo do begin

cbSize := SizeOf(ItemInfo);

fMask := MIIM_CHECKMARKS;

fType := MFT_BITMAP;

hBmpunChecked := HBmp1; {

Неотмеченное (Unchecked) состояние }

hBmpChecked := HBmp1; { Отмеченное (Checked) состояние }

 end;

 { /** Заменяем MenuItem Open1 законченным изображением **/ }

 SetMenuItemInfo(GetSubMenu(MainMenu1.Handle, File1.MenuIndex), Open1.MenuIndex, true, ItemInfo);

end;

end.

ProgressBar 

ProgressBar — невидимка

Письмо читателя 

Здравствуйте Валентин!

Заказчик моего проекта обратился с просьбой — "Сделать прогресс индикатор как в приложениях Нортона. Чтоб был в статус строке и НИКАКИХ рамок". ProgressBar в StatusBar — нет проблем, но как быть с рамкой от ProgressBar? ProgressBar всегда вычерчивает рамку и не имеет методов ее управления. Однако появилась интересная идея, воплотившаяся в компонент с новым свойством ShowFrame. Решение оказалось на удивление простым.

unit SProgress;

interface

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

type TVSProgressBar = class(TProgressBar)

 procedure WMNCPAINT(var Msg: TMessage); message WM_NCPAINT;

private

 { Private declarations }