RxFPC:patch from Iliya Iliev: 1. TRxDBLookupCombo - added protected method DoSelect - encapsulates OnSelect logic; 2. TRxDBLookupCombo - added public methods Clear & IsEmpty; 3. TRxDBLookupCombo - exposed property BorderStyle (default bsNone). When it's bsNone, nothing changed, while when it's bsSingle there are changes in Painting.; 4. TRxDBLookupCombo - changed method Paint - it respects BorderStyle property; 5. TPopUpFormOptions - added new property SearchFromStart (default false) - when it's false, nothing changed, while when it's true popup form locates the row only if it starts with the searched text.

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

components/rx/trunk/demos/RxLookup/project1.lpi

@@ -1,7 +1,7 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="9"/>
+    <Version Value="11"/>
     <General>
       <MainUnit Value="0"/>
       <ResourceType Value="res"/>
@@ -22,10 +22,14 @@
       <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
     </PublishOptions>
     <RunParams>
-      <local>
+      <FormatVersion Value="2"/>
-        <FormatVersion Value="1"/>
+      <Modes Count="1">
-        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+        <Mode0 Name="default">
-      </local>
+          <local>
+            <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+          </local>
+        </Mode0>
+      </Modes>
     </RunParams>
     <RequiredPackages Count="3">
       <Item1>
@@ -40,7 +44,7 @@
         <PackageName Value="LCL"/>
       </Item3>
     </RequiredPackages>
-    <Units Count="9">
+    <Units Count="11">
       <Unit0>
         <Filename Value="project1.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -56,8 +60,8 @@
         <ResourceBaseClass Value="Form"/>
         <UnitName Value="Unit1"/>
         <IsVisibleTab Value="True"/>
-        <TopLine Value="42"/>
+        <TopLine Value="53"/>
-        <CursorPos Y="47"/>
+        <CursorPos X="45" Y="69"/>
         <UsageCount Value="22"/>
         <Loaded Value="True"/>
         <LoadedDesigner Value="True"/>
@@ -115,12 +119,55 @@
         <CursorPos Y="326"/>
         <UsageCount Value="10"/>
       </Unit8>
+      <Unit9>
+        <Filename Value="/home/install/source/fpcsrc/packages/fcl-db/src/base/db.pas"/>
+        <EditorIndex Value="-1"/>
+        <TopLine Value="547"/>
+        <CursorPos X="3" Y="566"/>
+        <UsageCount Value="10"/>
+      </Unit9>
+      <Unit10>
+        <Filename Value="../../rxdb/rxlookup.pas"/>
+        <EditorIndex Value="1"/>
+        <TopLine Value="300"/>
+        <CursorPos X="3" Y="327"/>
+        <UsageCount Value="10"/>
+        <Loaded Value="True"/>
+      </Unit10>
     </Units>
-    <JumpHistory Count="1">
+    <JumpHistory Count="8" HistoryIndex="7">
       <Position1>
         <Filename Value="unit1.pas"/>
         <Caret Line="47" TopLine="34"/>
       </Position1>
+      <Position2>
+        <Filename Value="unit1.pas"/>
+        <Caret Line="61" Column="14" TopLine="37"/>
+      </Position2>
+      <Position3>
+        <Filename Value="unit1.pas"/>
+        <Caret Line="25" Column="5" TopLine="9"/>
+      </Position3>
+      <Position4>
+        <Filename Value="unit1.pas"/>
+        <Caret Line="12" Column="37" TopLine="9"/>
+      </Position4>
+      <Position5>
+        <Filename Value="unit1.pas"/>
+        <Caret Line="26" Column="21" TopLine="9"/>
+      </Position5>
+      <Position6>
+        <Filename Value="unit1.pas"/>
+        <Caret Line="27" Column="21" TopLine="9"/>
+      </Position6>
+      <Position7>
+        <Filename Value="unit1.pas"/>
+        <Caret Line="64" Column="43" TopLine="52"/>
+      </Position7>
+      <Position8>
+        <Filename Value="unit1.pas"/>
+        <Caret Line="65" Column="43" TopLine="53"/>
+      </Position8>
     </JumpHistory>
   </ProjectOptions>
   <CompilerOptions>

