tvplanit: Update VpEdShape to scale correctly in the HighDpi mode of Lazarus 1.8.

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

components/tvplanit/source/vpedshape.lfm

@@ -1,170 +1,254 @@
 object frmEditShape: TfrmEditShape
-  Left = 772
+  Left = 663
-  Height = 243
+  Height = 270
-  Top = 248
+  Top = 242
-  Width = 426
+  Width = 444
   HorzScrollBar.Page = 362
   VertScrollBar.Page = 313
+  AutoSize = True
   BorderStyle = bsDialog
   Caption = 'Edit Shape'
-  ClientHeight = 243
+  ClientHeight = 270
-  ClientWidth = 426
+  ClientWidth = 444
   OnCreate = FormCreate
   OnDestroy = FormDestroy
   OnShow = FormShow
   Position = poScreenCenter
   ShowHint = True
-  LCLVersion = '1.7'
+  LCLVersion = '1.6.0.4'
   object btnOk: TButton
+    AnchorSideRight.Control = btnCancel
     AnchorSideBottom.Control = gbPen
     AnchorSideBottom.Side = asrBottom
-    Left = 253
+    Left = 301
-    Height = 25
+    Height = 35
-    Top = 203
+    Top = 222
-    Width = 75
+    Width = 50
-    Anchors = [akLeft, akBottom]
+    Anchors = [akRight, akBottom]
+    AutoSize = True
+    BorderSpacing.Left = 8
     Caption = 'OK'
     Default = True
     OnClick = btnOkClick
     TabOrder = 3
   end
   object btnCancel: TButton
+    AnchorSideRight.Control = gbBrush
+    AnchorSideRight.Side = asrBottom
     AnchorSideBottom.Control = gbPen
     AnchorSideBottom.Side = asrBottom
-    Left = 333
+    Left = 359
-    Height = 25
+    Height = 35
-    Top = 203
+    Top = 222
-    Width = 75
+    Width = 77
-    Anchors = [akLeft, akBottom]
+    Anchors = [akRight, akBottom]
-    BorderSpacing.Right = 8
+    AutoSize = True
+    BorderSpacing.Left = 8
     Cancel = True
     Caption = 'Cancel'
     OnClick = btnCancelClick
     TabOrder = 4
   end
   object gbBrush: TGroupBox
-    Left = 216
+    AnchorSideLeft.Control = gbPen
-    Height = 86
+    AnchorSideLeft.Side = asrBottom
-    Top = 88
+    AnchorSideTop.Control = gbPen
-    Width = 192
+    AnchorSideRight.Side = asrBottom
-    BorderSpacing.Right = 8
+    Left = 233
+    Height = 97
+    Top = 80
+    Width = 203
+    AutoSize = True
+    BorderSpacing.Left = 12
+    BorderSpacing.Right = 12
     Caption = ' Brush '
-    ClientHeight = 66
+    ClientHeight = 67
-    ClientWidth = 188
+    ClientWidth = 199
+    Font.Style = [fsBold]
+    ParentFont = False
     TabOrder = 2
     object lblBrushStyle: TLabel
-      Left = 8
+      AnchorSideTop.Control = cbBrushStyle
-      Height = 15
+      AnchorSideTop.Side = asrCenter
-      Top = 35
+      AnchorSideRight.Control = cbBrushStyle
-      Width = 28
+      Left = 13
+      Height = 25
+      Top = 32
+      Width = 42
+      Anchors = [akTop, akRight]
       BorderSpacing.Left = 8
+      BorderSpacing.Right = 8
       Caption = 'Style:'
       FocusControl = cbBrushStyle
       ParentColor = False
+      ParentFont = False
     end
     object cbBrushStyle: TComboBox
-      Left = 52
+      AnchorSideLeft.Control = cbBrushColor
+      AnchorSideTop.Control = lblBrushColor
+      AnchorSideTop.Side = asrBottom
+      AnchorSideRight.Control = cbBrushColor
+      AnchorSideRight.Side = asrBottom
+      Left = 63
       Height = 21
-      Top = 32
+      Top = 34
-      Width = 129
+      Width = 128
-      BorderSpacing.Right = 8
+      Anchors = [akTop, akLeft, akRight]
-      BorderSpacing.Bottom = 8
+      BorderSpacing.Top = 8
+      BorderSpacing.Bottom = 12
       ItemHeight = 15
       OnChange = cbBrushStyleChange
       OnDrawItem = cbBrushStyleDrawItem
+      ParentFont = False
       Style = csOwnerDrawFixed
       TabOrder = 0
     end
     object lblBrushColor: TLabel
+      AnchorSideTop.Control = cbBrushColor
+      AnchorSideTop.Side = asrCenter
+      AnchorSideRight.Control = cbBrushColor
       Left = 8
-      Height = 15
+      Height = 25
-      Top = 5
+      Top = 1
-      Width = 32
+      Width = 47
+      Anchors = [akTop, akRight]
       BorderSpacing.Left = 8
+      BorderSpacing.Right = 8
       Caption = 'Color:'
       FocusControl = cbBrushColor
       ParentColor = False
+      ParentFont = False
     end
     object cbBrushColor: TColorBox
-      Left = 52
+      AnchorSideTop.Control = gbBrush
+      AnchorSideRight.Control = gbBrush
+      AnchorSideRight.Side = asrBottom
+      Left = 63
       Height = 22
-      Top = 1
+      Top = 2
-      Width = 124
+      Width = 128
       Style = [cbStandardColors, cbExtendedColors, cbPrettyNames, cbCustomColors]
+      Anchors = [akTop, akRight]
+      BorderSpacing.Top = 2
       BorderSpacing.Right = 8
       ItemHeight = 16
       OnChange = cbBrushColorChange
