Выделенный пункт в listbox

Corwin13 · #1 17.04.2013, 00:48

Есть два листбокса, в первом создаются пункты, во втором подпункты первого. Нужно сделать чтобы при выделении пункта листбокса1 подгружался список в листбокс2 относящийся именно к этому пункту.

Скажем:

Listbox1 ----------------Listbox2
Литеоратура ----------------Книги
----------------Журналы
----------------Газеты

Документы ---------------Шаблоны
---------------Накладные

ну и тд.
Часть сделал что касаемо листбокса1- сохранение/чтение, а вот со второй частью пока тупик.

Код:

procedure LoadListbox1Listbox2(const Groupname:string);
procedure TForm1.FormCreate(Sender: TObject);
var
    llist:tstringlist;
    i:integer;
begin

  llist:=tstringlist.create;
  llist.Clear;
  Listbox1.Clear;
  Edit1.Clear;
  try
    if fileexists('c:\Listbox1.pdb') then
       llist.LoadFromFile('c:\Listbox1.pdb')
  except

 end;
  for i:=0 to lList.Count-1 do
  begin
     Listbox1.AddItem(llist[i],nil);
  end;
  llist.Free;
 // Listbox1.ItemIndex:=0;
end;
procedure TForm1.N4Click(Sender: TObject);

var i:integer;
    llist:tstringlist;
begin

  if messagedlg('Вы действительно хотите удалить группу ',mtConfirmation,[mbNo,mbYes],0)=mrYes then begin
     Listbox1.DeleteSelected;
     llist:=tstringlist.create;
     llist.Clear;
     
        llist.AddStrings(Listbox1.Items);
     end;

     try

       llist.SaveToFile('c:\Listbox1.pdb');
     except

     end;
     llist.Free;
  end;


procedure TForm1.N3Click(Sender: TObject);
var newstr:string;
      i:integer;
      llist:tstringlist;
begin


  NewStr:=InputBox('Новая группа','Введите имя группы','');
  if newstr<>'' then
  begin
  Listbox1.Items.Add(newstr);

     llist:=tstringlist.create;
     llist.Clear;
    
     begin
        
        llist.AddStrings(Listbox1.Items);
     

       llist.SaveToFile('c:\Listbox1.pdb');
       llist.Free;

end;

end;


 end;

procedure TForm1.Listbox1Change(Sender: TObject; Item: TListItem;
  Change: TItemChange);
 var
 i:integer;
begin
 
  if Listbox1.Items.Count>0 then
     if (Listbox1.ItemIndex>=0) and (Listbox1.ItemIndex<Listbox1.Items.Count) then
       //LoadListbox1Listbox2(Listbox1.Items.);

 
end;
procedure LoadListbox1Listbox2(Const Groupname:string);
 var i,cur:integer;
     sec:tstringlist;
begin
 
 sec:=tstringlist.Create;

   try
     
     if form1.ListBox1.ItemIndex=0 then begin
        for i:=0 to sec.Count-1 do begin
          form1.ListBox2.Items.Add(Sec[i]);
        
         
        end;
      end;
      if form1.ListBox1.itemindex>0 then begin
        for i:=0 to  sec.Count-1 do begin
        
              cur:=form1.ListBox2.ItemIndex;
              form1.ListBox2.Items[cur]:=sec[i];
            
          end;
        end;
   
    except
   
    end;
  end;
 

procedure TForm1.N5Click(Sender: TObject);
var newcat:string;
      i:integer;
      clist:tstringlist;
begin


  Newcat:=InputBox('Новая категория','Введите имя категории','');
  if newcat<>'' then
  begin
  Listbox2.Items.Add(newcat);

     clist:=tstringlist.create;
     clist.Clear;
   

     begin
        
        clist.AddStrings(Listbox2.Items);
       

       clist.SaveToFile('c:\Listbox2.pdb');
       clist.Free;

end;

end;


 end;


procedure TForm1.N6Click(Sender: TObject);
var i:integer;
    clist:tstringlist;
begin

  if messagedlg('Вы действительно хотите удалить категорию ',mtConfirmation,[mbNo,mbYes],0)=mrYes then begin
     Listbox2.DeleteSelected;
     clist:=tstringlist.create;
     clist.Clear;
     //for i:=0 to Listbox1.Items.Count do begin
       // llist.add(Listbox1.Items[i]);
        clist.AddStrings(Listbox2.Items);
     end;

     try

       clist.SaveToFile('c:\Listbox2.pdb');
     except

     end;
     clist.Free;
  end;

end.

Alegun · #2 17.04.2013, 01:13

Вот, первое что в голову пришло

Код:

procedure TForm1.ListBox1Click(Sender: TObject);
begin

 case Listbox1.ItemIndex of
