Компонент 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;
type
TMinMax = class(TComponent)
private
OldWndProc: 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(varMessage: 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 write
SetMaximizedWidth;
property MaximizedHeight: Integer read GetMaximizedHeight write
SetMaximizedHeight;
{**************************** 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 ******************************}procedureRegister;
implementationprocedureRegister;
begin
RegisterComponents('Custom', [TMinMax]);
end;
destructor TMinMax.Destroy;
beginif FInstance <> nilthen
FreeObjectInstance(FInstance);
inherited Destroy;
end;
procedure TMinMax.Notification(aComponent: TComponent; Operation: TOperation);
beginif aComponent = Self thenif Operation = opInsert then
Subclass
elseif Operation = opRemove then
ResetSubclass;
inherited Notification(aComponent, Operation);
end;
procedure TMinMax.ResetSubclass;
beginif (FInstance <> nil) and
(Owner <> nil) thenif IsWindow(TWinControl(Owner).Handle) then
SetWindowLong(TWinControl(Owner).Handle, GWL_WNDPROC,
LongInt(OldWndProc));
end;
procedure TMinMax.Subclass;
beginif Owner is TWinControl thenwith 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 TForm thenwith ptMaxPosition docase TForm(Owner).BorderStyle of
bsSingle:
begin
X := -GetSystemMetrics(SM_CXBORDER);
Y := -GetSystemMetrics(SM_CYBORDER);
end;
bsSizeable:
begin
X := -GetSystemMetrics(SM_CXFRAME);
Y := -GetSystemMetrics(SM_CYFRAME);
end;
end;
with ptMaxSize dobegin
X := Screen.Width - 2 * ptMaxPosition.X;
Y := Screen.Height - 2 * ptMaxPosition.Y;
end;
ptMaxTrackSize := ptMaxSize;
end;
end;
procedure TMinMax.MinMaxWndProc(varMessage: 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;
begin
Result := MinMaxInfo.ptMinTrackSize.X;
end;
function TMinMax.GetMinHeight: Integer;
begin
Result := MinMaxInfo.ptMinTrackSize.Y;
end;
function TMinMax.GetMaxWidth: Integer;
begin
Result := MinMaxInfo.ptMaxTrackSize.X;
end;
function TMinMax.GetMaxHeight: Integer;
begin
Result := MinMaxInfo.ptMaxTrackSize.Y;
end;
function TMinMax.GetMaximizedX: Integer;
begin
Result := MinMaxInfo.ptMaxPosition.X;
end;
function TMinMax.GetMaximizedY: Integer;
begin
Result := MinMaxInfo.ptMaxPosition.Y;
end;
function TMinMax.GetMaximizedWidth: Integer;
begin
Result := MinMaxInfo.ptMaxSize.X;
end;
function TMinMax.GetMaximizedHeight: Integer;
begin
Result := MinMaxInfo.ptMaxSize.Y;
end;
function TMinMax.GetReset: Boolean;
begin
Result := False;
end;
procedure TMinMax.SetActive(Value: Boolean);
beginif Value <> FActive thenbegin
FActive := Value;
SetNewSize;
end;
end;
procedure TMinMax.SetMinWidth(Value: Integer);
beginif Value < 0 then
Value := 0;
if Value <> MinMaxInfo.ptMinTrackSize.X thenbegin
MinMaxInfo.ptMinTrackSize.X := Value;
SetNewSize;
end;
end;
procedure TMinMax.SetMinHeight(Value: Integer);
beginif Value < 0 then
Value := 0;
if Value <> MinMaxInfo.ptMinTrackSize.Y thenbegin
MinMaxInfo.ptMinTrackSize.Y := Value;
SetNewSize;
end;
end;
procedure TMinMax.SetMaxWidth(Value: Integer);
beginif Value < MinMaxInfo.ptMinTrackSize.X then
Value := MinMaxInfo.ptMinTrackSize.X;
if Value <> MinMaxInfo.ptMaxTrackSize.X thenbegin
MinMaxInfo.ptMaxTrackSize.X := Value;
SetNewSize;
end;
end;
procedure TMinMax.SetMaxHeight(Value: Integer);
beginif Value < MinMaxInfo.ptMinTrackSize.Y then
Value := MinMaxInfo.ptMinTrackSize.Y;
if Value <> MinMaxInfo.ptMaxTrackSize.Y thenbegin
MinMaxInfo.ptMaxTrackSize.Y := Value;
SetNewSize;
end;
end;
procedure TMinMax.SetMaximizedX(Value: Integer);
begin
MinMaxInfo.ptMaxPosition.X := Value;
end;
procedure TMinMax.SetMaximizedY(Value: Integer);
begin
MinMaxInfo.ptMaxPosition.Y := Value;
end;
procedure TMinMax.SetMaximizedWidth(Value: Integer);
begin
MinMaxInfo.ptMaxSize.X := Value;
end;
procedure TMinMax.SetMaximizedHeight(Value: Integer);
begin
MinMaxInfo.ptMaxSize.Y := Value;
end;
procedure TMinMax.SetReset(Value: Boolean);
beginif Value then
InitMinMaxInfo;
end;
procedure TMinMax.SetNewSize;
beginifnot FActive then
Exit;
{**************************** RCW 03-05-96 ******************************}{ Если размер окна превышает допустимые пределы, производим необходимую коррекцию. }{****************************** RCW 03-05-96 ****************************}if FInstance = nilthenraise Exception.Create('Не могу управлять WM_GETMINMAXINFO, поскольку
Owner не TWinControl' )
elsewith TWinControl(Owner), MinMaxInfo dobeginif (ptMinTrackSize.X <> 0) or
(ptMaxTrackSize.X <> 0) thenif Width < ptMinTrackSize.X then
Width := ptMinTrackSize.X
elseif Width > ptMaxTrackSize.X then
Width := ptMaxTrackSize.X;
if (ptMinTrackSize.Y <> 0) or
(ptMaxTrackSize.Y <> 0) thenif Height < ptMinTrackSize.Y then
Height := ptMinTrackSize.Y
elseif Height > ptMaxTrackSize.Y then
Height := ptMaxTrackSize.Y;
end;
end;
end.