+      ParentFont = False
       TabOrder = 1
     end
   end
   object gbPen: TGroupBox
-    Left = 8
+    AnchorSideLeft.Control = Owner
-    Height = 140
+    AnchorSideTop.Control = gbShapes
-    Top = 88
+    AnchorSideTop.Side = asrBottom
-    Width = 192
+    Left = 12
-    BorderSpacing.Left = 8
+    Height = 177
-    BorderSpacing.Bottom = 8
+    Top = 80
+    Width = 209
+    AutoSize = True
+    BorderSpacing.Left = 12
+    BorderSpacing.Top = 8
+    BorderSpacing.Bottom = 12
     Caption = ' Pen '
-    ClientHeight = 120
+    ClientHeight = 147
-    ClientWidth = 188
+    ClientWidth = 205
+    Font.Style = [fsBold]
+    ParentFont = False
     TabOrder = 1
     object lblPenStyle: TLabel
-      Left = 8
+      AnchorSideTop.Control = cbPenStyle
-      Height = 15
+      AnchorSideTop.Side = asrCenter
-      Top = 35
+      AnchorSideRight.Control = cbPenStyle
-      Width = 28
+      Left = 18
+      Height = 25
+      Top = 30
+      Width = 42
+      Anchors = [akTop, akRight]
       BorderSpacing.Left = 8
+      BorderSpacing.Right = 8
       Caption = 'Style:'
       FocusControl = cbPenStyle
       ParentColor = False
+      ParentFont = False
     end
     object lblPenWidth: TLabel
+      AnchorSideLeft.Side = asrBottom
+      AnchorSideTop.Control = edPenWidth
+      AnchorSideTop.Side = asrCenter
+      AnchorSideRight.Control = edPenWidth
       Left = 8
-      Height = 15
+      Height = 25
-      Top = 64
+      Top = 65
-      Width = 35
+      Width = 52
+      Anchors = [akTop, akRight]
       BorderSpacing.Left = 8
+      BorderSpacing.Right = 8
       Caption = 'Width:'
       FocusControl = edPenWidth
       ParentColor = False
+      ParentFont = False
     end
     object lblPenMode: TLabel
-      Left = 8
+      AnchorSideTop.Control = cbPenMode
-      Height = 15
+      AnchorSideTop.Side = asrCenter
-      Top = 92
+      AnchorSideRight.Control = cbPenMode
-      Width = 34
+      Left = 9
+      Height = 25
+      Top = 106
+      Width = 51
+      Anchors = [akTop, akRight]
       BorderSpacing.Left = 8
+      BorderSpacing.Right = 8
       Caption = 'Mode:'
       FocusControl = cbPenMode
       ParentColor = False
+      ParentFont = False
     end
     object cbPenStyle: TComboBox
-      Left = 52
+      AnchorSideLeft.Control = cbPenColor
+      AnchorSideTop.Control = cbPenColor
+      AnchorSideTop.Side = asrBottom
+      AnchorSideRight.Control = cbPenColor
+      AnchorSideRight.Side = asrBottom
+      Left = 68
       Height = 21
       Top = 32
-      Width = 124
+      Width = 129
-      BorderSpacing.Right = 8
+      Anchors = [akTop, akLeft, akRight]
+      BorderSpacing.Top = 8
       ItemHeight = 15
       OnChange = cbPenStyleChange
       OnDrawItem = cbPenStyleDrawItem
+      ParentFont = False
       ReadOnly = True
       Style = csOwnerDrawFixed
       TabOrder = 1
     end
     object cbPenMode: TComboBox
-      Left = 52
+      AnchorSideLeft.Control = cbPenColor
-      Height = 23
+      AnchorSideTop.Control = edPenWidth
-      Top = 88
+      AnchorSideTop.Side = asrBottom
-      Width = 124
+      AnchorSideRight.Control = cbPenColor
-      BorderSpacing.Right = 8
+      AnchorSideRight.Side = asrBottom
-      BorderSpacing.Bottom = 8
+      Left = 68
-      ItemHeight = 15
+      Height = 33
+      Top = 102
+      Width = 129
+      Anchors = [akTop, akLeft, akRight]
+      BorderSpacing.Top = 8
+      BorderSpacing.Bottom = 12
+      ItemHeight = 25
+      ParentFont = False
       TabOrder = 4
     end
     object udPenWidth: TUpDown
-      Left = 98
+      AnchorSideLeft.Control = edPenWidth
-      Height = 23
+      AnchorSideLeft.Side = asrBottom
-      Top = 60
+      AnchorSideTop.Control = edPenWidth
+      AnchorSideTop.Side = asrCenter
+      Left = 121
+      Height = 33
+      Top = 61
       Width = 12
       Associate = edPenWidth
       Min = 0
@@ -173,103 +257,135 @@ object frmEditShape: TfrmEditShape
       Wrap = False
     end
     object edPenWidth: TEdit
-      Left = 52
+      AnchorSideLeft.Control = cbPenStyle
-      Height = 23
+      AnchorSideTop.Control = cbPenStyle
-      Top = 60
+      AnchorSideTop.Side = asrBottom
-      Width = 46
+      Left = 68
+      Height = 33
+      Top = 61
+      Width = 53
+      Alignment = taRightJustify
+      BorderSpacing.Top = 8
       OnChange = edPenWidthChange
+      ParentFont = False
       TabOrder = 2
       Text = '0'
     end
     object cbPenColor: TColorBox
-      Left = 52
+      AnchorSideTop.Control = gbPen
+      AnchorSideRight.Control = gbPen
+      AnchorSideRight.Side = asrBottom
+      Left = 68
       Height = 22
