From cceabed98fd4f856a7e66d963b449fdb27945146 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sat, 20 May 2017 22:12:39 +0000 Subject: [PATCH] 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 | 358 ++++++++----- components/tvplanit/source/vpedshape.pas | 655 +++++++++++------------ 2 files changed, 539 insertions(+), 474 deletions(-) diff --git a/components/tvplanit/source/vpedshape.lfm b/components/tvplanit/source/vpedshape.lfm index 15a53f12f..aa170a1b0 100644 --- a/components/tvplanit/source/vpedshape.lfm +++ b/components/tvplanit/source/vpedshape.lfm @@ -1,170 +1,254 @@ object frmEditShape: TfrmEditShape - Left = 772 - Height = 243 - Top = 248 - Width = 426 + Left = 663 + Height = 270 + Top = 242 + Width = 444 HorzScrollBar.Page = 362 VertScrollBar.Page = 313 + AutoSize = True BorderStyle = bsDialog Caption = 'Edit Shape' - ClientHeight = 243 - ClientWidth = 426 + ClientHeight = 270 + 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 - Height = 25 - Top = 203 - Width = 75 - Anchors = [akLeft, akBottom] + Left = 301 + Height = 35 + Top = 222 + Width = 50 + 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 - Height = 25 - Top = 203 - Width = 75 - Anchors = [akLeft, akBottom] - BorderSpacing.Right = 8 + Left = 359 + Height = 35 + Top = 222 + Width = 77 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 Cancel = True Caption = 'Cancel' OnClick = btnCancelClick TabOrder = 4 end object gbBrush: TGroupBox - Left = 216 - Height = 86 - Top = 88 - Width = 192 - BorderSpacing.Right = 8 + AnchorSideLeft.Control = gbPen + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = gbPen + AnchorSideRight.Side = asrBottom + Left = 233 + Height = 97 + Top = 80 + Width = 203 + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Right = 12 Caption = ' Brush ' - ClientHeight = 66 - ClientWidth = 188 + ClientHeight = 67 + ClientWidth = 199 + Font.Style = [fsBold] + ParentFont = False TabOrder = 2 object lblBrushStyle: TLabel - Left = 8 - Height = 15 - Top = 35 - Width = 28 + AnchorSideTop.Control = cbBrushStyle + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = cbBrushStyle + 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 - Width = 129 - BorderSpacing.Right = 8 - BorderSpacing.Bottom = 8 + Top = 34 + Width = 128 + Anchors = [akTop, akLeft, akRight] + 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 - Top = 5 - Width = 32 + Height = 25 + Top = 1 + 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 - Width = 124 + Top = 2 + 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 - Height = 140 - Top = 88 - Width = 192 - BorderSpacing.Left = 8 - BorderSpacing.Bottom = 8 + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = gbShapes + AnchorSideTop.Side = asrBottom + Left = 12 + Height = 177 + Top = 80 + Width = 209 + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Bottom = 12 Caption = ' Pen ' - ClientHeight = 120 - ClientWidth = 188 + ClientHeight = 147 + ClientWidth = 205 + Font.Style = [fsBold] + ParentFont = False TabOrder = 1 object lblPenStyle: TLabel - Left = 8 - Height = 15 - Top = 35 - Width = 28 + AnchorSideTop.Control = cbPenStyle + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = cbPenStyle + 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 - Top = 64 - Width = 35 + Height = 25 + Top = 65 + 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 - Height = 15 - Top = 92 - Width = 34 + AnchorSideTop.Control = cbPenMode + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = cbPenMode + 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 - BorderSpacing.Right = 8 + Width = 129 + 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 - Height = 23 - Top = 88 - Width = 124 - BorderSpacing.Right = 8 - BorderSpacing.Bottom = 8 - ItemHeight = 15 + AnchorSideLeft.Control = cbPenColor + AnchorSideTop.Control = edPenWidth + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = cbPenColor + AnchorSideRight.Side = asrBottom + Left = 68 + 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 - Height = 23 - Top = 60 + AnchorSideLeft.Control = edPenWidth + AnchorSideLeft.Side = asrBottom + 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 - Height = 23 - Top = 60 - Width = 46 + AnchorSideLeft.Control = cbPenStyle + AnchorSideTop.Control = cbPenStyle + AnchorSideTop.Side = asrBottom + 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 - Width = 124 + Top = 2 + 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 - Height = 15 - Top = 5 - Width = 29 + AnchorSideTop.Control = cbPenColor + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = cbPenColor + 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 - Height = 67 + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = gbBrush + AnchorSideRight.Side = asrBottom + Left = 12 + Height = 64 Top = 8 - Width = 400 - BorderSpacing.Right = 8 + Width = 424 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 Caption = 'gbShapes' - ClientHeight = 47 - ClientWidth = 396 + ChildSizing.HorizontalSpacing = 8 + 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 - Height = 32 - Top = 4 - Width = 32 + Left = 8 + Height = 26 + Top = 0 + Width = 44 BorderSpacing.Left = 8 BorderSpacing.Bottom = 8 Down = True GroupIndex = 1 end object SpeedButton2: TSpeedButton - Left = 49 - Height = 32 - Top = 4 - Width = 32 + Left = 60 + Height = 26 + Top = 0 + Width = 44 GroupIndex = 1 end object SpeedButton3: TSpeedButton - Left = 86 - Height = 32 - Top = 4 - Width = 32 + Left = 112 + Height = 26 + Top = 0 + Width = 44 GroupIndex = 1 end object SpeedButton4: TSpeedButton - Left = 123 - Height = 32 - Top = 4 - Width = 32 + Left = 164 + Height = 26 + Top = 0 + Width = 44 GroupIndex = 1 end object SpeedButton5: TSpeedButton - Left = 160 - Height = 32 - Top = 4 - Width = 32 + Left = 216 + Height = 26 + Top = 0 + Width = 44 GroupIndex = 1 end object SpeedButton6: TSpeedButton - Left = 197 - Height = 32 - Top = 4 - Width = 32 + Left = 268 + Height = 26 + Top = 0 + Width = 44 GroupIndex = 1 end object SpeedButton7: TSpeedButton - Left = 234 - Height = 32 - Top = 4 - Width = 32 + Left = 320 + Height = 26 + Top = 0 + Width = 44 GroupIndex = 1 end object SpeedButton8: TSpeedButton - Left = 271 - Height = 32 - Top = 4 - Width = 32 + Left = 372 + Height = 26 + Top = 0 + Width = 40 BorderSpacing.Right = 8 BorderSpacing.Bottom = 8 GroupIndex = 1 diff --git a/components/tvplanit/source/vpedshape.pas b/components/tvplanit/source/vpedshape.pas index 8c2f23a8a..e4791e4a8 100644 --- a/components/tvplanit/source/vpedshape.pas +++ b/components/tvplanit/source/vpedshape.pas @@ -125,130 +125,11 @@ uses { TfrmEditShape } -procedure TfrmEditShape.CreateBitmaps; -var - shape: TVpShapeType; - w, h: Integer; +procedure TfrmEditShape.btnCancelClick(Sender: TObject); 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; + ModalResult := mrCancel; 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.