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

•  DeLiKaTeS Tetris (Тетрис)  4 724

•  TDictionary Custom Sort  6 725

•  Fast Watermark Sources  6 508

•  3D Designer  9 446

•  Sik Screen Capture  6 839

•  Patch Maker  7 289

•  Айболит (remote control)  7 231

•  ListBox Drag & Drop  6 094

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

•  Графические эффекты  7 407

•  Рисование по маске  6 704

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

•  Canvas Drawing  5 942

•  Рисование Луны  5 719

•  Поворот изображения  5 180

•  Рисование стержней  3 786

•  Paint on Shape  2 966

•  Генератор кроссвордов  3 907

•  Головоломка Paletto  3 105

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

•  Пазл Numbrix  2 578

•  Заборы и коммивояжеры  3 372

•  Игра HIP  2 313

•  Игра Go (Го)  2 212

•  Симулятор лифта  2 623

•  Программа укладки плитки  2 205

•  Генератор лабиринта  2 723

•  Проверка числового ввода  2 360

•  HEX View  2 698

•  Физический маятник  2 374

 
скрыть

Как в Delphi реализовать возможность пропищать звук различной длины и частоты



- Алло! Техотдел?! Я комп врубаю, а на экране ничего!!!
- Перезагрузи для начала.
- Как?
- Alt-Ctrl-Del.
- Не нажимаются!
- Тогда нажми Reset - потом перезвони.
(Минут через десять)
- Алло! На экране все равно ничего нет!
- Reset нажал?
- Нажал!
- Ну, и?..
- Что "и"?! Держу!!!


procedure SetPort(address, Value: Word);
var
  bValue: byte;
begin
  bValue := trunc(Value and 255);
  asm
    mov dx, address
    mov al, bValue
    out dx, al
  end;
end;

function GetPort(address: word): word;
var
  bValue: byte;
begin
  asm
    mov dx, address
    in al, dx
    mov bValue, al
  end;
  GetPort := bValue;
end;

procedure Sound(Freq: Word);
var
  B: Byte;
begin
  if Freq > 18 then
  begin
    Freq := Word(1193181 div LongInt(Freq));
    B := Byte(GetPort($61));
    if (B and 3) = 0 then
    begin
      SetPort($61, Word(B or 3));
      SetPort($43, $B6);
    end;
    SetPort($42, Freq);
    SetPort($42, Freq shr 8);
  end;
end;