In this example:
Code File:
Unit unit1; interfaceuses windows, messages, sysutils, variants, classes, graphics, controls, forms, dialogs, stdctrls, extctrls, comctrls, Bass; Type tform1 = Class (tform) opendialog1: timer; timer1: ttimer; Timer: timer; button1: tbutton; button2: tbutton; button3: tbutton; button4: tbutton; button5: tbutton; shape1: tshape; shape2: tshape; shape3: tshape; label1: tlabel; Procedure fo Processing (Sender: tobject); Procedure button1click (Sender: tobject); Procedure button2click (Sender: tobject); Procedure processing (Sender: tobject ); procedure paintbox1paint (Sender: tobject); Procedure timer1timer (Sender: tobject); Procedure destroy (Sender: tobject; button: tmousebutton; shift: tshiftstate; X, Y: integer ); procedure button4click (Sender: tobject); Procedure button5click (Sender: tobject); Private Procedure draw; end; Procedure mysyncloop (handle: hsync; channel, Data, user: DWORD); stdcall; var form1: tform1; implementation {$ R *. DFM} // uses bass; var HS: hstream; {stream handle} data: array of cardinal; bit: tbitmap; hsyncloop: Cardinal; {callback function handle} mp3len: Cardinal; {total MP3 bytes} procedure tform1.formcreate (Sender: tobject); begin label1.capti On: = 'prompt: Click the left mouse button to set the recurrence start point (yellow line); Right-click to set the recurrence inflection point (red line ). '; timer1.enabled: = false; timer1.interval: = 100; shape1.pen. style: = psclear; shape1.brush. color: = clwhite; shape1.width: = 3; shape1.height: = paintbox1.height; shape1.top: = 0; shape1.left: =-1; shape2.pen. style: = psclear; shape2.brush. color: = clyellow; shape2.width: = 3; shape2.height: = paintbox1.height; shape2.top: = 0; shape2.visible: = false; Shape3.pen. style: = psclear; shape3.brush. color: = clred; shape3.width: = 3; shape3.height: = paintbox1.height; shape3.top: = 0; shape3.visible: = false; bit: = tbitmap. create; paintbox1.align: = altop; If hiword (bass_getversion) bassversion then MessageBox (0, '"Bass. the DLL file version is not suitable! ', Nil, mb_iconerror); if not bass_init (-1, 44100, 0, 0, nil) Then showmessage ('initialization error'); end; {open} procedure tform1.button1click (Sender: tobject); var mp3path: ansistring; I: Cardinal; Time: Double; hs2: hstream; begin bass_streamfree (HS); opendialog1.filter: = 'mp3 file (*. MP3) | *. MP3 | WAV file (*. wav) | * WAV '; If opendialog1.execute then mp3path: = ansistring (opendialog1.filename); HS: = bass_streamcreatefile (false, pansichar (mp3path), 0, 0, 0); if hs
Form file:
Object form1: tform1 left = 222 Top = 114 caption = 'form1' clientheight = 177 clientwidth = 476 color = clbtnface font. charset = default_charset font. color = clwindowtext font. height =-11 font. name = 'tahoma 'font. style = [] oldcreateorder = false position = podesigned oncreate = formcreate ondestroy = formdestroy pixelsperinch = 96 textheight = 13 object paintbox1: tpaintbox left = 16 Top = 0 width = 105 Height = 105 onmousedown = paintbox1mousedown onpaint = paintbox1paint end object shape1: tshape left = 170 Top = 24 width = 65 Height = 65 end object shape2: tshape left = 241 Top = 24 width = 65 Height = 65 end object shape3: tshape left = 312 Top = 24 width = 65 Height = 65 end object label1: tlabel left = 11 Top = 156 width = 31 Height = 13 caption = 'label1' end object button1: tbutton left = 8 Top = 120 width = 75 Height = 25 caption = #25171 #24320 taborder = 0 onclick = button1click end object button2: tbutton left = 89 Top = 120 width = 75 Height = 25 caption = #25773 #25918 taborder = 1 onclick = button2click end object button3: tbutton left = 170 Top = 120 width = 75 Height = 25 caption = #26242 #20572 taborder = 2 onclick = button3click end object button4: tbutton left = 251 Top = 120 width = 75 Height = 25 caption = #20174 #22836 #25773 #25918 taborder = 3 onclick = button4click end object button5: tbutton left = 375 Top = 120 width = 93 Height = 25 caption = #28165 #38500 #21453 #22797 #26631 #35760 taborder = 4 onclick = button5click end object opendialog1: topendialog left = 128 Top = 24 end object timer1: ttimer ontimer = timer1timer left = 128 Top = 72 endend