
26.05.2010, 16:43
|
 |
Гуру
|
|
Регистрация: 09.03.2009
Адрес: На курорте, из окна вижу теплое Баренцево море. Бррр.
Сообщения: 4,723
Репутация: 52347
|
|
Люблю такие элегантные красивые задачки.
Держите:
Код:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls;
type
TForm1 = class(TForm)
Notebook: TPageControl;
procedure FormCreate(Sender: TObject);
procedure FileListClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
Var
Page: TTabSheet;
Memo: TMemo;
FileList: TListBox;
i,j: Integer;
FileInfo: TSearchRec;
FilePath,FileMask: String;
Files: TStringList;
begin
FilePath := ParamStr(1);
FileMask := ParamStr(2);
if FilePath = '' then FilePath := ExtractFilePath(ParamStr(0));
if FileMask = '' then FileMask := '*.txt';
Files := TStringList.Create;
Files.Sorted := True;
if FindFirst(FilePath + FileMask, faAnyFile, FileInfo) = 0
then repeat
if FileInfo.Attr and faAnyFile <> 0
then Files.Add(AnsiUpperCase(FileInfo.Name))
until FindNext(FileInfo) <> 0;
for i := 65 to 90
do begin
Page := TTabSheet.Create(Notebook);
Page.PageControl := Notebook;
Page.Caption := Chr(i);
FileList := TListBox.Create(Page);
FileList.Parent := Page;
FileList.Align := alLeft;
FileList.Width := 200;
FileList.OnClick := FileListClick;
Memo := TMemo.Create(Page);
Memo.Parent := Page;
Memo.Align := alClient;
for j := 0 to Files.Count - 1
do if Files.Strings[j][1] = AnsiUpperCase(Chr(i))
then FileList.AddItem(Files.Strings[j],nil);
end;
Files.Free;
end;
procedure TForm1.FileListClick(Sender: TObject);
Var
M: TMemo;
LB: TListBox;
begin
LB := TListBox(Notebook.ActivePage.Controls[0]);
M := TMemo(Notebook.ActivePage.Controls[1]);
M.Clear;
M.Lines.LoadFromFile(LB.Items[LB.ItemIndex]);
end;
end.
и dfm-файл
Код:
object Form1: TForm1
Left = 351
Top = 116
Width = 870
Height = 640
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Notebook: TPageControl
Left = 8
Top = 8
Width = 849
Height = 585
TabOrder = 0
TabPosition = tpBottom
TabWidth = 30
end
end
__________________
Жизнь такова какова она есть и больше никакова.
Помогаю за спасибо.
|