Для создания  приложения  «Распределение  файлов   ПК по типам» с начала создадим каталог для хранения файлов нашей программы.
Дапее добавим на форму  три кнопки Button  с панели компонентов Standart и компонент Chart с панели Additional(cм рис).


Распределение  файлов   ПК по типам


Программа  «Распределение  файлов   ПК по типам» считает графические файлы на вашем ПК  и выводит их виде диаграммы на форме приложения Delphi(cм. Рис.).


Распределение  файлов   ПК по типам

 

Ниже привожу исходный код данного приложения «Распределение  файлов   ПК по типам»:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,ShlObj, TeEngine, Series, ExtCtrls, TeeProcs, Chart, StdCtrls;
type
TForm1 = class(TForm)

    Button1: TButton;
Chart1: TChart;
Series1: TPieSeries;
Button2: TButton;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
Suffixes: TStringList;
SufCounts: array of Integer;
procedure DoCount (Path: string);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.DoCount(Path: string);
var
Found : TSearchRec;//найденный файл
Suffix: String; //его расширения
Idx: Integer;// номер этого расширения в списке Suffixes
begin
Path := IncludeTrailingPathDelimiter(Path);
if FindFirst(Path + '*.*', faAnyFile, Found) = 0 then
begin
// в папке Path есть хотя бы один файл: начинаем перебор
repeat
Suffix := ExtractFileExt(Found.Name);
if ((Found.Attr and faDirectory) = 0) and (Suffix <> '') then
begin
//найденный файл - не подпапка:
//его расширение уже извесно (есть в папке)?
Idx:= Suffixes.IndexOf(Suffix);
if Idx = -1 then begin
// нет: добавляем расширение в список и 1 в  массив
Suffixes.Add(Suffix);
//если размер массива недостаточен, увеличиваем его
if Suffixes.Count >=Length(SufCounts) then
SetLength(SufCounts, Suffixes.Count + 200);
SufCounts[Suffixes.Count - 1] := 1;
end else
//да увеличиваем количество вхождений
Inc(SufCounts[Idx] );
end;
//продолжаем перебор, пока остался хотя бы один непросмотренный файл
until FindNext (Found ) <> 0;
end;
//перебираем подпапки текущей папки, рекурсивно вызывая
//DoCount для каждой из них
if FindFirst(Path + '*.*', faAnyFile, Found) = 0 then begin
repeat
//если найденный файл - папка, причем не "." (текущая)
// и не ".." (родительская)
if ((Found.Attr and faDirectory) = faDirectory) and
(Found.Name[1] <> '.') then
begin
// чтобы приложение не выглядело зависшим,
//перед продолжением перебора дадим ему обработать
// накопившиеся сообщения
Application.ProcessMessages;
DoCount(Path + Found.Name);
end;
until  FindNext(Found)<> 0;
//освобождаем память от структуры Found
FindClose (Found);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
Buff: PChar;// буфер для помещения в него пути к папке "Мои документы"

begin
Suffixes:= TStringList.Create;
// при поиске строки в списке не будем различать регистр символов
Suffixes.CaseSensitive:= False;
Button1.Enabled:= False;
Caption := ' Подождите идет поиск...' ;
// узнаем путь к папке " Мои документы"
GetMem(Buff, MAX_PATH+1);
SHGetSpecialFolderPath(Handle, Buff, CSIDL_PERSONAL, false);
// перебираем файлы
DoCount(String(Buff));
FreeMem(Buff);
// список типов и массив количеств вхождений заполнены:
// приступаем к их отображению
Caption := 'Всего типов файлов:' + IntToStr (Suffixes.Count);
Button1.Enabled:= True;
Series1.Clear;//обнуляем числовой ряд
//задаем нисходящий порядок сортировки
Series1.YValues.Order:=loDescending;
// задаем критерий  для объединения элементов числового ряда
// в элемент " прочие " : доля меньших стольких-то процентов
Series1.OtherSlice.Style:= poBelowPercent;
// а именно 3%
Series1.OtherSlice.Value:= 3;
// задаем название (метку) элемента "прочие"
Series1.OtherSlice.Text:= 'Прочие' ;
// задаем метки остальных элементов: соответствующие расширения
for i:=0 to Suffixes.Count-1 do
Series1.Add(SufCounts[i], Suffixes.Strings[i]);
Suffixes.Free;
SufCounts:= nil;//так освобождается динамический массив
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Chart1.SaveToMetafile('graf3.wmf');
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
Chart1.CopyToClipboardMetafile(True);//EMF
//Chart1.CopyToClipboardBitmap;
//Chart1.CopyToClipboardMetafile(False); //WMF
end;
end.

Скачать книгу « Основы программирования в Delphi7. Самоучитель »:

 

Добавить комментарий


Защитный код
Обновить