-      Top = 1
+      Top = 2
-      Width = 124
+      Width = 129
       Style = [cbStandardColors, cbExtendedColors, cbPrettyNames, cbCustomColors]
+      Anchors = [akTop, akRight]
+      BorderSpacing.Top = 2
       BorderSpacing.Right = 8
       ItemHeight = 16
       OnChange = cbPenColorChange
+      ParentFont = False
       TabOrder = 0
     end
     object lblPenColor: TLabel
-      Left = 8
+      AnchorSideTop.Control = cbPenColor
-      Height = 15
+      AnchorSideTop.Side = asrCenter
-      Top = 5
+      AnchorSideRight.Control = cbPenColor
-      Width = 29
+      Left = 17
+      Height = 25
+      Top = 1
+      Width = 43
+      Anchors = [akTop, akRight]
       BorderSpacing.Left = 8
+      BorderSpacing.Right = 8
       Caption = 'Color'
       FocusControl = cbPenColor
       ParentColor = False
+      ParentFont = False
     end
   end
   object gbShapes: TGroupBox
-    Left = 8
+    AnchorSideLeft.Control = Owner
-    Height = 67
+    AnchorSideTop.Control = Owner
+    AnchorSideRight.Control = gbBrush
+    AnchorSideRight.Side = asrBottom
+    Left = 12
+    Height = 64
     Top = 8
-    Width = 400
+    Width = 424
-    BorderSpacing.Right = 8
+    Anchors = [akTop, akLeft, akRight]
+    BorderSpacing.Left = 12
+    BorderSpacing.Top = 8
     Caption = 'gbShapes'
-    ClientHeight = 47
+    ChildSizing.HorizontalSpacing = 8
-    ClientWidth = 396
+    ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+    ChildSizing.EnlargeVertical = crsHomogenousChildResize
+    ChildSizing.ShrinkHorizontal = crsHomogenousChildResize
+    ChildSizing.Layout = cclLeftToRightThenTopToBottom
+    ChildSizing.ControlsPerLine = 8
+    ClientHeight = 34
+    ClientWidth = 420
+    Font.Style = [fsBold]
+    ParentFont = False
     TabOrder = 0
     object SpeedButton1: TSpeedButton
-      Left = 12
+      Left = 8
-      Height = 32
+      Height = 26
-      Top = 4
+      Top = 0
-      Width = 32
+      Width = 44
       BorderSpacing.Left = 8
       BorderSpacing.Bottom = 8
       Down = True
       GroupIndex = 1
     end
     object SpeedButton2: TSpeedButton
-      Left = 49
+      Left = 60
-      Height = 32
+      Height = 26
-      Top = 4
+      Top = 0
-      Width = 32
+      Width = 44
       GroupIndex = 1
     end
     object SpeedButton3: TSpeedButton
-      Left = 86
+      Left = 112
-      Height = 32
+      Height = 26
-      Top = 4
+      Top = 0
-      Width = 32
+      Width = 44
       GroupIndex = 1
     end
     object SpeedButton4: TSpeedButton
-      Left = 123
+      Left = 164
-      Height = 32
+      Height = 26
-      Top = 4
+      Top = 0
-      Width = 32
+      Width = 44
       GroupIndex = 1
     end
     object SpeedButton5: TSpeedButton
-      Left = 160
+      Left = 216
-      Height = 32
+      Height = 26
-      Top = 4
+      Top = 0
-      Width = 32
+      Width = 44
       GroupIndex = 1
     end
     object SpeedButton6: TSpeedButton
-      Left = 197
+      Left = 268
-      Height = 32
+      Height = 26
-      Top = 4
+      Top = 0
-      Width = 32
+      Width = 44
       GroupIndex = 1
     end
     object SpeedButton7: TSpeedButton
-      Left = 234
+      Left = 320
-      Height = 32
+      Height = 26
-      Top = 4
+      Top = 0
-      Width = 32
+      Width = 44
       GroupIndex = 1
     end
     object SpeedButton8: TSpeedButton
-      Left = 271
+      Left = 372
-      Height = 32
+      Height = 26
-      Top = 4
+      Top = 0
-      Width = 32
+      Width = 40
       BorderSpacing.Right = 8
       BorderSpacing.Bottom = 8
       GroupIndex = 1

components/tvplanit/source/vpedshape.pas

@@ -125,130 +125,11 @@ uses
 
 { TfrmEditShape }
 
-procedure TfrmEditShape.CreateBitmaps;
+procedure TfrmEditShape.btnCancelClick(Sender: TObject);
-var
-  shape: TVpShapeType;
-  w, h: Integer;
 begin
-  w := SpeedButton1.Width div 2;
+  ModalResult := mrCancel;
-  h := SpeedButton1.Height div 2;
-  for shape := Low(TVpShapeType) to High(TVpShapeType) do begin
-    FShapeBitmaps[shape] := TBitmap.Create;
-    with FShapeBitmaps[shape] do begin
-      PixelFormat := pf24Bit;
-      SetSize(w, h);
-      Transparent := true;
-    end;
-    FShapeButtons[shape].Glyph.Assign(FShapeBitmaps[shape]);
-    case shape of
-      ustRectangle  : FShapeButtons[shape].Hint := RSRectangle;
-      ustTopLine    : FShapeButtons[shape].Hint := RSTopLine;
-      ustBottomLine : FShapeButtons[shape].Hint := RSBottomLine;
-      ustLeftLine   : FShapeButtons[shape].Hint := RSLeftLine;
-      ustRightLine  : FShapeButtons[shape].Hint := RSRightLine;
-      ustTLToBRLine : FShapeButtons[shape].Hint := RSTLToBRLine;
-      ustBLToTRLine : FShapeButtons[shape].Hint := RSBLToTRLine;
-      ustEllipse    : FShapeButtons[shape].Hint := RSEllipse;
-    end;
-  end;
 end;
 
