CheckLisstBox ta seçilmiş öğelerin String katarına aktarılması

[maydin60]

Aşağıdaki function CheckListBox ta seçilmiş kutucuklardaki items ismilerini tek tırnak içinde göstererek
bir string katarı oluşturuyor...

  Edit2 e atınca '0,75 lt','2,5 lt','15 lt' bu şekilde atama yapıyor. fakat Query nin Parametresıne aktarınca 

''0,75 lt','2,5 lt','15 lt''  başa ve sona çift tırnak atıyor.. ve derleme sonucunda hata alıyorum..


 Function TFUrunBilgileri.SecilmisKutulariGetir(CheckListBox: TCheckListBox): String;
var
  I : Integer;
begin
  for I := 0 to CheckListBox.Items.Count - 1 do
    if CheckListBox.State[I] = cbChecked then
      Result := Result + QuotedStr(CheckListBox.Items[I]) + ',';

      Result := Copy(Result, 0, Length(Result) - 1);

end;


procedure TFUrunBilgileri.BtnAktarClick(Sender: TObject);
var
  StrList:String;
begin
     edit2.text:=  SecilmisKutulariGetir (CheckListBox2);
     StrList:=edit2.text;
     

  Query1.Close ;
  Query1.ParamByName('LTGR_PARAM').AsString :=StrList;
//  Query1.Params [0].AsString :=StrList;
  Query1.Open ;


end;
**************************************

Sorum şu CheckList box taki seçili öğeleri daha farklı tek tırnak ve aralarında virgül atayarak string döndüren daha stabil yöntem varmı...
Şimdiden Sağolasınız arkadaşlar..

***************************************

Query nın SQL kodu :

SELECT 
             STOK_KODU
              STOK_ADI,
              DOLUM_LT
            FROM  STOK_BILGILERI

WHERE
             DOLUM_LT IN ( :LTGR_PARAM)

[hi_selamlar]

(25-05-2026, Saat: 20:39)maydin60 Adlı Kullanıcıdan Alıntı: Aşağıdaki function CheckListBox ta seçilmiş kutucuklardaki items ismilerini tek tırnak içinde göstererek
bir string katarı oluşturuyor...

  Edit2 e atınca '0,75 lt','2,5 lt','15 lt' bu şekilde atama yapıyor. fakat Query nin Parametresıne aktarınca 

''0,75 lt','2,5 lt','15 lt''  başa ve sona çift tırnak atıyor.. ve derleme sonucunda hata alıyorum..


 Function TFUrunBilgileri.SecilmisKutulariGetir(CheckListBox: TCheckListBox): String;
var
  I : Integer;
begin
  for I := 0 to CheckListBox.Items.Count - 1 do
    if CheckListBox.State[I] = cbChecked then
      Result := Result + QuotedStr(CheckListBox.Items[I]) + ',';

      Result := Copy(Result, 0, Length(Result) - 1);

end;


procedure TFUrunBilgileri.BtnAktarClick(Sender: TObject);
var
  StrList:String;
begin
     edit2.text:=  SecilmisKutulariGetir (CheckListBox2);
     StrList:=edit2.text;
     

  Query1.Close ;
  Query1.ParamByName('LTGR_PARAM').AsString :=StrList;
//  Query1.Params [0].AsString :=StrList;
  Query1.Open ;


end;
**************************************

Sorum şu CheckList box taki seçili öğeleri daha farklı tek tırnak ve aralarında virgül atayarak string döndüren daha stabil yöntem varmı...
Şimdiden Sağolasınız arkadaşlar..

***************************************

Query nın SQL kodu :

SELECT 
             STOK_KODU
              STOK_ADI,
              DOLUM_LT
            FROM  STOK_BILGILERI

WHERE
             DOLUM_LT IN ( :LTGR_PARAM)

Merhabalar,

Delphi 7 

En basit çözüm,

