{***************************************************************************** }
{ 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;
interface
uses Classes, Controls, Forms, Messages, SysUtils, WinProcs, WinTypes;
type
TMinMax = class(TComponent)
private
OldWndProc: Pointer;
FInstance: Pointer;
MinMaxInfo: TMinMaxInfo;
FActive: Boolean;
protected
procedure 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;
public
destructor Destroy; override;
published
property 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 ******************************}
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Custom', [TMinMax]);
end;
destructor TMinMax.Destroy;
begin
if FInstance <> nil then
FreeObjectInstance(FInstance);
inherited Destroy;
end;
procedure TMinMax.Notification(aComponent: TComponent; Operation: TOperation);
begin
if aComponent = Self then
if Operation = opInsert then
Subclass
else if Operation = opRemove then
ResetSubclass;
inherited Notification(aComponent, Operation);
end;
procedure TMinMax.ResetSubclass;
begin
if (FInstance <> nil) and
(Owner <> nil) then
if IsWindow(TWinControl(Owner).Handle) then
SetWindowLong(TWinControl(Owner).Handle, GWL_WNDPROC,
LongInt(OldWndProc));
end;
procedure TMinMax.Subclass;
begin
if Owner is TWinControl then
with TWinControl(Owner) do
begin
if FInstance = nil then
FInstance := MakeObjectInstance(MinMaxWndProc);
OldWndProc := Pointer(GetWindowLong(Handle, GWL_WNDPROC));
SetWindowLong(Handle, GWL_WNDPROC, LongInt(FInstance));
InitMinMaxInfo;
end;
end;
procedure TMinMax.InitMinMaxInfo;
begin
with MinMaxInfo do
begin
if Owner is TForm then
with ptMaxPosition do
case 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 do
begin
X := Screen.Width - 2 * ptMaxPosition.X;
Y := Screen.Height - 2 * ptMaxPosition.Y;
end;
ptMaxTrackSize := ptMaxSize;
end;
end;
procedure TMinMax.MinMaxWndProc(var Message: TMessage);
begin
Message.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);
begin
if Value <> FActive then
begin
FActive := Value;
SetNewSize;
end;
end;
procedure TMinMax.SetMinWidth(Value: Integer);
begin
if Value < 0 then
Value := 0;
if Value <> MinMaxInfo.ptMinTrackSize.X then
begin
MinMaxInfo.ptMinTrackSize.X := Value;
SetNewSize;
end;
end;
procedure TMinMax.SetMinHeight(Value: Integer);
begin
if Value < 0 then
Value := 0;
if Value <> MinMaxInfo.ptMinTrackSize.Y then
begin
MinMaxInfo.ptMinTrackSize.Y := Value;
SetNewSize;
end;
end;
procedure TMinMax.SetMaxWidth(Value: Integer);
begin
if Value < MinMaxInfo.ptMinTrackSize.X then
Value := MinMaxInfo.ptMinTrackSize.X;
if Value <> MinMaxInfo.ptMaxTrackSize.X then
begin
MinMaxInfo.ptMaxTrackSize.X := Value;
SetNewSize;
end;
end;
procedure TMinMax.SetMaxHeight(Value: Integer);
begin
if Value < MinMaxInfo.ptMinTrackSize.Y then
Value := MinMaxInfo.ptMinTrackSize.Y;
if Value <> MinMaxInfo.ptMaxTrackSize.Y then
begin
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);
begin
if Value then
InitMinMaxInfo;
end;
procedure TMinMax.SetNewSize;
begin
if not FActive then
Exit;
{**************************** RCW 03-05-96 ******************************}
{ Если размер окна превышает допустимые пределы, производим необходимую коррекцию. }
{****************************** RCW 03-05-96 ****************************}
if FInstance = nil then
raise Exception.Create('Не могу управлять WM_GETMINMAXINFO, поскольку
Owner не TWinControl' )
else
with TWinControl(Owner), MinMaxInfo do
begin
if (ptMinTrackSize.X <> 0) or
(ptMaxTrackSize.X <> 0) then
if Width < ptMinTrackSize.X then
Width := ptMinTrackSize.X
else if Width > ptMaxTrackSize.X then
Width := ptMaxTrackSize.X;
if (ptMinTrackSize.Y <> 0) or
(ptMaxTrackSize.Y <> 0) then
if Height < ptMinTrackSize.Y then
Height := ptMinTrackSize.Y
else if Height > ptMaxTrackSize.Y then
Height := ptMaxTrackSize.Y;
end;
end;
end.
|