Компонент TMinMax

{***************************************************************************** }
{                                 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.