Starts TCDComboBox implementation, with a native routine for an eventual native item choose popup/dialog

git-svn-id: trunk@35641 -
2025-11-19 19:09:28 +01:00 · 2012-03-01 15:30:26 +00:00 · 2012-03-01 15:30:26 +00:00 · 179972fb78
commit 179972fb78
parent f7471ce97d
11 changed files with 219 additions and 25 deletions
--- a/components/customdrawn/customdrawnextras.pas
+++ b/components/customdrawn/customdrawnextras.pas
@ -184,7 +184,7 @@ procedure Register;
 begin
  RegisterComponents('Custom Drawn', [
    // Standard tab
-    TCDButton, TCDEdit, TCDCheckBox, TCDRadioButton, TCDScrollBar, TCDGroupBox,
+    TCDButton, TCDEdit, TCDCheckBox, TCDRadioButton, TCDComboBox, TCDScrollBar, TCDGroupBox,
    // Additional
    TCDStaticText,
    // Common Controls
--- a/lcl/customdrawn_common.pas
+++ b/lcl/customdrawn_common.pas
@ -44,9 +44,10 @@ type
    procedure DrawShallowSunkenFrame(ADest: TCanvas; ADestPos: TPoint; ASize: TSize); override;
    procedure DrawTickmark(ADest: TCanvas; ADestPos: TPoint); override;
    procedure DrawSlider(ADest: TCanvas; ADestPos: TPoint; ASize: TSize; AState: TCDControlState); override;
-    procedure DrawCompactArrow(ADest: TCanvas; ADestPos: TPoint; ADirection: TCDControlState); override;
+    procedure DrawArrow(ADest: TCanvas; ADestPos: TPoint; ADirection: TCDControlState; ASize: Integer = 7); override;
    // Extra buttons drawing routines
    procedure DrawSmallCloseButton(ADest: TCanvas; ADestPos: TPoint); override;
+    procedure DrawButtonWithArrow(ADest: TCanvas; ADestPos: TPoint; ASize: TSize; AState: TCDControlState); override;
    // TCDControl
    procedure DrawControl(ADest: TCanvas; ASize: TSize;
      AState: TCDControlState; AStateEx: TCDControlStateEx); override;
@ -75,6 +76,9 @@ type
      AState: TCDControlState; AStateEx: TCDControlStateEx); override;
    procedure DrawRadioButton(ADest: TCanvas; ASize: TSize;
      AState: TCDControlState; AStateEx: TCDControlStateEx); override;
+    // TCDComboBox
+    procedure DrawComboBox(ADest: TCanvas; ASize: TSize;
+      AState: TCDControlState; AStateEx: TCDEditStateEx); override;
    // TCDScrollBar
    procedure DrawScrollBar(ADest: TCanvas; ASize: TSize;
      AState: TCDControlState; AStateEx: TCDPositionedCStateEx); override;
@ -550,39 +554,42 @@ begin
  end;
 end;

-procedure TCDDrawerCommon.DrawCompactArrow(ADest: TCanvas; ADestPos: TPoint;
-  ADirection: TCDControlState);
+procedure TCDDrawerCommon.DrawArrow(ADest: TCanvas; ADestPos: TPoint;
+  ADirection: TCDControlState; ASize: Integer = 7);
 var
  lPoints: array[0..2] of TPoint;
  lPos: TPoint;
+  lSize, lSizeHalf: Integer;
 begin
  lPos := ADestPos;
+  lSize := ASize - 1;
+  lSizeHalf := ASize div 2;
  // Move the arrow a little bit when a sunken state is passed
  if csfSunken in ADirection then lPos := Point(lPos.X+1, lPos.Y+1);

  if csfLeftArrow in ADirection then
  begin
-    lPoints[0] := Point(lPos.X,   lPos.Y+3);// left point
-    lPoints[1] := Point(lPos.X+3, lPos.Y+6);// lower point
-    lPoints[2] := Point(lPos.X+3, lPos.Y);  // upper point
+    lPoints[0] := Point(lPos.X,           lPos.Y+lSizeHalf);// left point
+    lPoints[1] := Point(lPos.X+lSizeHalf, lPos.Y+lSize);// lower point
+    lPoints[2] := Point(lPos.X+lSizeHalf, lPos.Y);  // upper point
  end
  else if csfRightArrow in ADirection then
  begin
-    lPoints[0] := Point(lPos.X+1, lPos.Y);  // upper point
-    lPoints[1] := Point(lPos.X+1, lPos.Y+6);// lower point
-    lPoints[2] := Point(lPos.X+4, lPos.Y+3);// right point
+    lPoints[0] := Point(lPos.X+1,           lPos.Y);  // upper point
+    lPoints[1] := Point(lPos.X+1,           lPos.Y+lSize);// lower point
+    lPoints[2] := Point(lPos.X+1+lSizeHalf, lPos.Y+lSizeHalf);// right point
  end
  else if csfUpArrow in ADirection then
  begin
-    lPoints[0] := Point(lPos.X+3, lPos.Y);  // upper point
-    lPoints[1] := Point(lPos.X,   lPos.Y+3);// left point
-    lPoints[2] := Point(lPos.X+6, lPos.Y+3);// right point
+    lPoints[0] := Point(lPos.X+lSizeHalf, lPos.Y);  // upper point
+    lPoints[1] := Point(lPos.X,           lPos.Y+lSizeHalf);// left point
+    lPoints[2] := Point(lPos.X+lSize,     lPos.Y+lSizeHalf);// right point
  end
  else // downArrow
  begin
-    lPoints[0] := Point(lPos.X,   lPos.Y+1);// left point
-    lPoints[1] := Point(lPos.X+6, lPos.Y+1);// right point
-    lPoints[2] := Point(lPos.X+3, lPos.Y+4);// lower point
+    lPoints[0] := Point(lPos.X,           lPos.Y+1);// left point
+    lPoints[1] := Point(lPos.X+lSize,     lPos.Y+1);// right point
+    lPoints[2] := Point(lPos.X+lSizeHalf, lPos.Y+1+lSizeHalf);// lower point
  end;
  ADest.Brush.Style := bsSolid;
  ADest.Brush.Color := clBlack;
@ -601,6 +608,22 @@ begin
  ADest.Pen.Width := 1;
 end;

+procedure TCDDrawerCommon.DrawButtonWithArrow(ADest: TCanvas; ADestPos: TPoint;
+  ASize: TSize; AState: TCDControlState);
+begin
+  // First the background color
+  ADest.Brush.Color := WIN2000_BTNFACE;
+  ADest.Brush.Style := bsSolid;
+  ADest.FillRect(Bounds(ADestPos.X, ADestPos.Y, ASize.CX, ASize.CY));
+
+  // Now the button frame
+  if csfSunken in AState then DrawSunkenFrame(ADest, ADestPos, ASize)
+  else DrawRaisedFrame(ADest, ADestPos, ASize);
+
+  // Now the arrow
+  DrawArrow(ADest, Point(ADestPos.X + ASize.CY div 4, ADestPos.Y + ASize.CY * 3 div 8), AState, ASize.CY div 2);
+end;
+
 procedure TCDDrawerCommon.DrawControl(ADest: TCanvas;
  ASize: TSize; AState: TCDControlState; AStateEx: TCDControlStateEx);
 var
@ -1040,6 +1063,18 @@ begin
  ADest.TextOut(lCircleHeight+5, 0, AStateEx.Caption);
 end;

+procedure TCDDrawerCommon.DrawComboBox(ADest: TCanvas; ASize: TSize;
+  AState: TCDControlState; AStateEx: TCDEditStateEx);
+begin
+  // First the edit, with a margin on the right for the button
+  AStateEx.RightTextMargin := ASize.CY;
+  DrawEdit(ADest, ASize, AState, AStateEx);
+
+  // Now the button
+  DrawButtonWithArrow(ADest, Point(ASize.CX - ASize.CY, 0), Size(ASize.CY, ASize.CY),
+    AStateEx.ExtraButtonState);
+end;
+
 procedure TCDDrawerCommon.DrawScrollBar(ADest: TCanvas;
  ASize: TSize; AState: TCDControlState; AStateEx: TCDPositionedCStateEx);
 var
@ -1076,8 +1111,8 @@ begin
  end;

  if csfHorizontal in AState then
-    DrawCompactArrow(ADest, Point(lPos.X+5, lPos.Y+5), [csfLeftArrow]+lArrowState)
-  else DrawCompactArrow(ADest, Point(lPos.X+5, lPos.Y+5), [csfUpArrow]+lArrowState);
+    DrawArrow(ADest, Point(lPos.X+5, lPos.Y+5), [csfLeftArrow]+lArrowState)
+  else DrawArrow(ADest, Point(lPos.X+5, lPos.Y+5), [csfUpArrow]+lArrowState);

  // Right/Bottom button
  if csfHorizontal in AState then
@ -1099,8 +1134,8 @@ begin
  end;

  if csfHorizontal in AState then
-    DrawCompactArrow(ADest, Point(lPos.X+5, lPos.Y+5), [csfRightArrow] + lArrowState)
-  else DrawCompactArrow(ADest, Point(lPos.X+5, lPos.Y+5), [csfDownArrow] + lArrowState);
+    DrawArrow(ADest, Point(lPos.X+5, lPos.Y+5), [csfRightArrow] + lArrowState)
+  else DrawArrow(ADest, Point(lPos.X+5, lPos.Y+5), [csfDownArrow] + lArrowState);

  // The slider
  lPos := Point(0, 0);
--- a/lcl/customdrawncontrols.pas
+++ b/lcl/customdrawncontrols.pas
@ -188,7 +188,6 @@ type
  private
    DragDropStarted: boolean;
    FCaretTimer: TTimer;
-    FEditState: TCDEditStateEx; // Points to the same object as FStateEx, so don't Free!
    function GetLeftTextMargin: Integer;
    function GetRightTextMargin: Integer;
    procedure HandleCaretTimer(Sender: TObject);
@ -202,6 +201,7 @@ type
    function MousePosToCaretPos(X, Y: Integer): TPoint;
    function IsSomethingSelected: Boolean;
  protected
+    FEditState: TCDEditStateEx; // Points to the same object as FStateEx, so don't Free!
    function GetControlId: TCDControlID; override;
    procedure CreateControlStateEx; override;
    // keyboard
@ -267,6 +267,30 @@ type
    property TabStop default True;
  end;

+  { TCDComboBox }
+
+  TCDComboBox = class(TCDEdit)
+  private
+    FIsClickingButton: Boolean;
+    FItemIndex: Integer;
+    FItems: TStringList;
+    function GetItems: TStrings;
+    procedure OnShowSelectItemDialogResult(ASelectedItem: Integer);
+    procedure SetItemIndex(AValue: Integer);
+  protected
+    function GetControlId: TCDControlID; override;
+    // mouse
+    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
+      X, Y: integer); override;
+    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+  published
+    property Items: TStrings read GetItems;
+    property ItemIndex: Integer read FItemIndex write SetItemIndex;
+  end;
+
  { TCDPositionedControl }

  TCDPositionedControl = class(TCDControl)
@ -674,6 +698,86 @@ implementation
 const
  sTABSHEET_DEFAULT_NAME = 'CTabSheet';

+{ TCDComboBox }
+
+function TCDComboBox.GetItems: TStrings;
+begin
+  Result := FItems;
+end;
+
+procedure TCDComboBox.OnShowSelectItemDialogResult(ASelectedItem: Integer);
+begin
+  SetItemIndex(ASelectedItem);
+end;
+
+procedure TCDComboBox.SetItemIndex(AValue: Integer);
+var
+  lValue: Integer;
+begin
+  lValue := AValue;
+
+  // First basic check
+  if lValue > FItems.Count then lValue := FItems.Count;
+  if lValue < -1 then lValue := -1;
+
+  if FItemIndex=lValue then Exit;
+  FItemIndex:=lValue;
+  if lValue >= 0 then Text := FItems.Strings[lValue];
+end;
+
+function TCDComboBox.GetControlId: TCDControlID;
+begin
+  Result := cidComboBox;
+end;
+
+procedure TCDComboBox.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
+  Y: integer);
+begin
+  if (X > Width - Height) then
+  begin
+    FIsClickingButton := True;
+    FEditState.ExtraButtonState := FEditState.ExtraButtonState + [csfSunken];
+    Invalidate;
+    Exit;
+  end;
+
+  inherited MouseDown(Button, Shift, X, Y);
+end;
+
+procedure TCDComboBox.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
+  Y: integer);
+begin
+  if FIsClickingButton then
+  begin
+    FIsClickingButton := False;
+    FEditState.ExtraButtonState := FEditState.ExtraButtonState - [csfSunken];
+    Invalidate;
+    if (X > Width - Height) then
+    begin
+      // Call the combobox dialog
+      LCLIntf.OnShowSelectItemDialogResult := @OnShowSelectItemDialogResult;
+      LCLIntf.ShowSelectItemDialog(FItems);
+
+      Exit;
+    end;
+  end;
+
+  inherited MouseUp(Button, Shift, X, Y);
+end;
+
+constructor TCDComboBox.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+
+  FItems := TStringList.Create;
+end;
+
+destructor TCDComboBox.Destroy;
+begin
+  FItems.Free;
+  inherited Destroy;
+end;
+
 { TCDPanel }

 function TCDPanel.GetControlId: TCDControlID;
--- a/lcl/customdrawndrawers.pas
+++ b/lcl/customdrawndrawers.pas
@ -150,6 +150,8 @@ type
    EventArrived: Boolean; // Added by event handlers and used by the caret so that it stops blinking while events are incoming
    // customizable extra margins, zero is the base value
    LeftTextMargin, RightTextMargin: Integer;
+    // For the combo box for example
+    ExtraButtonState: TCDControlState;
  end;

  TCDPanelStateEx = class(TCDControlStateEx)
@ -302,9 +304,10 @@ type
    procedure DrawShallowSunkenFrame(ADest: TCanvas; ADestPos: TPoint; ASize: TSize); virtual; abstract;
    procedure DrawTickmark(ADest: TCanvas; ADestPos: TPoint); virtual; abstract;
    procedure DrawSlider(ADest: TCanvas; ADestPos: TPoint; ASize: TSize; AState: TCDControlState); virtual; abstract;
-    procedure DrawCompactArrow(ADest: TCanvas; ADestPos: TPoint; ADirection: TCDControlState); virtual; abstract;
+    procedure DrawArrow(ADest: TCanvas; ADestPos: TPoint; ADirection: TCDControlState; ASize: Integer = 7); virtual; abstract;
    // Extra buttons drawing routines
    procedure DrawSmallCloseButton(ADest: TCanvas; ADestPos: TPoint); virtual; abstract;
+    procedure DrawButtonWithArrow(ADest: TCanvas; ADestPos: TPoint; ASize: TSize; AState: TCDControlState); virtual; abstract;
    // TCDControl
    procedure DrawControl(ADest: TCanvas; ASize: TSize;
      AState: TCDControlState; AStateEx: TCDControlStateEx); virtual; abstract;
@ -330,6 +333,9 @@ type
      AState: TCDControlState; AStateEx: TCDControlStateEx); virtual; abstract;
    procedure DrawRadioButton(ADest: TCanvas; ASize: TSize;
      AState: TCDControlState; AStateEx: TCDControlStateEx); virtual; abstract;
+    // TCDComboBox
+    procedure DrawComboBox(ADest: TCanvas; ASize: TSize;
+      AState: TCDControlState; AStateEx: TCDEditStateEx); virtual; abstract;
    // TCDScrollBar
    procedure DrawScrollBar(ADest: TCanvas; ASize: TSize;
      AState: TCDControlState; AStateEx: TCDPositionedCStateEx); virtual; abstract;
@ -642,6 +648,7 @@ begin
  cidEdit:       DrawEdit(ADest, ASize, AState, TCDEditStateEx(AStateEx));
  cidCheckBox:   DrawCheckBox(ADest, ASize, AState, AStateEx);
  cidRadioButton:DrawRadioButton(ADest, ASize, AState, AStateEx);
+  cidComboBox:   DrawComboBox(ADest, ASize, AState, TCDEditStateEx(AStateEx));
  cidScrollBar:  DrawScrollBar(ADest, ASize, AState, TCDPositionedCStateEx(AStateEx));
  cidGroupBox:   DrawGroupBox(ADest, ASize, AState, AStateEx);
  cidPanel:      DrawPanel(ADest, ASize, AState, TCDPanelStateEx(AStateEx));
--- a/lcl/include/intfbaselcl.inc
+++ b/lcl/include/intfbaselcl.inc
@ -659,6 +659,14 @@ begin

 end;

+// This routine is only for platforms which need a special combobox dialog, like Android
+// It returns true if a dialog was provided for doing this task or false otherwise
+// The process is assynchronous, so the result will be given in LCLIntf.OnShowSelectItemDialogResult
+function TWidgetSet.ShowSelectItemDialog(const AItems: TStrings): Boolean;
+begin
+  Result := False;
+end;
+
 function TWidgetSet.StretchMaskBlt(DestDC: HDC;
  X, Y, Width, Height: Integer; SrcDC: HDC;
  XSrc, YSrc, SrcWidth, SrcHeight: Integer;
--- a/lcl/include/lclintf.inc
+++ b/lcl/include/lclintf.inc
@ -457,6 +457,11 @@ begin
  WidgetSet.SetRubberBandRect(ARubberBand, ARect);
 end;

+function ShowSelectItemDialog(const AItems: TStrings): Boolean;
+begin
+  Result := Widgetset.ShowSelectItemDialog(AItems);
+end;
+
 function StretchMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer;
  SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer;
  Mask: HBITMAP; XMask, YMask: Integer; Rop: DWORD): Boolean;
--- a/lcl/include/lclintfh.inc
+++ b/lcl/include/lclintfh.inc
@ -120,6 +120,7 @@ function SetCaretRespondToFocus(handle: HWND; ShowHideOnFocus: boolean): Boolean
 function SetComboMinDropDownSize(Handle: HWND; MinItemsWidth, MinItemsHeight, MinItemCount: integer): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 procedure SetEventHandlerFlags(AHandler: PEventHandler; NewFlags: dword); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 procedure SetRubberBandRect(const ARubberBand: HWND; const ARect: TRect); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
+function ShowSelectItemDialog(const AItems: TStrings): Boolean;{$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 function StretchMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; Mask: HBITMAP; XMask, YMask: Integer; Rop: DWORD): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}

 function TextUTF8Out(DC: HDC; X, Y: Integer;  Str: PChar; Count: Longint): Boolean;  {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
--- a/lcl/lclintf.pas
+++ b/lcl/lclintf.pas
@ -82,6 +82,9 @@ function FindDefaultBrowser(out ABrowser, AParams: String): Boolean;
 function OpenURL(AURL: String): Boolean;
 function OpenDocument(APath: String): Boolean;

+var
+  OnShowSelectItemDialogResult: TOnShowSelectItemDialogResult;
+
 implementation

 type
--- a/lcl/lcltype.pp
+++ b/lcl/lcltype.pp
@ -96,6 +96,11 @@ type
  TNativeCanvasType = (nctWindowsDC, nctLazCanvas);
  TNativeCanvasTypes = set of TNativeCanvasType;

+  // Callback types for new LCLIntf dialogs
+
+  // -1 indicates that the dialog was canceled and no item selected
+  TOnShowSelectItemDialogResult = procedure (ASelectedItem: Integer) of object;
+
  {$ifndef WINDOWS}
  THandle = type PtrUInt; // define our own, because the SysUtils.THandle = System.THandle is a longint
  HANDLE = THandle;
--- a/test/customdrawn/mainform.lfm
+++ b/test/customdrawn/mainform.lfm
@ -10,10 +10,10 @@ object Form1: TForm1
  LCLVersion = '0.9.31'
  object comboControls: TComboBox
    Left = 80
-    Height = 21
+    Height = 27
    Top = 12
    Width = 136
-    ItemHeight = 13
+    ItemHeight = 0
    ItemIndex = 0
    Items.Strings = (
      'TCDMenu'
@ -61,7 +61,7 @@ object Form1: TForm1
    Height = 240
    Top = 40
    Width = 463
-    PageIndex = 23
+    PageIndex = 9
    Anchors = [akTop, akLeft, akRight]
    TabOrder = 2
    TabStop = True
@ -396,6 +396,30 @@ object Form1: TForm1
    object pageListBoxes: TPage
    end
    object pageComboBoxes: TPage
+      object ComboBox1: TComboBox
+        Left = 12
+        Height = 27
+        Top = 18
+        Width = 124
+        ItemHeight = 0
+        ItemIndex = 0
+        Items.Strings = (
+          'TComboBox'
+          'Item2'
+          'Item3'
+          'Item4'
+        )
+        TabOrder = 0
+        Text = 'TComboBox'
+      end
+      object CDComboBox1: TCDComboBox
+        Left = 160
+        Height = 25
+        Top = 20
+        Width = 128
+        DrawStyle = dsDefault
+        Text = 'CDComboBox1'
+      end
    end
    object pageScrollBars: TPage
      object sbNative1: TScrollBar
--- a/test/customdrawn/mainform.pas
+++ b/test/customdrawn/mainform.pas
@ -32,10 +32,12 @@ type
    CDCheckBox6: TCDCheckBox;
    CDCheckBox7: TCDCheckBox;
    CDCheckBox8: TCDCheckBox;
+    CDComboBox1: TCDComboBox;
    CDEdit1: TCDEdit;
    CDEdit2: TCDEdit;
    CDEdit3: TCDEdit;
    CDTabControl1: TCDTabControl;
+    ComboBox1: TComboBox;
    Edit2: TEdit;
    FloatSpinEdit1: TFloatSpinEdit;
    pageSpins: TPage;