Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001

MainMenu1: TMainMenu;

File1: TMenuItem;

Open1: TMenuItem;

procedureFormCreate(Sender: TObject);

procedureFormShow(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

Icn, MnuItm : TBitmap;

end;

varForm1: TForm1;

implementation

{$R *.DFM}

procedureTForm1.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;

withIcn do begin

Width:=32;

Height:=32;

Canvas.Brush.Color := clbtnface;

Canvas.Draw(0,0,Ic);

end;

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

MnuItm:=TBitmap.Create;

withMnuItm do begin

Width :=18;

Height:=18;

withCanvas do begin

Brush.Color:=clbtnface;

Pen.Color:=clbtnface;

CopyMode:=cmSrcAnd;

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

end;

end;

end;

procedureTForm1.FormShow(Sender: TObject);

var

ItemInfo: TMenuItemInfo;

hBmp1 : THandle;

begin

HBmp1:=MnuItm.Handle;

withItemInfo 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 в StatusBar — нет проблем, но как быть с рамкой от ProgressBar? ProgressBar всегда вычерчивает рамку и не имеет методов ее управления. Однако появилась интересная идея, воплотившаяся в компонент с новым свойством ShowFrame. Решение оказалось на удивление простым.

unitSProgress;

interface

usesWindows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls;

typeTVSProgressBar = class(TProgressBar)

procedureWMNCPAINT( varMsg: TMessage); messageWM_NCPAINT;

private

{ Private declarations }

FShowFrame: boolean;

procedureSetShowFrame(Value: boolean);

protected

{ Protected declarations }

public

{ Public declarations }

constructorCreate(AOwner: TComponent); override;

published

{ Published declarations }

propertyAlign;

propertyAnchors;

propertyBorderWidth;

propertyDragCursor;

propertyDragKind;

propertyDragMode;

propertyEnabled;

propertyHint;

propertyConstraints;

propertyMin;

propertyMax;

propertyOrientation;

propertyParentShowHint;

propertyPopupMenu;

propertyPosition;

propertyShowFrame: boolean readFShowFrame writeSetShowFrame;

propertyShowHint;

propertySmooth;

propertyStep;

propertyTabOrder;

propertyTabStop;

propertyVisible;

propertyOnContextPopup;

propertyOnDragDrop;

propertyOnDragOver;

propertyOnEndDock;

propertyOnEndDrag;

propertyOnEnter;

propertyOnExit;

propertyOnMouseDown;

propertyOnMouseMove;

propertyOnMouseUp;

propertyOnStartDock;

propertyOnStartDrag;

end;

procedure Register;

implementation

{ TVSProgressBar }

constructorTVSProgressBar.Create(AOwner: TComponent);

begin

Inherited;

FShowFrame:= True;

end;

procedureTVSProgressBar.SetShowFrame(Value: boolean);

begin

ifFShowFrame <> Value then begin