The Unofficial Newsletter of Delphi Users - by Robert Vivrette

Невизуальный компонент для изменения размеров Формы

By Christian Ebenegger - c.ebenegger@fsp.ch
and Thierry Revillard - thierry.revillard@fsp.ch

Перевод Руденко Е.В.   janer@newmail.ru    февраль  2002 года

 

Развивая идею статьи  In the Spirit of Thales - Resizing a Form (www.undu.com) , мы создали невизуальный компонент, который автоматически при изменении размеров формы выравнивает все компоненты формы вправо и изменяет размеры некоторых компонентов, таких как TFrame, TStringGrid, TListView и т.д.

.

unit AutoResize;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, Grids, DBGrids, StdCtrls, ExtCtrls, Buttons;

type
  TAutoResize = class(TComponent)
  private
    { Déclarations privées }
    TabCoord, TabEditBtn, TabCoordFr, TabEditBtnFr : array of array of Variant;
    OldHeight, OldWidth, OldHeightFr, OldWidthFr : Integer;
  protected
    { Déclarations protégées }
  public
    { Déclarations publiques }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure GetFormInfo(Form : TForm);
    procedure ResizeTheF(BForm : TForm);
    procedure GetFrameInfo(BFrame : TFrame);
    procedure ResizeTheFr(BFrame : TFrame);
  published
    { Déclarations publiées }
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Examples', [TAutoResize]);
end;

constructor TAutoResize.Create(AOwner: TComponent);
begin
  inherited ;
end;

destructor TAutoResize.Destroy;
begin
  inherited ;
end;

Определяем начальные позиции компонентов на форме..
procedure TAutoResize.GetFormInfo(Form : TForm);
var
 I, J, K, MaxLine, MaxCol : Integer;
 TheControl, TheJoinControl : TControl;
 TheOwner : TWinControl;
 OK : Boolean;
 RGN : TRect;
 CoordJoin : TPoint;
begin
 OldHeight := Form.ClientHeight;
 OldWidth  := Form.ClientWidth;
 TabCoord := nil;
 TabEditBtn := nil;
 MaxLine := 0;
 K := 0;
  for I := 0 to (Form.ComponentCount - 1) do
   begin
    TheControl := TControl(Form.FindComponent(Form.Components[I].Name));
    if (TheControl is TWinControl) or (TheControl is TGraphicControl) then
     begin
      if (TheControl is TEdit) or (TheControl is TBitBtn) then
       begin
        TheOwner := TheControl.Parent;
        CoordJoin.y := TheControl.Top + 1;
        CoordJoin.x := TheControl.Left + TheControl.Width + 2;
        TheJoinControl := TheOwner.ControlAtPos(CoordJoin, true, true);
        if TheJoinControl <> nil then
         begin
          if (TheJoinControl is TButton) or (TheJoinControl is TBitBtn) or (TheJoinControl is TComboBox) then
           begin
            SetLength(TabEditBtn, K + 1, 2);
            TabEditBtn[K, 0] := TheControl.Name;
            TabEditBtn[K, 1] := TheJoinControl.Name;
            Inc(K, 1);
           end;
         end;
       end;

      RGN := TheControl.BoundsRect;
      OK := False;
      J := 0;
      while OK = False do
       begin
        if TheControl.Parent <> nil then
         begin
          Inc(J,1);
          TheControl := TheControl.Parent;
         end
        else
         OK := True;
       end;
      if J > MaxLine then
       begin
        MaxCol := 0;
        MaxLine := J;
        SetLength(TabCoord, J);
        SetLength(TabCoord[(J - 1)], 5);
       end
      else
       begin
        MaxCol := Length(TabCoord[(J - 1)]);
        SetLength(TabCoord[(J - 1)], (MaxCol + 5));
       end;

      TabCoord[(J - 1), MaxCol] := Form.Components[I].Name;
      TabCoord[(J - 1), (MaxCol + 1)] := RGN.Left;
      TabCoord[(J - 1), (MaxCol + 2)] := RGN.Top;
      TabCoord[(J - 1), (MaxCol + 3)] := RGN.Right;
      TabCoord[(J - 1), (MaxCol + 4)] := RGN.Bottom;
     end;
   end;
end;

Определяем начальные позиции компонентов фрейма...
procedure TAutoResize.GetFrameInfo(BFrame : TFrame);
var
 I, J, K, MaxLine, MaxCol : Integer;
 TheControl, TheJoinControl : TControl;
 TheOwner : TWinControl;
 OK : Boolean;
 RGN : TRect;
 CoordJoin : TPoint;