-procedure TfrmEditShape.DestroyBitmaps;
-var
-  shape: TVpShapeType;
-begin
-  for shape := Low(TVpShapeType) to High(TVpShapeType) do
-    FShapeBitmaps[shape].Free;
-end;
-
-procedure TfrmEditShape.edPenWidthChange(Sender: TObject);
-begin
-  UpdateBitmaps;
-end;
-
-procedure TfrmEditShape.UpdateBitmap(AShape: TVpShapeType);
-var
-  pw: Integer;
-  bkcol, pcol, bcol: TColor;
-begin
-  pw := StrToInt(edPenWidth.Text);
-  pcol := cbPenColor.Selected;
-  bcol := cbBrushColor.Selected;
-  bkcol := clWhite;
-  while (bkcol = pcol) or (bkcol = bcol) do
-    bkcol := rgb(random(256), random(256), random(256));
-  with FShapeBitmaps[AShape] do begin
-    TransparentColor := bkcol;
-    Canvas.Brush.Color := bkCol;
-    Canvas.Brush.Style := bsSolid;
-    Canvas.FillRect(0, 0, Width, Height);
-    Canvas.Pen.Width := pw;
-    Canvas.Pen.Style := TPenStyle(cbPenStyle.ItemIndex);
-    Canvas.Pen.Color := pcol;
-    Canvas.Brush.Style := TBrushStyle(cbBrushStyle.ItemIndex);
-    Canvas.Brush.Color := bcol;
-    case AShape of
-      ustRectangle  : Canvas.Rectangle(pw, pw, Width-pw, Height-pw);
-      ustTopLine    : Canvas.Line(pw, pw, Width-pw, pw);
-      ustBottomLine : Canvas.Line(pw, Height-pw, Width, Height-pw);
-      ustLeftLine   : Canvas.Line(pw, pw, pw, Height-pw);
-      ustRightLine  : Canvas.Line(Width-pw, pw, Width-pw, Height);
-      ustTLToBRLine : Canvas.Line(pw, pw, Width-pw, Height-pw);
-      ustBLToTRLine : Canvas.Line(pw, Height-pw, Width-pw, pw);
-      ustEllipse    : Canvas.Ellipse(pw, pw, Width-pw, Height-pw);
-    end;
-  end;
-  FShapeButtons[AShape].Glyph.Assign(FShapeBitmaps[AShape]);
-end;
-
-procedure TfrmEditShape.UpdateBitmaps;
-var
-  shape: TVpShapeType;
-begin
-  for shape := Low(TVpShapeType) to High(TVpShapeType) do
-    UpdateBitmap(shape);
-end;
-
-procedure TfrmEditShape.FormCreate(Sender: TObject);
-begin
-  FShapeButtons[ustRectangle] := SpeedButton1;
-  FShapeButtons[ustTopLine] := SpeedButton2;
-  FShapeButtons[ustBottomLine] := SpeedButton3;
-  FShapeButtons[ustLeftLine] := SpeedButton4;
-  FShapeButtons[ustRightLine] := SpeedButton5;
-  FShapeButtons[ustTLToBRLine] := SpeedButton6;
-  FShapeButtons[ustBLToTRLine] := SpeedButton7;
-  FShapeButtons[ustEllipse] := SpeedButton8;
-
-  FillBrushStyleList;
-  FillPenStyleList;
-  FillPenModeList;
-
-  CreateBitmaps;
-  UpdateBitmaps;
-
-  SetCaptions;
-end;
-
-procedure TfrmEditShape.FormDestroy(Sender: TObject);
-begin
-  DestroyBitmaps;
-end;
-
-procedure TfrmEditShape.FormShow(Sender: TObject);
-begin
-  PositionControls;
-end;
-
-{=====}
-function TfrmEditShape.Execute(AShape: TVpPrintShape): Boolean;
-begin
-  SetData(AShape);
-  Result := ShowModal = mrOk;
-  if Result then
-    SaveData(AShape);
-end;
-{=====}
 procedure TfrmEditShape.btnOkClick(Sender: TObject);
 begin
   ModalResult := mrOk;
@@ -264,235 +145,6 @@ begin
   UpdateBitmaps;
 end;
 
-{=====}
-procedure TfrmEditShape.btnCancelClick(Sender: TObject);
-begin
-  ModalResult := mrCancel;
-end;
-{=====}
-procedure TfrmEditShape.FillBrushStyleList;
-var
-  Style: TBrushStyle;
-  StyleName: string;
-begin
-  for Style := Low(TBrushStyle) to High(TBrushStyle) do begin
-    StyleName := GetEnumName(TypeInfo(TBrushStyle), Ord(Style));
-    cbBrushStyle.Items.Add(StyleName);
-  end;
-end;
-{=====}
-procedure TfrmEditShape.FillPenModeList;
-var
-  Mode: TPenMode;
-  ModeName: string;
-begin
-  for Mode := Low(TPenMode) to High(TPenMode) do begin
-    ModeName := GetEnumName(TypeInfo(TPenMode), Ord(Mode));
-    cbPenMode.Items.Add(ModeName);
-  end;
-end;
-{=====}
-procedure TfrmEditShape.FillPenStyleList;
-var
-  Style: TPenStyle;
-  StyleName: string;
-begin
-  for Style := Low(TPenStyle) to High(TPenStyle) do begin
-    StyleName := GetEnumName(TypeInfo(TPenStyle), Ord(Style));
-    cbPenStyle.Items.Add(StyleName);
-  end;
-end;
-{=====}
-procedure TfrmEditShape.PositionControls;
-var
-  w, hc, hb: Integer;
-  shape: TVpShapeType;
-  DELTA: Integer = 8;
-  VDIST: Integer = 4;
-  cnv: TControlCanvas;
-  i: Integer;
-begin
-  AutoSize := false;
-  gbPen.AutoSize := false;
-  gbBrush.AutoSize := false;
-
-  // A workaround for the combobox height issue at higher dpi values:
-  // Create a combobox at runtime, it has the correct height, and apply its
-  // ItemHeight to the other comboboxes.
-  with TCombobox.Create(self) do
-  try
-    Parent := self;
-    hc := ItemHeight;
-  finally
-    Free;
-  end;
-  cbPenStyle.ItemHeight := hc;
-  cbPenColor.ItemHeight := hc;
-  cbBrushStyle.ItemHeight := hc;
-  cbBrushColor.ItemHeight := hc;
-
-  // Fix button hight at higher dpi.
-  hb := ScaleY(btnOK.Height, DesignTimeDPI);
-
-  DELTA := ScaleX(DELTA, DesignTimeDPI);
-  VDIST := ScaleY(VDIST, DesignTimeDPI);
-
-  { gsShapes - vert }
-  gbShapes.ClientHeight := SpeedButton1.Height + 3 * VDIST;
-  for shape := Low(TVpShapeType) to High(TVpShapeType) do
-    FShapeButtons[shape].Top := VDIST;
-
-  { gbPen - hor }
-  w := MaxValue([GetLabelWidth(lblPenColor), GetLabelWidth(lblPenStyle),
-    GetLabelWidth(lblPenWidth), GetLabelWidth(lblPenMode)]) + 2 * DELTA;
-  cbPenColor.Left := w;
-  cbPenStyle.Left := w;
-  edPenWidth.Left := w;
-  cbPenMode.Left := w;
-  lblPenColor.Left := cbPenColor.Left - GetLabelWidth(lblPenColor) - DELTA;
-  lblPenStyle.Left := cbPenColor.Left - GetLabelWidth(lblPenStyle) - DELTA;
-  lblPenWidth.Left := cbPenColor.Left - GetLabelWidth(lblPenWidth) - DELTA;
-  lblPenMode.Left := cbPenColor.Left - GetLabelWidth(lblPenMode) - DELTA;
-  udPenWidth.Left := RightOf(edPenWidth);
-
-  { gbPen - Width }
-  cnv := TControlCanvas.Create;
-  try
-    cnv.Control := cbPenStyle;
-    cnv.Font.Assign(cbPenStyle.Font);
-    w := 0;
-    for i:=0 to cbPenStyle.Items.Count-1 do
-      w := Max(w, cnv.TextWidth(cbPenStyle.Items[i]));
-    w := w + 10 + 2*cbPenStyle.Height;
-  finally
-    cnv.Free;
-  end;
-
-  cbPenColor.Width := w;
-  cbPenStyle.Width := w;
-  cbPenMode.Width := w;
-
-  { gbPen - vert }
-  lblPenColor.Top := cbPenColor.Top + (cbPenColor.Height - lblPenColor.Height) div 2;
-  cbPenStyle.Top := BottomOf(cbPenColor) + VDIST;
-  lblPenstyle.Top := cbPenStyle.Top + (cbPenStyle.Height - lblPenStyle.Height) div 2;
-  edPenWidth.Top := BottomOf(cbPenStyle) + VDIST;
-  udPenWidth.Top := edPenWidth.Top;
-  lblPenWidth.Top := edPenWidth.Top + (edPenWidth.Height - lblPenWidth.Height) div 2;
-  cbPenMode.Top := BottomOf(edPenWidth) + VDIST;
-  lblPenMode.Top := cbPenMode.Top + (cbPenMode.Height - lblPenMode.Height) div 2;
-
-  { gpPen - set size }
-  gbPen.AutoSize := true;
-  gbPen.Top := BottomOf(gbShapes) + VDIST*2;
-
-  { gbBrush - hor }
-  w := MaxValue([GetLabelWidth(lblBrushColor), GetLabelWidth(lblBrushStyle)]) + 2*DELTA;
-  cbBrushColor.Left := w;
-  cbBrushStyle.Left := w;
-  cbBrushColor.Width := cbPenColor.Width;
-  cbBrushStyle.Width := cbPenStyle.Width;
-  lblBrushColor.Left := cbBrushColor.Left - GetLabelWidth(lblBrushColor) - DELTA;
-  lblBrushStyle.Left := cbBrushColor.Left - GetLabelWidth(lblBrushStyle) - DELTA;
-  gbBrush.Left := RightOf(gbPen) + 16;
-
-  { gbBrush - ver }
-  lblBrushColor.Top := lblPenColor.Top;
-  cbBrushStyle.Top := cbPenStyle.Top;
-  lblBrushStyle.Top := lblPenStyle.Top;
-
-  { gbBrush - set size }
-  gbBrush.AutoSize := true;
-  gbBrush.Top := gbPen.Top;
-
-  { Buttons - hor }
-  btnOK.Width := Max(GetButtonWidth(btnOK), GetButtonWidth(btnCancel));
-  btnCancel.Width := btnOK.Width;
-  if btnOK.Width + DELTA + btnCancel.Width > gbBrush.Width then begin
-    cbBrushColor.Width := cbBrushColor.Width + btnOK.Width + DELTA + btnCancel.Width - gbBrush.Width;
-    cbBrushStyle.Width := cbBrushColor.Width;
-  end;
- {$IFDEF MSWINDOWS}
-  btnCancel.Left := RightOf(gbBrush) - btnCancel.Width;
-  btnOK.Left := btnCancel.Left - DELTA - btnOK.Width;
-  btnOK.TabOrder := gbBrush.TabOrder + 1;
-  btnCancel.TabOrder := btnOK.TabOrder + 1;
- {$ELSE}
-  btnOK.Left := RightOf(gbBrush) - btnOK.Width;
-  btnCancel.Left := btnOK.Left - DELTA - btnCancel.Width;
-  btnCancel.TabOrder := gbBrush.TabOrder + 1;
-  btnOK.TabOrder := btnCancel.TabOrder + 1;
- {$ENDIF}
-
-  { Buttons - vert }
-  btnOK.Height := hb;
-  btnCancel.Height := hb;
-  btnOK.Top := BottomOf(gbPen) - btnOK.Height;
-  btnCancel.Top := btnOK.Top;
-
-  { shapes - hor }
-  gbShapes.Width := RightOf(gbBrush) - gbShapes.Left;
-  w := (gbShapes.ClientWidth - 11 * DELTA) div 8;
-  for shape := Low(TVpShapeType) to High(TVpShapeType) do begin
-    if shape = Low(TVpShapeType) then
-      FShapeButtons[shape].Left := DELTA * 2 else
-      FShapeButtons[shape].Left := RightOf(FShapeButtons[pred(shape)]) + DELTA;
-    FShapeButtons[shape].Width := w;
-  end;
-
-  AutoSize := true;
-end;
-
-procedure TfrmEditShape.SaveData(AShape: TVpPrintShape);
-var
-  shape: TVpShapeType;
-begin
-  for shape := Low(TVpShapeType) to High(TVpShapeType) do
-    if FShapeButtons[shape].Down then begin
-      AShape.Shape := shape;
-      break;
-    end;
-  AShape.Pen.Style := TPenStyle(cbPenStyle.ItemIndex);
-  AShape.Pen.Width := udPenWidth.Position;
-  AShape.Pen.Color := cbPenColor.Selected;
-  AShape.Pen.Mode := TPenMode(cbPenMode.ItemIndex);
-
-  AShape.Brush.Style := TBrushStyle(cbBrushStyle.ItemIndex);
-  AShape.Brush.Color := cbBrushColor.Selected;
-end;
-{=====}
-procedure TfrmEditShape.SetCaptions;
-begin
-  Caption := RSEditShapeCaption;
-  gbShapes.Caption := RsShapeCaption;
-  gbPen.Caption := RSPenCaption;
-  lblPenColor.Caption := RSColorLbl;
-  lblPenStyle.Caption := RSStyleLbl;
-  lblPenWidth.Caption := RSWidthLbl;
-  lblPenMode.Caption := RSModeLbl;
-  gbBrush.Caption := RSBrushCaption;
-  lblBrushColor.Caption := RSColorLbl;
-  lblBrushStyle.Caption := RSStyleLbl;
-  btnOK.Caption := RSOKBtn;
-  btnCancel.Caption := RSCancelBtn;
-end;
-
-procedure TfrmEditShape.SetData(AShape: TVpPrintShape);
-begin
-  FShapeButtons[AShape.Shape].Down := true;
-
-  { pen settings }
-  cbPenColor.Selected := AShape.Pen.Color;
-  udPenWidth.Position := AShape.Pen.Width;
-  cbPenStyle.ItemIndex := ord(AShape.Pen.Style);
-  cbPenMode.ItemIndex := ord(AShape.Pen.Mode);
-
-  { brush settings }
-  cbBrushColor.Selected := AShape.Brush.Color;
-  cbBrushStyle.ItemIndex := ord(AShape.Brush.Style);
-end;
-{=====}
-
 procedure TfrmEditShape.cbBrushStyleDrawItem(Control: TWinControl;
   Index: Integer; Rect: TRect; State: TOwnerDrawState);
 const