components/rx/trunk/demos/RxLookup/unit1.lfm

@@ -8,14 +8,15 @@ object Form1: TForm1
   ClientHeight = 368
   ClientWidth = 498
   OnCreate = FormCreate
-  LCLVersion = '1.7'
+  LCLVersion = '1.9.0.0'
   object Label1: TLabel
     AnchorSideLeft.Control = Owner
-    AnchorSideTop.Control = Owner
+    AnchorSideTop.Control = GroupBox1
+    AnchorSideTop.Side = asrBottom
     Left = 6
-    Height = 20
+    Height = 13
-    Top = 6
+    Top = 94
-    Width = 85
+    Width = 68
     BorderSpacing.Around = 6
     Caption = 'Select item...'
     ParentColor = False
@@ -25,10 +26,10 @@ object Form1: TForm1
     AnchorSideLeft.Side = asrBottom
     AnchorSideTop.Control = Button1
     AnchorSideTop.Side = asrCenter
-    Left = 106
+    Left = 97
-    Height = 20
+    Height = 13
-    Top = 78
+    Top = 149
-    Width = 42
+    Width = 35
     BorderSpacing.Around = 6
     Caption = 'Label2'
     ParentColor = False
@@ -40,8 +41,8 @@ object Form1: TForm1
     AnchorSideRight.Control = Owner
     AnchorSideRight.Side = asrBottom
     Left = 12
-    Height = 32
+    Height = 25
-    Top = 32
+    Top = 113
     Width = 480
     AutoSize = True
     Anchors = [akTop, akLeft, akRight]
@@ -75,9 +76,9 @@ object Form1: TForm1
     AnchorSideTop.Control = RxDBLookupCombo1
     AnchorSideTop.Side = asrBottom
     Left = 6
-    Height = 36
+    Height = 23
-    Top = 70
+    Top = 144
-    Width = 94
+    Width = 85
     AutoSize = True
     BorderSpacing.Around = 6
     Caption = 'Test caption'
@@ -89,10 +90,10 @@ object Form1: TForm1
     AnchorSideTop.Side = asrBottom
     AnchorSideRight.Control = Owner
     AnchorSideRight.Side = asrBottom
-    Left = 424
+    Left = 427
-    Height = 36
+    Height = 23
-    Top = 112
+    Top = 173
-    Width = 68
+    Width = 65
     Anchors = [akTop, akRight]
     AutoSize = True
     BorderSpacing.Around = 6
@@ -106,25 +107,85 @@ object Form1: TForm1
     AnchorSideTop.Side = asrBottom
     AnchorSideRight.Control = Button2
     Left = 6
-    Height = 37
+    Height = 21
-    Top = 112
+    Top = 173
-    Width = 412
+    Width = 415
     Anchors = [akTop, akLeft, akRight]
     BorderSpacing.Around = 6
     TabOrder = 3
     Text = 'Edit1'
   end
   object DBGrid1: TDBGrid
+    AnchorSideTop.Control = Edit1
+    AnchorSideTop.Side = asrBottom
     Left = 0
-    Height = 208
+    Height = 168
-    Top = 160
+    Top = 200
     Width = 498
     Align = alBottom
+    Anchors = [akTop, akLeft, akRight, akBottom]
     Color = clWindow
     Columns = <>
     DataSource = dsLookUpData
     TabOrder = 4
   end
+  object GroupBox1: TGroupBox
+    AnchorSideLeft.Control = Owner
+    AnchorSideTop.Control = Owner
+    AnchorSideRight.Control = Owner
+    AnchorSideRight.Side = asrBottom
+    Left = 6
+    Height = 82
+    Top = 6
+    Width = 486
+    Anchors = [akTop, akLeft, akRight]
+    AutoSize = True
+    BorderSpacing.Around = 6
+    Caption = 'RxDBLookupCombo visual options'
+    ClientHeight = 64
+    ClientWidth = 482
+    TabOrder = 5
+    object CheckBox1: TCheckBox
+      AnchorSideLeft.Control = GroupBox1
+      AnchorSideTop.Control = GroupBox1
+      Left = 6
+      Height = 17
+      Top = 6
+      Width = 38
+      BorderSpacing.Around = 6
+      Caption = 'Flat'
+      OnChange = CheckBox1Change
+      TabOrder = 0
+    end
+    object RadioGroup1: TRadioGroup
+      AnchorSideLeft.Control = CheckBox1
+      AnchorSideLeft.Side = asrBottom
+      AnchorSideTop.Control = GroupBox1
+      Left = 50
+      Height = 52
+      Top = 6
+      Width = 77
+      AutoFill = True
+      AutoSize = True
+      BorderSpacing.Around = 6
+      Caption = 'Border style'
+      ChildSizing.LeftRightSpacing = 6
+      ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+      ChildSizing.EnlargeVertical = crsHomogenousChildResize
+      ChildSizing.ShrinkHorizontal = crsScaleChilds
+      ChildSizing.ShrinkVertical = crsScaleChilds
+      ChildSizing.Layout = cclLeftToRightThenTopToBottom
+      ChildSizing.ControlsPerLine = 1
+      ClientHeight = 34
+      ClientWidth = 73
+      Items.Strings = (
+        'bsNone'
+        'bsSingle'
+      )
+      OnClick = CheckBox1Change
+      TabOrder = 1
+    end
+  end
   object rxData1: TRxMemoryData
     FieldDefs = <    
       item
@@ -132,8 +193,8 @@ object Form1: TForm1
         DataType = ftInteger
       end>
     PacketRecords = 0
-    left = 320
+    Left = 320
-    top = 8
+    Top = 8
     object rxData1ID: TLongintField
       DisplayWidth = 10
       FieldKind = fkData
@@ -161,8 +222,8 @@ object Form1: TForm1
         DataType = ftCurrency
       end>
     PacketRecords = 0
-    left = 208
+    Left = 208
-    top = 56
+    Top = 56
     object rxLookUpDataID: TLongintField
       DisplayWidth = 10
       FieldKind = fkData
@@ -200,12 +261,12 @@ object Form1: TForm1
   end
   object dsData1: TDataSource
     DataSet = rxData1
-    left = 288
+    Left = 288
-    top = 8
+    Top = 8
   end
   object dsLookUpData: TDataSource
     DataSet = rxLookUpData
-    left = 176
+    Left = 176
-    top = 56
+    Top = 56
   end
 end

components/rx/trunk/demos/RxLookup/unit1.pas

@@ -6,7 +6,7 @@ interface
 
 uses
   Classes, SysUtils, db, FileUtil, LResources, Forms, Controls, Graphics,
-  Dialogs, StdCtrls, DBGrids, rxlookup, rxmemds;
+  Dialogs, StdCtrls, DBGrids, ExtCtrls, rxlookup, rxmemds;
 
 type
 
@@ -15,12 +15,15 @@ type
   TForm1 = class(TForm)
     Button1: TButton;
     Button2: TButton;
+    CheckBox1: TCheckBox;
     DBGrid1: TDBGrid;
     dsData1: TDatasource;
     dsLookUpData: TDatasource;
     Edit1: TEdit;
+    GroupBox1: TGroupBox;
     Label1: TLabel;
     Label2: TLabel;
+    RadioGroup1: TRadioGroup;
     rxData1ID: TLongintField;
     RxDBLookupCombo1: TRxDBLookupCombo;
     rxData1: TRxMemoryData;
@@ -30,6 +33,7 @@ type
     rxLookUpDataPrice: TCurrencyField;
     procedure Button1Click(Sender: TObject);
     procedure Button2Click(Sender: TObject);
+    procedure CheckBox1Change(Sender: TObject);
     procedure FormCreate(Sender: TObject);
   private
     { private declarations }
@@ -56,6 +60,16 @@ begin
   RxDBLookupCombo1.Text:=Edit1.Text;
 end;
 
+procedure TForm1.CheckBox1Change(Sender: TObject);
+begin
+  RxDBLookupCombo1.Flat:=CheckBox1.Checked;
+
+  case RadioGroup1.ItemIndex of
+    0:RxDBLookupCombo1.BorderStyle:=bsNone;
+    1:RxDBLookupCombo1.BorderStyle:=bsSingle;
+  end;
+end;
+
 procedure TForm1.FormCreate(Sender: TObject);
 begin
   rxData1.Open;

components/rx/trunk/rxdb/rxlookup.pas

@@ -259,6 +259,7 @@ type
     procedure DoPositionButton; virtual;
     procedure DoChange; virtual;
     procedure DoChangeData; virtual;
+    procedure DoSelect; virtual;
     procedure DoButtonClick(Sender: TObject); virtual;
     Procedure Loaded; override;
     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
@@ -310,6 +311,10 @@ type
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
+
+    procedure Clear;
+    function IsEmpty : Boolean;
+
     property PopupVisible:boolean read GetPopupVisible;
   end;
   
@@ -325,6 +330,7 @@ type
     property AutoSize;
     property Align;
     property Anchors;
+    property BorderStyle default bsNone;
     property BorderSpacing;
     property ButtonOnlyWhenFocused;
     Property ButtonWidth;
@@ -494,7 +500,6 @@ end;
 
 procedure TRxCustomDBLookupEdit.ShowPopUp;
 var
-  R:TPoint;
   AValue:string;
   ALookupField:string;
 begin
@@ -617,8 +622,6 @@ begin
 end;
 
 constructor TRxCustomDBLookupEdit.Create(AOwner: TComponent);
-var
-  P:TBitmap;
 begin
   inherited Create(AOwner);
   Spacing:=0;
@@ -1215,8 +1218,8 @@ begin
   end;
 
   SetFocus;
-  if (AResult) and (Assigned(FOnSelect)) then
+  if AResult then
-    FOnSelect(Self);
+    DoSelect;
 end;
 
 procedure TRxCustomDBLookupCombo.SetEnabled(Value: Boolean);
@@ -1242,19 +1245,13 @@ begin
     else
     if (Key = VK_ESCAPE) and not (Assigned(FDataField)) then
     begin
-      SetValueKey(FEmptyValue);
+      Clear;
-      if Assigned(FOnSelect) then
-        FOnSelect(Self);
       Key:=0;
     end
     else
     if (Key = VK_ESCAPE) and (not FDataField.IsNull) and (FDataLink.Edit) then
     begin
-      FDataField.Clear;
+      Clear;
-      UpdateKeyValue;
-      if Assigned(FOnSelect) then
-        FOnSelect(Self);
-      DoChangeData;
       Key:=0;
     end;
   end;
@@ -1277,8 +1274,7 @@ begin
       end;
       //FDataLink.UpdateRecord; -- no need more...
       Self.NeedUpdateData;
-      if Assigned(FOnSelect) then
+      DoSelect;
-        FOnSelect(Self);
       KeyValueChanged;
       Key:=0;
     end
@@ -1295,8 +1291,7 @@ begin
                    FLookupDataLink.DataSet.Next;
       end;
       SetValueKey(FKeyField.AsString);
-      if Assigned(FOnSelect) then
+      DoSelect;
-        FOnSelect(Self);
       Key:=0;
     end
   end;
@@ -1353,6 +1348,12 @@ begin
     FOnChangeData(Self)
 end;
 
+procedure TRxCustomDBLookupCombo.DoSelect;
+begin
+  if Assigned(FOnSelect) then
+    FOnSelect(Self);
+end;
+
 procedure TRxCustomDBLookupCombo.DoButtonClick(Sender: TObject);
 begin
   if (not FReadOnly) and (not FStopClick) then//We can do something if and only if that's not ReadOnly field...
@@ -1432,10 +1433,13 @@ begin
 end;
 
 procedure TRxCustomDBLookupCombo.Paint;
+const
+  padding : Integer = 1;
 var
   Selected:boolean;
   R, R1: TRect;
   AText: string;
+  border : Integer;
 begin
   Canvas.Font := Font;
   Canvas.Brush.Color := Color;
@@ -1451,25 +1455,33 @@ begin
     Canvas.Font.Color := clInactiveCaption;
   end;
 
-  SetRect(R, 0, 0, ClientWidth, ClientHeight);
+  R := Rect(0, 0, ClientWidth, ClientHeight);
-  if Flat then
+  if BorderStyle = bsNone then
   begin
-    Canvas.Frame3d(R, 3, bvLowered);
+    border := 3;
+    if Flat then
+    begin
+      Canvas.Frame3d(R, border, bvLowered);
+    end
+    else
+    begin
+      RxFrame3D(Canvas, R, clWindowFrame, clBtnHighlight, 1);
+      RxFrame3D(Canvas, R, clBtnShadow, clBtnFace, 1);
+    end;
   end
   else
   begin
-    RxFrame3D(Canvas, R, clWindowFrame, clBtnHighlight, 1);
+    border := 1;
-    RxFrame3D(Canvas, R, clBtnShadow, clBtnFace, 1);
   end;
 
-  if ClientWidth > 6 then
+  if ClientWidth > 2*border then
   begin
-    SetRect(R1, 3, 3, ClientWidth - 3, ClientHeight - 3);
+    R1 := Rect(border, border, ClientWidth - border, ClientHeight - border);
     Canvas.FillRect(R1);
-    R.Right:=R.Right - GetButtonWidth;
+    R.Right := R.Right - GetButtonWidth;
     if PopupVisible and (Caption<>'') then
     begin
-      AText:=Caption;
+      AText := Caption;
       Canvas.TextRect(R, TextMargin, Max(0, (HeightOf(R) - Canvas.TextHeight('Wg')) div 2), AText);
     end
     else
@@ -1479,13 +1491,13 @@ begin
     begin
       if Assigned(FDataField) and FDataField.IsNull then
       begin
-        SetRect(R1, 6, 6, ClientWidth - 6 - GetButtonWidth, ClientHeight - 6);
+        R1 := Rect(border + padding, border + padding, ClientWidth - (border + padding) - GetButtonWidth, ClientHeight - (border + padding));
         Canvas.Brush.Color:=FEmptyItemColor;
         Canvas.FillRect(R1);
         AText:=FEmptyValue
       end
       else
-      if FValuesList.Count>0 then
+      if FValuesList.Count > 0 then
         AText:=FValuesList[FLookupDisplayIndex]
       else
         AText:='';
@@ -1540,8 +1552,7 @@ begin
     end
     else
       SetValueKey(Value);
-    if Assigned(FOnSelect) then
+    DoSelect;
-      FOnSelect(Self);
   end;
 end;
 
@@ -1607,6 +1618,7 @@ begin
 
   ButtonWidth:=15;
   TabStop:=true;
+  BorderStyle := bsNone;
 end;
 
 destructor TRxCustomDBLookupCombo.Destroy;
@@ -1622,6 +1634,27 @@ begin
   inherited Destroy;
 end;
 
+procedure TRxCustomDBLookupCombo.Clear;
+begin
+  if not (Assigned(FDataField)) then
+  begin
+    SetValueKey(FEmptyValue);
+    DoSelect;
+  end
+  else if (not FDataField.IsNull) and (FDataLink.Edit) then
+  begin
+    FDataField.Clear;
+    UpdateKeyValue;
+    DoSelect;
+    DoChangeData;
+  end;
+end;
+
+function TRxCustomDBLookupCombo.IsEmpty: Boolean;
+begin
+  Result := (Value = EmptyValue);
+end;
+
 
 { TDataSourceLink }
 

components/rx/trunk/rxdb/rxpopupunit.pas

@@ -163,6 +163,7 @@ type
     FDropDownWidth: integer;
     FOnGetCellProps: TGetCellPropsEvent;
     FOptions: TPopUpGridOptions;
+    FSearchFromStart: boolean;
     FShowTitles: boolean;
     FTitleButtons: boolean;
     FTitleStyle: TTitleStyle;
@@ -175,6 +176,7 @@ type
     procedure SetDropDownCount(const AValue: integer);
     procedure SetDropDownWidth(const AValue: integer);
     procedure SetOptions(const AValue: TPopUpGridOptions);
+    procedure SetSearchFromStart(AValue: boolean);
     procedure SetShowTitles(const AValue: boolean);
     procedure SetTitleButtons(const AValue: boolean);
     procedure SetTitleStyle(const AValue: TTitleStyle);
@@ -189,6 +191,7 @@ type
     property AlternateColor: TColor read FAlternateColor write FAlternateColor stored IsAltColorStored;
     property Color: TColor read FColor write FColor default {$ifdef UseCLDefault}clDefault{$else}clWindow{$endif};
 
+    property SearchFromStart:boolean read FSearchFromStart write SetSearchFromStart default false;
     property AutoFillColumns:boolean read FAutoFillColumns write SetAutoFillColumns default false;
     property AutoSort:boolean read FAutoSort write SetAutoSort default false;
     property BorderStyle: TBorderStyle read FBorderStyle write FBorderStyle default bsNone;
@@ -547,6 +550,8 @@ begin
     ;
 
 
+  FGrid.SearchOptions.FromStart:=FPopUpFormOptions.SearchFromStart;
+  FGrid.SearchOptions.QuickSearchOptions:= [loCaseInsensitive, loPartialKey];
   FGrid.AutoSort:=FPopUpFormOptions.AutoSort;
   FGrid.TitleButtons:=FPopUpFormOptions.TitleButtons;
   FGrid.TitleStyle:=FPopUpFormOptions.TitleStyle;
@@ -615,6 +620,12 @@ begin
   FOptions:=AValue;
 end;
 
+procedure TPopUpFormOptions.SetSearchFromStart(AValue: boolean);
+begin
+  if FSearchFromStart=AValue then Exit;
+  FSearchFromStart:=AValue;
+end;
+
 procedure TPopUpFormOptions.SetShowTitles(const AValue: boolean);
 begin
   if FShowTitles=AValue then exit;
@@ -642,6 +653,7 @@ constructor TPopUpFormOptions.Create(AOwner: TPersistent);
 begin
   FOwner:=AOwner;
   inherited Create;
+  FSearchFromStart:=false;
   FAutoSort:=false;
   FDropDownCount:=8;
   FDropDownWidth:=0;
@@ -666,6 +678,7 @@ procedure TPopUpFormOptions.Assign(Source: TPersistent);
 begin
   if Source is TPopUpFormOptions then
   begin
+    FSearchFromStart:=TPopUpFormOptions(Source).FSearchFromStart;
     FAutoSort:=TPopUpFormOptions(Source).FAutoSort;
     FDropDownCount:=TPopUpFormOptions(Source).FDropDownCount;
     FDropDownWidth:=TPopUpFormOptions(Source).FDropDownWidth;
@@ -893,7 +906,7 @@ begin
     end;
     if V then
     begin
-      if DataSetLocateThrough(DataSource.DataSet, FLookupDisplayField, FFindLine + UTF8Key, [loCaseInsensitive, loPartialKey]) then
+      if DataSetLocateThrough(DataSource.DataSet, FLookupDisplayField, FFindLine + UTF8Key, SearchOptions.QuickSearchOptions, rsdAll, SearchOptions.FromStart) then
       begin
 //        TPopUpForm(Owner).WControl.Caption:=FFindLine;
 //        TPopUpForm(Owner).WControl.Repaint;
@@ -916,7 +929,7 @@ begin
   UTF8Delete(FFindLine, UTF8Length(FFindLine), 1);
   if (FFindLine<>'') then
   begin
-    if DataSetLocateThrough(DataSource.DataSet, FLookupDisplayField, FFindLine, [loCaseInsensitive, loPartialKey]) then
+    if DataSetLocateThrough(DataSource.DataSet, FLookupDisplayField, FFindLine, SearchOptions.QuickSearchOptions, rsdAll, SearchOptions.FromStart) then
     begin
 //     TPopUpForm(Owner).WControl.Caption:=FFindLine;
 //     TPopUpForm(Owner).WControl.Repaint;