Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Компонент TMinMax

Автор: Robert Wittig

Компонент 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;

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.

Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.