Советы по Delphi

         

Компонент TMinMax


Компонент TMinMax может быть размещен на форме для управления ее сообщением WM_GETMINMAXINFO. Вы можете устанавливать максимально/минимальный размер рамки при изменении размера формы, максимальный размер и положение окна через соответствующие свойства. Поскольку компонент управляет событием WM_GETMINMAXINFO своего владельца, вы можете разместить его на необходимом количестве форм, и управлять соответствующей формой через ее собственное событие WM_GETMINMAXINFO.

{***************************************************************************** }{ UMINMAX.PAS }{ Автор }{ Robert Wittig }{ 76401,242 }
{ Данный модуль обеспечивает вас интерфейсом для управления сообщением WM_GETMINMAXINFO }{ на основе компонента . C помощью этого компонента вы легко можете управлять }{ минимальным и максимальным размером окна. Вы можете также управлять размером и }{ положением максимально раскрытого окна. }
{ Данный модуль свободен в использовании. Вы можете без ограничений использовать его }{ в некоммерческих приложениях. Вы можете использовать его в коммерческих приложениях, }{ если данный код занимает менее 20% от всего кода приложения. Вы можете свободно }{ копировать и распространять данный модуль с условием сохранения (по возможности) }{ данной информации. }
{ Пожалуйста посылайте свои коментарии/предложения автору непосредственно в форум }{ или по e-mail по адресу 76401,242. Автор не дает никаких гарантий по работе }{ данного модуля. }
{ История модуля }{ ------------ }{ 03-05-96 Автор Robert Wittig (CompuServe ID 74601,242) }
{***************************************************************************** }unit uMinMax;
interfaceUses Classes, Controls, Forms, Messages, SysUtils, WinProcs, WinTypes;
TypeTMinMax = Class ( TComponent )PrivateOldWndProc : Pointer;FInstance : Pointer;
MinMaxInfo : TMinMaxInfo;FActive : Boolean;ProtectedProcedure Notification ( aComponent: TComponent; Operation: TOperation ); override;
Procedure ResetSubclass; virtual;Procedure Subclass; virtual;
Procedure InitMinMaxInfo; virtual;Procedure MinMaxWndProc ( Var Message : TMessage ); virtual;
Function GetMinWidth : Integer; virtual;Function GetMinHeight : Integer; virtual;Function GetMaxWidth : Integer; virtual;Function GetMaxHeight : Integer; virtual;
Function GetMaximizedX : Integer; virtual;Function GetMaximizedY : Integer; virtual;Function GetMaximizedWidth : Integer; virtual;Function GetMaximizedHeight : Integer; virtual;
Function GetReset : Boolean; virtual;
Procedure SetActive ( Value : Boolean ); virtual;
Procedure SetMinWidth ( Value : Integer ); virtual;Procedure SetMinHeight ( Value : Integer ); virtual;Procedure SetMaxWidthWM_GETMINMAXINFO ( Value : Integer ); virtual;Procedure SetMaxHeight ( Value : Integer ); virtual;
Procedure SetMaximizedX ( Value : Integer ); virtual;Procedure SetMaximizedY ( Value : Integer ); virtual;Procedure SetMaximizedWidth ( Value : Integer ); virtual;Procedure SetMaximizedHeight ( Value : Integer ); virtual;
Procedure SetReset ( Value : Boolean ); virtual;
Procedure SetNewSize; virtual;PublicDestructor Destroy; override;PublishedProperty Active : Boolean Read FActive Write SetActive;
Property MinWidth : Integer Read GetMinWidth Write SetMinWidth;Property MinHeight : Integer Read GetMinHeight Write SetMinHeight;Property MaxWidth : Integer Read GetMaxWidth Write SetMaxWidth;Property MaxHeight : Integer Read GetMaxHeight Write SetMaxHeight;
Property MaximizedX : Integer Read GetMaximizedX Write SetMaximizedX;Property MaximizedY : Integer Read GetMaximizedY Write SetMaximizedY;Property MaximizedWidth : Integer Read GetMaximizedWidth WriteSetMaximizedWidth;
Property MaximizedHeight : Integer Read GetMaximizedHeight WriteSetMaximizedHeight;

