delphici Posted April 10, 2012 Posted April 10, 2012 I turn from google translate I need a new combobox Adapted UniNewComboBox I give to you Do you know an instance. combobox have this feature in se select IDNumber, Country from Table ComboBox.Items.Add(FieldByName('Country').AsString); ComboBox.ValueList.Add(FieldByName('IDNumber').AsString); ComboBoxYeni.rar Quote
Administrators Farshad Mohajeri Posted April 10, 2012 Administrators Posted April 10, 2012 You maybe able to create a new component with same functionality based on TUniCustomComboBox. Quote
delphici Posted April 11, 2012 Author Posted April 11, 2012 Thank you for your interest. When you know which adapts TUniCustomComboBox very important to me Quote
Administrators Farshad Mohajeri Posted April 11, 2012 Administrators Posted April 11, 2012 When you know which adapts TUniCustomComboBox Sorry I didn't understand your question. Quote
delphici Posted April 11, 2012 Author Posted April 11, 2012 TUniCustomComboBox Adapted by the component when you know. Quote
Administrators Farshad Mohajeri Posted April 12, 2012 Administrators Posted April 12, 2012 I'll look at it... Quote
Administrators Farshad Mohajeri Posted April 12, 2012 Administrators Posted April 12, 2012 Here is your component adopted to TUniCustomComboBox by making few changes to your original code. I didn't test its functionality as I didn't know how to. It compiles, installs and appear in both web and vcl mode. unit ComboboxYeni; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, uniComboBox; type TComboBoxYeni = class(TUniCustomComboBox) private FValue : String; FList : TStrings; SonTus : Word; FAllValueList : TStrings; FParentValue: String; FAllItemList: TStrings; FParentValueList: TStrings; FTag: Longint; procedure SetValueControl(const Value: String); procedure SetValueList(const Value: TStrings); Function GetValueControl : String; procedure SetAllValueList(const Value: TStrings); procedure SetParentValue(const Value: String); procedure SetAllItemList(const Value: TStrings); procedure SetParentValueList(const Value: TStrings); procedure SetTag(const Value: Longint); { Private declarations } protected procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure DoExit;override; { Protected declarations } public LastKey : Word; constructor Create(AOwner: TComponent); override; destructor Destroy; override; Procedure ItemSil(Const PValue : String); Procedure ItemEkle(Const PItem,PValue ,PParentValue: String); Procedure ParentValueSil(Const PValue : String); Procedure ClearAll; function TirnakliText : String; Property AllValueList : TStrings Read FAllValueList Write SetAllValueList; Property AllItemList : TStrings Read FAllItemList Write SetAllItemList; Property ParentValueList : TStrings Read FParentValueList Write SetParentValueList; { Public declarations } published property Value : String read GetValueControl write SetValueControl; property ValueList : TStrings read FList write SetValueList; property ParentValue : String read FParentValue write SetParentValue; property Tag: Longint read FTag write SetTag; property Style; {Must be published before Items} property Anchors; property Color; property Constraints; property Enabled; property Font; property MaxLength; property ParentBiDiMode; property ParentColor; property ParentFont; property ParentShowHint; property ShowHint; property Sorted; property TabOrder; property TabStop; property Visible; property OnClick; property OnDblClick; property OnEnter; property OnExit; property OnKeyDown; property OnKeyPress; property OnKeyUp; property Items; { Must be published after OnMeasureItem } { Published declarations } end; procedure Register; implementation procedure Register; begin RegisterComponents('Standard', [TComboBoxYeni]); end; { TComboBoxYeni } constructor TComboBoxYeni.Create(AOwner: TComponent); begin inherited Create(AOwner); FList := TStringList.Create; FAllValueList := TStringList.Create; FAllItemList := TStringList.Create; FParentValueList:= TStringList.Create; FValue := ''; Try ItemIndex := Tag; Except End; end; destructor TComboBoxYeni.Destroy; begin FList.Free; FAllValueList.Free; FAllItemList.Free; FParentValueList.Free; inherited Destroy; end; procedure TComboBoxYeni.SetValueControl(const Value: String); begin FValue := Value; Try ItemIndex := ValueList.IndexOf(Value); Except ItemIndex := -1; End; end; Function TComboBoxYeni.GetValueControl : String; begin Try Result := ValueList.Strings[itemIndex] Except Result := ''; End; end; procedure TComboBoxYeni.KeyDown(var Key: Word; Shift: TShiftState); begin SonTus := Key; if ((SonTus = 8) or (SonTus = VK_DELETE)) then begin SonTus := 0; ItemIndex := -1; end; inherited KeyDown(Key,Shift); // If (Style = csDropDownList) And (Key = VK_DELETE) Then // ItemIndex := -1; end; function TComboBoxYeni.TirnakliText: String; begin Result := #39 + Trim(Value) + #39; end; procedure TComboBoxYeni.DoExit; begin If Text = '' Then Begin ItemIndex := -1; Value := ''; Hint := Value; End; //Else ItemIndex := ValueIndex; Inherited ; end; procedure TComboBoxYeni.SetValueList(const Value: TStrings); begin FList.Assign(Value); end; procedure TComboBoxYeni.SetAllValueList(const Value: TStrings); begin FAllValueList.Assign(Value); end; procedure TComboBoxYeni.SetAllItemList(const Value: TStrings); begin FAllItemList.Assign(Value); end; procedure TComboBoxYeni.SetParentValueList(const Value: TStrings); begin FParentValueList.Assign(Value); end; procedure TComboBoxYeni.SetParentValue(const Value: String); Var I : Integer; begin FParentValue := Value; If (AllValueList.Count > 0) Then Begin Items.Clear; // Listedekileri siler. ValueList.Clear; // Değer listesini siler... If ParentValueList.Count > 0 Then Begin For I := 0 To AllValueList.Count - 1 Do Begin If (ParentValueList.Strings[i] = FParentValue) or (FParentValue = '') Then Begin ValueList.Add(AllValueList.Strings[i]); Items.Add(AllItemList.Strings[i]); End; End; End Else Begin For I := 0 To AllValueList.Count - 1 Do Begin ValueList.Add(AllValueList.Strings[i]); Items.Add(AllItemList.Strings[i]); End; End; End; end; procedure TComboBoxYeni.SetTag(const Value: Longint); begin FTag := Value; Try ItemIndex := Value; Except ItemIndex := -1; End; end; procedure TComboBoxYeni.ItemSil(const PValue: String); Var I : Integer; begin // Tüm listeden siler I := AllValueList.IndexOf(PValue); If I > -1 Then Begin AllItemList.Delete(I); AllValueList.Delete(I); End; // Geçerli olan listeden siler... I := ValueList.IndexOf(PValue); If I > -1 Then Begin ValueList.Delete(I); Items.Delete(I); End; end; procedure TComboBoxYeni.ItemEkle(const PItem, PValue, PParentValue: String); begin If (PItem <> '') And (PValue <> '') And (PParentValue <> '') Then Begin AllValueList.Add(PValue); AllItemList.Add(PItem); ParentValueList.Add(PParentValue); Items.Add(PItem); End; end; procedure TComboBoxYeni.ParentValueSil(const PValue: String); Var I : Integer; begin For I := 0 To ParentValueList.Count - 1 Do Begin If ParentValueList.Strings[i] = PValue Then Begin ParentValueList.Delete(I); AllValueList.Delete(I); AllItemList.Delete(I); End; End; SetParentValue(ParentValue); end; procedure TComboBoxYeni.ClearAll; begin Items.Clear; ValueList.Clear; ParentValueList.Clear; AllValueList.Clear; AllItemList.Clear; end; end. Quote
delphici Posted April 12, 2012 Author Posted April 12, 2012 Thank you for your interest trying component Quote
Marlon Nardi Posted November 15, 2012 Posted November 15, 2012 Congratulations delphici! I was in search of this same solution. Quote
Phxtecno Posted June 26, 2015 Posted June 26, 2015 Hi, is this a combobox with two list ? as infopower vcl, with Display list and Value list ? Have you DBcomboBox version ? regards, Marc Quote
Phxtecno Posted June 26, 2015 Posted June 26, 2015 I have tried to inherit a new component from uniDBcomboBox, but without success... Anyone can help ? Regards Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.