0: ListBox2.Items.Text:='Книги'+#13+'Журналы'+#13+'Газеты';
1: ListBox2.Items.Text:='Шаблоны'+ #10 + 'Накладные';
end;
{
if Listbox1.Items.Strings[Listbox1.ItemIndex]=  'Литеоратура' then
ListBox2.Items.Text:='Книги'+#13+'Журналы'+#13+'Газеты'
else
ListBox2.Items.Text:='Шаблоны'+#10+'Накладные';
 }
end;

Corwin13 · #3 24.04.2013, 13:30

Немного продвинулось дело, но не дорабатывает до конца. По trace видно что при выделении строки в listbox1 -выводится список поочереди всех строк записанных в listbox2, но в конце выводится только последняя запись. Привожу код:

Код:

unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, ExtCtrls, ToolWin, Menus, inifiles, StdCtrls, Buttons,
  ActnList, shellApi,AppEvnts, XPMan;

type
  TForm = class(TForm)
    ActionList1: TActionList;
     ExitOnEsc: TAction;
    ApplicationEvents1: TApplicationEvents;
    N15: TMenuItem;
    N30: TMenuItem;
    PageControl1: TPageControl;
     Panel1: TPanel;
      status: TStatusBar;
        ToolBar3: TToolBar;
      StatusBar2: TStatusBar;
    Listbox1: TListBox;
    PopupMenu2: TPopupMenu;
    N6: TMenuItem;
    N7: TMenuItem;
    ListBox2: TListBox;
    PopupMenu3: TPopupMenu;
    N8: TMenuItem;
    N9: TMenuItem;
    procedure FormCreate(Sender: TObject);
     procedure FormActivate(Sender: TObject);
      procedure N6Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
     procedure Listbox1Change(Sender: TObject);
  procedure Listbox2Change(Sender: TObject; Item: TListItem;
  Change: TItemChange);
   procedure New_exe(Sender: TObject);
   private
    { Private declarations }
  public
    { Public declarations }
  end;


// My functions
procedure LoadListbox(Const Groupname:string);
var
  ini2:TiniFile;
implementation

uses new_cat;
procedure TForm.FormCreate(Sender: TObject);
var UT,AN,glist:tstringlist;
    m,k,n,i:integer;
    cfgini:Tinifile;
    llist:tstringlist;
begin
  dir:=extractfilepath(application.ExeName);
  
  ini2:=tinifile.create(dir+'Listbox2.pdb');
   /////////////////////
  llist:=tstringlist.create;
  llist.Clear;
  Listbox1.Clear;
  try
    if fileexists(dir+'Listbox1.pdb') then
       llist.LoadFromFile(dir+'Listbox1.pdb')
  except
   
 end;
 
  for i:=0 to lList.Count-1 do begin
     Listbox1.AddItem(lList[i],nil);
  end;
  lList.Free;
  /////////////////
 procedure TForm.Listbox2Change(Sender: TObject; Item: TListItem;Change: TItemChange);
var i:integer;
begin

  for i:=0 to 10 do begin
    try
      if ini2.readstring(item.Caption,'c'+inttostr(i),'@')<>'@' then
 
      except
        
      end;
  end;

end;


procedure TForm.FormActivate(Sender: TObject);
begin
  
    if Listbox2.Items.Count>0 then
    //Listbox2.Items[0].selected:=true;

   Listbox1.Update;

   Listbox2.Update;

   Listbox2.Realign;
  Listbox1.Realign;

/////////////////////////////
procedure TForm.Listbox1Change(Sender: TObject);

 var
 i:integer;
 Item: TListItem;
 Change: TItemChange;
begin

  if Listbox1.Items.Count>0 then
     if (Listbox1.ItemIndex>=0) and (Listbox1.ItemIndex<Listbox1.Items.Count) then
       LoadListbox(Listbox1.Items[ListBox1.ItemIndex]);


  //if Listbox2.Items.Count>0 then
    //Listbox2.ItemIndex:=true;
end;


////////////////////////////////////////////////////////////////////////////////
//   добавление группы
////////////////////////////////////////////////////////////////////////////////
procedure TForm.N6Click(Sender: TObject);
  var newstr:string;
      i:integer;
      llist:tstringlist;
begin


  NewStr:=InputBox('Новая группа','Введите имя группы','');
  if newstr<>'' then begin
  Listbox1.Items.Add(newstr);

     llist:=tstringlist.create;
     llist.Clear;
   

     begin
        llist.AddStrings(Listbox1.Items);
     

       llist.SaveToFile(dir+'Listbox1.pdb');
       llist.Free;
  
end;
end;
 end;

procedure TForm.N7Click(Sender: TObject);

var i:integer;
    llist:tstringlist;
begin

  if messagedlg('Вы действительно хотите удалить группу ',mtConfirmation,[mbNo,mbYes],0)=mrYes then begin
     Listbox1.DeleteSelected;
     llist:=tstringlist.create;
     llist.Clear;
     for i:=0 to Listbox1.Items.Count-1 do begin
        llist.add(Listbox1.Items[i]);
     end;

     try
      
       llist.SaveToFile(dir+'Listbox1.pdb');
     except
      
     end;
     llist.Free;
  end;
        end;