{**************************** RCW 03-05-96 ************************}{ Reset является псевдо-свойством. Если значение равно True, TMinMax сбрасывает }{ свойства Min/Max и устанавливает значения по умолчанию. }{**************************** RCW 03-05-96 ************************}Property Reset : Boolean Read GetReset Write SetReset;End;
{********************************** RCW 03-05-96 ******************************}{ Использование: Общая информация относительно WM_GETMINMAXINFO содержится }{ в статьях WM_GETMINMAXINFO и TMINMAXINFO в файле справке }{ по функциям API. Также, имейте в виду следующее: }{ 1) При перемещении границ окна минимальные/максимальные }{ размеры окна определяются свойствами MinWidth, MaxWidth,}{ MinHeight и MaxHeight. }
{ 2) При максимизации окна максимальная высота и ширина }{ окна определяются соответственно Min(MaxHeight, }{ MaximizedHeight) и Min(MaxWidth,MaximizedWidth). Это }{ функция Windows и не зависит от работы компонента. }{ ( Примечание: возможно иметь окно, которое }{ имеет рамку большего размера чем максимальный }{ размер окна. ) }
{ 3) Будьте осторожными при установке MaximizedX и MaximizedY. }{ Примечание: если вы установили это слишком маленьким }{ или слишком большим, ни кнопка, ни заголовок (для двойного }{ щелчка) видимыми не будут. Следовательно, вы не можете }{ восстановить окно до нормального состояния через нормальный }{ интерфейс Windows. }
{********************************** RCW 03-05-96 ******************************}

Procedure Register;
implementation
Procedure Register
;BeginRegisterComponents ( 'Custom', [TMinMax] );End;
Destructor TMinMax.Destroy;BeginIf FInstance <> NilThen FreeObjectInstance ( FInstance );
Inherited Destroy;End;
Procedure TMinMax.Notification ( aComponent: TComponent; Operation: TOperation );BeginIf aComponent = SelfThen If Operation = opInsertThen SubclassElse If Operation = opRemoveThen ResetSubclass;
Inherited Notification ( aComponent, Operation );End;
Procedure TMinMax.ResetSubclass;BeginIf ( FInstance <> Nil ) And( Owner <> Nil )Then If IsWindow ( TWinControl(Owner).Handle )Then SetWindowLong ( TWinControl(Owner).Handle, GWL_WNDPROC,LongInt ( OldWndProc ) );
End;
Procedure TMinMax.Subclass;BeginIf Owner Is TWinControlThen With TWinControl(Owner) DoBeginIf FInstance = NilThen FInstance := MakeObjectInstance ( MinMaxWndProc );OldWndProc := Pointer ( GetWindowLong ( Handle, GWL_WNDPROC ) );SetWindowLong ( Handle, GWL_WNDPROC, LongInt ( FInstance ) );InitMinMaxInfo;End;End;
Procedure TMinMax.InitMinMaxInfo;BeginWith MinMaxInfo DoBeginIf Owner Is TFormThen With ptMaxPosition DoCase TForm(Owner).BorderStyle OfbsSingle : BeginX := -GetSystemMetrics ( SM_CXBORDER );Y := -GetSystemMetrics ( SM_CYBORDER );End;bsSizeable : BeginX := -GetSystemMetrics ( SM_CXFRAME );Y := -GetSystemMetrics ( SM_CYFRAME );End;End;
With ptMaxSize DoBeginX := Screen.Width - 2 * ptMaxPosition.X;Y := Screen.Height - 2 * ptMaxPosition.Y;End;
ptMaxTrackSize := ptMaxSize;End;End;
Procedure TMinMax.MinMaxWndProc ( Var Message : TMessage );BeginMessage.Result := CallWindowProc ( TFarProc(OldWndProc), TWinControl(Owner).Handle,Message.Msg, Message.wParam, Message.lParam );