begin
 OldHeightFr := BFrame.ClientHeight;
 OldWidthFr  := BFrame.ClientWidth;
 TabCoordFr := nil;
 TabEditBtnFr := nil;
 MaxLine := 0;
 K := 0;

  for I := 0 to (BFrame.ComponentCount - 1) do
   begin
    TheControl := TControl(BFrame.FindComponent(BFrame.Components[I].Name));
    if (TheControl is TWinControl) or (TheControl is TGraphicControl) then
     begin
      if (TheControl is TEdit) or (TheControl is TBitBtn) then
       begin
        TheOwner := TheControl.Parent;
        CoordJoin.y := TheControl.Top + 1;
        CoordJoin.x := TheControl.Left + TheControl.Width + 2;
        TheJoinControl := TheOwner.ControlAtPos(CoordJoin, true, true);
        if TheJoinControl <> nil then
         begin
          if (TheJoinControl is TButton) or (TheJoinControl is TBitBtn) or (TheJoinControl is TComboBox) then
           begin
            SetLength(TabEditBtnFr, K + 1, 2);
            TabEditBtnFr[K, 0] := TheControl.Name;
            TabEditBtnFr[K, 1] := TheJoinControl.Name;
            Inc(K, 1);
           end;
         end;
       end;

      RGN := TheControl.BoundsRect;
      OK := False;
      J := 0;
      while OK = False do
       begin
        if TheControl.Parent <> nil then
         begin
          Inc(J,1);
          TheControl := TheControl.Parent;
         end
        else
         OK := True;
       end;
      if J > MaxLine then
       begin
        MaxCol := 0;
        MaxLine := J;
        SetLength(TabCoordFr, J);
        SetLength(TabCoordFr[(J - 1)], 5);
       end
      else
       begin
        MaxCol := Length(TabCoordFr[(J - 1)]);
        SetLength(TabCoordFr[(J - 1)], (MaxCol + 5));
       end;

      TabCoordFr[(J - 1), MaxCol] := BFrame.Components[I].Name;
      TabCoordFr[(J - 1), (MaxCol + 1)] := RGN.Left;
      TabCoordFr[(J - 1), (MaxCol + 2)] := RGN.Top;
      TabCoordFr[(J - 1), (MaxCol + 3)] := RGN.Right;
      TabCoordFr[(J - 1), (MaxCol + 4)] := RGN.Bottom;
     end;
   end;
end;

Изменяем размер формы...
procedure TAutoResize.ResizeTheF(BForm : TForm);
var
 TheControl, TheJoinControl : TControl;
 I, J, L, T, R, B, W, H, NewHeight, NewWidth : Integer;
  procedure SetBounds(Control: TControl);
   begin
    Control.SetBounds(L, T, W, H);
   end;
begin
 BForm.HorzScrollBar.Position := 0;
 BForm.VertScrollBar.Position := 0;
 BForm.AutoScroll := False;
 NewHeight := BForm.ClientHeight;
 NewWidth := BForm.ClientWidth;

 if (NewHeight >= OldHeight)  and (NewWidth >= OldWidth) then
  begin
   for I := 0 to High(TabCoord) do
    begin
     J := 0;
     while J <= High(TabCoord[I]) do
      begin
       TheControl := TControl(BForm.FindComponent(TabCoord[I,J]));
       if (TheControl is TWinControl) or (TheControl is TGraphicControl) then
        begin
         if (TheControl is TPageControl) or (TheControl is TTabSheet) or
            (TheControl is TStringGrid) or (TheControl is TListBox) or
            (TheControl is TGroupBox) or (TheControl is TPanel) or (TheControl is TTreeView) or
            (TheControl is TListView) or (TheControl is TDBGrid) or (TheControl is TMemo) or
            (TheControl is TTreeView) or (TheControl.ClassParent = TFrame) then
          begin
           L := ((TabCoord[I,(J + 1)] * NewWidth) div OldWidth);
           T := ((TabCoord[I,(J + 2)] * NewHeight) div OldHeight);
           R := ((TabCoord[I,(J + 3)] * NewWidth) div OldWidth);
           B := ((TabCoord[I,(J + 4)] * NewHeight) div OldHeight);
           W := R - L;
           H := B - T;
           SetBounds(TheControl);
           Inc(J,5);
          end
         else
          begin
           L := ((TabCoord[I,(J + 1)] * NewWidth) div OldWidth);
           T := ((TabCoord[I,(J + 2)] * NewHeight) div OldHeight);
           W := TheControl.Width;
           H := TheControl.Height;
           SetBounds(TheControl);
           Inc(J,5);
          end;
        end;
      end;
    end;
    for I := 0 to high(TabEditBtn) do
     begin
      TheControl := TControl(BForm.FindComponent(TabEditBtn[I, 0]));
      TheJoinControl := TControl(BForm.FindComponent(TabEditBtn[I, 1]));
      TheJoinControl.Left := TheControl.Left + TheControl.Width + 1;
     end;
  end
 else
  begin
   for I := 0 to High(TabCoord) do
    begin
     J := 0;
     while J <= High(TabCoord[I]) do
      begin
       TheControl := TControl(BForm.FindComponent(TabCoord[I,J]));
       if (TheControl is TWinControl) or (TheControl is TGraphicControl) then
        begin
         L := (TabCoord[I,(J + 1)]);
         T := (TabCoord[I,(J + 2)]);
         R := (TabCoord[I,(J + 3)]);
         B := (TabCoord[I,(J + 4)]);
         W := R - L;
         H := B - T;
         SetBounds(TheControl);
         Inc(J,5);
        end;
      end;
    end;
      BForm.AutoScroll := True;
      BForm.HorzScrollBar.Visible := True;
      BForm.HorzScrollBar.Range := OldWidth;
      BForm.VertScrollBar.Visible := True;
      BForm.VertScrollBar.Range := OldHeight;
  end;
