tvplanit: Improvements of event and contact editor at high-dpi, but still issues.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4951 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/tvplanit/examples/xmldatastore/project1.lpi

@@ -58,6 +58,9 @@
       <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
     <Linking>
+      <Debugging>
+        <UseExternalDbgSyms Value="True"/>
+      </Debugging>
       <Options>
         <Win32>
           <GraphicApplication Value="True"/>

components/tvplanit/source/vpcontacteditdlg.pas

@@ -374,9 +374,6 @@ const
 //  FormHeightOffset = 103;
 //  MinFormHeight    = 250;
   TopField         = 8;
-  DIST             = 4;   // distance between label and edit/combo
-  HBORDER          = 8;   // distance between container border and label
-  VDIST            = 2;   // vertical distance between edits
 
 type
   TLabelArray = array of TLabel;
@@ -395,8 +392,16 @@ var
   delta: Integer;
   corr: Integer;       // difference between form's client width and tabsheet width
   editHeight: Integer; // Height of an edit control
+  vDist: Integer;      // Vertical distance between edits
+  hBorder: Integer;    // Distance between container border and label
+  dist: Integer;       // distance between label and edit/combo
 
 begin
+  dist := round(4 * Screen.PixelsPerInch / DesignTimeDPI);
+  vdist := round(2 * Screen.PixelsPerInch / DesignTimeDPI);
+  hBorder := round(8 * Screen.PixelsPerInch / DesignTimeDPI);
+  editHeight := LastNameEdit.Height * Screen.PixelsPerInch div DesignTimeDPI;
+
   { Note: The resizing algorithm is dependent upon the labels having their
     FocusControl property set to the corresponding edit field or combobox. }
 
@@ -466,8 +471,6 @@ begin
   cboxState.Width := widestField;
 
   { Vertically arrange the fields. }
-  editHeight := LastNameEdit.Height;
-
   delta := (Labels[0].FocusControl.Height - labels[0].Height) div 2;
   FieldTop := TopField;
   for i := Low(Labels) to High(Labels) do
@@ -661,6 +664,11 @@ procedure TContactEditForm.FormShow(Sender: TObject);
 begin
   if tsContacts.ActivePage = tabMain then
     LastNameEdit.SetFocus;
+               (*
+  {$IFDEF LCL}
+  ScaleDPI(Self, DesigntimeDPI);
+  {$ENDIF}
+  *)
 end;
 
 

components/tvplanit/source/vpevnteditdlg.pas

@@ -606,6 +606,11 @@ end;
 procedure TDlgEventEdit.FormShow(Sender: TObject);
 begin
   PositionControls;
+  (*
+  {$IFDEF LCL}
+  ScaleDPI(Self, DesigntimeDPI);
+  {$ENDIF}
+    *)
   DescriptionEdit.SetFocus;
 end;
 {=====}

components/tvplanit/source/vpmisc.pas

@@ -138,6 +138,14 @@ function GetRealFontHeight(AFont: TFont): Integer;
 function DecodeLineEndings(const AText: String): String;
 function EncodeLineEndings(const AText: String): String;
 
+{$IFDEF LCL}
+procedure HighDPI(FromDPI: integer);
+procedure ScaleDPI(Control: TControl; FromDPI: integer);
+
+const
+  DesignTimeDPI = 96;
+{$ENDIF}
+
 procedure Unused(const A1); overload;
 procedure Unused(const A1, A2); overload;
 procedure Unused(const A1, A2, A3); overload;
@@ -586,6 +594,7 @@ var
 begin
   canvas := TControlCanvas.Create;
   canvas.Control := ALabel;
+  canvas.Font.Assign(ALabel.Font);
   Result := canvas.TextWidth(ALabel.Caption);
   canvas.Free;
 end;
@@ -594,7 +603,7 @@ function GetRealFontHeight(AFont: TFont): Integer;
 begin
   if AFont.Size = 0 then
    {$IFDEF LCL}
-    Result := GetFontData(AFont.Reference.Handle).Height
+    Result := GetFontData(AFont.Reference.Handle).Height * Screen.PixelsPerInch div DesignTimeDPI
    {$ELSE}
     Result := GetFontData(AFont.Handle).Height
    {$ENDIF}
@@ -645,6 +654,45 @@ begin
   Result := StringReplace(AText, LineEnding, '\n', [rfReplaceAll]);
 end;
 
+{$IFDEF LCL}
+procedure HighDPI(FromDPI: integer);
+var
+  i: integer;
+begin
+  if Screen.PixelsPerInch = FromDPI then
+    exit;
+
+  for i := 0 to Screen.FormCount - 1 do
+    ScaleDPI(Screen.Forms[i], FromDPI);
+end;
+
+procedure ScaleDPI(Control: TControl; FromDPI: integer);
+var
+  i: integer;
+  WinControl: TWinControl;
+begin
+  if Screen.PixelsPerInch = FromDPI then
+    exit;
+
+  with Control do
+  begin
+    Left := ScaleX(Left, FromDPI);
+    Top := ScaleY(Top, FromDPI);
+    Width := ScaleX(Width, FromDPI);
+    Height := ScaleY(Height, FromDPI);
+  end;
+
+  if Control is TWinControl then
+  begin
+    WinControl := TWinControl(Control);
+    if WinControl.ControlCount = 0 then
+      exit;
+    for i := 0 to WinControl.ControlCount - 1 do
+      ScaleDPI(WinControl.Controls[i], FromDPI);
+  end;
+end;
+{$ENDIF}
+
 {$PUSH}{$HINTS OFF}
 procedure Unused(const A1);
 begin