::: µ¨ÆÄÀÌ Tip&Trick :::

µ¨ÆÄÀÌ Tip&Trick ¼º°Ý¿¡ ¸ÂÁö ¾Ê´Â ±¤°í,ºñ¹æ,Áú¹®ÀÇ ±ÛÀº Áï½Ã »èÁ¦Çϸç
³»¿ëÀ» º¹»çÇÏ¿© »ç¿ëÇÒ °æ¿ì ¹Ýµå½Ã À̰÷(http://www.howto.pe.kr)À» Ãâó·Î ¸í½ÃÇÏ¿© ÁÖ¼¼¿ä


Category

  ±è¿µ´ë(2003-03-07 10:19:49, Hit : 4637, Vote : 923
 »ç¿îµåÆÄÀÏ ¾øÀÌ PC ½ºÇÇÄ¿·Î À½¾Ç¿¬ÁÖ

{Written By Luiz C. Vaz de Brito}

Unit Music;

Interface

Uses Windows, Classes, Forms;

Procedure PlaySong (TuneString:string);

Const
  BaseOctave: Integer = 0;

Implementation

Const
    SharpOffset = 60;

{ Frequency of notes }
   PitchArray: Array[1..120] of Word =
         (28,31,33,37,41,44,49,55,
          62,65,73,82,87,98,110,123,
          131,147,165,175,196,220,247,262,
          294,330,349,392,440,494,523,587,
          659,698,784,880,988,1047,1175,1319,
          1397,1568,1760,1976,2093,2349,2637,2794,
          3136,3520,3951,4186,4699,5274,5588,6272,
          32139,9738,1934,39659,29,33,35,39,
          44,46,52,58,65,69,78,87,
          92,104,117,131,139,156,175,185,
          208,233,262,277,311,349,370,415,
          466,523,554,622,698,740,831,932,
          1047,1109,1245,1397,1480,1661,1865,2093,
          2217,2489,2794,2960,3322,3729,4186,4435,
          4978,5588,5920,6645,35669,33772,1772,18119);

  Octave: Integer = 3; {Thirth Octave - Starts with half C}
  GenNoteType: Integer = 4; {Quarter of note}
  Tempo: Integer = 120; {120 BPM}
  PlayFrac: Byte = 7; {Normal - 7/8 of time}

Var vq: LongInt;
    TmpPitch: LongInt;

{ Write value on Sound port}
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;

{ Read value on Sound port}
function GetPort(address: Word): Word;
var
   bValue: Byte;
begin
   asm
     mov DX, address
     in AL, DX
     mov bValue, AL
   end;
   result := bValue;
end;

{ Stop sound}
procedure NoSound;
var
   wValue: Word;
begin
   wValue := GetPort($61);
   wValue := wValue and $FC;
   SetPort($61, wValue);
end;

{Make sound with passed frequency}
procedure Sound(Freq: Word);
var
   B: Word;
begin
   if Freq > 18 then begin
      Freq := Word(1193181 div LongInt(Freq));
      B := GetPort($61);
      if (B and 3) = 0 then begin
         SetPort($61, B or 3);
         SetPort($43, $B6);
      end;
      SetPort($42, Freq);
      SetPort($42, (Freq SHR 8));
   end;
end;

{Delay for x seconds }
procedure Delay(MSecs: Integer);
var
   FirstTickCount : LongInt;
begin
   FirstTickCount:=GetTickCount;
   repeat
      Application.ProcessMessages;
   until ((GetTickCount-FirstTickCount) >= LongInt(MSecs));
end;


{Exec string on music standard PLAY of basic }
Procedure PlaySong (TuneString:string);
  Var
    PlayTime: LongInt;
    IdleTime: LongInt;
    DotTime: LongInt;
    NoteTime : LongInt;
    NoteType: Integer;
    PitchIndex: Integer;
    Position: Integer;
    Number : Integer;
    Code: Integer;
    TuneStrLen: Integer;
    Character: Char;
    PlayDone: Boolean;


  Procedure NVal(Pos:integer; var v, code: integer);
  Var
      Posn:integer;
  Begin
     v := 0;
     posn := Pos;
     while (posn <= TuneStrLen) and (TuneString[posn] in ['0'..'9']) do
     Begin
       v := v*10 + ord(TuneString[posn]) - ord ('0');
       Inc(posn);
     End;
     code := posn - Pos + 1;
  End;

   Procedure CheckDots; {There are points after note?}
   Begin
      While (Position <= TuneStrLen) and (TuneString[Position] = '.') do

       Begin
          DotTime := DotTime + DotTime div 2;
          inc(Position)
       End;
   End;

Begin
  PlayDone := False;
  TuneStrLen := length(TuneString);
  Position := 1;
  Repeat
    NoteType := GenNoteType;
    DotTime := 1000;
    Character := upcase(TuneString[Position]);
    Case Character Of
      'A'..'G' : Begin
                 PitchIndex := (ord(Character)-64)+Octave*7;
                 If (Character='A') or (Character='B') Then
                   PitchIndex := PitchIndex + 7;
                 inc(Position);

                 {Bemol ou sustenido?}
                 if Position <= TuneStrLen then
                   case TuneString[Position] of
                     '#','+': begin
                              PitchIndex := PitchIndex+SharpOffset;
                              inc(Position);
                              end;
                     '-': begin
                          PitchIndex := PitchIndex+SharpOffset - 1;
                          inc(Position);
                          end;
                     End;

                 if (Position <= TuneStrLen) and
                 (TuneString[Position] in ['0'..'9']) then begin
                   NVal(Position,NoteType,Code);
                   inc(Position, Code - 1)
                 end;
                 CheckDots;
                 {Toca a nota}
                 NoteTime := Round(DotTime/Tempo/NoteType*240);
                 PlayTime := Round(NoteTime*PlayFrac/8);
                 IdleTime := NoteTime-PlayTime;
                 Sound(PitchArray[PitchIndex]);
                 Delay(PlayTime);
                 if IdleTime <> 0 then begin
                    NoSound;
                    Delay(IdleTime)
                   end;
                 End;
      'L' : {Duracao 1 - 64 }
            Begin
            NVal (Position+1,GenNoteType,Code);
            if (GenNoteType < 1) or (GenNoteType > 64) then
              GenNoteType := 4;
            inc(Position, Code);
            End;
      'M' : {"S" staccato,"L" legato,"N" normal.}
            Begin
            if Position < TuneStrLen then
              begin
              Case upcase(TuneString[Position+1]) Of
                'S' : PlayFrac := 6;
                'N' : PlayFrac := 7;
                'L' : PlayFrac := 8;
                End;
              inc(Position, 2);
              end;
            End;
      'O' : Begin
            NVal (Position+1,Octave,Code);
            Octave := Octave+BaseOctave;
            if Octave > 7 then
              Octave := 3;
            inc(Position, Code);
            End;
      'P' : Begin
            NoSound;
            NVal (Position+1,NoteType,Code);
            if (NoteType < 1) or (NoteType > 64) then
              NoteType := GenNoteType;
              inc(Position, Code);
              CheckDots;
              IdleTime := DotTime Div Tempo * (240 Div NoteType);
              Delay (IdleTime);
              End;
      'T' : {Tempo - BPM (32 - 255)}
            Begin
            NVal (Position+1,Tempo,Code);
            if (Tempo < 32) or (Tempo > 255) then
              Tempo := 120;
            inc(Position, Code);
            End;
      Else
        inc(Position); {Ignore wrong caracters}
      End;
    Until ((Position > TuneStrLen) Or (PlayDone));
    NoSound;
    End;
End.

-------------------------------------------------------------
And here, some musics yet for PlaySong.

William Tell Overture
=====================
PlaySong('O2L16T155P8MSO1BBB8BBB8BBO2E8F#8G#8O1BBB8BBO2E8G#G#F#8D#8O1B8BBB8BBB8BBO2E8F#8G#8EG#');
PlaySong('MLB4BMSAG#F#E8G#8E8O3BBB8BBB8BBO4E8F#8G#8O3BBB8BBO4E8G#G#F#8D#8O3B8BBB8BBB8BB');
PlaySong('O4E8F#8G#8MLEG#B4BAG#F#MSE8G#8E8P2');

Familia Adams;
==============
PlaySong('O3T220L8CDEFP4O0L4FP8FP8O3L8DEF#GP4O1L4GP8GP8O3L8DEF#GP4DEF#GP4CDEFP4O1L4FP8FP8');
PlaySong('P4T187O3L8CF.AF.DO2B-.O3GP4FE.GE.CO2A.O3FP4CF.AF.DO2B-.O3GP4FL64EFL8E.CD.EFP4');
PlaySong('O3T220L8CDEFP4O0L4FP8FP8O3L8DEF#GP4O1L4GP8GP8O3L8DEF#GP4DEF#GP4CDEFP4O1L4FP8FP8');
PlaySong('P4T187O3L8CF.AF.DO2B-.O3GP4FE.GE.CO2A.O3FP4CF.AF.DO2B-.O3GP4FL64EFL8E.CD.EFP2');

Beverly Hills Cop
=================
PlaySong('t125msl4o3fg#l8fl16fl8a#l8fd#l4fl4o4cl8o3fl16fl8o4c#co3g#fo4cl8fo3l16fl8d#l16d#l8cl8gl4fp2');
PlaySong('t125msl4o3fg#l8fl16fl8a#l8fd#l4fl4o4cl8o3fl16fl8o4c#co3g#fo4cl8fo3l16fl8d#l16d#l8cl8gl4fp2');
PlaySong('o1l4ffl8d#l16d#l8d#l8cd#l4ffp8l16fl8fcfl4c#c#l8d#l16d#l8d#d#d#fp2l8fco0l8a#g#l4f');
PlaySong('o1l4fl8d#l16d#l8d#l8cd#l4ffp8l16fl8fcfl4c#c#l8d#l16d#l8d#d#d#fp2');

James bond theme
================
PlaySong('mll8t125O1b4ebo2c4o1eo2cc#4o1eo2c#c4o1eo2cO1b4ebo2c4o1eo2cc#4o1eo2c#c4o1eo2c');
PlaySong('t150mno3ef#16f#16f#f#3o2eeemno3eg16g16gg3o2f#F#F#mno3ef#16f#16f#f#3o2eee');
PlaySong('mno3eg16g16gg3o2f#F#F#mno3ef#16f#16f#f#3o2eeemno3eg16g16gg3o2f#F#e');
PlaySong('mlo4d#o3b64o4dd2o2g64bf#64amlg24b1P2');

Leave it to beaver
==================
PlaySong('MST190O2L8CL4FL8A>C<AFL4GL8B-L4>DL8C<B>CFL4DL8<B-L4G..P16');
PlaySong('L8CL4FL8A>C<AFL4GL8B-L4>DL8C<B>CFD<GEL4F..P8O3L4AL8AL4G.L8FGFL4E-L8EDE-EFGG+L4A..P8');
PlaySong('O1L4GL8GL4F.L8EFEL4D-L8DDEFG>G<G>C<B-AG.P16O2L8CL4FL8A>C<AFL4GL8B-L4>D');
PlaySong('L8C<B>CFL4DL8<B-L4G..P16O3L8CL4FL8A>C<AFL4GL8B-L4>DL8C<B>CFD<GEL4F.L8>FP2');

London Bridge
=============
PlaySong('MST190O2L8CL4FL8A>C<AFL4GL8B-L4>DL8C<B>CFL4DL8<B-L4G..P16');
PlaySong('L8CL4FL8A>C<AFL4GL8B-L4>DL8C<B>CFD<GEL4F..P8O3L4AL8AL4G.L8FGFL4E-L8EDE-EFGG+L4A..P8');
PlaySong('O1L4GL8GL4F.L8EFEL4D-L8DDEFG>G<G>C<B-AG.P16O2L8CL4FL8A>C<AFL4GL8B-L4>D');
PlaySong('L8C<B>CFL4DL8<B-L4G..P16O3L8CL4FL8A>C<AFL4GL8B-L4>DL8C<B>CFD<GEL4F.L8>FP2');

My Darling Clementine
=====================
PlaySong('T120MNO2L8G.L16GL4GDL8B.L16BL4BGL8GBO3L4DDL8CO2BL2AL8ABO3L4CCO2L8B.L16AL4BGL8GB');
PlaySong('L4ADL8F#.L16AL2GL8G.L16GL4GDL8B.L16BL4BGL8GBO3L4D.L8DCO2BL2AL8ABO3L4CC');
PlaySong('O2L8B.L16AL4BGL8GBL4ADL8F#.L16AL2GL8G.L16GL4GDL8B.L16BL4BGL8GBO3L4DDL8C');
PlaySong('O2BL2AL8ABO3L4CCP2');

The Entertainers
================
PlaySong('T120MNO3L8DD#EO4L4CO3L8EO4L4CO3L8EO4L4C.P4P8L8CDD#ECDL4EL8O3BL4O4DCP4P4O3L8DD#EL4');
PlaySong('O4CO3L8EO4L4CO3L8EL4O4C.P4P4O3L8AGF#AO4CL4EL8DCO3AO4L4DP4P4O3L8DD#EL4O4C');
PlaySong('O3L8EO4L4CO3L8EO4L4C.P4P4L8CDD#ECDL4EL8O3BO4L4DCP4P4L8CDECDL4EL8CDCECDL4E');
PlaySong('L8CDCECDL4EO3BO4L4ECP2');
---------------------------------------





491   [ÀϹÝ/ÄÄÆ÷³ÍÆ®] ¼ýÀÚ¸¦ ÇÑ±Û Ç¥±â·Î ¹Ù²Ù±â  ±è¿µ´ë 2003/03/07 3610 927
490   [ÀϹÝ/ÄÄÆ÷³ÍÆ®] ¼ýÀÚ¸¦ ¿µ¹® Ç¥±â·Î ¹Ù²Ù±â  ±è¿µ´ë 2003/03/07 4244 890
489   [ÀϹÝ/ÄÄÆ÷³ÍÆ®] ÁÖ¾îÁø ¿µ¿ªÀÇ È­¸é ĸó  ±è¿µ´ë 2003/03/07 3558 1008
488   [³×Æ®¿÷/ÀÎÅͳÝ] RS232 Åë½Å  ±è¿µ´ë 2003/03/07 6916 1855
487   [½Ã½ºÅÛ] À©µµ¿ìÁî ½Ã½ºÅÛ Ç¥ÁØ ÆùÆ® ±¸ÇÏ±â  ±è¿µ´ë 2003/03/07 3019 850
486   [ÀϹÝ/ÄÄÆ÷³ÍÆ®] ¾ÆÀÌÄÜ »çÀÌÆ®  ±è¿µ´ë 2003/03/07 3613 1067
485   [ÀϹÝ/ÄÄÆ÷³ÍÆ®] À©µµ¿ìÁî Á¾·á¿Í °°Àº ±×´ÃÁø È­¸é ¸¸µé±â  ±è¿µ´ë 2003/03/07 3138 840
484   [³×Æ®¿÷/ÀÎÅͳÝ] ÇÁ·Î±×·¥À¸·Î ³×Æ®¿öÅ© µå¶óÀÌºê ¿¬°á/ÇØÁ¦  ±è¿µ´ë 2003/03/07 6716 1250
  [½Ã½ºÅÛ] »ç¿îµåÆÄÀÏ ¾øÀÌ PC ½ºÇÇÄ¿·Î À½¾Ç¿¬ÁÖ  ±è¿µ´ë 2003/03/07 4637 923
482   [½Ã½ºÅÛ] CPU Á¾·ù ±¸ÇÏ±â  ±è¿µ´ë 2003/03/07 4802 1194
481   [ÀϹÝ/ÄÄÆ÷³ÍÆ®] TRichEdit ÀÇ ¼±ÅÃµÈ ¿µ¿ª¸¸ ÀμâÇÏ±â  ±è¿µ´ë 2003/03/07 4472 725
480   [ÀϹÝ/ÄÄÆ÷³ÍÆ®] TRichEdit ÀÇ 64K ÇÑ°è  ±è¿µ´ë 2003/03/07 4027 1097
479   [½Ã½ºÅÛ] ¼³Ä¡µÈ ÇÁ¸°ÅÍ µå¶óÀ̹ö Á¤º¸ ±¸ÇÏ±â  ±è¿µ´ë 2003/03/07 3083 814
478   [ÀϹÝ/ÄÄÆ÷³ÍÆ®] PASCAL Æ÷ÀÎÅÍ ¿¬»ê  ±è¿µ´ë 2003/03/07 2828 789
477   [½Ã½ºÅÛ] Time Zone Á¤º¸¸¦ ½ÃºÐÀ¸·Î Àоî¿À±â  ±è¿µ´ë 2003/03/07 2909 790
476   [ÀϹÝ/ÄÄÆ÷³ÍÆ®] {$I-} and {$I+} do not work under NT4.0  ±è¿µ´ë 2003/03/07 2315 591
475   [½Ã½ºÅÛ] Thread »ç¿ëÇÏ±â  ±è¿µ´ë 2003/03/07 4216 1153
474   [ÀϹÝ/ÄÄÆ÷³ÍÆ®] ¿­°ÅÇü(Enumerated) »ó¼ö¸¦ ¹®ÀÚ¿­·Î ¹Ù²Ù±â  ±è¿µ´ë 2003/03/07 4338 1277
473   [ÀϹÝ/ÄÄÆ÷³ÍÆ®] ÆûÀÇ ÃÖ¼ÒÈ­½Ã ¿¡´Ï¸ÅÀÌ¼Ç ¾ÆÀÌÄÜ º¸¿©ÁÖ±â  ±è¿µ´ë 2003/03/07 3176 888
472   [ÀϹÝ/ÄÄÆ÷³ÍÆ®] À©µµ¿ìÁî Á¦¾îÆÇ È­¸é ¶ç¿ì±â  ±è¿µ´ë 2003/03/07 4568 1246
471   [µ¥ÀÌÅͺ£À̽º] TDBGrid - Boolean CheckBox  ±è¿µ´ë 2003/03/07 3249 807
470   [ÀϹÝ/ÄÄÆ÷³ÍÆ®] ÆÄÀÏÀÇ ¹öÀüÁ¤º¸ Àоî¿À±â  ±è¿µ´ë 2003/03/07 3431 891
469   [ÀϹÝ/ÄÄÆ÷³ÍÆ®] MS-OutLook À¸·Î ¸Þ½ÃÁö º¸³»±â  ±è¿µ´ë 2003/03/07 5132 1175
468   [ÀϹÝ/ÄÄÆ÷³ÍÆ®] MessageDlg()ÀÇ default ¹öư ¼±ÅÃÇØ¼­ ¶ç¿ì±â  ±è¿µ´ë 2003/03/07 3470 993
467   [³×Æ®¿÷/ÀÎÅͳÝ] ±âº» ÀÎÅÍ³Ý À¬ºê¶ó¿ìÀúÀÇ ÆÄÀÏ¸í ±¸ÇÏ±â  ±è¿µ´ë 2003/03/07 2861 783
466   [³×Æ®¿÷/ÀÎÅͳÝ] TCP/IP °¡ ¼³Ä¡µÇ¾î ÀÖ´ÂÁö °Ë»çÇÏ±â  ±è¿µ´ë 2003/03/07 3345 999
465   [½Ã½ºÅÛ] Message Queue¿¡ ƯÁ¤ ¸Þ½ÃÁö°¡ ÀÖ´ÂÁö °Ë»ç  ±è¿µ´ë 2003/03/07 3199 892
464   [À©µµ¿ìÁî API] EXCEL Á¾·á½ÃŰ±â  ±è¿µ´ë 2003/03/07 4673 1180
463   [½Ã½ºÅÛ] È­¸éº¸È£±â°¡ ¼³Ä¡µÇ¾î ÀÖ´ÂÁö °Ë»çÇÏ±â  ±è¿µ´ë 2003/03/07 3978 1153
462   [À©µµ¿ìÁî API] TreeViewÀÇ hint popup ¾ø¾Ö±â  ±è¿µ´ë 2003/03/07 5669 1811
461   [À©µµ¿ìÁî API] NT Server or NT Workstation ±¸ºÐÇÏ±â  ±è¿µ´ë 2003/03/07 3689 1094
460   [¾Ë°í¸®Áò] Bubble, Selection, Quick Sort algorithm  ±è¿µ´ë 2003/03/07 3155 927
459   [½Ã½ºÅÛ] µÎ°³ÀÇ ÆÄÀÏÀÌ ¿ÏÀüÈ÷ µ¿ÀÏÇÑÁö °Ë»çÇϱâ2  ±è¿µ´ë 2003/03/07 3376 973
458   [À©µµ¿ìÁî API] ½ÇÇàµÈ Tray Icon º¯°æÇÏ±â  ±è¿µ´ë 2003/03/07 6409 1912
457   [½Ã½ºÅÛ] BIOS ÇÔ¼ö¸¦ »ç¿ëÇÑ drive Á¢±Ù¹æ¹ý  ±è¿µ´ë 2003/03/07 3142 905
456   [ÀϹÝ/ÄÄÆ÷³ÍÆ®] TCanvas or TBitmap -> TGIFImage  ±è¿µ´ë 2003/03/07 4862 1150
455   [ÀϹÝ/ÄÄÆ÷³ÍÆ®] Memo, RichEdit ¼±ÅÃÇàÀÇ µé¿©¾²±â/³»¿©¾²±â  ±è¿µ´ë 2003/03/07 3236 709
454   [ÀϹÝ/ÄÄÆ÷³ÍÆ®] ¼ýÀÚ¾ÕÀÇ ¹«È¿ÇÑ 0 Á¦°ÅÇÏ±â  ±è¿µ´ë 2003/03/07 4050 1099
453   [½Ã½ºÅÛ] À©µµ¿ìÁî¿¡ ¼³Ä¡µÈ ÇÁ¸°ÅÍ ¸®½ºÆ® ±¸ÇÏ±â  ±è¿µ´ë 2003/03/07 4254 1120
452   [½Ã½ºÅÛ] PC ½ºÇÇÄ¿ ¿ï¸®±â(Sound, NoSound)  ±è¿µ´ë 2003/03/07 4425 1204

[ÀÌÀü 10°³] [1]..[11][12] 13 [14][15][16][17][18][19][20]..[25] [´ÙÀ½ 10°³]
 

Copyright 1999-2022 Zeroboard / skin by zero