Недавно добавленные исходники

•  TDictionary Custom Sort  3 223

•  Fast Watermark Sources  2 989

•  3D Designer  4 750

•  Sik Screen Capture  3 259

•  Patch Maker  3 466

•  Айболит (remote control)  3 526

•  ListBox Drag & Drop  2 903

•  Доска для игры Реверси  80 758

•  Графические эффекты  3 842

•  Рисование по маске  3 171

•  Перетаскивание изображений  2 544

•  Canvas Drawing  2 671

•  Рисование Луны  2 500

•  Поворот изображения  2 089

•  Рисование стержней  2 119

•  Paint on Shape  1 522

•  Генератор кроссвордов  2 180

•  Головоломка Paletto  1 730

•  Теорема Монжа об окружностях  2 156

•  Пазл Numbrix  1 649

•  Заборы и коммивояжеры  2 016

•  Игра HIP  1 261

•  Игра Go (Го)  1 200

•  Симулятор лифта  1 421

•  Программа укладки плитки  1 176

•  Генератор лабиринта  1 511

•  Проверка числового ввода  1 295

•  HEX View  1 465

•  Физический маятник  1 322

•  Задача коммивояжера  1 356

 
скрыть


Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Delphi Sources

Пример создания FileListBox 2



Автор: Mikel

{uses ShellAPI}
type
  PListBox = ^TListBox;

procedure FillList(List: PListBox; pathh, mask: string; attr: Cardinal);
var
  path: string;
  ser: TSearchRec;
begin
  path := pathh;
  if path[length(path)] <> '\' then
    path := path + '\';
  List^.Items.Clear;
  if FindFirst(path + mask, attr, ser) <> 0 then
    exit;
  List^.Items.Add(ser.Name);
  while FindNext(ser) = 0 do
  begin
    if ser.Attr and faDirectory = faDirectory then
      List^.Items.Add(' [' + Ser.Name + ']')
    else
      List^.Items.Add(Ser.Name);
  end;
  List^.Sorted := false;
  list^.Sorted := true;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FillList(@ListBox1, edit1.text, '*.*', faAnyFile);
end;

procedure TForm1.ListBox1DblClick(Sender: TObject);
var
  s: string;
begin
  s := ListBox1.Items[SendMessage(ListBox1.Handle, lb_GetCurSel, 0, 0)];
  if (not FileExists(edit1.text + s)) and (s[1] + s[2] = ' [') and (s[length(s)]
    = ']') then
  begin
    FillList(@ListBox1, edit1.text + copy(s, 3, length(s) - 3), '*.*',
      faAnyFile);
    edit1.text := edit1.text + copy(s, 3, length(s) - 3) + '\';
  end;
  if FileExists(edit1.text + s) then
    ShellExecute(handle, 'open', PChar(edit1.text + s), '', 'c:\', sw_show);
end;

Добавим иконки:

{uses ShellAPI}
type
  PListBox = ^TListBox;

procedure FillList(List: PListBox; pathh, mask: string; attr: Cardinal);
var
  path: string;
  ser: TSearchRec;
begin
  path := pathh;
  if path[length(path)] <> '\' then
    path := path + '\';
  List^.Items.Clear;
  if FindFirst(path + mask, attr, ser) <> 0 then
    exit;
  List^.Items.Add(ser.Name);
  while FindNext(ser) = 0 do
  begin
    if ser.Attr and faDirectory = faDirectory then
      List^.Items.Add(' [' + Ser.Name + ']')
    else
      List^.Items.Add(Ser.Name);
  end;
  List^.Sorted := false;
  list^.Sorted := true;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FillList(@ListBox1, edit1.text, '*.*', faAnyFile);
  listbox1.itemheight := 18;
end;

procedure TForm1.ListBox1DblClick(Sender: TObject);
var
  s: string;
  Icon: hIcon;
  IconIndex: word;
begin
  IconIndex := 1;
  s := ListBox1.Items[SendMessage(ListBox1.Handle, lb_GetCurSel, 0, 0)];
  if (not FileExists(edit1.text + s)) and (s[1] + s[2] = ' [') and (s[length(s)]
    = ']') then
  begin
    FillList(@ListBox1, edit1.text + copy(s, 3, length(s) - 3), '*.*',
      faAnyFile);
    edit1.text := edit1.text + copy(s, 3, length(s) - 3) + '\';
  end;
  if FileExists(edit1.text + s) then
    ShellExecute(handle, 'open', PChar(edit1.text + s), '', 'c:\', sw_show);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  a: array of integer;
  i: integer;
begin
  SetLength(a, ListBox1.Items.Count + 1);
  //ZeroMemory(@a,ListBox1.Items.Count*4);
  for i := 0 to ListBox1.Items.Count + 1 do
    a[i] := 10;
  beep;
  beep;
  beep;
  beep;
  beep;
  SendMessage(ListBox1.Handle, lb_SetTabStops, ListBox1.Items.Count,
    Integer(@a));
end;

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  icon: hIcon;
  iconindex: word;
  bm: TBitmap;
begin
  iconindex := 1;
  bm := TBitmap.create;
  bm.Width := 34;
  bm.Height := 34;
  ListBox1.Canvas.TextOut(17 + Rect.Left, Rect.Top, ListBox1.Items[index]);
  if (copy(ListBox1.Items[index], 1, 2) = ' [') and
    (not FileExists(edit1.text + ListBox1.Items[Index])) then
  begin
    Icon := ExtractAssociatedIcon(HInstance,
      PChar(edit1.text + copy(ListBox1.Items[Index], 3,
      length(ListBox1.Items[Index]) - 3)), IconIndex);
    DrawIcon(bm.Canvas.Handle, 0, 0, Icon);
    bm.Canvas.StretchDraw(classes.rect(0, 0, 16, 16), bm);
    ListBox1.Canvas.CopyRect(classes.rect(0, rect.top, 16, rect.top + 16),
      bm.canvas, classes.rect(0, 0, 16, 16));
  end
  else
  begin
    Icon := ExtractAssociatedIcon(HInstance,
      PChar(edit1.text + ListBox1.Items[Index]),
      IconIndex);
    DrawIcon(bm.Canvas.Handle, 0, 0, Icon);
    bm.Canvas.StretchDraw(classes.rect(0, 0, 16, 16), bm);
    ListBox1.Canvas.CopyRect(classes.rect(0, rect.top, 16, rect.top + 16),
      bm.canvas, classes.rect(0, 0, 16, 16));
  end;
  bm.Free;
  CloseHandle(Icon);
end;

procedure TForm1.ListBox1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  ListBox1.Repaint;
end;

procedure TForm1.ListBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  k: word;
begin
  k := 0;
  Listbox1.OnKeyDown(sender, k, shift);
end;




Похожие по теме исходники

Примеры работы с БД

Примеры оформления DBGrid

Пример использования DBGrid

File icons in TFileListBox

 



Copyright © 2004-2024 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте