Added BCComboBox

bccombobox.pas

@@ -0,0 +1,105 @@
+unit BCComboBox;
+
+{$mode delphi}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, BCButton,
+  StdCtrls;
+
+type
+
+  { TBCComboBox }
+
+  TBCComboBox = class(TCustomControl)
+  private
+    FButton: TBCButton;
+    FForm: TForm;
+    FListBox: TListBox;
+    procedure ButtonClick(Sender: TObject);
+    function GetItems: TStrings;
+    procedure ListBoxClick(Sender: TObject);
+    procedure ListBoxSelectionChange(Sender: TObject; User: boolean);
+    procedure SetItems(AValue: TStrings);
+  protected
+
+  public
+    constructor Create(AOwner: TComponent); override;
+  published
+    property Button: TBCButton read FButton write FButton;
+    property ListBox: TListBox read FListBox write FListBox;
+    property Form: TForm read FForm write FForm;
+    property Items: TStrings read GetItems write SetItems;
+  end;
+
+procedure Register;
+
+implementation
+
+procedure Register;
+begin
+  RegisterComponents('BGRA Controls', [TBCComboBox]);
+end;
+
+{ TBCComboBox }
+
+procedure TBCComboBox.ButtonClick(Sender: TObject);
+var
+  p: TPoint;
+begin
+  p := ControlToScreen(Point(FButton.Left, FButton.Top + FButton.Height));
+  FForm.Left := p.X;
+  FForm.Top := p.Y;
+  FForm.Visible := not FForm.Visible;
+  if FForm.Visible and FListBox.CanSetFocus then
+    FListBox.SetFocus;
+  if FForm.Visible then
+    FForm.Constraints.MinWidth := FButton.Width;
+end;
+
+function TBCComboBox.GetItems: TStrings;
+begin
+  Result := FListBox.Items;
+end;
+
+procedure TBCComboBox.ListBoxClick(Sender: TObject);
+begin
+  FForm.Visible := False;
+  FButton.Caption := FListBox.Items[FListBox.ItemIndex];
+end;
+
+procedure TBCComboBox.ListBoxSelectionChange(Sender: TObject; User: boolean);
+begin
+  FButton.Caption := FListBox.Items[FListBox.ItemIndex];
+end;
+
+procedure TBCComboBox.SetItems(AValue: TStrings);
+begin
+  Items := AValue;
+end;
+
+constructor TBCComboBox.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FButton := TBCButton.Create(Self);
+  FButton.Align := alClient;
+  FButton.Parent := Self;
+  FButton.OnClick := ButtonClick;
+  FButton.DropDownArrow := True;
+
+  FForm := TForm.Create(Self);
+  FForm.Visible := False;
+  FForm.FormStyle := fsStayOnTop;
+  FForm.BorderStyle := bsNone;
+  FForm.AutoSize := True;
+
+  FListBox := TListBox.Create(FForm);
+  FListBox.Align := alClient;
+  FListBox.Parent := FForm;
+  FListBox.BorderStyle := bsNone;
+  FListBox.OnClick := ListBoxClick;
+  FListBox.OnSelectionChange := ListBoxSelectionChange;
+end;
+
+end.

bgracontrols.lpk

@@ -21,20 +21,15 @@
       </Parsing>
       <CodeGeneration>
         <Optimizations>
-          <OptimizationLevel Value="3"/>
+          <OptimizationLevel Value="0"/>
           <VariablesInRegisters Value="True"/>
         </Optimizations>
       </CodeGeneration>
-      <Linking>
-        <Debugging>
-          <UseLineInfoUnit Value="False"/>
-        </Debugging>
-      </Linking>
     </CompilerOptions>
     <Description Value="BGRA Controls is a set of graphical UI elements that you can use with Lazarus LCL applications."/>
     <License Value="Modified LGPL"/>
     <Version Major="6" Minor="2" Release="1"/>
-    <Files Count="54">
+    <Files Count="55">
       <Item1>
         <Filename Value="bcbasectrls.pas"/>
         <AddToUsesPkgSection Value="False"/>
@@ -297,6 +292,11 @@
         <HasRegisterProc Value="True"/>
         <UnitName Value="BCGradientButton"/>
       </Item54>
+      <Item55>
+        <Filename Value="bccombobox.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="BCComboBox"/>
+      </Item55>
     </Files>
     <RequiredPkgs Count="2">
       <Item1>

bgracontrols.pas

@@ -17,7 +17,8 @@ uses
   BGRASpeedButton, BGRASpriteAnimation, BGRAVirtualScreen, ColorSpeedButton, 
   DTAnalogClock, DTAnalogCommon, DTAnalogGauge, dtthemedclock, dtthemedgauge, 
   MaterialColors, BGRAImageTheme, BGRAThemeButton, BGRATheme, BGRAColorTheme, 
-  BGRAThemeRadioButton, bgracontrolsinfo, BCGradientButton, LazarusPackageIntf;
+  BGRAThemeRadioButton, bgracontrolsinfo, BCGradientButton, BCComboBox, 
+  LazarusPackageIntf;
 
 implementation
 
@@ -59,6 +60,7 @@ begin
   RegisterUnit('BGRAColorTheme', @BGRAColorTheme.Register);
   RegisterUnit('BGRAThemeRadioButton', @BGRAThemeRadioButton.Register);
   RegisterUnit('BCGradientButton', @BCGradientButton.Register);
+  RegisterUnit('BCComboBox', @BCComboBox.Register);
 end;
 
 initialization

bgrapascalscriptcomponent.pas

@@ -2,13 +2,9 @@
   This source is only used to compile and install the package.
  }
 
-{******************************* CONTRIBUTOR(S) ******************************
-- Edivando S. Santos Brasil | mailedivando@gmail.com
-  (Compatibility with delphi VCL 11/2018)
-
-***************************** END CONTRIBUTOR(S) *****************************}
 unit bgrapascalscriptcomponent;
 
+{$warn 5023 off : no warning about unused units}
 interface
 
 uses
@@ -16,7 +12,7 @@ uses
 
 implementation
 
-{$IFDEF FPC}procedure Register;{$ENDIF}
+procedure Register;
 begin
   RegisterUnit('uPSI_BGRAPascalScript', @uPSI_BGRAPascalScript.Register);
 end;

test/test_bccombobox/test_bccombobox.lpi

@@ -0,0 +1,82 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="test_bccombobox"/>
+      <Scaled Value="True"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <XPManifest>
+        <DpiAware Value="True"/>
+      </XPManifest>
+      <Icon Value="0"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+      <Modes Count="0"/>
+    </RunParams>
+    <RequiredPackages Count="2">
+      <Item1>
+        <PackageName Value="bgracontrols"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="LCL"/>
+      </Item2>
+    </RequiredPackages>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="test_bccombobox.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="umain.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="Form1"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="test_bccombobox"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

test/test_bccombobox/test_bccombobox.lpr

@@ -0,0 +1,22 @@
+program test_bccombobox;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms, umain
+  { you can add units after this };
+
+{$R *.res}
+
+begin
+  RequireDerivedFormResource:=True;
+  Application.Scaled:=True;
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.
+

test/test_bccombobox/umain.lfm

@@ -0,0 +1,17 @@
+object Form1: TForm1
+  Left = 433
+  Height = 240
+  Top = 119
+  Width = 320
+  Caption = 'Form1'
+  ClientHeight = 240
+  ClientWidth = 320
+  OnCreate = FormCreate
+  LCLVersion = '2.1.0.0'
+  object BCComboBox1: TBCComboBox
+    Left = 8
+    Height = 39
+    Top = 8
+    Width = 205
+  end
+end

test/test_bccombobox/umain.pas

@@ -0,0 +1,72 @@
+unit umain;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, BCComboBox,
+  BCListBox, LCLType;
+
+type
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    BCComboBox1: TBCComboBox;
+    procedure FormCreate(Sender: TObject);
+  private
+    procedure OnListBoxDrawItem(Control: TWinControl; Index: integer;
+      ARect: TRect; State: TOwnerDrawState);
+  public
+
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+{$R *.lfm}
+
+{ TForm1 }
+
+procedure TForm1.FormCreate(Sender: TObject);
+begin
+  // Adding items
+  BCComboBox1.Items.Add('One');
+  BCComboBox1.Items.Add('Two');
+  BCComboBox1.Items.Add('Three');
+
+  // Selecting items
+  BCComboBox1.ListBox.ItemIndex := 0;
+
+  // Style
+  BCComboBox1.ListBox.Style := lbOwnerDrawFixed;
+  BCComboBox1.ListBox.OnDrawItem := @OnListBoxDrawItem;
+  BCComboBox1.ListBox.Color := clGray;
+  BCComboBox1.ListBox.ItemHeight := 2 * Canvas.GetTextHeight('aq');
+  BCComboBox1.ListBox.Options := []; // do not draw focus rect
+end;
+
+procedure TForm1.OnListBoxDrawItem(Control: TWinControl; Index: integer;
+  ARect: TRect; State: TOwnerDrawState);
+var
+  aCanvas: TCanvas;
+begin
+  aCanvas := TListBox(Control).Canvas;
+
+  if odSelected in State then
+    aCanvas.Brush.Color := clBlack
+  else
+    aCanvas.Brush.Color := clGray;
+
+  aCanvas.Font.Color := clWhite;
+  aCanvas.FillRect(ARect);
+
+  aCanvas.TextRect(ARect, 15, ARect.Top +
+    (aCanvas.GetTextHeight(TListBox(Control).Items[Index]) div 2),
+    TListBox(Control).Items[Index]);
+end;
+
+end.