Discussion :

[cincap]

Bonjour à toutes et à tous,

J'essaye de comprendre le pourquoi sur cette source qui lit un fichier .mid qui fonctionnait avant et que maintenant au chargement du fichier j'ai un message "indice de liste hors limites".

A toutes fin voici le code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
 
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Gauges, StdCtrls, ExtCtrls, ComCtrls, MMSystem;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Gauge1: TGauge;
    Timer1: TTimer;
    OpenDialog1: TOpenDialog;
    StatusBar1: TStatusBar;
    procedure Timer1Timer(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    Duree: String;
  protected
    function ExtractFileName(aFilename:String; WithExt: Boolean):String;
    function SecondesToJHMS(Time: Double): String;
  public
    procedure PlayMidi();
    procedure StopMidi();
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
function TForm1.ExtractFileName(aFilename:String; WithExt: Boolean):String;
var i: Integer;
begin
  aFileName := SysUtils.ExtractFileName(aFileName);
  if WithExt then Result := aFileName
  else
  begin
    Result := '';
    i :=0;
    while (aFileName[i] <> '.') do
    begin
     Result := Result + aFileName[i];
     Inc(i);
    end;
    Result := Trim(Result);
  end;
end;
 
function TForm1.SecondesToJHMS(Time: Double): String;
var
  base,
  res,
  r: integer;
  SL: TStringList;
  I: integer;
  Num: Integer;
begin
  Result := '';
  base := 60;
  Num := Trunc(Time);
  if num <= 0 then Result := '00';
  SL := TStringList.Create;
  While(Num>0) do
  begin
    res := Num div base;
    r := Num mod base;
    Num := res;
    SL.Add(IntToStr(r));
  end;
  for I := SL.Count -1 DownTo 0 do
  begin
    if (I = 0) then  Result := Result + Format('%.2u',[trunc( StrToInt(SL[I]) )])
    else
      Result := Result + Format('%.2u',[trunc( StrToInt(SL[I]) )]) +':';
  end;
  SL.Free;
end;
 
 
procedure  TForm1.PlayMidi();
var
 TotalTime: array[0..128] of char;
 filename: String;
 
begin
 if form1.Opendialog1.Execute then
 begin
   filename := form1.opendialog1.filename;
   MCISendString(PChar('close song'), nil, 0, 0);
   MCISendString(PChar('open ' + filename + ' alias song'),nil , 0, 0);
   MCISendString(PChar('set song time format ms'), 0, 0, 0);
   MCISendString(PChar('status song length'), TotalTime, 128, 0);
   MCISendString(PChar('play song'),nil, 0, 0);
 
   Gauge1.Progress := 0;
   Gauge1.MaxValue := strtoint(TotalTime);
   Timer1.Enabled := true;
 
   Duree := TrimRight(String(TotalTime));
   StatusBar1.Panels[0].Text := ExtractFileName(filename, False) + ' '
    + SecondesToJHMS(strtofloat(Duree) /1000);
   StatusBar1.Panels[1].Text := SecondesToJHMS(strtofloat(Duree) /1000);
 end;
end;
 
procedure  TForm1.StopMidi();
begin
  Timer1.Enabled := false;
  MCISendString(PChar('stop song'), nil, 0, 0);
end;
 
 
procedure TForm1.Timer1Timer(Sender: TObject);
var
  TimePos: array[0..128] of char;
begin
  with Gauge1 do
  begin
    if progress < MaxValue then
    begin
      MCISendString(PChar('set song time format milliseconds'), nil, 0, 0);
      MCISendString(PChar('STATUS SONG POSITION'), TimePos, 128, 0);
      Gauge1.Progress := StrToInt(TimePos);
      StatusBar1.Panels[1].Text := SecondesToJHMS(strtofloat(Duree) /1000 );
      Duree := FloatToStr(strtofloat(Duree) - Timer1.Interval);
    end else Timer1.Enabled := False;
  end;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
  StopMidi();
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
   PlayMidi();
end;
 
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  Timer1.Interval := 1000;
end;
 
end.

Si quelqu'un a une solution merci d'avance la source en attache se compile bien.

@+,

cincap