If FActive And ( Message.Msg = WM_GETMINMAXINFO )Then PMinMaxInfo ( Message.lParam )^ := MinMaxInfo;End;
Function TMinMax.GetMinWidth : Integer;BeginResult := MinMaxInfo.ptMinTrackSize.X;End;
Function TMinMax.GetMinHeight : Integer;BeginResult := MinMaxInfo.ptMinTrackSize.Y;End;
Function TMinMax.GetMaxWidth : Integer;BeginResult := MinMaxInfo.ptMaxTrackSize.X;End;
Function TMinMax.GetMaxHeight : Integer;BeginResult := MinMaxInfo.ptMaxTrackSize.Y;End;
Function TMinMax.GetMaximizedX : Integer;BeginResult := MinMaxInfo.ptMaxPosition.X;End;
Function TMinMax.GetMaximizedY : Integer;BeginResult := MinMaxInfo.ptMaxPosition.Y;End;
Function TMinMax.GetMaximizedWidth : Integer;BeginResult := MinMaxInfo.ptMaxSize.X;End;
Function TMinMax.GetMaximizedHeight : Integer;BeginResult := MinMaxInfo.ptMaxSize.Y;End;
Function TMinMax.GetReset : Boolean;BeginResult := False;End;
Procedure TMinMax.SetActive ( Value : Boolean );BeginIf Value <> FActiveThen BeginFActive := Value;SetNewSize;End;End;
Procedure TMinMax.SetMinWidth ( Value : Integer );BeginIf Value < 0Then Value := 0;
If Value <> MinMaxInfo.ptMinTrackSize.XThen BeginMinMaxInfo.ptMinTrackSize.X := Value;SetNewSize;End;End;
Procedure TMinMax.SetMinHeight ( Value : Integer );BeginIf Value < 0Then Value := 0;
If Value <> MinMaxInfo.ptMinTrackSize.YThen BeginMinMaxInfo.ptMinTrackSize.Y := Value;SetNewSize;End;End;
Procedure TMinMax.SetMaxWidth ( Value : Integer );BeginIf Value < MinMaxInfo.ptMinTrackSize.XThen Value := MinMaxInfo.ptMinTrackSize.X;
If Value <> MinMaxInfo.ptMaxTrackSize.XThen BeginMinMaxInfo.ptMaxTrackSize.X := Value;SetNewSize;End;End;
Procedure TMinMax.SetMaxHeight ( Value : Integer );BeginIf Value < MinMaxInfo.ptMinTrackSize.YThen Value := MinMaxInfo.ptMinTrackSize.Y;
If Value <> MinMaxInfo.ptMaxTrackSize.YThen BeginMinMaxInfo.ptMaxTrackSize.Y := Value;SetNewSize;End;End;
Procedure TMinMax.SetMaximizedX ( Value : Integer );BeginMinMaxInfo.ptMaxPosition.X := Value;End;
Procedure TMinMax.SetMaximizedY ( Value : Integer );BeginMinMaxInfo.ptMaxPosition.Y := Value;End;
Procedure TMinMax.SetMaximizedWidth ( Value : Integer );BeginMinMaxInfo.ptMaxSize.X := Value;End;
Procedure TMinMax.SetMaximizedHeight ( Value : Integer );BeginMinMaxInfo.ptMaxSize.Y := Value;End;
Procedure TMinMax.SetReset ( Value : Boolean );BeginIf ValueThen InitMinMaxInfo;End;
Procedure TMinMax.SetNewSize;BeginIf Not FActiveThen Exit;
{**************************** RCW 03-05-96 ******************************}{ Если размер окна превышает допустимые пределы, производим необходимую коррекцию. }{****************************** RCW 03-05-96 ****************************}If FInstance = NilThen Raise Exception.Create ( 'Не могу управлять WM_GETMINMAXINFO, посколькуOwner не TWinControl' )
Else With TWinControl(Owner), MinMaxInfo DoBeginIf ( ptMinTrackSize.X <> 0 ) Or( ptMaxTrackSize.X <> 0 )Then If Width < ptMinTrackSize.XThen Width := ptMinTrackSize.XElse If Width > ptMaxTrackSize.XThen Width := ptMaxTrackSize.X;
If ( ptMinTrackSize.Y <> 0 ) Or( ptMaxTrackSize.Y <> 0 )Then If Height < ptMinTrackSize.YThen Height := ptMinTrackSize.YElse If Height > ptMaxTrackSize.YThen Height := ptMaxTrackSize.Y;End;End;
end.

- Robert Wittig [000925]



Содержание раздела