@@ -569,8 +221,6 @@ begin
   UpdateBitmaps;
 end;
 
-{=====}
-
 procedure TfrmEditShape.cbPenStyleDrawItem(Control: TWinControl;
   Index: Integer; Rect: TRect; State: TOwnerDrawState);
 const
@@ -629,7 +279,306 @@ begin
     Pen.Color := SavePenColor;
   end;
 end;
-{=====}
+
+procedure TfrmEditShape.CreateBitmaps;
+var
+  shape: TVpShapeType;
+  w, h: Integer;
+begin
+  w := SpeedButton1.Width div 2;
+  h := SpeedButton1.Height div 2;
+  for shape := Low(TVpShapeType) to High(TVpShapeType) do begin
+    FShapeBitmaps[shape] := TBitmap.Create;
+    with FShapeBitmaps[shape] do begin
+      PixelFormat := pf24Bit;
+      SetSize(w, h);
+      Transparent := true;
+    end;
+    FShapeButtons[shape].Glyph.Assign(FShapeBitmaps[shape]);
+    case shape of
+      ustRectangle  : FShapeButtons[shape].Hint := RSRectangle;
+      ustTopLine    : FShapeButtons[shape].Hint := RSTopLine;
+      ustBottomLine : FShapeButtons[shape].Hint := RSBottomLine;
+      ustLeftLine   : FShapeButtons[shape].Hint := RSLeftLine;
+      ustRightLine  : FShapeButtons[shape].Hint := RSRightLine;
+      ustTLToBRLine : FShapeButtons[shape].Hint := RSTLToBRLine;
+      ustBLToTRLine : FShapeButtons[shape].Hint := RSBLToTRLine;
+      ustEllipse    : FShapeButtons[shape].Hint := RSEllipse;
+    end;
+  end;
+end;
+
+procedure TfrmEditShape.DestroyBitmaps;
+var
+  shape: TVpShapeType;
+begin
+  for shape := Low(TVpShapeType) to High(TVpShapeType) do
+    FShapeBitmaps[shape].Free;
+end;
+
+procedure TfrmEditShape.edPenWidthChange(Sender: TObject);
+begin
+  UpdateBitmaps;
+end;
+
+function TfrmEditShape.Execute(AShape: TVpPrintShape): Boolean;
+begin
+  SetData(AShape);
+  Result := ShowModal = mrOk;
+  if Result then
+    SaveData(AShape);
+end;
+
+procedure TfrmEditShape.FillBrushStyleList;
+var
+  Style: TBrushStyle;
+  StyleName: string;
+begin
+  for Style := Low(TBrushStyle) to High(TBrushStyle) do begin
+    StyleName := GetEnumName(TypeInfo(TBrushStyle), Ord(Style));
+    cbBrushStyle.Items.Add(StyleName);
+  end;
+end;
+
+procedure TfrmEditShape.FillPenModeList;
+var
+  Mode: TPenMode;
+  ModeName: string;
+begin
+  for Mode := Low(TPenMode) to High(TPenMode) do begin
+    ModeName := GetEnumName(TypeInfo(TPenMode), Ord(Mode));
+    cbPenMode.Items.Add(ModeName);
+  end;
+end;
+
+procedure TfrmEditShape.FillPenStyleList;
+var
+  Style: TPenStyle;
+  StyleName: string;
+begin
+  for Style := Low(TPenStyle) to High(TPenStyle) do begin
+    StyleName := GetEnumName(TypeInfo(TPenStyle), Ord(Style));
+    cbPenStyle.Items.Add(StyleName);
+  end;
+end;
+
+procedure TfrmEditShape.FormCreate(Sender: TObject);
+begin
+  FShapeButtons[ustRectangle] := SpeedButton1;
+  FShapeButtons[ustTopLine] := SpeedButton2;
+  FShapeButtons[ustBottomLine] := SpeedButton3;
+  FShapeButtons[ustLeftLine] := SpeedButton4;
+  FShapeButtons[ustRightLine] := SpeedButton5;
+  FShapeButtons[ustTLToBRLine] := SpeedButton6;
+  FShapeButtons[ustBLToTRLine] := SpeedButton7;
+  FShapeButtons[ustEllipse] := SpeedButton8;
+
+  FillBrushStyleList;
+  FillPenStyleList;
+  FillPenModeList;
+
+  CreateBitmaps;
+  UpdateBitmaps;
+
+  SetCaptions;
+end;
+
+procedure TfrmEditShape.FormDestroy(Sender: TObject);
+begin
+  DestroyBitmaps;
+end;
+
+procedure TfrmEditShape.FormShow(Sender: TObject);
+begin
+  PositionControls;
+end;
+
+procedure TfrmEditShape.PositionControls;
+var
+  w, h: Integer;
+  i: Integer;
+  cnv: TControlCanvas;
+  wbtn: Integer;
+begin
+  AutoSize := false;
+
+  udPenWidth.Width := udPenWidth.Height div 2 + 1;
+
+  // Autosize OK and Cancel buttons and put them in the right order
+  btnOK.AutoSize := true;
+  btnCancel.AutoSize := true;
+  w := Max(btnOK.Width, btnCancel.Width);
+  h := btnOK.Height;
+
+  btnOK.AutoSize := false;
+  btnOK.Width := w;
+  btnOK.Height := h;
+
+  btnCancel.AutoSize := false;
+  btnCancel.Width := w;
+  btnCancel.Height := h;
+
+  {$IFDEF MSWINDOWS}   // button order: OK - Cancel
+  btnCancel.AnchorSideRight.Control := gbBrush;
+  btnCancel.Anchors := [akBottom, akRight];
+  btnOK.AnchorSideRight.Control := btnCancel;
+  btnOK.Anchors := [akBottom, akRight];
+  btnOK.TabOrder := cbBrushStyle.TabOrder + 1;
+  btnCancel.TabOrder := btnOK.TabOrder + 1;
+  wbtn := btnCancel.Width + btnOK.Width + btnCancel.BorderSpacing.Left;
+  {$ELSE}              // button order: Cancel - OK
+  btnOK.AnchorSideRight.Control := gbBrush;
+  btnOK.Anchors := [akTop, akRight];
+  btnCancel.AnchorSideRight.Control := OKbtn;
+  btnCancel.Anchors := [akBottom, akRight];
+  btnCancel.TabOrder := cbBrushStyle.TabOrder + 1;
+  btnOK.TabOrder := btnOK.TabOrder + 1;
+  wbtn := btnCancel.Width + btnOK.Width + btnOK.BorderSpacing.Left;
+  {$ENDIF}
+
+  // A workaround for the combobox height issue at higher dpi values:
+  // Create a combobox at runtime, it has the correct height, and apply its
+  // ItemHeight to the other comboboxes.
+  with TCombobox.Create(self) do
+  try
+    Parent := self;
+    h := ItemHeight;
+  finally
+    Free;
+  end;
+  cbPenStyle.ItemHeight := h;
+  cbPenColor.ItemHeight := h;
+  cbBrushStyle.ItemHeight := h;
+  cbBrushColor.ItemHeight := h;
+
+  // Width of comboboxes
+  gbPen.AutoSize := false;
+  gbBrush.AutoSize := false;
+  cnv := TControlCanvas.Create;
+  try
+    cnv.Control := cbPenColor;
+    w := 0;
+    for i:=0 to cbPenColor.Items.Count-1 do
+      w := Max(w, cnv.TextWidth(cbPenColor.Items[i]));
+    for i:= 0 to cbPenStyle.Items.Count-1 do
+      w := max(w, cnv.TextWidth(cbPenStyle.Items[i]));
+    for i:= 0 to cbPenMode.Items.Count-1 do
+      w := Max(w, cnv.TextWidth(cbPenmode.Items[i]));
+    inc(w, GetSystemMetrics(SM_CXVSCROLL) + CbPenStyle.Height);
+    CbPenStyle.Width := w;
+    CbPenMode.Width := w;
+    CbPenColor.Width := w;
+    CbBrushColor.Width := w;
+    CbBrushStyle.Width := w;
+    gbPen.AutoSize := true;
+    gbBrush.AutoSize := true;
+    if gbBrush.Width < wbtn then begin
+      gbBrush.AutoSize := false;
+      gbBrush.Width := wbtn;
+      gbPen.AutoSize := false;
+      gbPen.Width := wbtn;
+    end;
+  finally
+    cnv.Free;
+  end;
+
+  // Make shape square
+  gbShapes.Height := gbShapes.Height + (SpeedButton1.Width - SpeedButton1.Height);
+
+  AutoSize := true;
+end;
+
+procedure TfrmEditShape.SaveData(AShape: TVpPrintShape);
+var
+  shape: TVpShapeType;
+begin
+  for shape := Low(TVpShapeType) to High(TVpShapeType) do
+    if FShapeButtons[shape].Down then begin
+      AShape.Shape := shape;
+      break;
+    end;
+  AShape.Pen.Style := TPenStyle(cbPenStyle.ItemIndex);
+  AShape.Pen.Width := udPenWidth.Position;
+  AShape.Pen.Color := cbPenColor.Selected;
+  AShape.Pen.Mode := TPenMode(cbPenMode.ItemIndex);
+
+  AShape.Brush.Style := TBrushStyle(cbBrushStyle.ItemIndex);
+  AShape.Brush.Color := cbBrushColor.Selected;
+end;
+
+procedure TfrmEditShape.SetCaptions;
+begin
+  Caption := RSEditShapeCaption;
+  gbShapes.Caption := RsShapeCaption;
+  gbPen.Caption := RSPenCaption;
+  lblPenColor.Caption := RSColorLbl;
+  lblPenStyle.Caption := RSStyleLbl;
+  lblPenWidth.Caption := RSWidthLbl;
+  lblPenMode.Caption := RSModeLbl;
+  gbBrush.Caption := RSBrushCaption;
+  lblBrushColor.Caption := RSColorLbl;
+  lblBrushStyle.Caption := RSStyleLbl;
+  btnOK.Caption := RSOKBtn;
+  btnCancel.Caption := RSCancelBtn;
+end;
+
+procedure TfrmEditShape.SetData(AShape: TVpPrintShape);
+begin
+  FShapeButtons[AShape.Shape].Down := true;
+
+  { pen settings }
+  cbPenColor.Selected := AShape.Pen.Color;
+  udPenWidth.Position := AShape.Pen.Width;
+  cbPenStyle.ItemIndex := ord(AShape.Pen.Style);
+  cbPenMode.ItemIndex := ord(AShape.Pen.Mode);
+
+  { brush settings }
+  cbBrushColor.Selected := AShape.Brush.Color;
+  cbBrushStyle.ItemIndex := ord(AShape.Brush.Style);
+end;
+
+procedure TfrmEditShape.UpdateBitmap(AShape: TVpShapeType);
+var
+  pw: Integer;
+  bkcol, pcol, bcol: TColor;
+begin
+  pw := StrToInt(edPenWidth.Text);
+  pcol := cbPenColor.Selected;
+  bcol := cbBrushColor.Selected;
+  bkcol := clWhite;
+  while (bkcol = pcol) or (bkcol = bcol) do
+    bkcol := rgb(random(256), random(256), random(256));
+  with FShapeBitmaps[AShape] do begin
+    TransparentColor := bkcol;
+    Canvas.Brush.Color := bkCol;
+    Canvas.Brush.Style := bsSolid;
+    Canvas.FillRect(0, 0, Width, Height);
+    Canvas.Pen.Width := pw;
+    Canvas.Pen.Style := TPenStyle(cbPenStyle.ItemIndex);
+    Canvas.Pen.Color := pcol;
+    Canvas.Brush.Style := TBrushStyle(cbBrushStyle.ItemIndex);
+    Canvas.Brush.Color := bcol;
+    case AShape of
+      ustRectangle  : Canvas.Rectangle(pw, pw, Width-pw, Height-pw);
+      ustTopLine    : Canvas.Line(pw, pw, Width-pw, pw);
+      ustBottomLine : Canvas.Line(pw, Height-pw, Width, Height-pw);
+      ustLeftLine   : Canvas.Line(pw, pw, pw, Height-pw);
+      ustRightLine  : Canvas.Line(Width-pw, pw, Width-pw, Height);
+      ustTLToBRLine : Canvas.Line(pw, pw, Width-pw, Height-pw);
+      ustBLToTRLine : Canvas.Line(pw, Height-pw, Width-pw, pw);
+      ustEllipse    : Canvas.Ellipse(pw, pw, Width-pw, Height-pw);
+    end;
+  end;
+  FShapeButtons[AShape].Glyph.Assign(FShapeBitmaps[AShape]);
+end;
+
+procedure TfrmEditShape.UpdateBitmaps;
+var
+  shape: TVpShapeType;
+begin
+  for shape := Low(TVpShapeType) to High(TVpShapeType) do
+    UpdateBitmap(shape);
+end;
 
 end.