dpiScaling for Windows by lainz

[lainz]

This is obsolete, please go to this Wiki article:

http://wiki.freepascal.org/High_DPI

Thanks.

[lainz]

TODO:
- Scale components inside other components (like Buttons inside GroupBox).

someone knows how to do it?

[jixian.yang]

procedure ScaleComponents(sControls: TControl; sDPI: Integer);
var
  i: Integer;
  Scale: Extended;
  Count: Integer;
begin
  Scale := Screen.PixelsPerInch / sDPI;
  Count := sControls.ControlCount;
  // Scale Controls
  sControls.Left := Round(sControls.Left * Scale);
  sControls.Top := Round(sControls.Top * Scale);
  sControls.Width := Round(sControls.Width * Scale);
  sControls.Height := Round(sControls.Height * Scale);
  // Scale SubControls
  for i:=0 to Count - 1 do begin
    with sControls.Controls do begin
      Left := Round(Left * Scale);
      Top := Round(Top * Scale);
      Width := Round(Width * Scale);
      Height := Round(Height * Scale);
    end;
  end;
end;


if GroupBox.ComponentCount > 0 then
  ScaleComponents(Buttons);

[lainz]

wich version of FPC are using? with FPC 2.4.2 you can't use sControls.ControlCount;

This is an *update*:

  dpi := 96;
  Scaling.ScaleControl(Self,dpi);
  Scaling.ScaleFormControls(Self,dpi);
  Scaling.ScaleGroupBoxControls(GroupBox1,dpi);
  Scaling.ScalePanelControls(Panel1,dpi);
  Scaling.ScaleFrameControls(Frame1_1,dpi);
  Scaling.ScaleScrollBoxControls(ScrollBox1,dpi);
  Scaling.ScaleToolBarControls(ToolBar1,dpi);
  Scaling.ScaleTabSheetControls(TabSheet1,dpi);
  Scaling.ScaleTabSheetControls(TabSheet2,dpi);
  Scaling.ScaleTabControlControls(TabControl1,dpi);
  Scaling.ScaleHeaderControlSections(HeaderControl1,dpi);

procedure TDPIScaling.ScaleControl(sControl: TControl; sDPI: Integer);
var
  Scale: Extended;
begin
  Scale := Screen.PixelsPerInch / sDPI;
  with sControl do begin
    Left := Round(Left * Scale);
    Top := Round(Top * Scale);
    Width := Round(Width * Scale);
    Height := Round(Height * Scale);
  end;
end;

procedure TDPIScaling.ScaleFormControls(sForm: TForm; sDPI: Integer);
var
  i: Integer;
  Scale: Extended;
  Count: Integer;
begin
  Scale := Screen.PixelsPerInch / sDPI;
  Count := sForm.ControlCount;
  for i:=0 to Count - 1 do begin
    with sForm.Controls do begin
      Left := Round(Left * Scale);
      Top := Round(Top * Scale);
      Width := Round(Width * Scale);
      Height := Round(Height * Scale);
    end;
  end;
end;

procedure TDPIScaling.ScaleGroupBoxControls(sGroupBox: TGroupBox; sDPI: Integer);
var
  i: Integer;
  Scale: Extended;
  Count: Integer;
begin
  Scale := Screen.PixelsPerInch / sDPI;
  Count := sGroupBox.ControlCount;
  for i:=0 to Count - 1 do begin
    with sGroupBox.Controls do begin
      Left := Round(Left * Scale);
      Top := Round(Top * Scale);
      Width := Round(Width * Scale);
      Height := Round(Height * Scale);
    end;
  end;
end;

procedure TDPIScaling.ScalePanelControls(sPanel: TPanel; sDPI: Integer);
var
  i: Integer;
  Scale: Extended;
  Count: Integer;
begin
  Scale := Screen.PixelsPerInch / sDPI;
  Count := sPanel.ControlCount;
  for i:=0 to Count - 1 do begin
    with sPanel.Controls do begin
      Left := Round(Left * Scale);
      Top := Round(Top * Scale);
      Width := Round(Width * Scale);
      Height := Round(Height * Scale);
    end;
  end;
end;

procedure TDPIScaling.ScaleFrameControls(sFrame: TFrame; sDPI: Integer);
var
  i: Integer;
  Scale: Extended;
  Count: Integer;
begin
  Scale := Screen.PixelsPerInch / sDPI;
  Count := sFrame.ControlCount;
  for i:=0 to Count - 1 do begin
    with sFrame.Controls do begin
      Left := Round(Left * Scale);
      Top := Round(Top * Scale);
      Width := Round(Width * Scale);
      Height := Round(Height * Scale);
    end;
  end;
end;

procedure TDPIScaling.ScaleScrollBoxControls(sScrollBox: TScrollBox; sDPI: Integer);
var
  i: Integer;
  Scale: Extended;
  Count: Integer;
begin
  Scale := Screen.PixelsPerInch / sDPI;
  Count := sScrollBox.ControlCount;
  for i:=0 to Count - 1 do begin
    with sScrollBox.Controls do begin
      Left := Round(Left * Scale);
      Top := Round(Top * Scale);
      Width := Round(Width * Scale);
      Height := Round(Height * Scale);
    end;
  end;
end;

procedure TDPIScaling.ScaleToolBarControls(sToolBar: TToolBar; sDPI: Integer);
var
  //i: Integer;
  Scale: Extended;
  //Count: Integer;
begin
  Scale := Screen.PixelsPerInch / sDPI;
  //Count := sToolBar.ControlCount;
  //for i:=0 to Count - 1 do begin
    with sToolBar{.Controls} do begin
      ButtonWidth := Round(ButtonWidth * Scale);
      ButtonHeight := Round(ButtonHeight * Scale);
    end;
  //end;
end;

procedure TDPIScaling.ScaleTabSheetControls(sTabSheet: TTabSheet; sDPI: Integer);
var
  i: Integer;
  Scale: Extended;
  Count: Integer;
begin
  Scale := Screen.PixelsPerInch / sDPI;
  Count := sTabSheet.ControlCount;
  for i:=0 to Count - 1 do begin
    with sTabSheet.Controls do begin
      Left := Round(Left * Scale);
      Top := Round(Top * Scale);
      Width := Round(Width * Scale);
      Height := Round(Height * Scale);
    end;
  end;
end;

procedure TDPIScaling.ScaleTabControlControls(sTabControl: TTabControl; sDPI: Integer);
var
  i: Integer;
  Scale: Extended;
  Count: Integer;
begin
  Scale := Screen.PixelsPerInch / sDPI;
  Count := sTabControl.ControlCount;
  for i:=0 to Count - 1 do begin
    with sTabControl.Controls do begin
      Left := Round(Left * Scale);
      Top := Round(Top * Scale);
      Width := Round(Width * Scale);
      Height := Round(Height * Scale);
    end;
  end;
end;

procedure TDPIScaling.ScaleHeaderControlSections(sHeaderControl: THeaderControl; sDPI: Integer);
var
  i: Integer;
  Scale: Extended;
  Count: Integer;
begin
  Scale := Screen.PixelsPerInch / sDPI;
  Count := sHeaderControl.Sections.Count;
  for i:=0 to Count - 1 do begin
    with sHeaderControl.Sections.Items do begin
      //Left := Round(Left * Scale);
      //Top := Round(Top * Scale);
      Width := Round(Width * Scale);
      //Height := Round(Height * Scale);
    end;
  end;
end;