diff --git a/DeviceForm.pas b/DeviceForm.pas index 5d906a3..a99d9d2 100644 --- a/DeviceForm.pas +++ b/DeviceForm.pas @@ -5,7 +5,7 @@ unit DeviceForm; interface uses - Classes, SysUtils, FlatButton, AppTheme, Forms, Controls, Graphics, Dialogs, + Classes, SysUtils, FlatButton, FlatEdit, FlatListBox, AppTheme, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, ComCtrls, IniFiles; // Декодирование типа платы (совпадает с MainForm.BoardTypeName) @@ -51,17 +51,17 @@ type PanelRight: TPanel; LblSaved: TLabel; - LstSaved: TListBox; + LstSaved: TFlatListBox; BtnAdd: TFlatButton; BtnRemove: TFlatButton; BtnSetAuto: TFlatButton; - EdName: TEdit; - EdIP: TEdit; + EdName: TFlatEdit; + EdIP: TFlatEdit; LblName: TLabel; LblIP: TLabel; LblFound: TLabel; - LstFound: TListBox; + LstFound: TFlatListBox; BtnDiscover: TFlatButton; BtnAddFound: TFlatButton; @@ -205,7 +205,7 @@ begin MakeLbl(PanelLeft, 'SAVED DEVICES', PAD, PAD); - LstSaved := TListBox.Create(Self); + LstSaved := TFlatListBox.Create(Self); LstSaved.Parent := PanelLeft; LstSaved.SetBounds(PAD, PAD + LabelH, LEFT_W - PAD * 2, 174); LstSaved.Color := CLR_BG; @@ -217,7 +217,7 @@ begin FieldTop := 212; MakeLbl(PanelLeft, 'Name:', PAD, FieldTop + 5); - EdName := TEdit.Create(Self); + EdName := TFlatEdit.Create(Self); EdName.Parent := PanelLeft; EdName.SetBounds(76, FieldTop, LEFT_W - 76 - PAD, EDIT_H); EdName.Color := CLR_BG; @@ -227,7 +227,7 @@ begin Inc(FieldTop, EDIT_H + 10); MakeLbl(PanelLeft, 'IP:', PAD, FieldTop + 5); - EdIP := TEdit.Create(Self); + EdIP := TFlatEdit.Create(Self); EdIP.Parent := PanelLeft; EdIP.SetBounds(76, FieldTop, LEFT_W - 76 - PAD, EDIT_H); EdIP.Color := CLR_BG; @@ -259,7 +259,7 @@ begin MakeLbl(PanelRight, 'DISCOVERED DEVICES', PAD, PAD); - LstFound := TListBox.Create(Self); + LstFound := TFlatListBox.Create(Self); LstFound.Parent := PanelRight; LstFound.SetBounds(PAD, PAD + LabelH, RIGHT_W - PAD * 2, 250); LstFound.Color := CLR_BG; @@ -349,14 +349,8 @@ begin Font.Color := T.Text; if PanelLeft <> nil then PanelLeft.Color := T.Panel; if PanelRight <> nil then PanelRight.Color := T.Panel; - if LstSaved <> nil then begin - LstSaved.Color := T.BG; - LstSaved.Font.Color := T.Text; - end; - if LstFound <> nil then begin - LstFound.Color := T.BG; - LstFound.Font.Color := T.Text; - end; + if LstSaved <> nil then LstSaved.SetAppTheme(T); + if LstFound <> nil then LstFound.SetAppTheme(T); StyleButton(BtnAdd, False); StyleButton(BtnRemove, False); StyleButton(BtnSetAuto, False); @@ -364,17 +358,8 @@ begin StyleButton(BtnAddFound, False); StyleButton(BtnCancel, False); StyleConnectButton(BtnConnect); - // Edit fields: white bg for light theme, dark bg for dark theme - if Integer(T.BG) > Integer(TColor($00808080)) then - begin - if EdName <> nil then begin EdName.Color := TColor($00FFFFFF); EdName.Font.Color := TColor($00202020); end; - if EdIP <> nil then begin EdIP.Color := TColor($00FFFFFF); EdIP.Font.Color := TColor($00202020); end; - end - else - begin - if EdName <> nil then begin EdName.Color := TColor($00121212); EdName.Font.Color := TColor($00E0E0E0); end; - if EdIP <> nil then begin EdIP.Color := TColor($00121212); EdIP.Font.Color := TColor($00E0E0E0); end; - end; + if EdName <> nil then EdName.SetAppTheme(T); + if EdIP <> nil then EdIP.SetAppTheme(T); WalkLabels(Self); Invalidate; end; diff --git a/FlatCheckBox.pas b/FlatCheckBox.pas new file mode 100644 index 0000000..6315efb --- /dev/null +++ b/FlatCheckBox.pas @@ -0,0 +1,285 @@ +unit FlatCheckBox; + +{ Custom checkbox with canvas rendering. + Use instead of TCheckBox where native widgetset styling is undesirable. } + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Controls, Graphics, Forms, LCLType, LMessages, Types, + AppTheme; + +type + TFlatCheckBox = class(TCustomControl) + private + FChecked: Boolean; + FHot: Boolean; + FDown: Boolean; + FOnChange: TNotifyEvent; + FClrBG: TColor; + FClrBox: TColor; + FClrBoxChecked: TColor; + FClrBoxHot: TColor; + FClrBorder: TColor; + FClrBorderHot: TColor; + FClrCheck: TColor; + FClrText: TColor; + FClrTextDisabled: TColor; + function DpiScale(V: Integer): Integer; + procedure SetChecked(V: Boolean); + procedure DoChange; + procedure CMTextChanged(var Msg: TLMessage); message CM_TEXTCHANGED; + protected + procedure Paint; override; + procedure MouseEnter; override; + procedure MouseLeave; override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + procedure KeyDown(var Key: Word; Shift: TShiftState); override; + public + constructor Create(AOwner: TComponent); override; + procedure SetAppTheme(const T: TAppTheme); + + property Checked: Boolean read FChecked write SetChecked; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + property Align; + property Anchors; + property Caption; + property Enabled; + property Font; + property ParentShowHint; + property PopupMenu; + property ShowHint; + property TabOrder; + property TabStop; + property Tag; + property Visible; + property OnClick; + end; + +implementation + +const + BASE_BOX_SIZE = 16; + BASE_BOX_LEFT = 1; + BASE_TEXT_GAP = 8; + BASE_CORNER = 2; + +constructor TFlatCheckBox.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + ControlStyle := ControlStyle + [csOpaque, csCaptureMouse, csClickEvents]; + Width := 160; + Height := 22; + TabStop := True; + Cursor := crHandPoint; + + Font.Name := 'Courier New'; + Font.Size := 9; + + FClrBG := TColor($00181818); + FClrBox := TColor($001A1A1A); + FClrBoxChecked := TColor($000C3010); + FClrBoxHot := TColor($00282828); + FClrBorder := TColor($00444444); + FClrBorderHot := TColor($00387838); + FClrCheck := TColor($0000FF88); + FClrText := TColor($00CCCCCC); + FClrTextDisabled := TColor($00666666); +end; + +function TFlatCheckBox.DpiScale(V: Integer): Integer; +begin + Result := MulDiv(V, Screen.PixelsPerInch, 96); + if (V > 0) and (Result < 1) then + Result := 1; +end; + +procedure TFlatCheckBox.SetAppTheme(const T: TAppTheme); +begin + FClrBG := T.Panel; + FClrBox := T.BtnNorm; + FClrBoxChecked := T.BtnActive; + FClrBoxHot := T.BtnHot; + FClrBorder := T.BtnBorderNorm; + FClrBorderHot := T.BtnBorderActive; + FClrCheck := T.BtnTextActive; + FClrText := T.Text; + FClrTextDisabled := T.TextDim; + Font.Color := T.Text; + Invalidate; +end; + +procedure TFlatCheckBox.SetChecked(V: Boolean); +begin + if FChecked = V then Exit; + FChecked := V; + Invalidate; + DoChange; +end; + +procedure TFlatCheckBox.DoChange; +begin + if Assigned(FOnChange) then + FOnChange(Self); +end; + +procedure TFlatCheckBox.CMTextChanged(var Msg: TLMessage); +begin + Invalidate; +end; + +procedure TFlatCheckBox.Paint; +var + BoxSize, BoxLeft, BoxTop, TextGap, TextTop, TX, Corner: Integer; + R: TRect; + BoxColor, BorderColor, TextColor: TColor; + + procedure DrawCheckMark(const AR: TRect); + var + P: array[0..6] of TPoint; + W, H: Integer; + + function PX(V: Integer): Integer; + begin + Result := AR.Left + MulDiv(V, W, BASE_BOX_SIZE); + end; + + function PY(V: Integer): Integer; + begin + Result := AR.Top + MulDiv(V, H, BASE_BOX_SIZE); + end; + begin + W := AR.Right - AR.Left; + H := AR.Bottom - AR.Top; + P[0] := Point(PX(4), PY(8)); + P[1] := Point(PX(6), PY(8)); + P[2] := Point(PX(7), PY(10)); + P[3] := Point(PX(12), PY(4)); + P[4] := Point(PX(13), PY(6)); + P[5] := Point(PX(8), PY(12)); + P[6] := Point(PX(6), PY(12)); + + Canvas.Brush.Color := FClrCheck; + Canvas.Brush.Style := bsSolid; + Canvas.Pen.Style := psClear; + Canvas.Polygon(P); + end; +begin + Canvas.Brush.Color := FClrBG; + Canvas.Brush.Style := bsSolid; + Canvas.Pen.Style := psClear; + Canvas.FillRect(ClientRect); + + BoxSize := DpiScale(BASE_BOX_SIZE); + if BoxSize > Height - DpiScale(4) then + BoxSize := Height - DpiScale(4); + if BoxSize < DpiScale(10) then + BoxSize := DpiScale(10); + BoxLeft := DpiScale(BASE_BOX_LEFT); + BoxTop := (Height - BoxSize) div 2; + TextGap := DpiScale(BASE_TEXT_GAP); + Corner := DpiScale(BASE_CORNER); + R := Rect(BoxLeft, BoxTop, BoxLeft + BoxSize, BoxTop + BoxSize); + + if FChecked then + BoxColor := FClrBoxChecked + else if FHot or Focused then + BoxColor := FClrBoxHot + else + BoxColor := FClrBox; + + if FHot or Focused then + begin + BorderColor := FClrBorderHot; + end + else + BorderColor := FClrBorder; + + if not Enabled then + begin + BoxColor := FClrBG; + BorderColor := FClrBorder; + TextColor := FClrTextDisabled; + end + else + TextColor := FClrText; + + Canvas.Brush.Color := BoxColor; + Canvas.Brush.Style := bsSolid; + Canvas.Pen.Color := BorderColor; + Canvas.Pen.Style := psSolid; + Canvas.Pen.Width := 1; + Canvas.RoundRect(R.Left, R.Top, R.Right - 1, R.Bottom - 1, CORNER * 2, CORNER * 2); + + if FChecked then + DrawCheckMark(R); + + TX := R.Right + TextGap; + TextTop := (Height - Canvas.TextHeight('Ag')) div 2; + Canvas.Brush.Style := bsClear; + Canvas.Font.Assign(Font); + Canvas.Font.Color := TextColor; + Canvas.TextOut(TX, TextTop, Caption); +end; + +procedure TFlatCheckBox.MouseEnter; +begin + inherited; + FHot := True; + Invalidate; +end; + +procedure TFlatCheckBox.MouseLeave; +begin + inherited; + FHot := False; + FDown := False; + Invalidate; +end; + +procedure TFlatCheckBox.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + inherited; + if (Button = mbLeft) and Enabled then + begin + SetFocus; + FDown := True; + Invalidate; + end; +end; + +procedure TFlatCheckBox.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + inherited; + if (Button = mbLeft) and FDown and Enabled then + begin + FDown := False; + if PtInRect(ClientRect, Point(X, Y)) then + begin + Checked := not Checked; + Click; + end + else + Invalidate; + end; +end; + +procedure TFlatCheckBox.KeyDown(var Key: Word; Shift: TShiftState); +begin + inherited; + if Enabled and ((Key = VK_SPACE) or (Key = VK_RETURN)) then + begin + Checked := not Checked; + Click; + Key := 0; + end; +end; + +end. diff --git a/FlatComboBox.pas b/FlatComboBox.pas new file mode 100644 index 0000000..e6c7aef --- /dev/null +++ b/FlatComboBox.pas @@ -0,0 +1,532 @@ +unit FlatComboBox; + +{ Custom drop-down list with canvas rendering. + Use instead of TComboBox where native widgetset styling is undesirable. } + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Controls, Graphics, Forms, LCLType, LMessages, Types, + Math, AppTheme; + +type + TFlatComboBox = class; + + TFlatComboPopup = class(TCustomControl) + private + FCombo: TFlatComboBox; + FHotIndex: Integer; + FTopIndex: Integer; + function ItemAt(Y: Integer): Integer; + procedure EnsureHotVisible; + protected + procedure Paint; override; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + procedure DoExit; override; + procedure KeyDown(var Key: Word; Shift: TShiftState); override; + function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override; + function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override; + public + constructor CreatePopup(AOwner: TComponent; ACombo: TFlatComboBox); reintroduce; + end; + + TFlatComboBox = class(TCustomControl) + private + FItems: TStringList; + FItemIndex: Integer; + FHot: Boolean; + FDown: Boolean; + FPopup: TFlatComboPopup; + FOnChange: TNotifyEvent; + FClrOuterBG: TColor; + FClrBG: TColor; + FClrBGHot: TColor; + FClrBorder: TColor; + FClrBorderHot: TColor; + FClrText: TColor; + FClrTextDim: TColor; + FClrPopupBG: TColor; + FClrPopupHot: TColor; + FClrPopupSel: TColor; + function DpiScale(V: Integer): Integer; + function ItemHeight: Integer; + function ArrowWidth: Integer; + procedure ItemsChanged(Sender: TObject); + procedure SetItemIndex(V: Integer); + function GetText: string; + procedure SetText(const V: string); + procedure DoChange; + procedure ClosePopup; + procedure CMTextChanged(var Msg: TLMessage); message CM_TEXTCHANGED; + protected + procedure Paint; override; + procedure MouseEnter; override; + procedure MouseLeave; override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + procedure KeyDown(var Key: Word; Shift: TShiftState); override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure SetAppTheme(const T: TAppTheme); + procedure DropDown; + + property Items: TStringList read FItems; + property ItemIndex: Integer read FItemIndex write SetItemIndex; + property Text: string read GetText write SetText; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + property Align; + property Anchors; + property Enabled; + property Font; + property ParentShowHint; + property PopupMenu; + property ShowHint; + property TabOrder; + property TabStop; + property Tag; + property Visible; + end; + +implementation + +const + BASE_ITEM_H = 24; + BASE_ARROW_W = 24; + BASE_PAD = 8; + +{ TFlatComboPopup } + +constructor TFlatComboPopup.CreatePopup(AOwner: TComponent; ACombo: TFlatComboBox); +begin + inherited Create(AOwner); + FCombo := ACombo; + FHotIndex := ACombo.ItemIndex; + FTopIndex := Max(0, FHotIndex - 4); + TabStop := True; + Cursor := crDefault; + Color := ACombo.FClrPopupBG; +end; + +function TFlatComboPopup.ItemAt(Y: Integer): Integer; +begin + Result := FTopIndex + Y div FCombo.ItemHeight; + if (Result < 0) or (Result >= FCombo.Items.Count) then + Result := -1; +end; + +procedure TFlatComboPopup.EnsureHotVisible; +var + VisibleCount: Integer; +begin + VisibleCount := Max(1, Height div FCombo.ItemHeight); + if FHotIndex < FTopIndex then + FTopIndex := FHotIndex + else if FHotIndex >= FTopIndex + VisibleCount then + FTopIndex := FHotIndex - VisibleCount + 1; + FTopIndex := EnsureRange(FTopIndex, 0, Max(0, FCombo.Items.Count - VisibleCount)); +end; + +procedure TFlatComboPopup.Paint; +var + i, ItemIdx, Y, TextY, VisibleCount: Integer; + R: TRect; +begin + Canvas.Brush.Color := FCombo.FClrPopupBG; + Canvas.Brush.Style := bsSolid; + Canvas.Pen.Style := psClear; + Canvas.FillRect(ClientRect); + + Canvas.Font.Assign(FCombo.Font); + VisibleCount := Max(1, Height div FCombo.ItemHeight); + for i := 0 to VisibleCount - 1 do + begin + ItemIdx := FTopIndex + i; + if ItemIdx >= FCombo.Items.Count then Break; + Y := i * FCombo.ItemHeight; + R := Rect(0, Y, Width, Y + FCombo.ItemHeight); + if ItemIdx = FCombo.ItemIndex then + Canvas.Brush.Color := FCombo.FClrPopupSel + else if ItemIdx = FHotIndex then + Canvas.Brush.Color := FCombo.FClrPopupHot + else + Canvas.Brush.Color := FCombo.FClrPopupBG; + Canvas.FillRect(R); + + Canvas.Brush.Style := bsClear; + Canvas.Font.Color := FCombo.FClrText; + TextY := Y + (FCombo.ItemHeight - Canvas.TextHeight('Ag')) div 2; + Canvas.TextOut(FCombo.DpiScale(BASE_PAD), TextY, FCombo.Items[ItemIdx]); + Canvas.Brush.Style := bsSolid; + end; + + Canvas.Pen.Color := FCombo.FClrBorder; + Canvas.Pen.Style := psSolid; + Canvas.Brush.Style := bsClear; + Canvas.Rectangle(0, 0, Width, Height); +end; + +procedure TFlatComboPopup.MouseMove(Shift: TShiftState; X, Y: Integer); +var + Idx: Integer; +begin + inherited; + if PtInRect(ClientRect, Point(X, Y)) then + Idx := ItemAt(Y) + else + Idx := -1; + if FHotIndex = Idx then Exit; + FHotIndex := Idx; + Invalidate; +end; + +procedure TFlatComboPopup.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +var + Idx: Integer; +begin + inherited; + if Button <> mbLeft then Exit; + if PtInRect(ClientRect, Point(X, Y)) then + begin + Idx := ItemAt(Y); + if Idx >= 0 then + FCombo.ItemIndex := Idx; + end; + FCombo.ClosePopup; +end; + +procedure TFlatComboPopup.DoExit; +begin + inherited; + if Assigned(FCombo) then + FCombo.ClosePopup; +end; + +procedure TFlatComboPopup.KeyDown(var Key: Word; Shift: TShiftState); +begin + inherited; + case Key of + VK_ESCAPE: + begin + FCombo.ClosePopup; + Key := 0; + end; + VK_RETURN: + begin + if FHotIndex >= 0 then + FCombo.ItemIndex := FHotIndex; + FCombo.ClosePopup; + Key := 0; + end; + VK_UP: + begin + FHotIndex := EnsureRange(FHotIndex - 1, 0, FCombo.Items.Count - 1); + EnsureHotVisible; + Invalidate; + Key := 0; + end; + VK_DOWN: + begin + FHotIndex := EnsureRange(FHotIndex + 1, 0, FCombo.Items.Count - 1); + EnsureHotVisible; + Invalidate; + Key := 0; + end; + end; +end; + +function TFlatComboPopup.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; +begin + FTopIndex := Max(0, FTopIndex - 1); + Invalidate; + Result := True; +end; + +function TFlatComboPopup.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; +var + VisibleCount: Integer; +begin + VisibleCount := Max(1, Height div FCombo.ItemHeight); + FTopIndex := Min(Max(0, FCombo.Items.Count - VisibleCount), FTopIndex + 1); + Invalidate; + Result := True; +end; + +{ TFlatComboBox } + +constructor TFlatComboBox.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + ControlStyle := ControlStyle + [csOpaque, csCaptureMouse, csClickEvents]; + FItems := TStringList.Create; + FItems.OnChange := @ItemsChanged; + FItemIndex := -1; + Width := 140; + Height := DpiScale(26); + TabStop := True; + Cursor := crDefault; + + Font.Name := 'Courier New'; + Font.Size := 9; + + FClrBG := TColor($001A1A1A); + FClrOuterBG := TColor($00181818); + FClrBGHot := TColor($00282828); + FClrBorder := TColor($00444444); + FClrBorderHot := TColor($00387838); + FClrText := TColor($00E0E0E0); + FClrTextDim := TColor($00888888); + FClrPopupBG := TColor($00181818); + FClrPopupHot := TColor($000C3010); + FClrPopupSel := TColor($00183618); +end; + +function TFlatComboBox.DpiScale(V: Integer): Integer; +begin + Result := MulDiv(V, Screen.PixelsPerInch, 96); + if (V > 0) and (Result < 1) then + Result := 1; +end; + +function TFlatComboBox.ItemHeight: Integer; +begin + Result := DpiScale(BASE_ITEM_H); + if Result < Canvas.TextHeight('Ag') + DpiScale(8) then + Result := Canvas.TextHeight('Ag') + DpiScale(8); +end; + +function TFlatComboBox.ArrowWidth: Integer; +begin + Result := DpiScale(BASE_ARROW_W); +end; + +destructor TFlatComboBox.Destroy; +begin + ClosePopup; + FItems.Free; + inherited Destroy; +end; + +procedure TFlatComboBox.SetAppTheme(const T: TAppTheme); +begin + FClrBG := T.BtnNorm; + FClrOuterBG := T.Panel; + FClrBGHot := T.BtnHot; + FClrBorder := T.Border; + FClrBorderHot := T.Border; + FClrText := T.Text; + FClrTextDim := T.TextDim; + FClrPopupBG := T.Panel; + FClrPopupHot := T.BtnActive; + FClrPopupSel := T.SliderTrackFill; + Font.Color := T.Text; + Invalidate; +end; + +procedure TFlatComboBox.ItemsChanged(Sender: TObject); +begin + if FItemIndex >= FItems.Count then + FItemIndex := FItems.Count - 1; + if FItems.Count = 0 then + FItemIndex := -1; + Invalidate; +end; + +procedure TFlatComboBox.SetItemIndex(V: Integer); +begin + V := EnsureRange(V, -1, FItems.Count - 1); + if FItemIndex = V then Exit; + FItemIndex := V; + Invalidate; + DoChange; +end; + +function TFlatComboBox.GetText: string; +begin + if (FItemIndex >= 0) and (FItemIndex < FItems.Count) then + Result := FItems[FItemIndex] + else + Result := ''; +end; + +procedure TFlatComboBox.SetText(const V: string); +var + Idx: Integer; +begin + Idx := FItems.IndexOf(V); + if Idx >= 0 then + ItemIndex := Idx + else + begin + FItems.Add(V); + ItemIndex := FItems.Count - 1; + end; +end; + +procedure TFlatComboBox.DoChange; +begin + if Assigned(FOnChange) then + FOnChange(Self); +end; + +procedure TFlatComboBox.ClosePopup; +begin + if FPopup = nil then Exit; + FPopup.MouseCapture := False; + FreeAndNil(FPopup); + FDown := False; + Invalidate; +end; + +procedure TFlatComboBox.DropDown; +var + Root: TCustomForm; + P: TPoint; + H, IH: Integer; +begin + if (FPopup <> nil) or (FItems.Count = 0) then Exit; + Root := GetParentForm(Self); + if Root = nil then Exit; + P := Root.ScreenToClient(ClientToScreen(Point(0, Height))); + IH := ItemHeight; + H := Min(FItems.Count * IH + 1, IH * 10 + 1); + if P.Y + H > Root.ClientHeight then + P.Y := Root.ScreenToClient(ClientToScreen(Point(0, 0))).Y - H; + if P.Y < 0 then + P.Y := 0; + + FPopup := TFlatComboPopup.CreatePopup(Root, Self); + FPopup.Parent := Root; + FPopup.SetBounds(P.X, P.Y, Width, H); + FPopup.BringToFront; + FPopup.Visible := True; + FPopup.SetFocus; + FPopup.MouseCapture := True; + FDown := True; + Invalidate; +end; + +procedure TFlatComboBox.CMTextChanged(var Msg: TLMessage); +begin + Invalidate; +end; + +procedure TFlatComboBox.Paint; +var + R: TRect; + TextY, MidY, X, Pad, AW, Chevron: Integer; + BG, Bdr: TColor; + S: string; +begin + R := ClientRect; + if FHot or FDown or Focused then + begin + BG := FClrBGHot; + Bdr := FClrBorderHot; + end + else + begin + BG := FClrBG; + Bdr := FClrBorder; + end; + + Canvas.Brush.Color := FClrOuterBG; + Canvas.Brush.Style := bsSolid; + Canvas.Pen.Style := psClear; + Canvas.FillRect(R); + + Canvas.Brush.Color := BG; + Canvas.Brush.Style := bsSolid; + Canvas.Pen.Color := Bdr; + Canvas.Pen.Style := psSolid; + Canvas.Pen.Width := 1; + Canvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom); + + Pad := DpiScale(BASE_PAD); + AW := ArrowWidth; + Canvas.Font.Assign(Font); + if Enabled then + Canvas.Font.Color := FClrText + else + Canvas.Font.Color := FClrTextDim; + Canvas.Brush.Style := bsClear; + S := Text; + TextY := (Height - Canvas.TextHeight('Ag')) div 2; + Canvas.TextRect(Rect(Pad, 0, Width - AW - DpiScale(4), Height), Pad, TextY, S); + + X := Width - AW div 2; + MidY := Height div 2; + Chevron := DpiScale(4); + Canvas.Pen.Color := FClrTextDim; + Canvas.Pen.Style := psSolid; + Canvas.Pen.Width := Max(1, DpiScale(2)); + Canvas.Line(X - Chevron, MidY - Chevron div 2, X, MidY + Chevron div 2); + Canvas.Line(X, MidY + Chevron div 2, X + Chevron, MidY - Chevron div 2); + Canvas.Pen.Width := 1; +end; + +procedure TFlatComboBox.MouseEnter; +begin + inherited; + FHot := True; + Invalidate; +end; + +procedure TFlatComboBox.MouseLeave; +begin + inherited; + FHot := False; + Invalidate; +end; + +procedure TFlatComboBox.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + inherited; + if (Button = mbLeft) and Enabled then + SetFocus; +end; + +procedure TFlatComboBox.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + inherited; + if (Button = mbLeft) and Enabled and PtInRect(ClientRect, Point(X, Y)) then + begin + if FPopup <> nil then + ClosePopup + else + DropDown; + end; +end; + +procedure TFlatComboBox.KeyDown(var Key: Word; Shift: TShiftState); +begin + inherited; + case Key of + VK_SPACE, VK_RETURN: + begin + DropDown; + Key := 0; + end; + VK_UP: + begin + ItemIndex := FItemIndex - 1; + Key := 0; + end; + VK_DOWN: + begin + ItemIndex := FItemIndex + 1; + Key := 0; + end; + end; +end; + +end. diff --git a/FlatEdit.pas b/FlatEdit.pas new file mode 100644 index 0000000..c8e751a --- /dev/null +++ b/FlatEdit.pas @@ -0,0 +1,586 @@ +unit FlatEdit; + +{ Custom single-line edit with canvas rendering. + Use instead of TEdit where native widgetset styling is undesirable. } + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Controls, Graphics, Forms, LCLType, LMessages, Types, + Clipbrd, Math, LazUTF8, AppTheme; + +type + TFlatEdit = class(TCustomControl) + private + FText: string; + FTextHint: string; + FPasswordChar: Char; + FMaxLength: Integer; + FCaretPos: Integer; + FSelStart: Integer; + FSelLen: Integer; + FHot: Boolean; + FEditing: Boolean; + FDragging: Boolean; + FOnChange: TNotifyEvent; + FClrOuterBG: TColor; + FClrBG: TColor; + FClrBGHot: TColor; + FClrBorder: TColor; + FClrText: TColor; + FClrTextDim: TColor; + FClrSelBG: TColor; + FClrSelText: TColor; + function DpiScale(V: Integer): Integer; + function DisplayText: string; + function TextLen: Integer; + function HasSelection: Boolean; + function SelFirst: Integer; + function SelAfter: Integer; + function CaretPosAtX(X: Integer): Integer; + procedure SetText(const V: string); + procedure SetTextHint(const V: string); + procedure SetPasswordChar(V: Char); + procedure SetMaxLength(V: Integer); + procedure SetCaretPos(V: Integer); + procedure DeleteSelection; + procedure InsertText(const S: string); + procedure DoChange; + procedure AppUserInput(Sender: TObject; Msg: Cardinal); + procedure CMTextChanged(var Msg: TLMessage); message CM_TEXTCHANGED; + protected + procedure Paint; override; + procedure MouseEnter; override; + procedure MouseLeave; override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + procedure DblClick; override; + procedure KeyDown(var Key: Word; Shift: TShiftState); override; + procedure KeyPress(var Key: char); override; + procedure UTF8KeyPress(var UTF8Key: TUTF8Char); override; + procedure DoEnter; override; + procedure DoExit; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure SetAppTheme(const T: TAppTheme); + procedure SelectAll; + + property Text: string read FText write SetText; + property TextHint: string read FTextHint write SetTextHint; + property PasswordChar: Char read FPasswordChar write SetPasswordChar; + property MaxLength: Integer read FMaxLength write SetMaxLength; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + property Align; + property Anchors; + property Enabled; + property Font; + property ParentShowHint; + property PopupMenu; + property ShowHint; + property TabOrder; + property TabStop; + property Tag; + property Visible; + property OnEnter; + property OnExit; + property OnKeyDown; + property OnKeyPress; + end; + +implementation + +const + BASE_PAD_X = 8; + +constructor TFlatEdit.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + ControlStyle := ControlStyle + [csOpaque, csCaptureMouse, csClickEvents]; + Width := 120; + Height := DpiScale(26); + TabStop := True; + Cursor := crIBeam; + FMaxLength := 0; + FCaretPos := 0; + FSelStart := 0; + FSelLen := 0; + FEditing := False; + FDragging := False; + + Font.Name := 'Courier New'; + Font.Size := 9; + + FClrOuterBG := TColor($00181818); + FClrBG := TColor($001A1A1A); + FClrBGHot := TColor($00202020); + FClrBorder := TColor($00444444); + FClrText := TColor($00E0E0E0); + FClrTextDim := TColor($00666666); + FClrSelBG := TColor($000C3010); + FClrSelText := TColor($0000FF88); + Application.AddOnUserInputHandler(@AppUserInput); +end; + +destructor TFlatEdit.Destroy; +begin + Application.RemoveOnUserInputHandler(@AppUserInput); + inherited Destroy; +end; + +function TFlatEdit.DpiScale(V: Integer): Integer; +begin + Result := MulDiv(V, Screen.PixelsPerInch, 96); + if (V > 0) and (Result < 1) then + Result := 1; +end; + +procedure TFlatEdit.SetAppTheme(const T: TAppTheme); +begin + FClrOuterBG := T.Panel; + FClrBG := T.BtnNorm; + FClrBGHot := T.BtnHot; + FClrBorder := T.Border; + FClrText := T.Text; + FClrTextDim := T.TextDim; + FClrSelBG := T.BtnActive; + FClrSelText := T.BtnTextActive; + Font.Color := T.Text; + Invalidate; +end; + +function TFlatEdit.DisplayText: string; +begin + if FPasswordChar <> #0 then + Result := StringOfChar(FPasswordChar, TextLen) + else + Result := FText; +end; + +function TFlatEdit.TextLen: Integer; +begin + Result := UTF8Length(FText); +end; + +function TFlatEdit.HasSelection: Boolean; +begin + Result := FSelLen <> 0; +end; + +function TFlatEdit.SelFirst: Integer; +begin + if FSelLen >= 0 then + Result := FSelStart + else + Result := FSelStart + FSelLen; +end; + +function TFlatEdit.SelAfter: Integer; +begin + if FSelLen >= 0 then + Result := FSelStart + FSelLen + else + Result := FSelStart; +end; + +function TFlatEdit.CaretPosAtX(X: Integer): Integer; +var + I, Pad, RelX, BestDist, Dist: Integer; + S: string; +begin + Pad := DpiScale(BASE_PAD_X); + RelX := X - Pad; + S := DisplayText; + Result := 0; + BestDist := Abs(RelX); + for I := 1 to UTF8Length(S) do + begin + Dist := Abs(RelX - Canvas.TextWidth(UTF8Copy(S, 1, I))); + if Dist < BestDist then + begin + BestDist := Dist; + Result := I; + end; + end; +end; + +procedure TFlatEdit.SetText(const V: string); +var + S: string; +begin + S := V; + if (FMaxLength > 0) and (UTF8Length(S) > FMaxLength) then + S := UTF8Copy(S, 1, FMaxLength); + if FText = S then Exit; + FText := S; + FCaretPos := EnsureRange(FCaretPos, 0, TextLen); + FSelStart := FCaretPos; + FSelLen := 0; + Invalidate; + DoChange; +end; + +procedure TFlatEdit.SetTextHint(const V: string); +begin + if FTextHint = V then Exit; + FTextHint := V; + Invalidate; +end; + +procedure TFlatEdit.SetPasswordChar(V: Char); +begin + if FPasswordChar = V then Exit; + FPasswordChar := V; + Invalidate; +end; + +procedure TFlatEdit.SetMaxLength(V: Integer); +begin + FMaxLength := Max(0, V); + if (FMaxLength > 0) and (UTF8Length(FText) > FMaxLength) then + SetText(UTF8Copy(FText, 1, FMaxLength)); +end; + +procedure TFlatEdit.SetCaretPos(V: Integer); +begin + FCaretPos := EnsureRange(V, 0, TextLen); + FSelStart := FCaretPos; + FSelLen := 0; + Invalidate; +end; + +procedure TFlatEdit.DeleteSelection; +var + A, B: Integer; +begin + if not HasSelection then Exit; + A := SelFirst; + B := SelAfter; + UTF8Delete(FText, A + 1, B - A); + FCaretPos := A; + FSelStart := FCaretPos; + FSelLen := 0; +end; + +procedure TFlatEdit.InsertText(const S: string); +var + AddText: string; + SpaceLeft: Integer; +begin + if S = '' then Exit; + DeleteSelection; + AddText := S; + if FMaxLength > 0 then + begin + SpaceLeft := FMaxLength - TextLen; + if SpaceLeft <= 0 then Exit; + AddText := UTF8Copy(AddText, 1, SpaceLeft); + end; + UTF8Insert(AddText, FText, FCaretPos + 1); + Inc(FCaretPos, UTF8Length(AddText)); + FSelStart := FCaretPos; + FSelLen := 0; + Invalidate; + DoChange; +end; + +procedure TFlatEdit.DoChange; +begin + if Assigned(FOnChange) then + FOnChange(Self); +end; + +procedure TFlatEdit.AppUserInput(Sender: TObject; Msg: Cardinal); +var + P: TPoint; +begin + if not FEditing then Exit; + case Msg of + LM_LBUTTONDOWN, LM_RBUTTONDOWN, LM_MBUTTONDOWN: ; + else + Exit; + end; + + P := ScreenToClient(Mouse.CursorPos); + if PtInRect(ClientRect, P) then Exit; + + FDragging := False; + MouseCapture := False; + FEditing := False; + FHot := False; + FSelLen := 0; + Invalidate; +end; + +procedure TFlatEdit.CMTextChanged(var Msg: TLMessage); +begin + Invalidate; +end; + +procedure TFlatEdit.Paint; +var + R, TextR, SelR: TRect; + Pad, TextY, CaretX, A, B: Integer; + S, BeforeSel, SelText: string; +begin + R := ClientRect; + Canvas.Brush.Color := FClrOuterBG; + Canvas.Brush.Style := bsSolid; + Canvas.Pen.Style := psClear; + Canvas.FillRect(R); + + if FHot or FEditing then + Canvas.Brush.Color := FClrBGHot + else + Canvas.Brush.Color := FClrBG; + Canvas.Pen.Color := FClrBorder; + Canvas.Pen.Style := psSolid; + Canvas.Pen.Width := 1; + Canvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom); + + Canvas.Font.Assign(Font); + Pad := DpiScale(BASE_PAD_X); + TextR := Rect(Pad, 0, Width - Pad, Height); + TextY := (Height - Canvas.TextHeight('Ag')) div 2; + + if (FText = '') and not FEditing and (FTextHint <> '') then + begin + Canvas.Brush.Style := bsClear; + Canvas.Font.Color := FClrTextDim; + Canvas.TextRect(TextR, TextR.Left, TextY, FTextHint); + Exit; + end; + + S := DisplayText; + if HasSelection then + begin + A := SelFirst; + B := SelAfter; + BeforeSel := UTF8Copy(S, 1, A); + SelText := UTF8Copy(S, A + 1, B - A); + SelR := Rect(TextR.Left + Canvas.TextWidth(BeforeSel), TextY, + TextR.Left + Canvas.TextWidth(BeforeSel + SelText), TextY + Canvas.TextHeight('Ag')); + Canvas.Brush.Color := FClrSelBG; + Canvas.Brush.Style := bsSolid; + Canvas.Pen.Style := psClear; + Canvas.FillRect(SelR); + end; + + Canvas.Brush.Style := bsClear; + Canvas.Font.Color := FClrText; + Canvas.TextRect(TextR, TextR.Left, TextY, S); + + if HasSelection then + begin + A := SelFirst; + B := SelAfter; + BeforeSel := UTF8Copy(S, 1, A); + SelText := UTF8Copy(S, A + 1, B - A); + Canvas.Font.Color := FClrSelText; + Canvas.TextOut(TextR.Left + Canvas.TextWidth(BeforeSel), TextY, SelText); + end; + + if FEditing and not HasSelection then + begin + CaretX := TextR.Left + Canvas.TextWidth(UTF8Copy(S, 1, FCaretPos)); + Canvas.Pen.Color := FClrText; + Canvas.Pen.Style := psSolid; + Canvas.Pen.Width := 1; + Canvas.Line(CaretX, TextY, CaretX, TextY + Canvas.TextHeight('Ag')); + end; +end; + +procedure TFlatEdit.MouseEnter; +begin + inherited; + FHot := True; + Invalidate; +end; + +procedure TFlatEdit.MouseLeave; +begin + inherited; + FHot := False; + Invalidate; +end; + +procedure TFlatEdit.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +var + Pos: Integer; +begin + inherited; + if (Button <> mbLeft) or not Enabled then Exit; + SetFocus; + FEditing := True; + FDragging := True; + MouseCapture := True; + Pos := CaretPosAtX(X); + FCaretPos := Pos; + FSelStart := Pos; + FSelLen := 0; + Invalidate; +end; + +procedure TFlatEdit.MouseMove(Shift: TShiftState; X, Y: Integer); +var + Pos: Integer; +begin + inherited; + if not FDragging then Exit; + Pos := CaretPosAtX(X); + FCaretPos := Pos; + FSelLen := Pos - FSelStart; + Invalidate; +end; + +procedure TFlatEdit.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + inherited; + if Button <> mbLeft then Exit; + FDragging := False; + MouseCapture := False; + Invalidate; +end; + +procedure TFlatEdit.DblClick; +begin + inherited; + FEditing := True; + SelectAll; +end; + +procedure TFlatEdit.KeyDown(var Key: Word; Shift: TShiftState); +begin + inherited; + if not Enabled then Exit; + FEditing := True; + case Key of + VK_LEFT: + begin + SetCaretPos(FCaretPos - 1); + Key := 0; + end; + VK_RIGHT: + begin + SetCaretPos(FCaretPos + 1); + Key := 0; + end; + VK_HOME: + begin + SetCaretPos(0); + Key := 0; + end; + VK_END: + begin + SetCaretPos(TextLen); + Key := 0; + end; + VK_BACK: + begin + if HasSelection then + DeleteSelection + else if FCaretPos > 0 then + begin + UTF8Delete(FText, FCaretPos, 1); + Dec(FCaretPos); + end; + FSelStart := FCaretPos; + FSelLen := 0; + Invalidate; + DoChange; + Key := 0; + end; + VK_DELETE: + begin + if HasSelection then + DeleteSelection + else if FCaretPos < TextLen then + UTF8Delete(FText, FCaretPos + 1, 1); + FSelStart := FCaretPos; + FSelLen := 0; + Invalidate; + DoChange; + Key := 0; + end; + Ord('A'): + if ssCtrl in Shift then + begin + SelectAll; + Key := 0; + end; + Ord('C'): + if (ssCtrl in Shift) and HasSelection then + begin + Clipboard.AsText := UTF8Copy(FText, SelFirst + 1, SelAfter - SelFirst); + Key := 0; + end; + Ord('X'): + if (ssCtrl in Shift) and HasSelection then + begin + Clipboard.AsText := UTF8Copy(FText, SelFirst + 1, SelAfter - SelFirst); + DeleteSelection; + Invalidate; + DoChange; + Key := 0; + end; + Ord('V'): + if ssCtrl in Shift then + begin + InsertText(Clipboard.AsText); + Key := 0; + end; + end; +end; + +procedure TFlatEdit.KeyPress(var Key: char); +begin + inherited; + if not Enabled then Exit; + if Key >= #32 then + Key := #0; +end; + +procedure TFlatEdit.UTF8KeyPress(var UTF8Key: TUTF8Char); +begin + inherited; + if not Enabled then Exit; + FEditing := True; + if (UTF8Key <> '') and (UTF8Key[1] >= #32) then + begin + InsertText(UTF8Key); + UTF8Key := ''; + end; +end; + +procedure TFlatEdit.DoEnter; +begin + inherited; + FEditing := True; + Invalidate; +end; + +procedure TFlatEdit.DoExit; +begin + inherited; + FEditing := False; + FHot := False; + FSelLen := 0; + Invalidate; +end; + +procedure TFlatEdit.SelectAll; +begin + FSelStart := 0; + FSelLen := TextLen; + FCaretPos := TextLen; + Invalidate; +end; + +end. diff --git a/FlatFloatSpinEdit.pas b/FlatFloatSpinEdit.pas new file mode 100644 index 0000000..d052e78 --- /dev/null +++ b/FlatFloatSpinEdit.pas @@ -0,0 +1,821 @@ +unit FlatFloatSpinEdit; + +{ Custom floating-point spin edit with canvas rendering. + Use instead of TFloatSpinEdit where native widgetset styling is undesirable. } + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Controls, Graphics, Forms, LCLType, LMessages, Types, + Clipbrd, Math, AppTheme; + +type + TFlatFloatSpinPart = (ffspNone, ffspEdit, ffspUp, ffspDown); + + TFlatFloatSpinEdit = class(TCustomControl) + private + FValue: Double; + FMinValue: Double; + FMaxValue: Double; + FIncrement: Double; + FDecimalPlaces: Integer; + FText: string; + FCaretPos: Integer; + FSelStart: Integer; + FSelLen: Integer; + FHot: Boolean; + FEditing: Boolean; + FDragging: Boolean; + FHotPart: TFlatFloatSpinPart; + FDownPart: TFlatFloatSpinPart; + FOnChange: TNotifyEvent; + FClrOuterBG: TColor; + FClrBG: TColor; + FClrBGHot: TColor; + FClrBorder: TColor; + FClrText: TColor; + FClrTextDim: TColor; + FClrSelBG: TColor; + FClrSelText: TColor; + FClrBtnHot: TColor; + FClrBtnDown: TColor; + FClrBtnText: TColor; + function DpiScale(V: Integer): Integer; + function ButtonWidth: Integer; + function EditRect: TRect; + function UpRect: TRect; + function DownRect: TRect; + function PartAt(X, Y: Integer): TFlatFloatSpinPart; + function HasSelection: Boolean; + function SelFirst: Integer; + function SelAfter: Integer; + function CaretPosAtX(X: Integer): Integer; + function FormatValue(V: Double): string; + function TryTextToValue(const S: string; out V: Double): Boolean; + procedure SetValue(V: Double); + procedure SetMinValue(V: Double); + procedure SetMaxValue(V: Double); + procedure SetIncrement(V: Double); + procedure SetDecimalPlaces(V: Integer); + procedure SetTextInternal(const S: string); + procedure DeleteSelection; + procedure InsertText(const S: string); + procedure UpdateValueFromText; + procedure CommitText; + procedure StepValue(Dir: Integer); + procedure DoChange; + procedure AppUserInput(Sender: TObject; Msg: Cardinal); + protected + procedure Paint; override; + procedure MouseEnter; override; + procedure MouseLeave; override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + procedure DblClick; override; + procedure KeyDown(var Key: Word; Shift: TShiftState); override; + procedure KeyPress(var Key: char); override; + procedure DoEnter; override; + procedure DoExit; override; + function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override; + function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure SetAppTheme(const T: TAppTheme); + procedure SelectAll; + + property Value: Double read FValue write SetValue; + property MinValue: Double read FMinValue write SetMinValue; + property MaxValue: Double read FMaxValue write SetMaxValue; + property Increment: Double read FIncrement write SetIncrement; + property DecimalPlaces: Integer read FDecimalPlaces write SetDecimalPlaces; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + property Align; + property Anchors; + property Enabled; + property Font; + property ParentShowHint; + property PopupMenu; + property ShowHint; + property TabOrder; + property TabStop; + property Tag; + property Visible; + property OnEnter; + property OnExit; + property OnKeyDown; + property OnKeyPress; + end; + +implementation + +const + BASE_PAD_X = 8; + BASE_BTN_W = 22; + VALUE_EPS = 1.0e-12; + +constructor TFlatFloatSpinEdit.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + ControlStyle := ControlStyle + [csOpaque, csCaptureMouse, csClickEvents]; + Width := 96; + Height := DpiScale(26); + TabStop := True; + Cursor := crIBeam; + + Font.Name := 'Courier New'; + Font.Size := 9; + + FMinValue := 0.0; + FMaxValue := 100.0; + FIncrement := 1.0; + FDecimalPlaces := 2; + FValue := 0.0; + FText := FormatValue(FValue); + FCaretPos := Length(FText); + FSelStart := FCaretPos; + + FClrOuterBG := TColor($00181818); + FClrBG := TColor($001A1A1A); + FClrBGHot := TColor($00202020); + FClrBorder := TColor($00444444); + FClrText := TColor($00E0E0E0); + FClrTextDim := TColor($00666666); + FClrSelBG := TColor($000C3010); + FClrSelText := TColor($0000FF88); + FClrBtnHot := TColor($000C3010); + FClrBtnDown := TColor($00183618); + FClrBtnText := TColor($0000FF88); + Application.AddOnUserInputHandler(@AppUserInput); +end; + +destructor TFlatFloatSpinEdit.Destroy; +begin + Application.RemoveOnUserInputHandler(@AppUserInput); + inherited Destroy; +end; + +function TFlatFloatSpinEdit.DpiScale(V: Integer): Integer; +begin + Result := MulDiv(V, Screen.PixelsPerInch, 96); + if (V > 0) and (Result < 1) then + Result := 1; +end; + +function TFlatFloatSpinEdit.ButtonWidth: Integer; +begin + Result := DpiScale(BASE_BTN_W); + if Result > Width div 2 then + Result := Width div 2; +end; + +function TFlatFloatSpinEdit.EditRect: TRect; +begin + Result := Rect(0, 0, Width - ButtonWidth, Height); +end; + +function TFlatFloatSpinEdit.UpRect: TRect; +begin + Result := Rect(Width - ButtonWidth, 0, Width, Height div 2); +end; + +function TFlatFloatSpinEdit.DownRect: TRect; +begin + Result := Rect(Width - ButtonWidth, Height div 2, Width, Height); +end; + +function TFlatFloatSpinEdit.PartAt(X, Y: Integer): TFlatFloatSpinPart; +begin + if not PtInRect(ClientRect, Point(X, Y)) then + Exit(ffspNone); + if PtInRect(UpRect, Point(X, Y)) then + Exit(ffspUp); + if PtInRect(DownRect, Point(X, Y)) then + Exit(ffspDown); + Result := ffspEdit; +end; + +procedure TFlatFloatSpinEdit.SetAppTheme(const T: TAppTheme); +begin + FClrOuterBG := T.Panel; + FClrBG := T.BtnNorm; + FClrBGHot := T.BtnHot; + FClrBorder := T.Border; + FClrText := T.Text; + FClrTextDim := T.TextDim; + FClrSelBG := T.BtnActive; + FClrSelText := T.BtnTextActive; + FClrBtnHot := T.BtnActive; + FClrBtnDown := T.SliderTrackFill; + FClrBtnText := T.BtnTextActive; + Font.Color := T.Text; + Invalidate; +end; + +function TFlatFloatSpinEdit.HasSelection: Boolean; +begin + Result := FSelLen <> 0; +end; + +function TFlatFloatSpinEdit.SelFirst: Integer; +begin + if FSelLen >= 0 then + Result := FSelStart + else + Result := FSelStart + FSelLen; +end; + +function TFlatFloatSpinEdit.SelAfter: Integer; +begin + if FSelLen >= 0 then + Result := FSelStart + FSelLen + else + Result := FSelStart; +end; + +function TFlatFloatSpinEdit.CaretPosAtX(X: Integer): Integer; +var + I, Pad, RelX, BestDist, Dist: Integer; +begin + Pad := DpiScale(BASE_PAD_X); + RelX := X - Pad; + Result := 0; + BestDist := Abs(RelX); + for I := 1 to Length(FText) do + begin + Dist := Abs(RelX - Canvas.TextWidth(Copy(FText, 1, I))); + if Dist < BestDist then + begin + BestDist := Dist; + Result := I; + end; + end; +end; + +function TFlatFloatSpinEdit.FormatValue(V: Double): string; +var + FS: TFormatSettings; +begin + FS := DefaultFormatSettings; + FS.DecimalSeparator := '.'; + if FDecimalPlaces <= 0 then + Result := FormatFloat('0', V, FS) + else + Result := FormatFloat('0.' + StringOfChar('0', FDecimalPlaces), V, FS); +end; + +function TFlatFloatSpinEdit.TryTextToValue(const S: string; out V: Double): Boolean; +var + FS: TFormatSettings; + T: string; +begin + T := Trim(S); + if (T = '') or (T = '-') or (T = '.') or (T = '-.') then + Exit(False); + T := StringReplace(T, ',', '.', [rfReplaceAll]); + FS := DefaultFormatSettings; + FS.DecimalSeparator := '.'; + Result := TryStrToFloat(T, V, FS); +end; + +procedure TFlatFloatSpinEdit.SetTextInternal(const S: string); +begin + FText := S; + FCaretPos := EnsureRange(FCaretPos, 0, Length(FText)); + FSelStart := FCaretPos; + FSelLen := 0; + Invalidate; +end; + +procedure TFlatFloatSpinEdit.SetValue(V: Double); +var + NewText: string; +begin + V := EnsureRange(V, FMinValue, FMaxValue); + NewText := FormatValue(V); + if (Abs(FValue - V) <= VALUE_EPS) and (FText = NewText) then Exit; + FValue := V; + FText := NewText; + FCaretPos := Length(FText); + FSelStart := FCaretPos; + FSelLen := 0; + Invalidate; + DoChange; +end; + +procedure TFlatFloatSpinEdit.SetMinValue(V: Double); +begin + FMinValue := V; + if FMaxValue < FMinValue then + FMaxValue := FMinValue; + SetValue(FValue); +end; + +procedure TFlatFloatSpinEdit.SetMaxValue(V: Double); +begin + FMaxValue := V; + if FMinValue > FMaxValue then + FMinValue := FMaxValue; + SetValue(FValue); +end; + +procedure TFlatFloatSpinEdit.SetIncrement(V: Double); +begin + FIncrement := Abs(V); + if FIncrement <= 0.0 then + FIncrement := 1.0; +end; + +procedure TFlatFloatSpinEdit.SetDecimalPlaces(V: Integer); +begin + FDecimalPlaces := EnsureRange(V, 0, 8); + SetTextInternal(FormatValue(FValue)); +end; + +procedure TFlatFloatSpinEdit.DeleteSelection; +var + A, B: Integer; +begin + if not HasSelection then Exit; + A := SelFirst; + B := SelAfter; + Delete(FText, A + 1, B - A); + FCaretPos := A; + FSelStart := FCaretPos; + FSelLen := 0; +end; + +procedure TFlatFloatSpinEdit.InsertText(const S: string); +begin + if S = '' then Exit; + DeleteSelection; + Insert(S, FText, FCaretPos + 1); + Inc(FCaretPos, Length(S)); + FSelStart := FCaretPos; + FSelLen := 0; + UpdateValueFromText; + Invalidate; +end; + +procedure TFlatFloatSpinEdit.UpdateValueFromText; +var + V: Double; +begin + if not TryTextToValue(FText, V) then Exit; + if (V < FMinValue) or (V > FMaxValue) then Exit; + if Abs(FValue - V) <= VALUE_EPS then Exit; + FValue := V; + DoChange; +end; + +procedure TFlatFloatSpinEdit.CommitText; +var + V: Double; +begin + if not TryTextToValue(FText, V) then + begin + SetValue(FValue); + Exit; + end; + SetValue(V); +end; + +procedure TFlatFloatSpinEdit.StepValue(Dir: Integer); +begin + CommitText; + SetValue(FValue + Dir * FIncrement); +end; + +procedure TFlatFloatSpinEdit.DoChange; +begin + if Assigned(FOnChange) then + FOnChange(Self); +end; + +procedure TFlatFloatSpinEdit.AppUserInput(Sender: TObject; Msg: Cardinal); +var + P: TPoint; +begin + if not FEditing then Exit; + case Msg of + LM_LBUTTONDOWN, LM_RBUTTONDOWN, LM_MBUTTONDOWN: ; + else + Exit; + end; + + P := ScreenToClient(Mouse.CursorPos); + if PtInRect(ClientRect, P) then Exit; + + CommitText; + FDragging := False; + MouseCapture := False; + FEditing := False; + FHot := False; + FHotPart := ffspNone; + FDownPart := ffspNone; + FSelLen := 0; + Invalidate; +end; + +procedure TFlatFloatSpinEdit.Paint; +var + R, ER, UR, DR, TextR, SelR: TRect; + Pad, TextY, CaretX, A, B, MidX, MidY, S: Integer; + BeforeSel, SelText: string; + + procedure FillPart(const AR: TRect; Part: TFlatFloatSpinPart); + begin + if not Enabled then + Canvas.Brush.Color := FClrBG + else if FDownPart = Part then + Canvas.Brush.Color := FClrBtnDown + else if FHotPart = Part then + Canvas.Brush.Color := FClrBtnHot + else if FHot or FEditing or Focused then + Canvas.Brush.Color := FClrBGHot + else + Canvas.Brush.Color := FClrBG; + Canvas.Pen.Style := psClear; + Canvas.Brush.Style := bsSolid; + Canvas.FillRect(AR); + end; + + procedure DrawArrow(const AR: TRect; Up: Boolean); + var + P: array[0..2] of TPoint; + Size: Integer; + begin + Size := Max(3, DpiScale(4)); + MidX := (AR.Left + AR.Right) div 2; + MidY := (AR.Top + AR.Bottom) div 2; + if Up then + begin + P[0] := Point(MidX, MidY - Size div 2); + P[1] := Point(MidX - Size, MidY + Size div 2); + P[2] := Point(MidX + Size, MidY + Size div 2); + end + else + begin + P[0] := Point(MidX - Size, MidY - Size div 2); + P[1] := Point(MidX + Size, MidY - Size div 2); + P[2] := Point(MidX, MidY + Size div 2); + end; + if Enabled then + Canvas.Brush.Color := FClrBtnText + else + Canvas.Brush.Color := FClrTextDim; + Canvas.Pen.Style := psClear; + Canvas.Polygon(P); + end; +begin + R := ClientRect; + ER := EditRect; + UR := UpRect; + DR := DownRect; + + Canvas.Brush.Color := FClrOuterBG; + Canvas.Brush.Style := bsSolid; + Canvas.Pen.Style := psClear; + Canvas.FillRect(R); + + if FHot or FEditing or Focused then + Canvas.Brush.Color := FClrBGHot + else + Canvas.Brush.Color := FClrBG; + Canvas.Pen.Color := FClrBorder; + Canvas.Pen.Style := psSolid; + Canvas.Pen.Width := 1; + Canvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom); + + FillPart(UR, ffspUp); + FillPart(DR, ffspDown); + Canvas.Pen.Color := FClrBorder; + Canvas.Pen.Style := psSolid; + Canvas.Line(UR.Left, 1, UR.Left, Height - 1); + Canvas.Line(UR.Left, DR.Top, Width - 1, DR.Top); + DrawArrow(UR, True); + DrawArrow(DR, False); + + Canvas.Font.Assign(Font); + if Enabled then + Canvas.Font.Color := FClrText + else + Canvas.Font.Color := FClrTextDim; + Pad := DpiScale(BASE_PAD_X); + TextR := Rect(ER.Left + Pad, ER.Top, ER.Right - DpiScale(3), ER.Bottom); + TextY := (Height - Canvas.TextHeight('Ag')) div 2; + + if HasSelection then + begin + A := SelFirst; + B := SelAfter; + BeforeSel := Copy(FText, 1, A); + SelText := Copy(FText, A + 1, B - A); + SelR := Rect(TextR.Left + Canvas.TextWidth(BeforeSel), TextY, + TextR.Left + Canvas.TextWidth(BeforeSel + SelText), TextY + Canvas.TextHeight('Ag')); + Canvas.Brush.Color := FClrSelBG; + Canvas.Pen.Style := psClear; + Canvas.FillRect(SelR); + end; + + Canvas.Brush.Style := bsClear; + Canvas.TextRect(TextR, TextR.Left, TextY, FText); + + if HasSelection then + begin + A := SelFirst; + B := SelAfter; + BeforeSel := Copy(FText, 1, A); + SelText := Copy(FText, A + 1, B - A); + Canvas.Font.Color := FClrSelText; + Canvas.TextOut(TextR.Left + Canvas.TextWidth(BeforeSel), TextY, SelText); + end; + + if FEditing and not HasSelection then + begin + S := EnsureRange(FCaretPos, 0, Length(FText)); + CaretX := TextR.Left + Canvas.TextWidth(Copy(FText, 1, S)); + Canvas.Pen.Color := FClrText; + Canvas.Pen.Style := psSolid; + Canvas.Pen.Width := 1; + Canvas.Line(CaretX, TextY, CaretX, TextY + Canvas.TextHeight('Ag')); + end; +end; + +procedure TFlatFloatSpinEdit.MouseEnter; +begin + inherited; + FHot := True; + Invalidate; +end; + +procedure TFlatFloatSpinEdit.MouseLeave; +begin + inherited; + FHot := False; + FHotPart := ffspNone; + Invalidate; +end; + +procedure TFlatFloatSpinEdit.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +var + Pos: Integer; +begin + inherited; + if (Button <> mbLeft) or not Enabled then Exit; + SetFocus; + FEditing := True; + FDownPart := PartAt(X, Y); + FHotPart := FDownPart; + if FDownPart in [ffspUp, ffspDown] then + begin + FDragging := False; + MouseCapture := True; + if FDownPart = ffspUp then + StepValue(1) + else + StepValue(-1); + end + else + begin + FDragging := True; + MouseCapture := True; + Pos := CaretPosAtX(X); + FCaretPos := Pos; + FSelStart := Pos; + FSelLen := 0; + end; + Invalidate; +end; + +procedure TFlatFloatSpinEdit.MouseMove(Shift: TShiftState; X, Y: Integer); +var + Pos: Integer; + Part: TFlatFloatSpinPart; +begin + inherited; + Part := PartAt(X, Y); + if FHotPart <> Part then + begin + FHotPart := Part; + if Part = ffspEdit then + Cursor := crIBeam + else + Cursor := crDefault; + Invalidate; + end; + + if not FDragging then Exit; + Pos := CaretPosAtX(X); + FCaretPos := Pos; + FSelLen := Pos - FSelStart; + Invalidate; +end; + +procedure TFlatFloatSpinEdit.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + inherited; + if Button <> mbLeft then Exit; + FDragging := False; + FDownPart := ffspNone; + MouseCapture := False; + Invalidate; +end; + +procedure TFlatFloatSpinEdit.DblClick; +begin + inherited; + if FHotPart <> ffspEdit then Exit; + FEditing := True; + SelectAll; +end; + +procedure TFlatFloatSpinEdit.KeyDown(var Key: Word; Shift: TShiftState); +begin + inherited; + if not Enabled then Exit; + FEditing := True; + case Key of + VK_LEFT: + begin + FCaretPos := EnsureRange(FCaretPos - 1, 0, Length(FText)); + FSelStart := FCaretPos; + FSelLen := 0; + Invalidate; + Key := 0; + end; + VK_RIGHT: + begin + FCaretPos := EnsureRange(FCaretPos + 1, 0, Length(FText)); + FSelStart := FCaretPos; + FSelLen := 0; + Invalidate; + Key := 0; + end; + VK_HOME: + begin + FCaretPos := 0; + FSelStart := FCaretPos; + FSelLen := 0; + Invalidate; + Key := 0; + end; + VK_END: + begin + FCaretPos := Length(FText); + FSelStart := FCaretPos; + FSelLen := 0; + Invalidate; + Key := 0; + end; + VK_UP: + begin + StepValue(1); + Key := 0; + end; + VK_DOWN: + begin + StepValue(-1); + Key := 0; + end; + VK_RETURN: + begin + CommitText; + SelectAll; + Key := 0; + end; + VK_ESCAPE: + begin + SetTextInternal(FormatValue(FValue)); + Key := 0; + end; + VK_BACK: + begin + if HasSelection then + DeleteSelection + else if FCaretPos > 0 then + begin + Delete(FText, FCaretPos, 1); + Dec(FCaretPos); + end; + FSelStart := FCaretPos; + FSelLen := 0; + UpdateValueFromText; + Invalidate; + Key := 0; + end; + VK_DELETE: + begin + if HasSelection then + DeleteSelection + else if FCaretPos < Length(FText) then + Delete(FText, FCaretPos + 1, 1); + FSelStart := FCaretPos; + FSelLen := 0; + UpdateValueFromText; + Invalidate; + Key := 0; + end; + Ord('A'): + if ssCtrl in Shift then + begin + SelectAll; + Key := 0; + end; + Ord('C'): + if (ssCtrl in Shift) and HasSelection then + begin + Clipboard.AsText := Copy(FText, SelFirst + 1, SelAfter - SelFirst); + Key := 0; + end; + Ord('X'): + if (ssCtrl in Shift) and HasSelection then + begin + Clipboard.AsText := Copy(FText, SelFirst + 1, SelAfter - SelFirst); + DeleteSelection; + UpdateValueFromText; + Invalidate; + Key := 0; + end; + Ord('V'): + if ssCtrl in Shift then + begin + InsertText(Clipboard.AsText); + Key := 0; + end; + end; +end; + +procedure TFlatFloatSpinEdit.KeyPress(var Key: char); +begin + inherited; + if not Enabled then Exit; + FEditing := True; + if Key in ['0'..'9'] then + begin + InsertText(Key); + Key := #0; + end + else if (Key in ['.', ',']) and (Pos('.', FText) = 0) and (Pos(',', FText) = 0) then + begin + InsertText('.'); + Key := #0; + end + else if (Key = '-') and (FMinValue < 0.0) and (FCaretPos = 0) and (Pos('-', FText) = 0) then + begin + InsertText(Key); + Key := #0; + end + else if Key >= #32 then + Key := #0; +end; + +procedure TFlatFloatSpinEdit.DoEnter; +begin + inherited; + FEditing := True; + Invalidate; +end; + +procedure TFlatFloatSpinEdit.DoExit; +begin + inherited; + CommitText; + FEditing := False; + FHot := False; + FHotPart := ffspNone; + FDownPart := ffspNone; + FSelLen := 0; + Invalidate; +end; + +function TFlatFloatSpinEdit.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; +begin + if Enabled then + StepValue(1); + Result := True; +end; + +function TFlatFloatSpinEdit.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; +begin + if Enabled then + StepValue(-1); + Result := True; +end; + +procedure TFlatFloatSpinEdit.SelectAll; +begin + FSelStart := 0; + FSelLen := Length(FText); + FCaretPos := Length(FText); + Invalidate; +end; + +end. diff --git a/FlatListBox.pas b/FlatListBox.pas new file mode 100644 index 0000000..a7894a9 --- /dev/null +++ b/FlatListBox.pas @@ -0,0 +1,382 @@ +unit FlatListBox; + +{ Custom list box with canvas rendering. + Use instead of TListBox where native widgetset styling is undesirable. } + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Controls, Graphics, Forms, LCLType, LMessages, Types, + Math, AppTheme; + +type + TFlatListBox = class(TCustomControl) + private + FItems: TStringList; + FItemIndex: Integer; + FHotIndex: Integer; + FTopIndex: Integer; + FMouseDownIndex: Integer; + FClrOuterBG: TColor; + FClrBG: TColor; + FClrBGHot: TColor; + FClrBorder: TColor; + FClrText: TColor; + FClrTextDim: TColor; + FClrSelBG: TColor; + FClrSelText: TColor; + FClrScroll: TColor; + function DpiScale(V: Integer): Integer; + function ItemHeight: Integer; + function VisibleCount: Integer; + function ItemAt(Y: Integer): Integer; + procedure ItemsChanged(Sender: TObject); + procedure SetItemIndex(V: Integer); + procedure SetTopIndex(V: Integer); + procedure EnsureItemVisible(Idx: Integer); + procedure CMTextChanged(var Msg: TLMessage); message CM_TEXTCHANGED; + protected + procedure Paint; override; + procedure MouseEnter; override; + procedure MouseLeave; override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + procedure KeyDown(var Key: Word; Shift: TShiftState); override; + function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override; + function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure SetAppTheme(const T: TAppTheme); + + property Items: TStringList read FItems; + property ItemIndex: Integer read FItemIndex write SetItemIndex; + property TopIndex: Integer read FTopIndex write SetTopIndex; + property Align; + property Anchors; + property Enabled; + property Font; + property ParentShowHint; + property PopupMenu; + property ShowHint; + property TabOrder; + property TabStop; + property Tag; + property Visible; + property OnClick; + property OnDblClick; + end; + +implementation + +const + BASE_ITEM_H = 22; + BASE_PAD_X = 8; + BASE_SCROLL_W = 3; + +constructor TFlatListBox.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + ControlStyle := ControlStyle + [csOpaque, csCaptureMouse, csClickEvents, csDoubleClicks]; + FItems := TStringList.Create; + FItems.OnChange := @ItemsChanged; + FItemIndex := -1; + FHotIndex := -1; + FTopIndex := 0; + FMouseDownIndex := -1; + Width := 180; + Height := 140; + TabStop := True; + Cursor := crDefault; + + Font.Name := 'Courier New'; + Font.Size := 8; + + FClrOuterBG := TColor($00181818); + FClrBG := TColor($00101010); + FClrBGHot := TColor($000C3010); + FClrBorder := TColor($00303030); + FClrText := TColor($00CCCCCC); + FClrTextDim := TColor($00666666); + FClrSelBG := TColor($00183618); + FClrSelText := TColor($0000FF88); + FClrScroll := TColor($00387838); +end; + +destructor TFlatListBox.Destroy; +begin + FItems.Free; + inherited Destroy; +end; + +function TFlatListBox.DpiScale(V: Integer): Integer; +begin + Result := MulDiv(V, Screen.PixelsPerInch, 96); + if (V > 0) and (Result < 1) then + Result := 1; +end; + +function TFlatListBox.ItemHeight: Integer; +begin + Canvas.Font.Assign(Font); + Result := DpiScale(BASE_ITEM_H); + if Result < Canvas.TextHeight('Ag') + DpiScale(7) then + Result := Canvas.TextHeight('Ag') + DpiScale(7); +end; + +function TFlatListBox.VisibleCount: Integer; +begin + Result := Max(1, (Height - DpiScale(2)) div ItemHeight); +end; + +function TFlatListBox.ItemAt(Y: Integer): Integer; +begin + Result := FTopIndex + (Y - DpiScale(1)) div ItemHeight; + if (Result < 0) or (Result >= FItems.Count) then + Result := -1; +end; + +procedure TFlatListBox.SetAppTheme(const T: TAppTheme); +begin + FClrOuterBG := T.Panel; + FClrBG := T.BG; + FClrBGHot := T.BtnActive; + FClrBorder := T.Border; + FClrText := T.Text; + FClrTextDim := T.TextDim; + FClrSelBG := T.SliderTrackFill; + FClrSelText := T.BtnTextActive; + FClrScroll := T.BtnBorderActive; + Font.Color := T.Text; + Invalidate; +end; + +procedure TFlatListBox.ItemsChanged(Sender: TObject); +begin + if FItems.Count = 0 then + FItemIndex := -1 + else if FItemIndex >= FItems.Count then + FItemIndex := FItems.Count - 1; + if FHotIndex >= FItems.Count then + FHotIndex := -1; + SetTopIndex(FTopIndex); + Invalidate; +end; + +procedure TFlatListBox.SetItemIndex(V: Integer); +begin + V := EnsureRange(V, -1, FItems.Count - 1); + if FItemIndex = V then + begin + EnsureItemVisible(FItemIndex); + Exit; + end; + FItemIndex := V; + EnsureItemVisible(FItemIndex); + Invalidate; +end; + +procedure TFlatListBox.SetTopIndex(V: Integer); +begin + V := EnsureRange(V, 0, Max(0, FItems.Count - VisibleCount)); + if FTopIndex = V then Exit; + FTopIndex := V; + Invalidate; +end; + +procedure TFlatListBox.EnsureItemVisible(Idx: Integer); +var + VC: Integer; +begin + if Idx < 0 then Exit; + VC := VisibleCount; + if Idx < FTopIndex then + SetTopIndex(Idx) + else if Idx >= FTopIndex + VC then + SetTopIndex(Idx - VC + 1); +end; + +procedure TFlatListBox.CMTextChanged(var Msg: TLMessage); +begin + Invalidate; +end; + +procedure TFlatListBox.Paint; +var + i, ItemIdx, IH, Y, TextY, Pad, ScrollW, ThumbTop, ThumbH: Integer; + R, TextR: TRect; +begin + Canvas.Brush.Color := FClrOuterBG; + Canvas.Brush.Style := bsSolid; + Canvas.Pen.Style := psClear; + Canvas.FillRect(ClientRect); + + Canvas.Brush.Color := FClrBG; + Canvas.Brush.Style := bsSolid; + Canvas.Pen.Color := FClrBorder; + Canvas.Pen.Style := psSolid; + Canvas.Pen.Width := 1; + Canvas.Rectangle(0, 0, Width, Height); + + Canvas.Font.Assign(Font); + IH := ItemHeight; + Pad := DpiScale(BASE_PAD_X); + ScrollW := DpiScale(BASE_SCROLL_W); + for i := 0 to VisibleCount - 1 do + begin + ItemIdx := FTopIndex + i; + if ItemIdx >= FItems.Count then Break; + Y := DpiScale(1) + i * IH; + R := Rect(DpiScale(1), Y, Width - DpiScale(1), Y + IH); + if ItemIdx = FItemIndex then + begin + Canvas.Brush.Color := FClrSelBG; + Canvas.Font.Color := FClrSelText; + end + else if (ItemIdx = FHotIndex) and Enabled then + begin + Canvas.Brush.Color := FClrBGHot; + Canvas.Font.Color := FClrText; + end + else + begin + Canvas.Brush.Color := FClrBG; + if Enabled then + Canvas.Font.Color := FClrText + else + Canvas.Font.Color := FClrTextDim; + end; + Canvas.Pen.Style := psClear; + Canvas.Brush.Style := bsSolid; + Canvas.FillRect(R); + Canvas.Brush.Style := bsClear; + TextY := Y + (IH - Canvas.TextHeight('Ag')) div 2; + TextR := Rect(Pad, Y, Width - Pad - ScrollW, Y + IH); + Canvas.TextRect(TextR, TextR.Left, TextY, FItems[ItemIdx]); + end; + + if FItems.Count > VisibleCount then + begin + ThumbH := Max(DpiScale(16), MulDiv(Height - DpiScale(4), VisibleCount, FItems.Count)); + ThumbTop := DpiScale(2) + MulDiv(Height - DpiScale(4) - ThumbH, + FTopIndex, Max(1, FItems.Count - VisibleCount)); + Canvas.Brush.Color := FClrScroll; + Canvas.Brush.Style := bsSolid; + Canvas.Pen.Style := psClear; + Canvas.FillRect(Rect(Width - DpiScale(5), ThumbTop, Width - DpiScale(2), ThumbTop + ThumbH)); + end; +end; + +procedure TFlatListBox.MouseEnter; +begin + inherited; + Invalidate; +end; + +procedure TFlatListBox.MouseLeave; +begin + inherited; + FHotIndex := -1; + Invalidate; +end; + +procedure TFlatListBox.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + inherited; + if (Button <> mbLeft) or not Enabled then Exit; + SetFocus; + FMouseDownIndex := ItemAt(Y); + if FMouseDownIndex >= 0 then + SetItemIndex(FMouseDownIndex); +end; + +procedure TFlatListBox.MouseMove(Shift: TShiftState; X, Y: Integer); +var + Idx: Integer; +begin + inherited; + if PtInRect(ClientRect, Point(X, Y)) then + Idx := ItemAt(Y) + else + Idx := -1; + if FHotIndex = Idx then Exit; + FHotIndex := Idx; + Invalidate; +end; + +procedure TFlatListBox.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + inherited; + if Button <> mbLeft then Exit; + FMouseDownIndex := -1; +end; + +procedure TFlatListBox.KeyDown(var Key: Word; Shift: TShiftState); +var + OldIndex: Integer; +begin + inherited; + if not Enabled then Exit; + OldIndex := FItemIndex; + case Key of + VK_UP: + begin + if FItems.Count > 0 then + SetItemIndex(EnsureRange(FItemIndex - 1, 0, FItems.Count - 1)); + Key := 0; + end; + VK_DOWN: + begin + if FItems.Count > 0 then + SetItemIndex(EnsureRange(FItemIndex + 1, 0, FItems.Count - 1)); + Key := 0; + end; + VK_PRIOR: + begin + if FItems.Count > 0 then + SetItemIndex(EnsureRange(FItemIndex - VisibleCount, 0, FItems.Count - 1)); + Key := 0; + end; + VK_NEXT: + begin + if FItems.Count > 0 then + SetItemIndex(EnsureRange(FItemIndex + VisibleCount, 0, FItems.Count - 1)); + Key := 0; + end; + VK_HOME: + begin + if FItems.Count > 0 then + SetItemIndex(0); + Key := 0; + end; + VK_END: + begin + if FItems.Count > 0 then + SetItemIndex(FItems.Count - 1); + Key := 0; + end; + end; + if (Key = 0) and (FItemIndex <> OldIndex) then + Click; +end; + +function TFlatListBox.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; +begin + SetTopIndex(FTopIndex - 3); + Result := True; +end; + +function TFlatListBox.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; +begin + SetTopIndex(FTopIndex + 3); + Result := True; +end; + +end. diff --git a/FlatRadioButton.pas b/FlatRadioButton.pas new file mode 100644 index 0000000..078d438 --- /dev/null +++ b/FlatRadioButton.pas @@ -0,0 +1,294 @@ +unit FlatRadioButton; + +{ Custom radio button with canvas rendering. + Use instead of TRadioButton where native widgetset styling is undesirable. } + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Controls, Graphics, Forms, LCLType, LMessages, Types, Math, + AppTheme; + +type + TFlatRadioButton = class(TCustomControl) + private + FChecked: Boolean; + FHot: Boolean; + FDown: Boolean; + FOnChange: TNotifyEvent; + FClrBG: TColor; + FClrCircle: TColor; + FClrCircleChecked: TColor; + FClrCircleHot: TColor; + FClrBorder: TColor; + FClrBorderHot: TColor; + FClrDot: TColor; + FClrText: TColor; + FClrTextDisabled: TColor; + function DpiScale(V: Integer): Integer; + procedure SetCheckedSilently(V: Boolean); + procedure SetChecked(V: Boolean); + procedure DoChange; + procedure UncheckSiblings; + procedure CMTextChanged(var Msg: TLMessage); message CM_TEXTCHANGED; + protected + procedure Paint; override; + procedure MouseEnter; override; + procedure MouseLeave; override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + procedure KeyDown(var Key: Word; Shift: TShiftState); override; + public + constructor Create(AOwner: TComponent); override; + procedure SetAppTheme(const T: TAppTheme); + + property Checked: Boolean read FChecked write SetChecked; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + property Align; + property Anchors; + property Caption; + property Enabled; + property Font; + property ParentShowHint; + property PopupMenu; + property ShowHint; + property TabOrder; + property TabStop; + property Tag; + property Visible; + property OnClick; + end; + +implementation + +const + BASE_CIRCLE_SIZE = 16; + BASE_CIRCLE_LEFT = 1; + BASE_TEXT_GAP = 8; + +constructor TFlatRadioButton.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + ControlStyle := ControlStyle + [csOpaque, csCaptureMouse, csClickEvents]; + Width := 160; + Height := 22; + TabStop := True; + Cursor := crHandPoint; + + Font.Name := 'Courier New'; + Font.Size := 9; + + FClrBG := TColor($00181818); + FClrCircle := TColor($001A1A1A); + FClrCircleChecked := TColor($000C3010); + FClrCircleHot := TColor($00282828); + FClrBorder := TColor($00444444); + FClrBorderHot := TColor($00387838); + FClrDot := TColor($0000FF88); + FClrText := TColor($00CCCCCC); + FClrTextDisabled := TColor($00666666); +end; + +function TFlatRadioButton.DpiScale(V: Integer): Integer; +begin + Result := MulDiv(V, Screen.PixelsPerInch, 96); + if (V > 0) and (Result < 1) then + Result := 1; +end; + +procedure TFlatRadioButton.SetAppTheme(const T: TAppTheme); +begin + FClrBG := T.Panel; + FClrCircle := T.BtnNorm; + FClrCircleChecked := T.BtnActive; + FClrCircleHot := T.BtnHot; + FClrBorder := T.BtnBorderNorm; + FClrBorderHot := T.BtnBorderActive; + FClrDot := T.BtnTextActive; + FClrText := T.Text; + FClrTextDisabled := T.TextDim; + Font.Color := T.Text; + Invalidate; +end; + +procedure TFlatRadioButton.SetChecked(V: Boolean); +begin + if FChecked = V then Exit; + if V then + UncheckSiblings; + FChecked := V; + Invalidate; + DoChange; +end; + +procedure TFlatRadioButton.SetCheckedSilently(V: Boolean); +begin + if FChecked = V then Exit; + FChecked := V; + Invalidate; +end; + +procedure TFlatRadioButton.DoChange; +begin + if Assigned(FOnChange) then + FOnChange(Self); +end; + +procedure TFlatRadioButton.UncheckSiblings; +var + i: Integer; + Ctrl: TControl; +begin + if Parent = nil then Exit; + for i := 0 to Parent.ControlCount - 1 do + begin + Ctrl := Parent.Controls[i]; + if (Ctrl <> Self) and (Ctrl is TFlatRadioButton) then + TFlatRadioButton(Ctrl).SetCheckedSilently(False); + end; +end; + +procedure TFlatRadioButton.CMTextChanged(var Msg: TLMessage); +begin + Invalidate; +end; + +procedure TFlatRadioButton.Paint; +var + CircleSize, CircleLeft, CircleTop, DotSize, TextGap, TextTop, TX: Integer; + R: TRect; + CircleColor, BorderColor, TextColor: TColor; + + procedure FillCircle(CX, CY, Radius: Integer; AColor: TColor); + var + DY, DX: Integer; + begin + Canvas.Brush.Color := AColor; + Canvas.Brush.Style := bsSolid; + Canvas.Pen.Style := psClear; + for DY := -Radius to Radius do + begin + DX := Trunc(Sqrt(Sqr(Radius) - Sqr(DY))); + Canvas.FillRect(Rect(CX - DX, CY + DY, CX + DX + 1, CY + DY + 1)); + end; + end; +begin + Canvas.Brush.Color := FClrBG; + Canvas.Brush.Style := bsSolid; + Canvas.Pen.Style := psClear; + Canvas.FillRect(ClientRect); + + CircleSize := DpiScale(BASE_CIRCLE_SIZE); + if CircleSize > Height - DpiScale(4) then + CircleSize := Height - DpiScale(4); + if CircleSize < DpiScale(10) then + CircleSize := DpiScale(10); + CircleLeft := DpiScale(BASE_CIRCLE_LEFT); + CircleTop := (Height - CircleSize) div 2; + TextGap := DpiScale(BASE_TEXT_GAP); + R := Rect(CircleLeft, CircleTop, CircleLeft + CircleSize, CircleTop + CircleSize); + + if FChecked then + CircleColor := FClrCircleChecked + else if FHot or Focused then + CircleColor := FClrCircleHot + else + CircleColor := FClrCircle; + + if FHot or Focused then + BorderColor := FClrBorderHot + else + BorderColor := FClrBorder; + + if not Enabled then + begin + CircleColor := FClrBG; + BorderColor := FClrBorder; + TextColor := FClrTextDisabled; + end + else + TextColor := FClrText; + + FillCircle((R.Left + R.Right) div 2, (R.Top + R.Bottom) div 2, + CircleSize div 2, BorderColor); + FillCircle((R.Left + R.Right) div 2, (R.Top + R.Bottom) div 2, + Max(1, CircleSize div 2 - DpiScale(1)), CircleColor); + + if FChecked then + begin + DotSize := Max(DpiScale(5), CircleSize div 2 - DpiScale(2)); + if DotSize mod 2 = 0 then + Dec(DotSize); + FillCircle((R.Left + R.Right) div 2, (R.Top + R.Bottom) div 2, + DotSize div 2, FClrDot); + end; + + if Caption <> '' then + begin + Canvas.Font.Assign(Font); + Canvas.Font.Color := TextColor; + Canvas.Brush.Style := bsClear; + TX := R.Right + TextGap; + TextTop := (Height - Canvas.TextHeight('Ag')) div 2; + Canvas.TextOut(TX, TextTop, Caption); + end; +end; + +procedure TFlatRadioButton.MouseEnter; +begin + inherited; + FHot := True; + Invalidate; +end; + +procedure TFlatRadioButton.MouseLeave; +begin + inherited; + FHot := False; + FDown := False; + Invalidate; +end; + +procedure TFlatRadioButton.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + inherited; + if (Button <> mbLeft) or not Enabled then Exit; + SetFocus; + FDown := True; + Invalidate; +end; + +procedure TFlatRadioButton.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + inherited; + if Button <> mbLeft then Exit; + FDown := False; + if Enabled and PtInRect(ClientRect, Point(X, Y)) then + begin + if not Checked then + Checked := True; + Click; + end; + Invalidate; +end; + +procedure TFlatRadioButton.KeyDown(var Key: Word; Shift: TShiftState); +begin + inherited; + if not Enabled then Exit; + if Key in [VK_SPACE, VK_RETURN] then + begin + if not Checked then + Checked := True; + Click; + Key := 0; + end; +end; + +end. diff --git a/FlatSpinEdit.pas b/FlatSpinEdit.pas new file mode 100644 index 0000000..812d0aa --- /dev/null +++ b/FlatSpinEdit.pas @@ -0,0 +1,777 @@ +unit FlatSpinEdit; + +{ Custom integer spin edit with canvas rendering. + Use instead of TSpinEdit where native widgetset styling is undesirable. } + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Controls, Graphics, Forms, LCLType, LMessages, Types, + Clipbrd, Math, AppTheme; + +type + TFlatSpinPart = (fspNone, fspEdit, fspUp, fspDown); + + TFlatSpinEdit = class(TCustomControl) + private + FValue: Integer; + FMinValue: Integer; + FMaxValue: Integer; + FIncrement: Integer; + FText: string; + FCaretPos: Integer; + FSelStart: Integer; + FSelLen: Integer; + FHot: Boolean; + FEditing: Boolean; + FDragging: Boolean; + FHotPart: TFlatSpinPart; + FDownPart: TFlatSpinPart; + FOnChange: TNotifyEvent; + FClrOuterBG: TColor; + FClrBG: TColor; + FClrBGHot: TColor; + FClrBorder: TColor; + FClrText: TColor; + FClrTextDim: TColor; + FClrSelBG: TColor; + FClrSelText: TColor; + FClrBtnHot: TColor; + FClrBtnDown: TColor; + FClrBtnText: TColor; + function DpiScale(V: Integer): Integer; + function ButtonWidth: Integer; + function EditRect: TRect; + function UpRect: TRect; + function DownRect: TRect; + function PartAt(X, Y: Integer): TFlatSpinPart; + function HasSelection: Boolean; + function SelFirst: Integer; + function SelAfter: Integer; + function CaretPosAtX(X: Integer): Integer; + procedure SetValue(V: Integer); + procedure SetMinValue(V: Integer); + procedure SetMaxValue(V: Integer); + procedure SetIncrement(V: Integer); + procedure SetTextInternal(const S: string; AFireChange: Boolean); + procedure DeleteSelection; + procedure InsertText(const S: string); + procedure UpdateValueFromText; + procedure CommitText; + procedure StepValue(Dir: Integer); + procedure DoChange; + procedure AppUserInput(Sender: TObject; Msg: Cardinal); + protected + procedure Paint; override; + procedure MouseEnter; override; + procedure MouseLeave; override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + procedure DblClick; override; + procedure KeyDown(var Key: Word; Shift: TShiftState); override; + procedure KeyPress(var Key: char); override; + procedure DoEnter; override; + procedure DoExit; override; + function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override; + function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure SetAppTheme(const T: TAppTheme); + procedure SelectAll; + + property Value: Integer read FValue write SetValue; + property MinValue: Integer read FMinValue write SetMinValue; + property MaxValue: Integer read FMaxValue write SetMaxValue; + property Increment: Integer read FIncrement write SetIncrement; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + property Align; + property Anchors; + property Enabled; + property Font; + property ParentShowHint; + property PopupMenu; + property ShowHint; + property TabOrder; + property TabStop; + property Tag; + property Visible; + property OnEnter; + property OnExit; + property OnKeyDown; + property OnKeyPress; + end; + +implementation + +const + BASE_PAD_X = 8; + BASE_BTN_W = 22; + +constructor TFlatSpinEdit.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + ControlStyle := ControlStyle + [csOpaque, csCaptureMouse, csClickEvents]; + Width := 96; + Height := DpiScale(26); + TabStop := True; + Cursor := crIBeam; + + Font.Name := 'Courier New'; + Font.Size := 9; + + FMinValue := 0; + FMaxValue := 100; + FIncrement := 1; + FValue := 0; + FText := '0'; + FCaretPos := Length(FText); + FSelStart := FCaretPos; + + FClrOuterBG := TColor($00181818); + FClrBG := TColor($001A1A1A); + FClrBGHot := TColor($00202020); + FClrBorder := TColor($00444444); + FClrText := TColor($00E0E0E0); + FClrTextDim := TColor($00666666); + FClrSelBG := TColor($000C3010); + FClrSelText := TColor($0000FF88); + FClrBtnHot := TColor($000C3010); + FClrBtnDown := TColor($00183618); + FClrBtnText := TColor($0000FF88); + Application.AddOnUserInputHandler(@AppUserInput); +end; + +destructor TFlatSpinEdit.Destroy; +begin + Application.RemoveOnUserInputHandler(@AppUserInput); + inherited Destroy; +end; + +function TFlatSpinEdit.DpiScale(V: Integer): Integer; +begin + Result := MulDiv(V, Screen.PixelsPerInch, 96); + if (V > 0) and (Result < 1) then + Result := 1; +end; + +function TFlatSpinEdit.ButtonWidth: Integer; +begin + Result := DpiScale(BASE_BTN_W); + if Result > Width div 2 then + Result := Width div 2; +end; + +function TFlatSpinEdit.EditRect: TRect; +begin + Result := Rect(0, 0, Width - ButtonWidth, Height); +end; + +function TFlatSpinEdit.UpRect: TRect; +begin + Result := Rect(Width - ButtonWidth, 0, Width, Height div 2); +end; + +function TFlatSpinEdit.DownRect: TRect; +begin + Result := Rect(Width - ButtonWidth, Height div 2, Width, Height); +end; + +function TFlatSpinEdit.PartAt(X, Y: Integer): TFlatSpinPart; +begin + if not PtInRect(ClientRect, Point(X, Y)) then + Exit(fspNone); + if PtInRect(UpRect, Point(X, Y)) then + Exit(fspUp); + if PtInRect(DownRect, Point(X, Y)) then + Exit(fspDown); + Result := fspEdit; +end; + +procedure TFlatSpinEdit.SetAppTheme(const T: TAppTheme); +begin + FClrOuterBG := T.Panel; + FClrBG := T.BtnNorm; + FClrBGHot := T.BtnHot; + FClrBorder := T.Border; + FClrText := T.Text; + FClrTextDim := T.TextDim; + FClrSelBG := T.BtnActive; + FClrSelText := T.BtnTextActive; + FClrBtnHot := T.BtnActive; + FClrBtnDown := T.SliderTrackFill; + FClrBtnText := T.BtnTextActive; + Font.Color := T.Text; + Invalidate; +end; + +function TFlatSpinEdit.HasSelection: Boolean; +begin + Result := FSelLen <> 0; +end; + +function TFlatSpinEdit.SelFirst: Integer; +begin + if FSelLen >= 0 then + Result := FSelStart + else + Result := FSelStart + FSelLen; +end; + +function TFlatSpinEdit.SelAfter: Integer; +begin + if FSelLen >= 0 then + Result := FSelStart + FSelLen + else + Result := FSelStart; +end; + +function TFlatSpinEdit.CaretPosAtX(X: Integer): Integer; +var + I, Pad, RelX, BestDist, Dist: Integer; +begin + Pad := DpiScale(BASE_PAD_X); + RelX := X - Pad; + Result := 0; + BestDist := Abs(RelX); + for I := 1 to Length(FText) do + begin + Dist := Abs(RelX - Canvas.TextWidth(Copy(FText, 1, I))); + if Dist < BestDist then + begin + BestDist := Dist; + Result := I; + end; + end; +end; + +procedure TFlatSpinEdit.SetTextInternal(const S: string; AFireChange: Boolean); +begin + FText := S; + FCaretPos := EnsureRange(FCaretPos, 0, Length(FText)); + FSelStart := FCaretPos; + FSelLen := 0; + Invalidate; + if AFireChange then + DoChange; +end; + +procedure TFlatSpinEdit.SetValue(V: Integer); +begin + V := EnsureRange(V, FMinValue, FMaxValue); + if (FValue = V) and (FText = IntToStr(V)) then Exit; + FValue := V; + FText := IntToStr(FValue); + FCaretPos := Length(FText); + FSelStart := FCaretPos; + FSelLen := 0; + Invalidate; + DoChange; +end; + +procedure TFlatSpinEdit.SetMinValue(V: Integer); +begin + FMinValue := V; + if FMaxValue < FMinValue then + FMaxValue := FMinValue; + SetValue(FValue); +end; + +procedure TFlatSpinEdit.SetMaxValue(V: Integer); +begin + FMaxValue := V; + if FMinValue > FMaxValue then + FMinValue := FMaxValue; + SetValue(FValue); +end; + +procedure TFlatSpinEdit.SetIncrement(V: Integer); +begin + FIncrement := Max(1, Abs(V)); +end; + +procedure TFlatSpinEdit.DeleteSelection; +var + A, B: Integer; +begin + if not HasSelection then Exit; + A := SelFirst; + B := SelAfter; + Delete(FText, A + 1, B - A); + FCaretPos := A; + FSelStart := FCaretPos; + FSelLen := 0; +end; + +procedure TFlatSpinEdit.InsertText(const S: string); +begin + if S = '' then Exit; + DeleteSelection; + Insert(S, FText, FCaretPos + 1); + Inc(FCaretPos, Length(S)); + FSelStart := FCaretPos; + FSelLen := 0; + UpdateValueFromText; + Invalidate; +end; + +procedure TFlatSpinEdit.UpdateValueFromText; +var + Code, V: Integer; +begin + Val(FText, V, Code); + if (Code <> 0) or (V < FMinValue) or (V > FMaxValue) then Exit; + if FValue = V then Exit; + FValue := V; + DoChange; +end; + +procedure TFlatSpinEdit.CommitText; +var + Code, V: Integer; +begin + if (FText = '') or (FText = '-') then + begin + SetValue(FValue); + Exit; + end; + Val(FText, V, Code); + if Code <> 0 then + V := FValue; + SetValue(V); +end; + +procedure TFlatSpinEdit.StepValue(Dir: Integer); +begin + CommitText; + SetValue(FValue + Dir * FIncrement); +end; + +procedure TFlatSpinEdit.DoChange; +begin + if Assigned(FOnChange) then + FOnChange(Self); +end; + +procedure TFlatSpinEdit.AppUserInput(Sender: TObject; Msg: Cardinal); +var + P: TPoint; +begin + if not FEditing then Exit; + case Msg of + LM_LBUTTONDOWN, LM_RBUTTONDOWN, LM_MBUTTONDOWN: ; + else + Exit; + end; + + P := ScreenToClient(Mouse.CursorPos); + if PtInRect(ClientRect, P) then Exit; + + CommitText; + FDragging := False; + MouseCapture := False; + FEditing := False; + FHot := False; + FHotPart := fspNone; + FDownPart := fspNone; + FSelLen := 0; + Invalidate; +end; + +procedure TFlatSpinEdit.Paint; +var + R, ER, UR, DR, TextR, SelR: TRect; + Pad, TextY, CaretX, A, B, MidX, MidY, S: Integer; + BeforeSel, SelText: string; + + procedure FillPart(const AR: TRect; Part: TFlatSpinPart); + begin + if not Enabled then + Canvas.Brush.Color := FClrBG + else if FDownPart = Part then + Canvas.Brush.Color := FClrBtnDown + else if FHotPart = Part then + Canvas.Brush.Color := FClrBtnHot + else if FHot or FEditing or Focused then + Canvas.Brush.Color := FClrBGHot + else + Canvas.Brush.Color := FClrBG; + Canvas.Pen.Style := psClear; + Canvas.Brush.Style := bsSolid; + Canvas.FillRect(AR); + end; + + procedure DrawArrow(const AR: TRect; Up: Boolean); + var + P: array[0..2] of TPoint; + Size: Integer; + begin + Size := Max(3, DpiScale(4)); + MidX := (AR.Left + AR.Right) div 2; + MidY := (AR.Top + AR.Bottom) div 2; + if Up then + begin + P[0] := Point(MidX, MidY - Size div 2); + P[1] := Point(MidX - Size, MidY + Size div 2); + P[2] := Point(MidX + Size, MidY + Size div 2); + end + else + begin + P[0] := Point(MidX - Size, MidY - Size div 2); + P[1] := Point(MidX + Size, MidY - Size div 2); + P[2] := Point(MidX, MidY + Size div 2); + end; + if Enabled then + Canvas.Brush.Color := FClrBtnText + else + Canvas.Brush.Color := FClrTextDim; + Canvas.Pen.Style := psClear; + Canvas.Polygon(P); + end; +begin + R := ClientRect; + ER := EditRect; + UR := UpRect; + DR := DownRect; + + Canvas.Brush.Color := FClrOuterBG; + Canvas.Brush.Style := bsSolid; + Canvas.Pen.Style := psClear; + Canvas.FillRect(R); + + if FHot or FEditing or Focused then + Canvas.Brush.Color := FClrBGHot + else + Canvas.Brush.Color := FClrBG; + Canvas.Pen.Color := FClrBorder; + Canvas.Pen.Style := psSolid; + Canvas.Pen.Width := 1; + Canvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom); + + FillPart(UR, fspUp); + FillPart(DR, fspDown); + Canvas.Pen.Color := FClrBorder; + Canvas.Pen.Style := psSolid; + Canvas.Line(UR.Left, 1, UR.Left, Height - 1); + Canvas.Line(UR.Left, DR.Top, Width - 1, DR.Top); + DrawArrow(UR, True); + DrawArrow(DR, False); + + Canvas.Font.Assign(Font); + if Enabled then + Canvas.Font.Color := FClrText + else + Canvas.Font.Color := FClrTextDim; + Pad := DpiScale(BASE_PAD_X); + TextR := Rect(ER.Left + Pad, ER.Top, ER.Right - DpiScale(3), ER.Bottom); + TextY := (Height - Canvas.TextHeight('Ag')) div 2; + + if HasSelection then + begin + A := SelFirst; + B := SelAfter; + BeforeSel := Copy(FText, 1, A); + SelText := Copy(FText, A + 1, B - A); + SelR := Rect(TextR.Left + Canvas.TextWidth(BeforeSel), TextY, + TextR.Left + Canvas.TextWidth(BeforeSel + SelText), TextY + Canvas.TextHeight('Ag')); + Canvas.Brush.Color := FClrSelBG; + Canvas.Pen.Style := psClear; + Canvas.FillRect(SelR); + end; + + Canvas.Brush.Style := bsClear; + Canvas.TextRect(TextR, TextR.Left, TextY, FText); + + if HasSelection then + begin + A := SelFirst; + B := SelAfter; + BeforeSel := Copy(FText, 1, A); + SelText := Copy(FText, A + 1, B - A); + Canvas.Font.Color := FClrSelText; + Canvas.TextOut(TextR.Left + Canvas.TextWidth(BeforeSel), TextY, SelText); + end; + + if FEditing and not HasSelection then + begin + S := EnsureRange(FCaretPos, 0, Length(FText)); + CaretX := TextR.Left + Canvas.TextWidth(Copy(FText, 1, S)); + Canvas.Pen.Color := FClrText; + Canvas.Pen.Style := psSolid; + Canvas.Pen.Width := 1; + Canvas.Line(CaretX, TextY, CaretX, TextY + Canvas.TextHeight('Ag')); + end; +end; + +procedure TFlatSpinEdit.MouseEnter; +begin + inherited; + FHot := True; + Invalidate; +end; + +procedure TFlatSpinEdit.MouseLeave; +begin + inherited; + FHot := False; + FHotPart := fspNone; + Invalidate; +end; + +procedure TFlatSpinEdit.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +var + Pos: Integer; +begin + inherited; + if (Button <> mbLeft) or not Enabled then Exit; + SetFocus; + FEditing := True; + FDownPart := PartAt(X, Y); + FHotPart := FDownPart; + if FDownPart in [fspUp, fspDown] then + begin + FDragging := False; + MouseCapture := True; + if FDownPart = fspUp then + StepValue(1) + else + StepValue(-1); + end + else + begin + FDragging := True; + MouseCapture := True; + Pos := CaretPosAtX(X); + FCaretPos := Pos; + FSelStart := Pos; + FSelLen := 0; + end; + Invalidate; +end; + +procedure TFlatSpinEdit.MouseMove(Shift: TShiftState; X, Y: Integer); +var + Pos: Integer; + Part: TFlatSpinPart; +begin + inherited; + Part := PartAt(X, Y); + if FHotPart <> Part then + begin + FHotPart := Part; + if Part = fspEdit then + Cursor := crIBeam + else + Cursor := crDefault; + Invalidate; + end; + + if not FDragging then Exit; + Pos := CaretPosAtX(X); + FCaretPos := Pos; + FSelLen := Pos - FSelStart; + Invalidate; +end; + +procedure TFlatSpinEdit.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + inherited; + if Button <> mbLeft then Exit; + FDragging := False; + FDownPart := fspNone; + MouseCapture := False; + Invalidate; +end; + +procedure TFlatSpinEdit.DblClick; +begin + inherited; + if FHotPart <> fspEdit then Exit; + FEditing := True; + SelectAll; +end; + +procedure TFlatSpinEdit.KeyDown(var Key: Word; Shift: TShiftState); +begin + inherited; + if not Enabled then Exit; + FEditing := True; + case Key of + VK_LEFT: + begin + FCaretPos := EnsureRange(FCaretPos - 1, 0, Length(FText)); + FSelStart := FCaretPos; + FSelLen := 0; + UpdateValueFromText; + Invalidate; + Key := 0; + end; + VK_RIGHT: + begin + FCaretPos := EnsureRange(FCaretPos + 1, 0, Length(FText)); + FSelStart := FCaretPos; + FSelLen := 0; + UpdateValueFromText; + Invalidate; + Key := 0; + end; + VK_HOME: + begin + FCaretPos := 0; + FSelStart := FCaretPos; + FSelLen := 0; + Invalidate; + Key := 0; + end; + VK_END: + begin + FCaretPos := Length(FText); + FSelStart := FCaretPos; + FSelLen := 0; + Invalidate; + Key := 0; + end; + VK_UP: + begin + StepValue(1); + Key := 0; + end; + VK_DOWN: + begin + StepValue(-1); + Key := 0; + end; + VK_RETURN: + begin + CommitText; + SelectAll; + Key := 0; + end; + VK_ESCAPE: + begin + SetTextInternal(IntToStr(FValue), False); + Key := 0; + end; + VK_BACK: + begin + if HasSelection then + DeleteSelection + else if FCaretPos > 0 then + begin + Delete(FText, FCaretPos, 1); + Dec(FCaretPos); + end; + FSelStart := FCaretPos; + FSelLen := 0; + Invalidate; + Key := 0; + end; + VK_DELETE: + begin + if HasSelection then + DeleteSelection + else if FCaretPos < Length(FText) then + Delete(FText, FCaretPos + 1, 1); + FSelStart := FCaretPos; + FSelLen := 0; + Invalidate; + Key := 0; + end; + Ord('A'): + if ssCtrl in Shift then + begin + SelectAll; + Key := 0; + end; + Ord('C'): + if (ssCtrl in Shift) and HasSelection then + begin + Clipboard.AsText := Copy(FText, SelFirst + 1, SelAfter - SelFirst); + Key := 0; + end; + Ord('X'): + if (ssCtrl in Shift) and HasSelection then + begin + Clipboard.AsText := Copy(FText, SelFirst + 1, SelAfter - SelFirst); + DeleteSelection; + UpdateValueFromText; + Invalidate; + Key := 0; + end; + Ord('V'): + if ssCtrl in Shift then + begin + InsertText(Clipboard.AsText); + Key := 0; + end; + end; +end; + +procedure TFlatSpinEdit.KeyPress(var Key: char); +begin + inherited; + if not Enabled then Exit; + FEditing := True; + if Key in ['0'..'9'] then + begin + InsertText(Key); + Key := #0; + end + else if (Key = '-') and (FMinValue < 0) and (FCaretPos = 0) and (Pos('-', FText) = 0) then + begin + InsertText(Key); + Key := #0; + end + else if Key >= #32 then + Key := #0; +end; + +procedure TFlatSpinEdit.DoEnter; +begin + inherited; + FEditing := True; + Invalidate; +end; + +procedure TFlatSpinEdit.DoExit; +begin + inherited; + CommitText; + FEditing := False; + FHot := False; + FHotPart := fspNone; + FDownPart := fspNone; + FSelLen := 0; + Invalidate; +end; + +function TFlatSpinEdit.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; +begin + if Enabled then + StepValue(1); + Result := True; +end; + +function TFlatSpinEdit.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; +begin + if Enabled then + StepValue(-1); + Result := True; +end; + +procedure TFlatSpinEdit.SelectAll; +begin + FSelStart := 0; + FSelLen := Length(FText); + FCaretPos := Length(FText); + Invalidate; +end; + +end. diff --git a/SettingsForm.pas b/SettingsForm.pas index c583e35..f371282 100644 --- a/SettingsForm.pas +++ b/SettingsForm.pas @@ -26,8 +26,10 @@ interface uses Classes, SysUtils, Math, Forms, Controls, Graphics, Dialogs, - StdCtrls, ExtCtrls, Spin, - FlatButton, EqualizerControl, AudioOutput, AudioInput, AppTheme, Settings; + StdCtrls, ExtCtrls, + FlatButton, FlatCheckBox, FlatComboBox, FlatEdit, FlatSpinEdit, FlatFloatSpinEdit, + FlatRadioButton, + EqualizerControl, AudioOutput, AudioInput, AppTheme, Settings; type // PA: MaxPower в Вт, BandCal[0..10] — калибровка 38.8..100.0 на диапазон @@ -89,125 +91,125 @@ type FNavTransmit: TFlatButton; // ---- Audio tab controls ---- - FCmbRXDev: TComboBox; + FCmbRXDev: TFlatComboBox; FRXDevIndices: array[0..63] of Integer; FRXDevCount: Integer; - FCmbTXDev: TComboBox; + FCmbTXDev: TFlatComboBox; FTXDevIndices: array[0..63] of Integer; FTXDevCount: Integer; - FCmbAudioBuffer: TComboBox; + FCmbAudioBuffer: TFlatComboBox; // ---- RX1 sub-tab controls ---- - FCmbFFTSize: TComboBox; - FCmbWindow: TComboBox; - FCmbSpecDet: TComboBox; - FCmbSpecAvg: TComboBox; - FSpecAvgTime: TFloatSpinEdit; - FCmbWfDet: TComboBox; - FCmbWfAvg: TComboBox; - FWfAvgTime: TFloatSpinEdit; - FWfHigh: TFloatSpinEdit; - FWfLow: TFloatSpinEdit; - FWfAGCOffset: TFloatSpinEdit; - FChkWfAGC: TCheckBox; - FChkWfNF: TCheckBox; - FEdRefLevel: TEdit; - FEdRange: TEdit; - FCmbGridStep: TComboBox; + FCmbFFTSize: TFlatComboBox; + FCmbWindow: TFlatComboBox; + FCmbSpecDet: TFlatComboBox; + FCmbSpecAvg: TFlatComboBox; + FSpecAvgTime: TFlatFloatSpinEdit; + FCmbWfDet: TFlatComboBox; + FCmbWfAvg: TFlatComboBox; + FWfAvgTime: TFlatFloatSpinEdit; + FWfHigh: TFlatFloatSpinEdit; + FWfLow: TFlatFloatSpinEdit; + FWfAGCOffset: TFlatFloatSpinEdit; + FChkWfAGC: TFlatCheckBox; + FChkWfNF: TFlatCheckBox; + FEdRefLevel: TFlatEdit; + FEdRange: TFlatEdit; + FCmbGridStep: TFlatComboBox; // ---- General display tab controls ---- - FChkShowSpectrum: TCheckBox; - FChkShowWaterfall: TCheckBox; - FCmbFPS: TComboBox; - FChkLightTheme: TCheckBox; - FCmbFreqMhzDigits: TComboBox; + FChkShowSpectrum: TFlatCheckBox; + FChkShowWaterfall: TFlatCheckBox; + FCmbFPS: TFlatComboBox; + FChkLightTheme: TFlatCheckBox; + FCmbFreqMhzDigits: TFlatComboBox; // ---- PA Settings tab controls ---- - FEdMaxPower: TSpinEdit; - FEdBandCal: array[0..10] of TFloatSpinEdit; - FEdVHFCal: array[0..CFG_XVTR_COUNT-1] of TFloatSpinEdit; + FEdMaxPower: TFlatSpinEdit; + FEdBandCal: array[0..10] of TFlatFloatSpinEdit; + FEdVHFCal: array[0..CFG_XVTR_COUNT-1] of TFlatFloatSpinEdit; FVHFCalLabels: array[0..CFG_XVTR_COUNT-1] of TLabel; // ---- Transmit tab controls ---- // Текущее состояние, отдаётся в OnTXChange целиком при любой правке. FTX: TTXSettings; - FCmbTXMicJack: TComboBox; // "Mic In" / "Line In" - FChkTXMicBoost: TCheckBox; // +20 dB (только Mic In) + FCmbTXMicJack: TFlatComboBox; // "Mic In" / "Line In" + FChkTXMicBoost: TFlatCheckBox; // +20 dB (только Mic In) FLblLineInGain: TLabel; // метка "Line In gain" (только Line In) - FEdLineInGain: TFloatSpinEdit; // -34.5..+12 dB, шаг 1.5 (только Line In) - FChkTXMicBias: TCheckBox; - FChkTXMicPTT: TCheckBox; - FCmbTXMicTR: TComboBox; // "Tip" / "Ring" (только Orion) + FEdLineInGain: TFlatFloatSpinEdit; // -34.5..+12 dB, шаг 1.5 (только Line In) + FChkTXMicBias: TFlatCheckBox; + FChkTXMicPTT: TFlatCheckBox; + FCmbTXMicTR: TFlatComboBox; // "Tip" / "Ring" (только Orion) FLblTipRing: TLabel; // метка (только Orion) - FEdTXMicGain: TFloatSpinEdit; - FEdTXAttOnTX: TSpinEdit; + FEdTXMicGain: TFlatFloatSpinEdit; + FEdTXAttOnTX: TFlatSpinEdit; // Tune (TUN button) - FEdTUNLevel: TSpinEdit; - FEdTUNFreq: TSpinEdit; + FEdTUNLevel: TFlatSpinEdit; + FEdTUNFreq: TFlatSpinEdit; // Filter - FEdTXFiltLow: TSpinEdit; - FEdTXFiltHigh: TSpinEdit; - FCmbTXFiltNC: TComboBox; - FCmbTXFiltMP: TComboBox; - FCmbTXFiltWindow: TComboBox; + FEdTXFiltLow: TFlatSpinEdit; + FEdTXFiltHigh: TFlatSpinEdit; + FCmbTXFiltNC: TFlatComboBox; + FCmbTXFiltMP: TFlatComboBox; + FCmbTXFiltWindow: TFlatComboBox; // Compressor - FChkTXCompOn: TCheckBox; - FEdTXCompGain: TFloatSpinEdit; + FChkTXCompOn: TFlatCheckBox; + FEdTXCompGain: TFlatFloatSpinEdit; // Leveler - FChkTXLevOn: TCheckBox; - FEdTXLevTop: TFloatSpinEdit; - FEdTXLevDecay: TSpinEdit; + FChkTXLevOn: TFlatCheckBox; + FEdTXLevTop: TFlatFloatSpinEdit; + FEdTXLevDecay: TFlatSpinEdit; // ALC - FChkTXALCOn: TCheckBox; - FEdTXALCMaxGain: TFloatSpinEdit; - FEdTXALCDecay: TSpinEdit; + FChkTXALCOn: TFlatCheckBox; + FEdTXALCMaxGain: TFlatFloatSpinEdit; + FEdTXALCDecay: TFlatSpinEdit; // Phase Rotator - FChkTXPHROn: TCheckBox; - FEdTXPHRStages: TSpinEdit; - FEdTXPHRFreq: TFloatSpinEdit; + FChkTXPHROn: TFlatCheckBox; + FEdTXPHRStages: TFlatSpinEdit; + FEdTXPHRFreq: TFlatFloatSpinEdit; // EQ FTXEQControl: TEqualizerControl; // AM - FEdTXAMCarrier: TFloatSpinEdit; + FEdTXAMCarrier: TFlatFloatSpinEdit; // FM - FEdTXFMDev: TFloatSpinEdit; - FEdTXFMLow: TSpinEdit; - FEdTXFMHigh: TSpinEdit; - FCmbTXFMEmph: TComboBox; + FEdTXFMDev: TFlatFloatSpinEdit; + FEdTXFMLow: TFlatSpinEdit; + FEdTXFMHigh: TFlatSpinEdit; + FCmbTXFMEmph: TFlatComboBox; // CTCSS - FChkTXCTCSSOn: TCheckBox; - FEdTXCTCSSFreq: TFloatSpinEdit; + FChkTXCTCSSOn: TFlatCheckBox; + FEdTXCTCSSFreq: TFlatFloatSpinEdit; // TX Display (отдельный analyzer) - FCmbTXFFT: TComboBox; - FCmbTXWindow: TComboBox; - FCmbTXSpecDet: TComboBox; - FCmbTXSpecAvg: TComboBox; - FEdTXSpecAvgTime: TFloatSpinEdit; - FCmbTXWfDet: TComboBox; - FCmbTXWfAvg: TComboBox; - FEdTXWfAvgTime: TFloatSpinEdit; + FCmbTXFFT: TFlatComboBox; + FCmbTXWindow: TFlatComboBox; + FCmbTXSpecDet: TFlatComboBox; + FCmbTXSpecAvg: TFlatComboBox; + FEdTXSpecAvgTime: TFlatFloatSpinEdit; + FCmbTXWfDet: TFlatComboBox; + FCmbTXWfAvg: TFlatComboBox; + FEdTXWfAvgTime: TFlatFloatSpinEdit; // TX Grid (отдельные от RX grid в Display) - FEdTXRefLevel: TEdit; - FEdTXRange: TEdit; - FCmbTXGridStep: TComboBox; + FEdTXRefLevel: TFlatEdit; + FEdTXRange: TFlatEdit; + FCmbTXGridStep: TFlatComboBox; // ---- Alex / Antenna tab controls ---- FPageAlex: TScrollBox; FNavAlex: TFlatButton; // Per-band antenna radio buttons (bands 0..10 = 160m..6m) - FAlexRxAnt: array[0..10, 1..3] of TRadioButton; - FAlexTxAnt: array[0..10, 1..3] of TRadioButton; + FAlexRxAnt: array[0..10, 1..3] of TFlatRadioButton; + FAlexTxAnt: array[0..10, 1..3] of TFlatRadioButton; // Per-band secondary RX (взаимно исключающие checkboxes) - FAlexRxByps: array[0..10] of TCheckBox; // BYPS: Ext1+Bypass - FAlexRxExt1: array[0..10] of TCheckBox; // EXT1: Ext2+Bypass - FAlexRxXvtr: array[0..10] of TCheckBox; // XVTR: XvtrDDC+Bypass + FAlexRxByps: array[0..10] of TFlatCheckBox; // BYPS: Ext1+Bypass + FAlexRxExt1: array[0..10] of TFlatCheckBox; // EXT1: Ext2+Bypass + FAlexRxXvtr: array[0..10] of TFlatCheckBox; // XVTR: XvtrDDC+Bypass // Per-band Do Not TX - FAlexDoNotTx: array[0..10] of TCheckBox; + FAlexDoNotTx: array[0..10] of TFlatCheckBox; // Global TX routing flags - FAlexRxBypassOnTx: TCheckBox; - FAlexExt1OnTx: TCheckBox; - FAlexGndBpf2OnTx: TCheckBox; - FAlexEnableXvtrHf: TCheckBox; + FAlexRxBypassOnTx: TFlatCheckBox; + FAlexExt1OnTx: TFlatCheckBox; + FAlexGndBpf2OnTx: TFlatCheckBox; + FAlexEnableXvtrHf: TFlatCheckBox; // Current Alex config state FAlexConfig: TAlexSettings; FAlexBoardType: Integer; @@ -217,39 +219,39 @@ type // ---- XVTR (Transverter) tab controls ---- FPageXvtr: TScrollBox; FNavXvtr: TFlatButton; - FXvtrEn: array[0..CFG_XVTR_COUNT-1] of TCheckBox; - FXvtrName: array[0..CFG_XVTR_COUNT-1] of TEdit; - FXvtrBegin: array[0..CFG_XVTR_COUNT-1] of TFloatSpinEdit; // MHz - FXvtrEnd: array[0..CFG_XVTR_COUNT-1] of TFloatSpinEdit; // MHz - FXvtrLOOff: array[0..CFG_XVTR_COUNT-1] of TFloatSpinEdit; // MHz - FXvtrLOErr: array[0..CFG_XVTR_COUNT-1] of TFloatSpinEdit; // Hz (целые) - FXvtrRXGain: array[0..CFG_XVTR_COUNT-1] of TFloatSpinEdit; // dB - FXvtrRXOnly: array[0..CFG_XVTR_COUNT-1] of TCheckBox; - FXvtrPower: array[0..CFG_XVTR_COUNT-1] of TSpinEdit; // 0..100 - FXvtrDisPA: array[0..CFG_XVTR_COUNT-1] of TCheckBox; - FXvtrRXAnt: array[0..CFG_XVTR_COUNT-1] of TComboBox; // 0=def..3=ANT3 - FChkXvtrTunPwr: TCheckBox; + FXvtrEn: array[0..CFG_XVTR_COUNT-1] of TFlatCheckBox; + FXvtrName: array[0..CFG_XVTR_COUNT-1] of TFlatEdit; + FXvtrBegin: array[0..CFG_XVTR_COUNT-1] of TFlatFloatSpinEdit; // MHz + FXvtrEnd: array[0..CFG_XVTR_COUNT-1] of TFlatFloatSpinEdit; // MHz + FXvtrLOOff: array[0..CFG_XVTR_COUNT-1] of TFlatFloatSpinEdit; // MHz + FXvtrLOErr: array[0..CFG_XVTR_COUNT-1] of TFlatFloatSpinEdit; // Hz (целые) + FXvtrRXGain: array[0..CFG_XVTR_COUNT-1] of TFlatFloatSpinEdit; // dB + FXvtrRXOnly: array[0..CFG_XVTR_COUNT-1] of TFlatCheckBox; + FXvtrPower: array[0..CFG_XVTR_COUNT-1] of TFlatSpinEdit; // 0..100 + FXvtrDisPA: array[0..CFG_XVTR_COUNT-1] of TFlatCheckBox; + FXvtrRXAnt: array[0..CFG_XVTR_COUNT-1] of TFlatComboBox; // 0=def..3=ANT3 + FChkXvtrTunPwr: TFlatCheckBox; FXvtrConfig: TXvtrSettings; FOnXvtrChange: TOnXvtrChange; // ---- CAT tab controls ---- - FCATSerialEn: array[0..3] of TCheckBox; - FCATSerialPort: array[0..3] of TEdit; - FCATSerialBaud: array[0..3] of TComboBox; - FCATSerialDataBits: array[0..3] of TComboBox; - FCATSerialStopBits: array[0..3] of TComboBox; - FCATSerialParity: array[0..3] of TComboBox; - FCATTcpEn: TCheckBox; - FCATTcpPort: TSpinEdit; + FCATSerialEn: array[0..3] of TFlatCheckBox; + FCATSerialPort: array[0..3] of TFlatEdit; + FCATSerialBaud: array[0..3] of TFlatComboBox; + FCATSerialDataBits: array[0..3] of TFlatComboBox; + FCATSerialStopBits: array[0..3] of TFlatComboBox; + FCATSerialParity: array[0..3] of TFlatComboBox; + FCATTcpEn: TFlatCheckBox; + FCATTcpPort: TFlatSpinEdit; // ---- Advanced tab controls ---- - FChkDither: TCheckBox; - FChkRandom: TCheckBox; - FChkWebEnabled: TCheckBox; - FEdWebPort: TSpinEdit; - FEdWebBind: TEdit; - FEdWebUser: TEdit; - FEdWebPass: TEdit; + FChkDither: TFlatCheckBox; + FChkRandom: TFlatCheckBox; + FChkWebEnabled: TFlatCheckBox; + FEdWebPort: TFlatSpinEdit; + FEdWebBind: TFlatEdit; + FEdWebUser: TFlatEdit; + FEdWebPass: TFlatEdit; // ---- Close button ---- FBtnClose: TFlatButton; @@ -307,7 +309,7 @@ type function MakeLbl(AParent: TWinControl; const Cap: string; ALeft, ATop, AW: Integer): TLabel; function MakeCombo(AParent: TWinControl; ALeft, ATop, AW: Integer; - OnChange: TNotifyEvent): TComboBox; + OnChange: TNotifyEvent): TFlatComboBox; function MakeGroupPanel(AParent: TWinControl; const Cap: string; ALeft, ATop, AW, AH: Integer): TPanel; function MakeScrollPage: TScrollBox; @@ -497,15 +499,14 @@ begin end; function TSettingsForm.MakeCombo(AParent: TWinControl; ALeft, ATop, AW: Integer; - OnChange: TNotifyEvent): TComboBox; + OnChange: TNotifyEvent): TFlatComboBox; begin - Result := TComboBox.Create(Self); + Result := TFlatComboBox.Create(Self); Result.Parent := AParent; Result.Left := ALeft; Result.Top := ATop; Result.Width := AW; Result.Height := BTN_H; - Result.Style := csDropDownList; Result.Color := CLR_INPUT; Result.Font.Color := CLR_INPUT_TEXT; Result.Font.Name := UI_FONT; @@ -801,7 +802,7 @@ begin Grp := MakeGroupPanel(FPageDisplay, 'Visible Panes', MARGIN, 86, 650, 86); - FChkShowSpectrum := TCheckBox.Create(Self); + FChkShowSpectrum := TFlatCheckBox.Create(Self); FChkShowSpectrum.Parent := Grp; FChkShowSpectrum.Caption := 'Spectrum'; FChkShowSpectrum.SetBounds(PAD, R1, CHKW, 22); @@ -811,7 +812,7 @@ begin FChkShowSpectrum.Font.Size := 9; FChkShowSpectrum.OnChange := OnVisibilityChkChange; - FChkShowWaterfall := TCheckBox.Create(Self); + FChkShowWaterfall := TFlatCheckBox.Create(Self); FChkShowWaterfall.Parent := Grp; FChkShowWaterfall.Caption := 'Waterfall'; FChkShowWaterfall.SetBounds(PAD + CHKW + 20, R1, CHKW, 22); @@ -831,7 +832,7 @@ begin Grp := MakeGroupPanel(FPageDisplay, 'Appearance', MARGIN, 292, 650, 68); - FChkLightTheme := TCheckBox.Create(Self); + FChkLightTheme := TFlatCheckBox.Create(Self); FChkLightTheme.Parent := Grp; FChkLightTheme.Caption := 'Light theme'; FChkLightTheme.SetBounds(PAD, R1, CHKW, 22); @@ -873,9 +874,9 @@ var i: Integer; function MkFloat(AX, AY, AW: Integer; AValue, AMin, AMax, AInc: Double; - AOnChange: TNotifyEvent): TFloatSpinEdit; + AOnChange: TNotifyEvent): TFlatFloatSpinEdit; begin - Result := TFloatSpinEdit.Create(Self); + Result := TFlatFloatSpinEdit.Create(Self); Result.Parent := Grp; Result.SetBounds(AX, AY, AW, BTN_H); Result.Value := AValue; Result.MinValue := AMin; @@ -887,9 +888,9 @@ var end; function MkEdit(AX, AY, AW: Integer; const AText: string; - AOnExit: TNotifyEvent): TEdit; + AOnExit: TNotifyEvent): TFlatEdit; begin - Result := TEdit.Create(Self); + Result := TFlatEdit.Create(Self); Result.Parent := Grp; Result.SetBounds(AX, AY, AW, BTN_H); Result.Color := CLR_INPUT; Result.Font.Color := CLR_INPUT_TEXT; @@ -987,7 +988,7 @@ begin FWfAGCOffset := MkFloat(CX, R1 + 2 * STEP, SPW, 0.0, -40.0, 40.0, 0.5, OnWfThresholdChange); Grp := MakeGroupPanel(FPageWaterfall, 'AGC && Noise Floor', MARGIN, 458, 650, 140); - FChkWfAGC := TCheckBox.Create(Self); + FChkWfAGC := TFlatCheckBox.Create(Self); FChkWfAGC.Parent := Grp; FChkWfAGC.Caption := 'Waterfall AGC'; FChkWfAGC.SetBounds(PAD, R1, 200, 22); @@ -996,7 +997,7 @@ begin FChkWfAGC.Font.Name := UI_FONT; FChkWfAGC.Font.Size := 9; FChkWfAGC.OnChange := OnWfAGCNFChkChange; - FChkWfNF := TCheckBox.Create(Self); + FChkWfNF := TFlatCheckBox.Create(Self); FChkWfNF.Parent := Grp; FChkWfNF.Caption := 'Waterfall NF'; FChkWfNF.SetBounds(PAD, R1 + STEP, 200, 22); @@ -1026,9 +1027,9 @@ var Grp: TPanel; Y, i: Integer; - function MkSpin(AParent: TWinControl; AX, AY: Integer; AMin, AMax, AVal: Integer): TSpinEdit; + function MkSpin(AParent: TWinControl; AX, AY: Integer; AMin, AMax, AVal: Integer): TFlatSpinEdit; begin - Result := TSpinEdit.Create(Self); + Result := TFlatSpinEdit.Create(Self); Result.Parent := AParent; Result.SetBounds(AX, AY, SPW, BTN_H); Result.MinValue := AMin; @@ -1042,9 +1043,9 @@ var end; function MkFloat(AParent: TWinControl; AX, AY: Integer; - AVal, AMin, AMax, AInc: Double): TFloatSpinEdit; + AVal, AMin, AMax, AInc: Double): TFlatFloatSpinEdit; begin - Result := TFloatSpinEdit.Create(Self); + Result := TFlatFloatSpinEdit.Create(Self); Result.Parent := AParent; Result.SetBounds(AX, AY, SPW, BTN_H); Result.MinValue := AMin; @@ -1059,9 +1060,9 @@ var Result.OnChange := OnTXAnyChange; end; - function MkChk(AParent: TWinControl; AX, AY, AW: Integer; const ACap: string): TCheckBox; + function MkChk(AParent: TWinControl; AX, AY, AW: Integer; const ACap: string): TFlatCheckBox; begin - Result := TCheckBox.Create(Self); + Result := TFlatCheckBox.Create(Self); Result.Parent := AParent; Result.Caption := ACap; Result.SetBounds(AX, AY, AW, 22); @@ -1071,7 +1072,7 @@ var Result.OnChange := OnTXAnyChange; end; - function MkCmb(AParent: TWinControl; AX, AY, AW: Integer): TComboBox; + function MkCmb(AParent: TWinControl; AX, AY, AW: Integer): TFlatComboBox; begin Result := MakeCombo(AParent, AX, AY, AW, OnTXAnyChange); end; @@ -1272,7 +1273,7 @@ begin Grp := MakeGroupPanel(FPageTransmit, 'TX Grid', MARGIN, Y, GRP_W, 170); MakeLbl(Grp, 'Reference level', PAD, R1 + 5, LW); - FEdTXRefLevel := TEdit.Create(Self); + FEdTXRefLevel := TFlatEdit.Create(Self); FEdTXRefLevel.Parent := Grp; FEdTXRefLevel.SetBounds(CX, R1, 96, BTN_H); FEdTXRefLevel.Color := CLR_INPUT; @@ -1283,7 +1284,7 @@ begin FEdTXRefLevel.OnExit := OnTXAnyChange; MakeLbl(Grp, 'Range (dB)', PAD, R1 + STEP + 5, LW); - FEdTXRange := TEdit.Create(Self); + FEdTXRange := TFlatEdit.Create(Self); FEdTXRange.Parent := Grp; FEdTXRange.SetBounds(CX, R1 + STEP, 96, BTN_H); FEdTXRange.Color := CLR_INPUT; @@ -1537,10 +1538,10 @@ const GRP_H = 222; function MakeFloatSpin(AParent: TWinControl; ALeft, ATop: Integer; - AChange: TNotifyEvent): TFloatSpinEdit; - var E: TFloatSpinEdit; + AChange: TNotifyEvent): TFlatFloatSpinEdit; + var E: TFlatFloatSpinEdit; begin - E := TFloatSpinEdit.Create(Self); + E := TFlatFloatSpinEdit.Create(Self); E.Parent := AParent; E.SetBounds(ALeft, ATop, ED_W, BTN_H + 2); E.Color := CLR_INPUT; @@ -1559,7 +1560,7 @@ const var Grp: TPanel; Lbl: TLabel; - Spin: TSpinEdit; + Spin: TFlatSpinEdit; i, r, c, X, Y: Integer; begin with TLabel.Create(Self) do @@ -1594,7 +1595,7 @@ begin Lbl.Font.Name := UI_FONT; Lbl.Font.Size := 9; - Spin := TSpinEdit.Create(Self); + Spin := TFlatSpinEdit.Create(Self); Spin.Parent := Grp; Spin.SetBounds(GRP_PAD + 150, R1, ED_W, BTN_H + 2); Spin.Color := CLR_INPUT; @@ -1683,9 +1684,9 @@ const R1 = 42; var Grp: TPanel; - Chk: TCheckBox; - Ed: TEdit; - Spin: TSpinEdit; + Chk: TFlatCheckBox; + Ed: TFlatEdit; + Spin: TFlatSpinEdit; Y: Integer; begin with TLabel.Create(Self) do @@ -1702,7 +1703,7 @@ begin // ── ADC ─────────────────────────────────────────────────────────────────── Grp := MakeGroupPanel(FPageAdvanced, 'ADC', MARGIN, 86, 420, 128); - Chk := TCheckBox.Create(Self); + Chk := TFlatCheckBox.Create(Self); Chk.Parent := Grp; Chk.Caption := 'Dither Enabled'; Chk.SetBounds(GRP_PAD, R1, 260, 22); @@ -1713,7 +1714,7 @@ begin Chk.OnChange := OnADCChkChange; FChkDither := Chk; - Chk := TCheckBox.Create(Self); + Chk := TFlatCheckBox.Create(Self); Chk.Parent := Grp; Chk.Caption := 'Random Enabled'; Chk.SetBounds(GRP_PAD, R1 + ROW_H, 260, 22); @@ -1728,7 +1729,7 @@ begin Grp := MakeGroupPanel(FPageAdvanced, 'Web Server', MARGIN, 230, 500, 252); Y := R1; - Chk := TCheckBox.Create(Self); + Chk := TFlatCheckBox.Create(Self); Chk.Parent := Grp; Chk.Caption := 'Enabled'; Chk.SetBounds(GRP_PAD, Y, 260, 22); @@ -1741,7 +1742,7 @@ begin Y := Y + ROW_H; MakeLbl(Grp, 'Port:', GRP_PAD, Y + 4, LBL_W); - Spin := TSpinEdit.Create(Self); + Spin := TFlatSpinEdit.Create(Self); Spin.Parent := Grp; Spin.SetBounds(GRP_PAD + LBL_W + 12, Y, 90, BTN_H); Spin.Color := CLR_INPUT; @@ -1756,7 +1757,7 @@ begin Y := Y + ROW_H; MakeLbl(Grp, 'Interface:', GRP_PAD, Y + 4, LBL_W); - Ed := TEdit.Create(Self); + Ed := TFlatEdit.Create(Self); Ed.Parent := Grp; Ed.SetBounds(GRP_PAD + LBL_W + 12, Y, ED_W, BTN_H); Ed.Color := CLR_INPUT; @@ -1769,7 +1770,7 @@ begin Y := Y + ROW_H; MakeLbl(Grp, 'Username:', GRP_PAD, Y + 4, LBL_W); - Ed := TEdit.Create(Self); + Ed := TFlatEdit.Create(Self); Ed.Parent := Grp; Ed.SetBounds(GRP_PAD + LBL_W + 12, Y, ED_W, BTN_H); Ed.Color := CLR_INPUT; @@ -1782,7 +1783,7 @@ begin Y := Y + ROW_H; MakeLbl(Grp, 'Password:', GRP_PAD, Y + 4, LBL_W); - Ed := TEdit.Create(Self); + Ed := TFlatEdit.Create(Self); Ed.Parent := Grp; Ed.SetBounds(GRP_PAD + LBL_W + 12, Y, ED_W, BTN_H); Ed.Color := CLR_INPUT; @@ -1885,8 +1886,18 @@ procedure TSettingsForm.ApplyTheme(const T: TAppTheme); else TLabel(Ctrl).Font.Color := T.TextDim; end - else if Ctrl is TCheckBox then - TCheckBox(Ctrl).Font.Color := T.Text + else if Ctrl is TFlatCheckBox then + TFlatCheckBox(Ctrl).SetAppTheme(T) + else if Ctrl is TFlatComboBox then + TFlatComboBox(Ctrl).SetAppTheme(T) + else if Ctrl is TFlatEdit then + TFlatEdit(Ctrl).SetAppTheme(T) + else if Ctrl is TFlatSpinEdit then + TFlatSpinEdit(Ctrl).SetAppTheme(T) + else if Ctrl is TFlatFloatSpinEdit then + TFlatFloatSpinEdit(Ctrl).SetAppTheme(T) + else if Ctrl is TFlatRadioButton then + TFlatRadioButton(Ctrl).SetAppTheme(T) else if Ctrl is TListBox then begin TListBox(Ctrl).Color := T.BG; @@ -2472,10 +2483,10 @@ const var i, col, row, gx, gy, j: Integer; Grp: TPanel; - Chk: TCheckBox; - Ed: TEdit; - Cmb: TComboBox; - Spin: TSpinEdit; + Chk: TFlatCheckBox; + Ed: TFlatEdit; + Cmb: TFlatComboBox; + Spin: TFlatSpinEdit; begin with TLabel.Create(Self) do begin @@ -2502,7 +2513,7 @@ begin Grp := MakeGroupPanel(FPageCAT, 'Serial Port ' + IntToStr(i + 1), gx, gy, GRP_W, GRP_H); - Chk := TCheckBox.Create(Self); + Chk := TFlatCheckBox.Create(Self); Chk.Parent := Grp; Chk.Caption := 'Enable'; Chk.SetBounds(PAD, R1, GRP_W - PAD * 2, 22); @@ -2513,7 +2524,7 @@ begin FCATSerialEn[i] := Chk; MakeLbl(Grp, 'Port:', PAD, R1 + STEP + 6, LW); - Ed := TEdit.Create(Self); + Ed := TFlatEdit.Create(Self); Ed.Parent := Grp; Ed.SetBounds(CX, R1 + STEP, EDT_W, BTN_H); Ed.Color := CLR_INPUT; Ed.Font.Color := CLR_INPUT_TEXT; @@ -2560,7 +2571,7 @@ begin gy := 86 + 2 * (GRP_H + GRP_GAP); Grp := MakeGroupPanel(FPageCAT, 'TCP CAT Server', MARGIN, gy, GRP_W * 2 + GRP_GAP, 116); - FCATTcpEn := TCheckBox.Create(Self); + FCATTcpEn := TFlatCheckBox.Create(Self); FCATTcpEn.Parent := Grp; FCATTcpEn.Caption := 'Enable TCP server (default port 19090)'; FCATTcpEn.SetBounds(PAD, R1, 300, 22); @@ -2569,7 +2580,7 @@ begin FCATTcpEn.OnChange := OnCATTcpChange; MakeLbl(Grp, 'Port:', PAD, R1 + STEP + 6, LW); - Spin := TSpinEdit.Create(Self); + Spin := TFlatSpinEdit.Create(Self); Spin.Parent := Grp; Spin.SetBounds(CX, R1 + STEP, 100, BTN_H + 2); Spin.Color := CLR_INPUT; Spin.Font.Color := CLR_INPUT_TEXT; @@ -2696,7 +2707,7 @@ var Grp, GrpTX: TPanel; b: Integer; Y: Integer; - Chk: TCheckBox; + Chk: TFlatCheckBox; RxGrp, TxGrp: TPanel; // In Lazarus, TRadioButton has no GroupIndex; buttons are grouped by parent. @@ -2712,9 +2723,9 @@ var Result.Caption := ''; end; - function MkRb(AParent: TWinControl; AX: Integer): TRadioButton; + function MkRb(AParent: TWinControl; AX: Integer): TFlatRadioButton; begin - Result := TRadioButton.Create(Self); + Result := TFlatRadioButton.Create(Self); Result.Parent := AParent; Result.Caption := ''; Result.SetBounds(AX, 0, 22, 20); @@ -2725,9 +2736,9 @@ var end; function MkCh(AParent: TWinControl; const ACap: string; - AX, AY, AW: Integer): TCheckBox; + AX, AY, AW: Integer): TFlatCheckBox; begin - Result := TCheckBox.Create(Self); + Result := TFlatCheckBox.Create(Self); Result.Parent := AParent; Result.Caption := ACap; Result.SetBounds(AX, AY, AW, 20); @@ -2893,11 +2904,11 @@ var Tag, b: Integer; begin if FLoading then Exit; - Tag := TCheckBox(Sender).Tag; + Tag := TFlatCheckBox(Sender).Tag; if Tag >= 200 then begin b := Tag - 200; // XVTR - if TCheckBox(Sender).Checked then + if TFlatCheckBox(Sender).Checked then begin FLoading := True; FAlexRxByps[b].Checked := False; @@ -2908,7 +2919,7 @@ begin else if Tag >= 100 then begin b := Tag - 100; // EXT1 - if TCheckBox(Sender).Checked then + if TFlatCheckBox(Sender).Checked then begin FLoading := True; FAlexRxByps[b].Checked := False; @@ -2919,7 +2930,7 @@ begin else begin b := Tag; // BYPS - if TCheckBox(Sender).Checked then + if TFlatCheckBox(Sender).Checked then begin FLoading := True; FAlexRxExt1[b].Checked := False; @@ -2988,9 +2999,9 @@ var L: TLabel; function MakeFlt(AParent: TWinControl; AX, AY, AW: Integer; - AMin, AMax, AStep: Double; ADec: Integer): TFloatSpinEdit; + AMin, AMax, AStep: Double; ADec: Integer): TFlatFloatSpinEdit; begin - Result := TFloatSpinEdit.Create(Self); + Result := TFlatFloatSpinEdit.Create(Self); Result.Parent := AParent; Result.SetBounds(AX, AY, AW, BTN_H); Result.MinValue := AMin; @@ -3005,9 +3016,9 @@ var end; function MakeInt(AParent: TWinControl; AX, AY, AW: Integer; - AMin, AMax: Integer): TSpinEdit; + AMin, AMax: Integer): TFlatSpinEdit; begin - Result := TSpinEdit.Create(Self); + Result := TFlatSpinEdit.Create(Self); Result.Parent := AParent; Result.SetBounds(AX, AY, AW, BTN_H); Result.MinValue := AMin; @@ -3020,9 +3031,9 @@ var end; // Чекбокс без подписи (только квадрат). Подпись пишем отдельно над колонкой. - function MakeChk(AParent: TWinControl; AX, AY: Integer): TCheckBox; + function MakeChk(AParent: TWinControl; AX, AY: Integer): TFlatCheckBox; begin - Result := TCheckBox.Create(Self); + Result := TFlatCheckBox.Create(Self); Result.Parent := AParent; Result.Caption := ''; Result.SetBounds(AX, AY, 22, 20); @@ -3032,9 +3043,9 @@ var Result.OnChange := OnXvtrAnyChange; end; - function MakeEdt(AParent: TWinControl; AX, AY, AW: Integer): TEdit; + function MakeEdt(AParent: TWinControl; AX, AY, AW: Integer): TFlatEdit; begin - Result := TEdit.Create(Self); + Result := TFlatEdit.Create(Self); Result.Parent := AParent; Result.SetBounds(AX, AY, AW, BTN_H); Result.Color := CLR_INPUT; @@ -3045,12 +3056,11 @@ var Result.OnChange := OnXvtrAnyChange; end; - function MakeCmb(AParent: TWinControl; AX, AY, AW: Integer): TComboBox; + function MakeCmb(AParent: TWinControl; AX, AY, AW: Integer): TFlatComboBox; begin - Result := TComboBox.Create(Self); + Result := TFlatComboBox.Create(Self); Result.Parent := AParent; Result.SetBounds(AX, AY, AW, BTN_H); - Result.Style := csDropDownList; Result.Color := CLR_INPUT; Result.Font.Color := CLR_INPUT_TEXT; Result.Font.Name := UI_FONT; @@ -3144,7 +3154,7 @@ begin GrpY := GrpY + GRP_TITLE_H + HDR_H + CFG_XVTR_COUNT * ROW_H + 14 + 18; GrpOpts := MakeGroupPanel(FPageXvtr, 'Options', MARGIN, GrpY, GRP_W, GRP_TITLE_H + 36); - FChkXvtrTunPwr := TCheckBox.Create(Self); + FChkXvtrTunPwr := TFlatCheckBox.Create(Self); FChkXvtrTunPwr.Parent := GrpOpts; FChkXvtrTunPwr.Caption := 'Use XVTR power for TUN ' + '(TUN button uses the per-slot TX Power instead of the global TUN Level)'; diff --git a/ewsdr.lpi b/ewsdr.lpi index dc940c5..6eae773 100644 --- a/ewsdr.lpi +++ b/ewsdr.lpi @@ -131,6 +131,34 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +