Jump to content

I need a new uniGUI combobox


delphici

Recommended Posts

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

Link to comment
Share on other sites

  • Administrators

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.

Link to comment
Share on other sites

  • 7 months later...
  • 2 years later...

Please sign in to comment

You will be able to leave a comment after signing in



Sign In Now
×
×
  • Create New...