end;

Изменяем размер фрейма...
procedure TAutoResize.ResizeTheFr(BFrame : TFrame);
var
 TheControl, TheJoinControl : TControl;
 I, J, L, T, R, B, W, H, NewHeight, NewWidth : Integer;
  procedure SetBounds(Control: TControl);
   begin
    Control.SetBounds(L, T, W, H);
   end;
begin

 NewHeight := BFrame.Height;
 NewWidth := BFrame.Width;

 if (NewHeight >= OldHeightFr)  and (NewWidth >= OldWidthFr) then
  begin
   for I := 0 to High(TabCoordFr) do
    begin
     J := 0;
     while J <= High(TabCoordFr[I]) do
      begin
       TheControl := TControl(BFrame.FindComponent(TabCoordFr[I,J]));
       if (TheControl is TWinControl) or (TheControl is TGraphicControl) then
        begin
         if (TheControl is TPageControl) or (TheControl is TTabSheet) or
            (TheControl is TStringGrid) or (TheControl is TListBox) or
            (TheControl is TGroupBox) or (TheControl is TPanel) or (TheControl is TTreeView) or
            (TheControl is TListView) or (TheControl is TDBGrid) or (TheControl is TMemo) or
            (TheControl.ClassParent = TFrame)then
          begin
           L := ((TabCoordFr[I,(J + 1)] * NewWidth) div OldWidthFr);
           T := ((TabCoordFr[I,(J + 2)] * NewHeight) div OldHeightFr);
           R := ((TabCoordFr[I,(J + 3)] * NewWidth) div OldWidthFr);
           B := ((TabCoordFr[I,(J + 4)] * NewHeight) div OldHeightFr);
           W := R - L;
           H := B - T;
           SetBounds(TheControl);
           Inc(J,5);
          end
         else
          begin
           L := ((TabCoordFr[I,(J + 1)] * NewWidth) div OldWidthFr);
           T := ((TabCoordFr[I,(J + 2)] * NewHeight) div OldHeightFr);
           W := TheControl.Width;
           H := TheControl.Height;
           SetBounds(TheControl);
           Inc(J,5);
          end;
        end;
      end;
    end;
    for I := 0 to high(TabEditBtnFr) do
     begin
      TheControl := TControl(BFrame.FindComponent(TabEditBtnFr[I, 0]));
      TheJoinControl := TControl(BFrame.FindComponent(TabEditBtnFr[I, 1]));
      TheJoinControl.Left := TheControl.Left + TheControl.Width + 1;
     end;
  end
 else
  begin
   for I := 0 to High(TabCoordFr) do
    begin
     J := 0;
     while J <= High(TabCoordFr[I]) do
      begin
       TheControl := TControl(BFrame.FindComponent(TabCoordFr[I,J]));
       if (TheControl is TWinControl) or (TheControl is TGraphicControl) then
        begin
         L := (TabCoordFr[I,(J + 1)]);
         T := (TabCoordFr[I,(J + 2)]);
         R := (TabCoordFr[I,(J + 3)]);
         B := (TabCoordFr[I,(J + 4)]);
         W := R - L;
         H := B - T;
         SetBounds(TheControl);
         Inc(J,5);
        end;
      end;
    end;
  end;
end;

end.

Теперь в модуле Формы мы размещаем  AutoResize в списке  uses  и декларируем  private переменную :
MyAutoResize : TAutoResize;
И в модуле Фрейма мы размещаем  AutoResize в списке uses и декларируем private переменную :
FrAutoResize : TAutoResize;
Затем в модуле Формы в событии  OnShow Event мы устанавливаем :
procedure TForm.FormOnShow(Sender: TObject);
begin
 MyAutoResize := TAutoResize.Create(Self);
 MyAutoResize.GetFormInfo(Form);
 FFrame.GetAutoResizeFrameInfo(FFrame);
end;
В событии OnResize Event мы устанавливаем :
procedure TForm.FormOnResize(Sender: TObject);
begin
MyAutoResize.ResizeTheF(Form);
end;
И окончательно в событии  OnClose Event мы устанавливаем :
procedure TForm.FormOnClose(Sender: TObject; var Action: TCloseAction);
begin
  MyAutoResize.Free;
  FFrame.FreeAutoResize;
end;
В модуле Фрейма мы получаем такие процедуры :
procedure T Frame.GetAutoResizeFrameInfo(TheFrame : TFrame);
begin
 FrAutoResize := TAutoResize.Create(Self);
 FrAutoResize.GetFrameInfo(TheFrame);
end;

procedure T Frame.FrameResize(Sender: TObject);
begin
 if FrAutoResize <> nil then
   FrAutoResize.ResizeTheFr(Sender as TFrame);
end;

procedure TFrame.FreeAutoResize;
begin
 FrAutoResize.Free;
end;
 

Щелкните здесь для получения исходных кодов статьи.

Возврат в Tips&Tricks