procedure TForm.New_exe(Sender: TObject);

begin
  Application.CreateForm(TNewCat, NewCat);
  if NewCat.ShowModal=mrOk then
     if Listbox1.itemIndex>0 then
        LoadListbox(Listbox1.Items[ListBox1.ItemIndex])
     else
        LoadListbox(Listbox1.Items[ListBox1.ItemIndex]);
  NewCat.free;
end;

procedure LoadListbox(Const Groupname:string);
 var i,cur2:integer;
     lis2:tstringlist;
    
begin
  lis2:=tstringlist.Create;

 with form do begin
   Listbox2.Clear;
   try
     ini2.ReadSections(lis2);
     status.panels[1].text:=' число заисей: '+inttostr(lis2.Count);

      if Listbox1.ItemIndex=0 then begin
        for i:=0 to lis2.Count-1 do begin
           
           Listbox2.Items.Add(lis2[i]);
          end;
      end;
      if Listbox1.itemindex>0 then begin
        for i:=0 to  lis2.Count-1 do begin
          if ini2.readstring(lis2[i],'n10','')=GroupName then begin
              Listbox2.ItemIndex:=cur2;
             
             Listbox2.items[cur2]:=lis2[i];
            end;
        end;
      end;
    except
   end;
  end;
  end;
end.




unit New_Cat;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, ActnList;

type
  TNewCat = class(TForm)
    ComboBox1: TComboBox;
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    ActionList1: TActionList;
    Action1: TAction;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Action1Execute(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  NewCat: TNewCat;

implementation

uses main,cfg;

{$R *.dfm}

procedure TNewCat.Button1Click(Sender: TObject);
begin
close;
end;
procedure TNewCat.Button2Click(Sender: TObject);
var i:integer;
begin
 try
   if length(Edit1.text)>0 then begin

     main.ini2.WriteString(Edit1.text,'n10',ComboBox1.Text);

   end
   else showmessage('Необходимо ввести название категории');
 except
   // writeLog(log,'WriteError','New_Cat.Button2Click');
 end;
end;


procedure TNewCat.FormActivate(Sender: TObject);
var i:integer;
begin
 ComboBox1.Items.clear;
 for i:=1 to phoneBook.Listbox1.Items.Count-1 do begin
    ComboBox1.Items.Add(phoneBook.Listbox1.Items[phoneBook.ListBox1.ItemIndex]);
 end;


 for i:=0 to ComboBox1.Items.count-1 do
   if(phoneBook.Listbox1.ItemIndex>=0)and(phoneBook.Listbox1.ItemIndex<phonebook.Listbox1.Items.Count)then
     if ComboBox1.Items[i]=phoneBook.Listbox1.Items[phoneBook.ListBox1.ItemIndex] then
        ComboBox1.ItemIndex:=i;
 Edit1.Text:='';

end;

procedure TNewCat.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 if ord(key)=vk_escape then close;
end;

procedure TNewCat.Action1Execute(Sender: TObject);
begin
  close;
end;

procedure TNewCat.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if (Key = #13) then begin
     Key:=#0;
     Perform(WM_NEXTDLGCTL,0,0);
  end;
end;


end.

Думаю, что надо поправить процедуру LoadListbox. Гляньте пожалуйста.

Alegun · #4 25.04.2013, 02:06

Лучше бы минимальный проект вместо простыней, на глаз мало что поймёшь правильно сразу, особенно когда много букофф, а в среду переносить это дело затратно по времени.

По этой причине проще было примерчик набросать, может поможет?

Страдалецъ · #5 25.04.2013, 03:41

А не проще было сделать простейшую связку мастер-деталь для клиентдатасета?

Corwin13 · #6 26.04.2013, 09:56

Вот часть, про listbox.

Corwin13 · #7 29.04.2013, 17:38

А можно вместо listbox2 прикрутить listview?

Alegun · #8 30.04.2013, 10:56

Цитата:

Сообщение от Corwin13

А можно вместо listbox2 прикрутить listview?

Можно, но только данная тема называется "Выделенный пункт в listbox", а с listview это совсем другая песня...
Нарушение ПФ, см. http://www.delphisources.ru/pages/forum_rules.html

Corwin13 · #9 30.04.2013, 11:04

Учту на будущее. Не могли бы вы посмотреть. Я в вашем примере попробовал прикрутить, но получилось не очень.

Alegun · #10 30.04.2013, 11:09

Угу, посмотрю, но отвечу в ЛС, немного погодя - последний рабочий предпраздничный день как ни как

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	RSS лента	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Новости сайта Новости форума	Ссылки и Баннеры Donate О сайте Реклама Контакты

Этот пользователь сказал Спасибо Alegun за это полезное сообщение:
Corwin13 (26.04.2013)

Этот пользователь сказал Спасибо Alegun за это полезное сообщение:
Corwin13 (30.04.2013)