Query1.Close;

 // Parametre kullanma, direkt yaz
 Query1.SQL.Text := 'SELECT STOK_KODU, STOK_ADI, DOLUM_LT FROM STOK_BILGILERI ' +
                    'WHERE DOLUM_LT IN (' + SecilmisKutulariGetir(CheckListBox2) + ')';

 Query1.Open;

Kullandığınız veritabnı nedir belirtmemişsiniz. RDBMS tarzı bir DB kullanıyorsanız onlarında
kendi içlerinde bazı fonksiyonları mevcut.

Kolay gelsin

[barutali]

Daha güncel bir delphi sürümü kullansaydınız Generics.Collections ile çözerdik ama bu da işinizi görür. 

function CheckListBoxItems2CommaText(const ACheckListBox: TcxCheckListBox): string;
var
 TempList: TStringList;
begin
 TempList := TStringList.Create;
 try
   for var I := 0 to ACheckListBox.Items.Count - 1 do
   begin
     if ACheckListBox.Items[I].Checked then
       TempList.Add(ACheckListBox.Items[I].Text);
   end;

   // CommaText aralarına virgül koyarak listesi döndürür.
   // CSV Mantığında çalıştığı için boşluk, virgül vb. varsa otomatik olarak " karakteri atar.
   // Onu da ' karakteri ile değiştiriyoruz.
   // Kullandığın DB'nin Double Quote desteği varsa replace i iptal edebilirsin.
   Result := StringReplace(TempList.CommaText, '"', '''', [rfReplaceAll]);
 finally
   TempList.Free;
 end;
end;

Kullanımı 

Memo1.Text := CheckListBoxItems2CommaText(cxCheckListBox1);

[emailx45]

Need some optimization ok!
but the main idea is: just 1 point to acess the data!


DBGrid1.My_Proc( Param1, Param2 ) ... etc...

0) ObterTextoItensChecados = for any TCheckListBox in your form

1)  ObterMarcadosPelaTela  = this will use the DBGrid representation on screen ( any one )

2) ObterMarcadosPeloDataSet = this will use the Dataset representation ( if you want FDMemTable, FDQuery, TQuery, TSQLQuery, etc...) ( any one )

NOTE: you can not need use a TStringList at all, you can use TArray<string> as your function result, or your "OUT param" like:
function xxxxx: TArray<string>;
procedure xxxx( ..., out OResult:TArray<string> );


3) to SQL you can to do: 'select Field_Resulted from Table_X where Field_Check = true'; does not matter the RDBMS
 // note: always that possible, DONT USE "in (....) " =>>> LIST or COUNT( * ) 

4) if you want use "CommaText" or similar, try this: 
function xxxxxx(...) : TArray<string>; // result is temporary on memory... no objects!!!
begin
SetLength( result,  N_COUNT_RECORD_on_Table );
for var i:= 0 to N_COUNT_RECORD_on_Table-1 do
... your code to get the values here... if 100 record => record = 100 values
result[i]:= YOUR_STRING_VALUE_HERE;
end;

5) later, you can join all items using " stringXXXXX.Join(',', array_with_result_value );


Form1 for test:

Kod: (Select All)

unit Unit1;

interface

uses
 Winapi.Windows,
 Winapi.Messages,
 System.SysUtils,
 System.Variants,
 System.Classes,
 Vcl.Graphics,
 
 ...
 
 Vcl.StdCtrls,
 Vcl.CheckLst,
 //
 Unit2,
 Unit3;

type
 TForm1 = class( TForm )
   FDMemTable1: TFDMemTable;
   DataSource1: TDataSource;
   DBGrid1: TDBGrid;
   FDMemTable1ID: TIntegerField;
   FDMemTable1Names: TStringField;
   FDMemTable1Checked: TBooleanField;
   FDConnection1: TFDConnection;
   CheckListBox1: TCheckListBox;
   Button1: TButton;
   Memo1: TMemo;
   Button2: TButton;
   procedure Button1Click( Sender: TObject );
   procedure Button2Click( Sender: TObject );
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click( Sender: TObject );
begin
 Memo1.Text := CheckListBox1.ObterTextoItensChecados;
end;

procedure TForm1.Button2Click( Sender: TObject );
var
 ValoresMarcados: string;
begin
 // Chamamos o metodo injetado passando os nomes dos seus campos da FDMemTable
 // DBGrid1 é o nome do seu componente na tela
 Memo1.Text := DBGrid1.ObterMarcadosPelaTela( 'Names', 'Checked' );
 Memo1.Lines.Add( DBGrid1.ObterMarcadosPeloDataSet( 'Names', 'Checked' ) );
end;

end.

Kod: (Select All)

unit unit3;

interface

uses
 Winapi.Windows,
 Vcl.DBGrids,
 Data.DB,
 System.Classes;

type
 // Classe interposta para injetar as propriedades de consulta
 TDBGrid = class(Vcl.DBGrids.TDBGrid)
 public
   { Cenario 1: Varre apenas as linhas que estao fisicamente visiveis na tela }
   function ObterMarcadosPelaTela(const NomeCampoTexto, NomeCampoBool: string): string;

   { Cenario 2: Varre todos os registros do Dataset local de forma ultra-otimizada }
   function ObterMarcadosPeloDataSet(const NomeCampoTexto, NomeCampoBool: string): string;
 end;

implementation

{ TDBGrid }

function TDBGrid.ObterMarcadosPelaTela(const NomeCampoTexto, NomeCampoBool: string): string;
var
 ListaTemporaria  : TStringList;
 ODataSet         : TDataSet;
 LinhasVisiveis   : Integer;
 DistanciaAteOTopo: Integer;
 I                : Integer;
 SalvaPosicao     : TBookmark;
 CampoTexto, CampoBool: TField;
begin
 Result := '';
 if (Self.DataSource = nil) or (Self.DataSource.DataSet = nil) then
   Exit;

 ODataSet := Self.DataSource.DataSet;
 if not ODataSet.Active then
   Exit;

 LinhasVisiveis := Self.VisibleRowCount;
 if LinhasVisiveis <= 0 then
   Exit;

 // Calcula a distancia matematica exata ate o topo da grid visivel
 if dgTitles in Self.Options then
   DistanciaAteOTopo := Self.Row - 1
 else
   DistanciaAteOTopo := Self.Row;

 ListaTemporaria := TStringList.Create;
 ODataSet.DisableControls;
 try
   SalvaPosicao := ODataSet.GetBookmark;
   try
     if DistanciaAteOTopo > 0 then
       ODataSet.MoveBy(-DistanciaAteOTopo);

     // Extrai os ponteiros dos Fields UMA UNICA VEZ antes de iniciar o loop
     CampoTexto := ODataSet.FieldByName(NomeCampoTexto);
     CampoBool  := ODataSet.FieldByName(NomeCampoBool);

     for I := 0 to LinhasVisiveis - 1 do
     begin
       if CampoBool.AsBoolean then
       begin
         ListaTemporaria.Add(CampoTexto.AsString);
       end;

       ODataSet.Next;
       if ODataSet.Eof then
         Break;
     end;

     Result := ListaTemporaria.CommaText;
   finally
     if ODataSet.BookmarkValid(SalvaPosicao) then
       ODataSet.GotoBookmark(SalvaPosicao);
   end;
 finally
   ODataSet.EnableControls;
   ListaTemporaria.Free;
 end;
end;

function TDBGrid.ObterMarcadosPeloDataSet(const NomeCampoTexto, NomeCampoBool: string): string;
var
 ListaTemporaria   : TStringList;
 ODataSet          : TDataSet;
 SalvaPosicao      : TBookmark;
 DataSourceOriginal: TDataSource;
 CampoTexto, CampoBool: TField;
begin
 Result := '';
 if (Self.DataSource = nil) or (Self.DataSource.DataSet = nil) then
   Exit;

 ODataSet := Self.DataSource.DataSet;
 if not ODataSet.Active then
   Exit;

 ListaTemporaria := TStringList.Create;

 // Desconecta o DataSource da Grid temporariamente para zerar o overhead visual
 DataSourceOriginal := Self.DataSource;
 Self.DataSource    := nil;

 ODataSet.DisableControls;
 try
   SalvaPosicao := ODataSet.GetBookmark;
   try
     // Extrai os ponteiros dos Fields UMA UNICA VEZ antes de iniciar o loop
     CampoTexto := ODataSet.FieldByName(NomeCampoTexto);
     CampoBool  := ODataSet.FieldByName(NomeCampoBool);

     ODataSet.First;
     while not ODataSet.Eof do
     begin
       if CampoBool.AsBoolean then
       begin
         ListaTemporaria.Add(CampoTexto.AsString);
       end;
       ODataSet.Next;
     end;

     Result := ListaTemporaria.CommaText;
   finally
     if ODataSet.BookmarkValid(SalvaPosicao) then
       ODataSet.GotoBookmark(SalvaPosicao);
   end;
 finally
   ODataSet.EnableControls;
   Self.DataSource := DataSourceOriginal; // Devolve o controle visual limpo
   ListaTemporaria.Free;
 end;
end;

end.

to TCheckListBox, we can use a "Interposed class" to TCheckListBox and work for all components on screen

Kod: (Select All)

unit Unit2;

interface

uses
 Winapi.Windows,
 Winapi.Messages,
 System.Classes,
 Vcl.CheckLst;

type
 // Criamos a classe interposta com o exato mesmo nome do componente.
 // Ela herda de TCheckListBox para ganhar acesso aos metodos protegidos.
 TCheckListBox = class( Vcl.CheckLst.TCheckListBox )
 public
   { Retorna True se o item ja possui um objeto Wrapper alocado na memoria }
   // meu ExtractWrapper( Index:Integer) customizado!!!
   function TemWrapper( Index: Integer ): Boolean;

   { Retorna os textos dos itens checados de forma ultra-rápida,
     varrendo apenas quem de fato ja existe na memoria }
   function ObterTextoItensChecados: string;
 end;

implementation

{ TCheckListBox }

function TCheckListBox.TemWrapper( Index: Integer ): Boolean;
var
 LData: LongInt;
begin
 // Replicamos a exata engenharia do ExtractWrapper da VCL.
 // O metodo GetItemData envia o LB_GETITEMDATA e é acessivel por heranca.
 //LData := Self.GetItemData( index );
 LData := Self.InternalGetItemData( index );

 // Se for diferente de erro (LB_ERR) e diferente de zero, o wrapper existe!
 Result := ( LData <> LB_ERR ) and ( LData <> 0 );
end;

function TCheckListBox.ObterTextoItensChecados: string;
var
 I              : Integer;
 ListaTemporaria: TStringList;
begin
 Result := '';
 if Self.Items.Count = 0 then
   Exit;

 ListaTemporaria := TStringList.Create;
 try
   for I := 0 to Self.Items.Count - 1 do
   begin
     // 1. Checagem ultra-rápida: o item tem wrapper alocado?
     if Self.TemWrapper( I ) then
     begin
       // 2. Se tem wrapper, podemos ler a propriedade Checked com seguranca,
       // pois ela apenas consultará o objeto ja existente, sem criar nada novo!
       if Self.Checked[ I ] then
         ListaTemporaria.Add( Self.Items[ I ] );
     end;
   end;
   Result := ListaTemporaria.CommaText;
 finally
   ListaTemporaria.Free;
 end;
end;

end.

[maydin60]

Arkadaşlar cevaplar için teşekkurler.... Hi_selamlar ın kısa yöntemi çalıştı..
Diğer arkadaşların cevaplarını maalesef Eski sürümde kaldıgım için deneyemedım......
Bu arada Kullandıgım Veri tabanı Firebird
İlginiz için çok teşekkurler