Starport BBS
VIEWER: gplmain.pas MODE: TEXT (ASCII)
unit gplmain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ExtCtrls;

type
  Tgplform = class(TForm)
    LoadButton: TButton;
    OpenDialog: TOpenDialog;
    PlayButton: TButton;
    StopButton: TButton;
    PosTrack: TTrackBar;
    UpdateTimer: TTimer;
    procedure LoadButtonClick(Sender: TObject);
    procedure PlayButtonClick(Sender: TObject);
    procedure StopButtonClick(Sender: TObject);
    procedure PosTrackChange(Sender: TObject);
    procedure UpdateTimerTimer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  gplform: Tgplform;

procedure MIDASerror;

implementation

uses midasdll;

var
   module : MIDASmodule;
   playing : boolean;

procedure MIDASerror;
var
   message : PChar;
begin
     message := MIDASgetErrorMessage(MIDASgetLastError);
     Application.MessageBox(message, 'MIDAS error', MB_OK or MB_ICONSTOP);
     MIDASclose;
     halt;
end;

{$R *.DFM}

procedure Tgplform.LoadButtonClick(Sender: TObject);
var
  cfilename : array[0..256] of char;
  info : MIDASmoduleInfo;
  captxt : string[64];
begin
  if OpenDialog.Execute then
  begin
    StrPCopy(cfilename, OpenDialog.FileName);
    if module <> NIL then begin
      if not MIDASstopModule(module) then
        midasError;
      if not MIDASfreeModule(module) then
        midasError;
      module := NIL;
    end;

    module := MIDASloadModule(cfilename);
    if module = NIL then begin
      Application.MessageBox(MIDASgetErrorMessage(MIDASgetLastError),
        'Module loading error', MB_OK or MB_ICONSTOP);
      exit;
    end;

    if not MIDASplayModule(module, 0) then
      MIDASerror;
    playing := true;

    if not MIDASgetModuleInfo(module, @info) then
      MIDASerror;

    captxt := info.songName;
    gplform.Caption := captxt;

    PosTrack.Enabled := true;
    PosTrack.Min := 0;
    PosTrack.Max := info.songLength - 1;    
  end;
end;

procedure Tgplform.PlayButtonClick(Sender: TObject);
begin
  if (not playing) and (module <> NIL) then
  begin
    if not MIDASplayModule(module, 0) then
      MIDASerror;
    playing := true;
    PosTrack.Enabled := true;
  end;
end;



procedure Tgplform.StopButtonClick(Sender: TObject);
begin
    if (playing) and (module <> NIL) then
    begin
        if not MIDASstopModule(module) then
            MIDASerror;
        playing := false;
        PosTrack.Enabled := false;
    end;
end;


procedure Tgplform.PosTrackChange(Sender: TObject);
begin
    if playing then
    begin
        if not MIDASsetPosition(PosTrack.Position) then
            MIDASerror;
    end;
end;

procedure Tgplform.UpdateTimerTimer(Sender: TObject);
var
    state : MIDASplayStatus;
begin
    if playing then
    begin
        if not MIDASgetPlayStatus(@state) then
            MIDASerror;
        if state.position <> PosTrack.position then
            PosTrack.position := state.position;
    end;
end;


begin
  module := NIL;
  playing := false;
end.
[ RETURN TO DIRECTORY ]