視窗元件跟著放大縮小

uses System.TypInfo, Vcl.ComCtrls
type
  TForm1 = class(TForm)
 private
    { Private declarations }
        var
    OW,OH,OP: Longint;
    PropInfo: PPropInfo;
    OldCName,OldCSize: TStringList;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  S: String;
  I,J: Integer;
begin
 
  // 儲存 原 Form width , height , PixelsPerInch
  OW := TForm(Sender).Width;
  OH := TForm(Sender).Height;
  OP := TForm(Sender).PixelsPerInch;
  OldCName := TStringList.Create;
  OldCSize := TStringList.Create;
  for I := 0 to ComponentCount-1 do begin
      // Have Font
      PropInfo := GetPropInfo(Components[I], 'ImeName');
      if PropInfo <> nil then TEdit(Components[I]).ImeName := '';
      if not (Components[I] is TControl) then Continue;
      // Top,Left,Width,Height
      OldCName.Add(Components[I].Name); OldCSize.Add(Components[I].Name);
      OldCName.Add(Components[I].Name+'.Top'); OldCSize.Add(IntToStr(TControl(Components[I]).Top));
      OldCName.Add(Components[I].Name+'.Left'); OldCSize.Add(IntToStr(TControl(Components[I]).Left));
      OldCName.Add(Components[I].Name+'.Width'); OldCSize.Add(IntToStr(TControl(Components[I]).Width));
      OldCName.Add(Components[I].Name+'.Height'); OldCSize.Add(IntToStr(TControl(Components[I]).Height));
      // Have Font
      PropInfo := GetPropInfo(Components[I], 'Font');
      if PropInfo <> nil then begin
         OldCName.Add(Components[I].Name+'Font.FontSize'); OldCSize.Add(IntToStr(TEdit(Components[I]).Font.Size));
         OldCName.Add(Components[I].Name+'Font.FontHeight'); OldCSize.Add(IntToStr(TEdit(Components[I]).Font.Height));
      end;
      // TStatusBar
      if Components[I] is TStatusBar then
         with TStatusBar(Components[I]) do
              for J := 0 to Panels.Count-1 do begin
                  S := Name;
                  S := S+'Panels.'+FormatFloat('00',J)+'.Width';
                  OldCName.Add(Name+'Panels.'+FormatFloat('00',J)+'.Width'); OldCSize.Add(IntToStr(Panels[J].Width));
                  OldCName.Add(Name+'Panels.'+FormatFloat('00',J)+'.Width'); OldCSize.Add(IntToStr(Panels[J].Width));
              end;
  end;     
  
end;

procedure TForm1.FormResize(Sender: TObject);
var
  I,J: Integer;
  NW,NH,NP: Longint;
  T,L,W,H,FS,FH: Longint;
begin
 // m:=myMethod.Create;
  //self:=TVN90F(m.FormCreate(self));
  if OldCName = Nil then Exit;
  NW := TForm(Sender).Width;
  NH := TForm(Sender).Height;
  NP := TForm(Sender).PixelsPerInch;
  for I := 0 to ComponentCount-1 do begin
      if not (Components[I] is TControl) then Continue;
      if OldCName.IndexOf(Components[I].Name) = -1 then Continue;
      T := OldCName.IndexOf(Components[I].Name+'.Top'); T := StrToInt(OldCSize.Strings[T]);
      L := OldCName.IndexOf(Components[I].Name+'.Left'); L := StrToInt(OldCSize.Strings[L]);
      W := OldCName.IndexOf(Components[I].Name+'.Width'); W := StrToInt(OldCSize.Strings[W]);
      H := OldCName.IndexOf(Components[I].Name+'.Height'); H := StrToInt(OldCSize.Strings[H]);
      TControl(Components[I]).Top    := Longint((T * NH div OH) * NP div OP);
      TControl(Components[I]).Left   := Longint((L * NW div OW) * NP div OP);
      TControl(Components[I]).Width  := Longint((W * NW div OW) * NP div OP);
      TControl(Components[I]).Height := Longint((H * NH div OH) * NP div OP);
      // 檢查是否有 font property
     PropInfo := GetPropInfo(Components[I], 'Font');
      if PropInfo <> nil then begin
         FS := OldCName.IndexOf(Components[I].Name+'Font.FontSize');
         FH := OldCName.IndexOf(Components[I].Name+'.FontHeight');
         if FS <> -1 then begin
            FS := StrToInt(OldCSize.Strings[FS]);
            TEdit(Components[I]).Font.Size := Longint((FS * NP div OP) * NH div OH);
         end;
      end;
      if Components[I] is TStatusBar then
      with TStatusBar(Components[I]) do begin
           for J := 0 to Panels.Count-1 do begin
               W := OldCName.IndexOf(Name+'Panels.'+FormatFloat('00',J)+'.Width'); W := StrToInt(OldCSize.Strings[W]);
               Panels[J].Width  := Longint((W * NW div OW) * NP div OP);
           end;
      end;
  end;   
end;