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

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


Category

  ±è¿µ´ë(2003-03-07 10:19:49, Hit : 7604, Vote : 1138
 »ç¿îµåÆÄÀÏ ¾øÀÌ 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   [ÀϹÝ/ÄÄÆ÷³ÍÆ®] TRichEdit ÀÇ ¼±ÅÃµÈ ¿µ¿ª¸¸ ÀμâÇÏ±â  ±è¿µ´ë 2003/03/07 5043 937
490   [½Ã½ºÅÛ] CPU Á¾·ù ±¸ÇÏ±â  ±è¿µ´ë 2003/03/07 5395 1388
  [½Ã½ºÅÛ] »ç¿îµåÆÄÀÏ ¾øÀÌ PC ½ºÇÇÄ¿·Î À½¾Ç¿¬ÁÖ  ±è¿µ´ë 2003/03/07 7604 1138
488   [³×Æ®¿÷/ÀÎÅͳÝ] ÇÁ·Î±×·¥À¸·Î ³×Æ®¿öÅ© µå¶óÀÌºê ¿¬°á/ÇØÁ¦  ±è¿µ´ë 2003/03/07 7429 1428
487   [ÀϹÝ/ÄÄÆ÷³ÍÆ®] À©µµ¿ìÁî Á¾·á¿Í °°Àº ±×´ÃÁø È­¸é ¸¸µé±â  ±è¿µ´ë 2003/03/07 3552 946
486   [ÀϹÝ/ÄÄÆ÷³ÍÆ®] ¾ÆÀÌÄÜ »çÀÌÆ®  ±è¿µ´ë 2003/03/07 4071 1209
485   [½Ã½ºÅÛ] À©µµ¿ìÁî ½Ã½ºÅÛ Ç¥ÁØ ÆùÆ® ±¸ÇÏ±â  ±è¿µ´ë 2003/03/07 3486 967
484   [³×Æ®¿÷/ÀÎÅͳÝ] RS232 Åë½Å  ±è¿µ´ë 2003/03/07 7593 2020
483   [ÀϹÝ/ÄÄÆ÷³ÍÆ®] ÁÖ¾îÁø ¿µ¿ªÀÇ È­¸é ĸó  ±è¿µ´ë 2003/03/07 3926 1119
482   [ÀϹÝ/ÄÄÆ÷³ÍÆ®] ¼ýÀÚ¸¦ ¿µ¹® Ç¥±â·Î ¹Ù²Ù±â  ±è¿µ´ë 2003/03/07 4693 1044
481   [ÀϹÝ/ÄÄÆ÷³ÍÆ®] ¼ýÀÚ¸¦ ÇÑ±Û Ç¥±â·Î ¹Ù²Ù±â  ±è¿µ´ë 2003/03/07 4029 1056
480   [ÀϹÝ/ÄÄÆ÷³ÍÆ®] RichEdit ÀÇ ³»¿ëÀ» Bitmap À¸·Î ¸¸µé±â 2  ±è¿µ´ë 2003/03/07 4347 1610
479   [COM/OLE] MS-WORD Á¾·á½ÃÅ°±â  ±è¿µ´ë 2003/03/07 3044 853
478   [À©µµ¿ìÁî API] ½Ã½ºÅÛ »ç¿îµå ¿¬ÁÖÇÏ±â  ±è¿µ´ë 2003/03/07 5353 1455
477   [ÀϹÝ/ÄÄÆ÷³ÍÆ®] Algorithm to sort a TStringGrid #2  ±è¿µ´ë 2003/03/07 5291 1375
476   [À©µµ¿ìÁî API] ¿ÜºÎ ÇÁ·Î±×·¥ÀÇ ÁÂÇ¥,»óÅ ±¸ÇÏ±â  ±è¿µ´ë 2003/03/07 3672 1155
475   [À©µµ¿ìÁî API] À©µµ¿ìÁî Telnet À¸·Î È£½ºÆ® Á¢¼ÓÇÏ±â  ±è¿µ´ë 2003/03/07 4564 1247
474   [ÀϹÝ/ÄÄÆ÷³ÍÆ®] ƯÁ¤ÇÑ Æú´õ·Î À̵¿ÇÑ DOS â ¶ç¿ì±â  ±è¿µ´ë 2003/03/07 4649 1256
473   [½Ã½ºÅÛ] DOS ¸í·É¾î ½ÇÇàÇÏ°í °á°ú ¹Þ¾Æ¿À±â  ±è¿µ´ë 2003/03/07 7162 1680
472   [À©µµ¿ìÁî API] NTÀÇ ÇöÀç user°¡ administrative privilege ¸¦ °¡Áö°í ÀÖ´ÂÁö?  ±è¿µ´ë 2003/03/07 3541 966
471   [ÀϹÝ/ÄÄÆ÷³ÍÆ®] µÎ°³ÀÇ StringGrid sync ¸¶Ãß±â  ±è¿µ´ë 2003/03/07 4125 1132
470   [ÀϹÝ/ÄÄÆ÷³ÍÆ®] À©µµ¿ìÀÇ title bar ÆùÆ® ¹Ù²Ù±â  ±è¿µ´ë 2003/03/07 3649 960
469   [³×Æ®¿÷/ÀÎÅͳÝ] ³×Æ®¿öÅ© °øÀ¯ ¼³Á¤/ÇØÁ¦ Çϱâ (Windows 9x)  ±è¿µ´ë 2003/03/07 4878 1229
468   [³×Æ®¿÷/ÀÎÅͳÝ] ³×Æ®¿öÅ© °øÀ¯ Á¤º¸ Àоî¿À±â (WIndows 9x)  ±è¿µ´ë 2003/03/07 4130 1154
467   [ÀϹÝ/ÄÄÆ÷³ÍÆ®] ´­·ÁÁø Å°º¸µå Å°ÀÇ ¸íĪ ±¸ÇÏ±â  ±è¿µ´ë 2003/03/07 7879 1583
466   [À©µµ¿ìÁî API] Windows98 ¿¡¼­ÀÇ SetForegroundWindow  ±è¿µ´ë 2003/03/07 6390 1664
465   [À©µµ¿ìÁî API] Task bar ¿¡ ³ªÅ¸³ªÁö ¾Ê´Â ÇÁ·Î±×·¥ ¸¸µé±â  ±è¿µ´ë 2003/03/07 5663 1660
464   [COM/OLE] Outlook »ç¿ëÇÏ±â  ±è¿µ´ë 2003/03/07 4047 1335
463   [½Ã½ºÅÛ] ÁöÁ¤ÇÑ drive°¡ CD-ROM ÀÎÁö °Ë»çÇÏ±â  ±è¿µ´ë 2003/03/07 6905 1820
462   [½Ã½ºÅÛ] ¾î¶² ¾îÇø®ÄÉÀ̼ÇÀÌ ½ÃÀÛ µÇ´ÂÁö hookÀ¸·Î ¾Ë¾Æ³»±â  ±è¿µ´ë 2003/03/07 5787 1729
461   [À©µµ¿ìÁî API] À©µµ¿ìÁî Ž»ö±âÀÇ ¾ÆÀÌÄÜ »Ì¾Æ³»¼­ »ç¿ëÇÏ±â  ±è¿µ´ë 2003/03/07 8602 2063
460   [À©µµ¿ìÁî API] System Images  ±è¿µ´ë 2003/03/07 8530 1986
459   [À©µµ¿ìÁî API] ÄÄÇ»ÅÍ/ÆÄÀÏ/Æú´õ ã±â È­¸é ¶ç¿ì±â  ±è¿µ´ë 2003/03/07 8553 1696
458   [ÀϹÝ/ÄÄÆ÷³ÍÆ®] Unix-format time À» TDateTime ·Î ¹Ù²Ù±â  ±è¿µ´ë 2003/03/07 4506 1240
457   [ÀϹÝ/ÄÄÆ÷³ÍÆ®] ½ÇÇà½Ã component ¸¦ Move/Resize ½ÃÅ°±â  ±è¿µ´ë 2003/03/07 3692 1067
456   [ÀϹÝ/ÄÄÆ÷³ÍÆ®] TMemo ¸¦ È­¸éÅ©±â·Î ÀμâÇÏ±â  ±è¿µ´ë 2003/03/07 3198 809
455   [ÀϹÝ/ÄÄÆ÷³ÍÆ®] SpeedButton ¿¡ OnMouseEnter/OnMouseExit À̺¥Æ® ³Ö±â  ±è¿µ´ë 2003/03/07 4374 1183
454   [À©µµ¿ìÁî API] Å°º¸µåÀÇ Scroll Lock Äѱâ/²ô±â  ±è¿µ´ë 2003/03/07 4755 1276
453   [µ¥ÀÌÅͺ£À̽º] table packing ÇÏ±â  ±è¿µ´ë 2003/03/07 4040 1119
452   [À©µµ¿ìÁî API] reboot Windows  ±è¿µ´ë 2003/03/07 5108 1343

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

Copyright 1999-2025 Zeroboard / skin by zero