Советы по 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 }

 FShowFrame: boolean;

 procedure SetShowFrame(Value: boolean);

protected

 { Protected declarations }

public

 { Public declarations }

 constructor Create(AOwner: TComponent); override;

published

 { Published declarations }

 property Align;

 property Anchors;