Программирование

    for i:=1 to NR do

        sum := sum + n[i];

    for i:=1 to NR do

        p[i] := n[i] / sum;

     m := 1;

     for i := 2 to NR do

        if n[i] > n[m] then m:=i;

    for i :=1 to NR do

        h[i] := Round((Form1.Image1.Height - 20) *

                n[i]/n[m]);

    obr := TRUE;

end; 

procedure diagr;

const

    WR = 25;

    DR = 10;

var

    x,y: integer;

    i: integer;

begin

    with Form1.Image1 do

    begin

      x:=10;

      y:=Height;

      Canvas.Brush.Color := clWindow;

      Canvas.Rectangle(0,0,Width,Height);

      for i:=1 to 4 do

      begin

        Canvas.Brush.Color := BarColor[i];

        Canvas.Rectangle(x,y,x+WR,y-h[i]);

        Canvas.Brush.Color := clWindow; 

        Canvas.TextOut(x,y-h[i]-15,

               FloatToStrF(p[i]*100,ffGeneral,3,2)+'%');

        x := x + WR + DR;

      end;

      x := x + 20;

      y:=20;

      for i:=1 to 4 do

      begin

        Canvas.Brush.Color := BarColor[i];

        Canvas.Rectangle(x,y,x+25,y+14);

        Canvas.Brush.Color := clWindow;

        Canvas.TextOut(x+WR+10,y,

               Form1.StringGrid1.Cells[0,i]);

        y := y + 20; 

      end;

    end;

end; 

procedure TForm1.FormCreate(Sender: TObject);

begin

    StringGrid1.Cells[0,0] := 'Íàèìåíîâàíèå';

    StringGrid1.Cells[1,0] := 'Êîë-âî';

    StringGrid1.Width :=

           StringGrid1.ColWidths[0] + StringGrid1.ColWidths[1]+5; 

end; 

procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);

begin

   if Key = #13 then

   begin

    if StringGrid1.Col < StringGrid1.ColCount - 1

       then

          StringGrid1.Col := StringGrid1.Col + 1 // ê ñëåä ñòîëáöó

       else

          if ( StringGrid1.Row < StringGrid1.RowCount - 1 ) then

            begin

              StringGrid1.Col :=0;

              StringGrid1.Row := StringGrid1.Row +1;

            end

          else Button1.SetFocus;

      exit;

    end;

    if StringGrid1.Col = 1 then

        case Key of

        '0'..'9',#8: ;

        '.',',':

           begin

                Key := DecimalSeparator;

                if Pos(DecimalSeparator,

                   StringGrid1.Cells[StringGrid1.Row,

                   StringGrid1.Col]) <> 0

                then Key := Char(0);

           end;

        else Key := Char(0);

        end; 

end; 

procedure TForm1.Button1Click(Sender: TObject);

begin

    if Obr

        then diagr;

end; 

end.

6. Руководство пользователя

  Запустите  программу. Введите данные в  таблицу, для того чтобы перейти  к следующей ячейке нажимайте  «Enter» , и нажните кнопку «Построить». 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 

6. Задача 6
1. Условие задачи

  Напишите  программу, используя которую  можно прослушать звуковые файлы Windows.

2. Таблица реквизитов

3. Требования  к программе

  Программа  должна воспроизводить звуковые  файлы Windows.

4. Форма программы

 

 Label1 

 Label2 

 ListBox1 
 
 

     MediaPlayer1

 

5. Листинг программы

unit WinSound_; 

interface 

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

  StdCtrls, MPlayer, ExtCtrls; 

type

  TForm1 = class(TForm)

    MediaPlayer1: TMediaPlayer;

    ListBox1: TListBox;

    Label2: TLabel;

    Label1: TLabel;

    procedure ListBox1Click(Sender: TObject);

    procedure MediaPlayer1Click(Sender: TObject; Button: TMPBtnType;

      var DoDefault: Boolean);

    procedure FormCreate(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end; 

var

  Form1: TForm1; 

implementation 

{$R *.DFM} 

var

    SOUNDPATCH: string[80]; 

procedure TForm1.FormCreate(Sender: TObject);

var

  lpBuf: PChar;

  sWinDir: string[128]; 

  SearchRec: TSearchRec;

begin

  GetMem(lpBuf,MAX_PATH);

  GetWindowsDirectory(lpBuf,MAX_PATH);

  sWinDir:=lpbuf;

  SOUNDPATCH:=sWinDir+'\Media\';

  FreeMem(lpBuf);

  if FindFirst(SOUNDPATCH+'*.wav', faAnyFile, SearchRec) =0 then

     begin

          Form1.ListBox1.Items.Add(SearchRec.Name);

          while (FindNext(SearchRec) = 0) do

              Form1.ListBox1.Items.Add(SearchRec.Name);

     end;

end; 

procedure TForm1.ListBox1Click(Sender: TObject);

begin

Label2.Caption:=ListBox1.Items[ListBox1.itemIndex];

end; 

procedure TForm1.MediaPlayer1Click(Sender: TObject; Button: TMPBtnType;

  var DoDefault: Boolean);

begin

     if (Button = btPlay) and (Label2.Caption <> '') then

     begin

        with MediaPlayer1 do

          begin

             FileName:=SOUNDPATCH+Label2.Caption;

             Open;

          end;

     end;

end; 

end. 

6. Руководство пользователя

  Перед тем как запустить программу добавьте в список звуковые файлы с расширением .wav.Для того чтобы проиграть звуковой файл нажмите Play, чтобы остановить проигрывание нажмите Stop. 
 
 
 
 
 

 
 
 
 
 
 
 
 
 
 
 
 
 
 

7. Задача 7
1. Условие задачи

  Напишите  программу, которая  в указанном  пользователем каталоге и его  и его под каталогах выполняет  поиск файла. Для ввода имени  каталога во время работы программы  используйте стандартное диалоговое  окно Обзор папок.

2. Таблица реквизитов

3. Требования  к программе

  Программа должна выполнять поиск файла.

4. Форма программы

 

 Label2 

Label1  Button2

 Edit2

Label3  Edit1 

 Button1 
 

 Memo1 
 
 
 
 
 
 
 
 

5. Листинг программы 

unit FindFile_; 

interface 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls,

  FileCtrl; 

type

  TForm1 = class(TForm)

    Edit1: TEdit;

    Edit2: TEdit;

    Memo1: TMemo;

    Button1: TButton;

    Button2: TButton;

    Label1: TLabel;

    Label2: TLabel;

    Label3: TLabel;

    Label4: TLabel;

    procedure Button1Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end; 

var

  Form1: TForm1; 

implementation 

{$R *.dfm} 

var

   FileName: string;

   cDir: string;

   n: integer; 

procedure Find;

var

   SearchRec: TSearchRec;

begin

   GetDir(0,cDir);

   if cDir[length(cDir)] <> '\' then cDir := cDir+'\'; 

   if FindFirst(FileName, faAnyFile,SearchRec) = 0 then

       repeat

          if (SearchRec.Attr and faAnyFile) = SearchRec.Attr then

             begin

               Form1.Memo1.Lines.Add(cDir +  SearchRec.Name);

               n := n + 1;

             end;

        until FindNext(SearchRec) <> 0;

       if FindFirst('*', faAnyFile, SearchRec) = 0 then

          repeat

              if (SearchRec.Attr and faDirectory) = faDirectory then

                    if SearchRec.Name[1] <> '.' then