Программирование -> Delphi / Pascal -> Оболочка для компакт-диска своими руками

Предыстория.

Дело в том, что иногда ты сносишь свою винду по ряду причин будь то атака вирусов или отсутствие свободного места на жестких(бывают и такие) и после её перестановки ты начинаешь устанавливать необходимый тебе софт. Всё бы нечего, но есть одно "но" - все нужные проги находятся на разных дисках, казалось бы создал диск, записал на него что надо и все, но разве так поступает настоящий Delphi кодер. К тому же у меня, например часто спрашивают мои диски с софтом, а потом задают вопросы: "Что за прога?"; "Для чего она нужна?" и т.д. Так вот ты видел диски от AlexSoft? Мы сделаем такой же. Приступим.

С самого начала.

Для написания программы нам понадобится голова, руки, Delphi (6,7), Блокнот, небольшое знание HTML.

Пишем основу.

Берем стандартную форму, я назвал её MainForm и ставим на неё (в зависимости от ваших дизайнерских предпочтений) компонент WebBrowser с вкладки Internet. В свойстве name напишем HTMLView. А в FormCreate поместим этот код:

path:=extractfilepath(application.ExeName);
HTMLView.Navigate(path+'INTRO.html');

Этот код определяет какой html будет загружен первым (при старте программы). Также бросим на форму две кнопки. В свойствах Caption и Name напишем соответственно: Назад, Вперед, BackButton, ForwardButton. И напишем к ним соответственные обработчики событий:

procedure TMainForm.backbuttonClick(Sender: TObject);
 begin
  try
   HTMLView.GoBack;
  except
 end;
end;

procedure TMainForm.forwardbuttonClick(Sender: TObject);
 begin
  try
   HTMLView.GoForward
  except
 end;
end;

Структура try...except...end направлена на то, чтобы спасти программу от краха в том случае есди пользователь еще никуда не сдвинулся или двигаться уже некуда.

Теперь поговорим о навигации. Здесь все зависит от ваших нужд. Лично я выделил три раздела SYSTEM, NET, DOCS на своем диске и соответственно добавил столько же кнопок на форму с соответствующими Caption'ами и name'ами. И написал такой код:

procedure TMainForm.systemClick(Sender: TObject);
begin
 HTMLView.Navigate(path+'html\system.html');
end;

procedure TMainForm.NETClick(Sender: TObject);
begin
 HTMLView.Navigate(path+'html\net.html');
end;

procedure TMainForm.DOCSClick(Sender: TObject);
begin
 HTMLView.Navigate(path+'html\DOCS.html');
end;

Как видно невооруженым глазом при нажатии на соответствующие кнопки в HTMLView'е будут отображаться нужные html файлы(конечно назвать их можете по своему усмотрению, главное не запутаться). Можно также создать еще одну кнопку с Caption:='Browse CD' и Name:='BrowseCD'. Предназначение её самое простое : при нажатии на неё в explorer'е откроется наш диск со всеми файлами, чтобы так произошло напишем это:

procedure TMainForm.BrowseCDClick(Sender: TObject);
begin
 winexec(PChar('explorer.exe '+extractfiledir(application.ExeName)),1);
end;

Конечно можно использовать функцию CreateProcess, но уж слишком параметров много, а так проще.

Пикантности.

Основа готова, но можно добавить немного живости приложения. Поместим на форму компонент MediaPlayer и обзовем его MediaPlayerMenu, свойство Visible=false. С помощью него будет проигрываться соответствующий звук, когда курсор будет над какой-либо кнопкой. Для этого пишем код:

procedure TMainForm.NETMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  MediaPlayerMenu.FileName:=extractfiledir(application.ExeName)+'\check.wav';
  mediaplayermenu.Open;
  mediaplayermenu.Play;
end;

Файл check.wav находится в папке с екзешником (ваш файл может называться по-другому). И всем оставшимся кнопкам ставим в Events->OnMouseMove соответствующую процедуру.

Музыка, музыка, музыка...

Устанавливать программы не всегда весело, поэтому можно сделать так, что во время пока работает наша оболочка будет проигрываться музыка (конечно, твоя любимая). Помещаем на форму компонент MediaPlayer и называем его musicmenu или как-нибудь по-другому. В свойство Visible ставим fasle. И помещаем на форму четыре кнопки с name'ами previousbutton(предыдущая мелодия), nextbutton(следующая), playbutton(играть), pausebutton(пауза). Пишем обработчики:

procedure TMainForm.playbuttonClick(Sender: TObject);
begin
 musicmenu.Play;
 pausebutton.Enabled:=true;
 playbutton.Enabled:=false;
end;

procedure TMainForm.pausebuttonClick(Sender: TObject);
begin
 musicmenu.Pause;
 playbutton.Enabled:=true;
 pausebutton.Enabled:=false;
end;

procedure TMainForm.nextbuttonClick(Sender: TObject);
var i:integer;
begin
 s2:=musicmenu.filename;
 count:=1;
 if findfirst(path+'music\'+'*.mp3',faanyfile,sr)=0 then
   begin
    if musicmenu.FileName=path+'music\'+sr.name then
      begin
       i:=findnext(sr);
       musicmenu.FileName:=path+'music\'+sr.Name;
      end
    else
      begin
        repeat
          if musicmenu.filename=path+'music\'+sr.Name then
            begin
              i:=findnext(sr);
              musicmenu.FileName:=path+'music\'+sr.Name;
            end
        until findnext(sr)<>0;
      end;
    end;
if musicmenu.filename=s2 then
  begin
    findclose(sr);
      if findfirst(path+'music\'+'*.mp3',faanyfile,sr)=0 then
        begin
          musicmenu.FileName:=path+'music\'+sr.Name;
        end;
      end;
    findclose(sr);
    try
      musicmenu.Open;
      musictime:=musicmenu.length; // об этой переменной чуть позже
      musicmenu.Play;
      playbutton.Enabled:=false;
      pausebutton.Enabled:=true;
    except
  end;
end;

procedure TMainForm.previousbuttonClick(Sender: TObject);
var ss: string;
i: integer;
begin
 if count=1 then
    begin
      count:=0;
      musicmenu.FileName:=s2;
    end
 else
  begin
    s1:=musicmenu.FileName;
    if findfirst(path+'music\'+'*.mp3',faanyfile,sr)=0 then
    begin
    if musicmenu.FileName=path+'music\'+sr.name then
      begin
        repeat
       i:=findnext(sr)
        until i<>0;
       musicmenu.FileName:=path+'music\'+sr.Name;
      end
     else
       begin
         findclose(sr);
         if findfirst(path+'music\'+'*.mp3',faanyfile,sr)=0 then
        begin
          ss:=sr.Name;
          repeat
           if musicmenu.filename=path+'music\'+sr.Name then
            musicmenu.FileName:=path+'music\'+ss;
           ss:=sr.Name;
          until findnext(sr)<>0;
        end;
        end;
  end;
  end;
try
musicmenu.Open;
musictime:=musicmenu.length;
musicmenu.Play;
playbutton.Enabled:=false;
pausebutton.Enabled:=true;
except
end;

end;

Теперь можно осуществлять действия с воспроизведением музыки. Файлы я брал в формате mp3. Встречающиеся переменные должны распространяться на всю прогу. Но вот беда после окончания одного трека переход на другой не осуществляется. Думаем и пишем вот это как отдельную процедуру(общую):

procedure TMainForm.musicchange;
var i:integer;
begin
 s2:=musicmenu.filename;
 count:=1;
 if findfirst(path+'music\'+'*.mp3',faanyfile,sr)=0 then
    begin
    if musicmenu.FileName=path+'music\'+sr.name then
      begin
       i:=findnext(sr);
       musicmenu.FileName:=path+'music\'+sr.Name;
      end
     else
       begin
        repeat
        if musicmenu.filename=path+'music\'+sr.Name then
         begin
           i:=findnext(sr);
           musicmenu.FileName:=path+'music\'+sr.Name;
         end
         until findnext(sr)<>0;
        end;
  end;
if musicmenu.filename=s2 then
   begin
   findclose(sr);
    if findfirst(path+'music\'+'*.mp3',faanyfile,sr)=0 then
     begin
      musicmenu.FileName:=path+'music\'+sr.Name;
     end;
   end;
findclose(sr);
try
musicmenu.Open;
musictime:=musicmenu.length;
musicmenu.Play;
playbutton.Enabled:=false;
pausebutton.Enabled:=true;
except
end;

end;

А чтобы музыка играла сразу после начала работы пишем вот это в FormCreate:

findfirst(path+'\music\*.mp3',faanyfile,sr);
findnext(sr);
findnext(sr);
musicmenu.filename:=path+'\music\'+sr.Name;
musicmenu.Open;
musictime:=musicmenu.length;
musicmenu.Play;
playbutton.Enabled:=false;

В коде встречается переменная musictime, так вот она нужна для того, чтобы хранить длительность mp3, и если текущая позиция равна концу файла, то осуществляем переход. Для проверки кладем на форму компонент Timer и пишем процедуру:

procedure Tautorunform.Timer1Timer(Sender: TObject);
begin
if musictime=0 then
   musicchange
else
if musicmenu.Position>=musictime then musicchange;
end;

Свойство Interval=500.

Во избежании недомолвок напишу и вот это(а то всякое бывает):

  private
 { Private declarations }
  public
 { Public declarations }

  end;

var
  MainForm: TMainForm;
  count,musictime:integer;
  s2,s1,path:string;
  sr :tsearchrec;
implementation

{$R *.dfm}

Это до FormCreate.

Создание HTML.

Программа написана, но не хватает html файлов. Так вот краткая структура:

// так надо 
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"> 
<html> // начало самой html'ки
<head>
<title>NET</title> //заголовок
// тоже надо
<meta http-equiv="Content-Type" content="text/html; charset=windows-1251"> 
// это если стили использовать
<link href="style.css" rel="stylesheet" type="text/css"> 
</head>
<body> // здесь будет размещать сам текст до </body>
//название программы
<br> //перенос на новую строку
// пишите о чем прога
<br>
<a href="здесь путь до папки">здесь текст обозначающий ссылку</a>
// еще текст
// текст
// и текст
</body>
</html> //конец

Больше о html на этом сайте (сами посмотрите - куча материала).

Заключение.

Программу можно дополнить по-вашему усмотрению. Конечно, все выглядит блекло, но можно подключить скины, лично я использовал компоненты Dinamic Skin Form причем код даже менять не надо - просто замените нужные компоненты на соответствующие.

Автор: Панков Константин
Источник: www.codenet.ru