demo1.pas

让喇叭发声的控件

Unit Demo1;

{ Andy Preston - Apollo Developments - Swindon U.K. - http://www.apollod.omnia.co.uk/aa/ }

{ Demo program for Bleeper / BleepInt / GWBleep }

{ Copyright (C) 1999 - 2001  Andy Preston }

{ This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public }
{ License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later }
{ version. }

{ This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty }
{ of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more details. }

{ You should have received a copy of the GNU General Public License along with this program; if not, write to the }
{ Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA. }

Interface

{ IF your demo program uses exotic 3rd Party controlls the loads of people won't be able to run it - KEEP IT SIMPLE }

Uses
  Classes, Controls, Forms, StdCtrls;

Type
  TDemoForm = Class (TForm)
    BuiltInLbl : TGroupBox;
    OKBtn : TButton;
    IntBtn : TButton;
    ErrBtn : TButton;
    RollLbl : TGroupBox;
    SlideBtn : TButton;
    PainBtn : TButton;
    CloseBtn : TButton;
    GWLbl : TGroupBox;
    BoatBtn : TButton;
    Testlbl: TGroupBox;
    FreqBox: TComboBox;
    TestBtn: TButton;
    TextLbl: TLabel;
    Procedure BleepIntClick (Sender : TObject);
    Procedure SlideBtnClick (Sender : TObject);
    Procedure BoatBtnClick (Sender : TObject);
    Procedure PainBtnClick (Sender : TObject);
    Procedure CloseBtnClick (Sender : TObject);
    procedure FormShow(Sender: TObject);
    procedure TestBtnClick(Sender: TObject);
    procedure FreqBoxChange(Sender: TObject);
  End;

Var
  DemoForm : TDemoForm;

Implementation

Uses
  Sysutils,
  Bleeper, BleepInt, GWBleep;

{$R *.DFM}

{ Watch out! If it's not in a 32-bit console app (i.e. most of the time) Bleepint routines call Application.ProcessMessages,
  so you might have to disable timer, buttons etc. whilst it's working }

Procedure TDemoForm.CloseBtnClick (Sender : TObject);
Begin
  Close;
End;

procedure TDemoForm.FormShow(Sender: TObject);
begin
  FreqBox.ItemIndex:=0;
end;

{ -- --- -- --- -- --- To use this routine you must add Bleepint to your Uses clause -- --- -- --- -- --- -- --- -- --- }

Procedure TDemoForm.BleepIntClick (Sender : TObject);
Begin
  PainBtn.Caption := 'Pain';
  If Sender=OKBtn Then Bleep (bOK)
  Else If Sender=IntBtn Then Bleep (bInterrupt)
  Else Bleep (bError);
End;

{ -- --- -- --- -- --- To use these routines you must add Bleeper to your Uses clause -- --- -- --- -- --- -- --- -- --- }

Procedure TDemoForm.SlideBtnClick (Sender : TObject);
Var
  I : Integer;
Begin
  PainBtn.Caption := 'Pain';
  For I := 100 To 150 Do DoBleep (I * 10, I Div 10);
  For I := 150 Downto 100 Do DoBleep (I * 10, I Div 10);
End;

Procedure TDemoForm.PainBtnClick (Sender : TObject);
Begin
  If PainBtn.Caption = 'Pain' Then Begin
    PainBtn.Caption := 'Relief';
    { DoBleep (800, -1); }{ bleeper default procedure }
    Sound (8000); { Turbo Pascal mode }
  End
  Else Begin
    PainBtn.Caption := 'Pain';
    { ShutUp; }{ bleeper default procedure }
    NoSound; { Turbo Pascal mode }
  End;
End;

procedure TDemoForm.TestBtnClick(Sender: TObject);
begin
  PainBtn.Caption := 'Pain';
  DoBleep (FreqBox.Tag, 500);
  { Sound (FreqBox.Tag); } { Turbo Pascal mode }
  { Delay (500); } { Turbo Pascal mode }
  { NoSound; } { Turbo Pascal mode }
end;

procedure TDemoForm.FreqBoxChange(Sender: TObject);
Var
  Freq:string;
begin
  Freq:=FreqBox.Items[FreqBox.ItemIndex];
  FreqBox.Tag:=StrToInt(Copy (Freq, 1, Pos (' ',Freq)-1));
end;

{ -- --- -- --- -- --- To use this routine you must add GWBleep to your Uses clause -- --- -- --- -- --- -- --- -- --- }

Procedure TDemoForm.BoatBtnClick (Sender : TObject);
Begin
  PainBtn.Caption := 'Pain';
  { 'Ei Ukhnem', More popularly known as 'The Volga Boat Song' }
  { This world famous song dates back to the days when teams of men pulled boats up The }
  { Volga. At each pull of the rope, the team would sing "Ei Ukhnem" (one more sigh).   }
  { The words sing the praise of the great "Mother of Rivers", the wide deep Volga      }
  PlayBleep ('MSL2D4<B4E<BP8C#8D4<B4E<BP8C#DGF#GEL4D<BEE<B1');
  PlayBleep ('MNO5L2D4<B4E<BP8C#8D4<B4E<BP8C#DGF#GEL4D<BEE<B1');
  PlayBleep ('MLO3L2D4<B4E<BP8C#8D4<B4E<BP8C#DGF#GEL4D<BEE<B1');
End;

End.