форимрование списка ссылок

[Slym]

а где ProcessFile

[GROMOZEKA82]

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  z:string;

implementation

{$R *.dfm}

uses shellApi;

procedure TForm1.FormCreate(Sender: TObject);
var
tsr : tsearchrec;
begin
if FindFirst('D:\LNK\*.lnk', faAnyFile,tsr) = 0 then
repeat
ListBox1.Items.Add(tsr.name);
until FindNext(tsr) <> 0;
FindClose(tsr);
end;

procedure TForm1.ListBox1Click(Sender: TObject);
var z:string;
begin
z:='D:\LNK\'+Listbox1.Items[Listbox1.ItemIndex];
ShellExecute(0,'open',pchar(z),'','',SW_SHOW);
end;
end.

работает
но procedure TForm1.ListBox2Click(Sender: TObject);
работать отказывается, там список из ссылок получается, главное - навигация по нему должна осуществляться клавиатурой, вверх вниз, энтер
а при нажимании стрелки - выбирается следующий пункт и сразу запускается, соответственно нужно 2 клика

[Slym]

работа с ярлыком тебе показана - в чем вопрос?

[GROMOZEKA82]

можешь немного с моим кодом помочь?
(чтоб только при нажатии ентера запуск происходил), а дальше надеюсь сам уже справлюсь (посоздовать несколько форм по аналогии с этой и связать красивым меню)

[Slym]

procedure TForm1.ListBox1KeyPress(Sender: TObject; var Key: Char);
var z:string;
begin
  if ord(Key)=13 then
  begin
    z:='D:\LNK\'+Listbox1.Items[Listbox1.ItemIndex];
    ShellExecute(0,'open',pchar(z),'','',SW_SHOW);
  end;
end;

[GROMOZEKA82]

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, shellApi, StdCtrls;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure ListBox1KeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const
  p ='D:\LNK\';
  f = '*.lnk';
var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var  tsr:TSearchRec;
begin
  if FindFirst(p+f, faAnyFile,tsr) = 0 then
    repeat
      ListBox1.Items.Add(tsr.Name);
    until FindNext(tsr) <> 0;
    FindClose(tsr);
end;
procedure TForm1.ListBox1KeyPress(Sender: TObject; var Key: Char);
var z:string;
begin
  if ord(Key)=13 then begin
      z:=p+Listbox1.Items[Listbox1.ItemIndex];
      ShellExecute(0,'open',pchar(z),'','',SW_SHOW);
  end;
end;

end.

список файлов выводится так
file1.lnk
file2.lnk
file3.lnk

а хотелось бы
file1
file2
file3

т.е. без отображения расширения

как это реализовать можно?

[Slym]

function ExtractFileName(const FileName: string): string;
var
  I: Integer;
begin
  I := LastDelimiter('.' + PathDelim + DriveDelim, FileName);
  if (I > 0) and (FileName[I] = '.') then
    Result := Copy(FileName, 1, i-1) else
    Result := '';
end;
....
ListBox1.Items.Add(ExtractFileName(tsr.Name));

[GROMOZEKA82]

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, shellApi;

type
TForm1 = class(TForm)
ListBox1: TListBox;
procedure FormCreate(Sender: TObject);
procedure ListBox1KeyPress(Sender: TObject; var Key: Char);
private
{ Private declarations }
public
{ Public declarations }
end;


const
p ='D:\LNK\';
f = '*.lnk';
var
tsr: TSearchRec;
Form1: TForm1;

implementation

{$R *.dfm}


function ExtractFileName(const FileName: string): string;
var
I: Integer;
begin
I := LastDelimiter('.' + PathDelim + DriveDelim, FileName);
if (I > 0) and (FileName[I] = '.') then
Result := Copy(FileName, 1, i-1) else
Result := '';
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
if FindFirst(p+f, faAnyFile,tsr) = 0 then
repeat
ListBox1.Items.Add(tsr.Name);
until FindNext(tsr) <> 0;
FindClose(tsr);
end;


procedure TForm1.ListBox1KeyPress(Sender: TObject; var Key: Char);
var z:string;
begin

ListBox1.Items.Add(ExtractFileName(tsr.Name));

if ord(Key)=13 then begin
z:=p+Listbox1.Items[Listbox1.ItemIndex];
ShellExecute(0,'open',pchar(z),'','',SW_SHOW);
end;
end;

end.

работает, но расширение всё равно осталось

[Slym]

в танке что ли?

function ExtractFileName(const FileName: string): string;
var
I: Integer;
begin
I := LastDelimiter('.' + PathDelim + DriveDelim, FileName);
if (I > 0) and (FileName[I] = '.') then
Result := Copy(FileName, 1, i-1) else
Result := '';
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
if FindFirst(p+f, faAnyFile,tsr) = 0 then
repeat
ListBox1.Items.Add(ExtractFileName(tsr.Name));
until FindNext(tsr) <> 0;
FindClose(tsr);
end;


procedure TForm1.ListBox1KeyPress(Sender: TObject; var Key: Char);
var z:string;
begin
if ord(Key)=13 then begin
z:=p+Listbox1.Items[Listbox1.ItemIndex];
ShellExecute(0,'open',pchar(z),'','',SW_SHOW);
end;
end;

[GROMOZEKA82]

у меня так заработало

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, shellApi, StdCtrls;

type
TForm1 = class(TForm)
ListBox1: TListBox;
procedure FormCreate(Sender: TObject);
procedure ListBox1KeyPress(Sender: TObject; var Key: Char);
procedure ListBox1DblClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

const
p ='D:\LNK\';
f = '*.lnk';
var
tsr: TSearchRec;
Form1: TForm1;

implementation

{$R *.dfm}


function ExtractFileName(const FileName: string): string;
var
I: Integer;
begin
I := LastDelimiter('.' + PathDelim + DriveDelim, FileName);
if (I > 0) and (FileName[I] = '.') then
Result := Copy(FileName, 1, i-1) else
Result := '';
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
if FindFirst(p+f, faAnyFile,tsr) = 0 then
repeat
//ListBox1.Items.Add(tsr.Name);
ListBox1.Items.Add(ExtractFileName(tsr.Name));
until FindNext(tsr) <> 0;
FindClose(tsr);
end;

procedure TForm1.ListBox1KeyPress(Sender: TObject; var Key: Char);
var z:string;
begin
if ord(Key)=13 then begin
z:=p+Listbox1.Items[Listbox1.ItemIndex];
ShellExecute(0,'open',pchar(z),'','',SW_SHOW);
end;

end;

procedure TForm1.ListBox1DblClick(Sender: TObject);
var z:string;
begin
z:=p+Listbox1.Items[Listbox1.ItemIndex];
end;

end.