fminstruments.pas

Delphi的另一款钢琴软件

unit fmInstruments;

interface

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

type
  TInstrumentsForm = class(TForm)
    gbInstrument: TGroupBox;
    gbPatches: TGroupBox;
    btnOk: TBitBtn;
    btnCancel: TBitBtn;
    Label1: TLabel;
    edInstrumentFileName: TEdit;
    btnBrowse: TBitBtn;
    btnAdd: TBitBtn;
    btnEdit: TBitBtn;
    btnDelete: TBitBtn;
    OpenInstrumentDialog: TOpenDialog;
    elvPatches: TListView;
    rgBankSelection: TRadioGroup;
    btnAdvanced: TBitBtn;
    procedure btnBrowseClick(Sender: TObject);
    procedure edInstrumentFileNameExit(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure btnAddClick(Sender: TObject);
    procedure edInstrumentFileNameChange(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnEditClick(Sender: TObject);
    procedure btnDeleteClick(Sender: TObject);
    procedure elvPatchesChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure elvPatchesCompare(Sender: TObject; Item1, Item2: TListItem;
      Data: Integer; var Compare: Integer);
  private
    fFileName : string;
    fInstrument : TInstrument;
    procedure LoadInstrument;
    procedure SetFileName (value : string);
    procedure RefreshPatchList;
    procedure RefreshEditButtons;

  public
    destructor Destroy; override;
    property FileName : string read fFileName write SetFileName;
  end;

var
  InstrumentsForm: TInstrumentsForm;

function ExtractInstrumentName (pathName : string) : string;

implementation

{$R *.DFM}

uses Registry, Globals, fmPatchDetails;

function ExtractInstrumentName (pathName : string) : string;
begin
  result := ExtractFileName (pathName);
  if Pos ('.', result) > 0 then
    Delete (result, Pos ('.', result), Length (result));
end;

destructor TInstrumentsForm.Destroy;
begin
  if Assigned (fInstrument) then fInstrument.free;
  inherited;
end;

procedure TInstrumentsForm.LoadInstrument;
begin
  try
    Screen.Cursor := crHourglass;
    if Assigned (fInstrument) then
    begin
      fInstrument.free;
      fInstrument := Nil
    end;

    try
      with TFileStream.Create (fFileName, fmOpenRead) do
      try
        try
          fInstrument := ReadComponent (nil) as TInstrument;
          with TRegistry.Create do
          try
            OpenKey (ProgramKey + '\' + DirectoriesKey, true);
            WriteString (InstrumentPathValue, ExtractFilePath (fFileName));
          finally
            free
          end;
        except
          fInstrument := TInstrument.Create (self)
        end
      finally
        free
      end
    except
      fInstrument := TInstrument.Create (self)
    end
  finally
    RefreshPatchList;
    Screen.Cursor := crDefault
  end
end;

procedure TInstrumentsForm.SetFileName (value : String);
var s : string;
begin
  if fFileName <> value then
  begin
    fFileName := value;
    if fFileName <> '' then
    begin
      fFileName := value;
      chdir (ExtractFilePath (fFileName));
      OpenInstrumentDialog.FileName := ExtractInstrumentName (fFileName);
      edInstrumentFileName.Text := OpenInstrumentDialog.FileName;
      LoadInstrument
    end
    else
    begin
      if Assigned (fInstrument) then
      begin
        fInstrument.free;
        fInstrument := Nil
      end;
      with TRegistry.Create do
      try
        OpenKey (ProgramKey + '\' + DirectoriesKey, true);
        try
          s := ReadString (InstrumentPathValue);
          chdir (s);
        except
        end
      finally
        Free
      end
    end
  end
end;

procedure TInstrumentsForm.RefreshPatchList;
var i : Integer;
begin
  rgBankSelection.ItemIndex := Integer (fInstrument.fBankChangeRec.bcType);
  elvPatches.Items.BeginUpdate;
  elvPatches.SortType := stNone;
  elvPatches.Items.Clear;
  try
    with fInstrument do
      for i := 0 to ComponentCount - 1 do
        with Components [i] as TPatch do
        begin
          with elvPatches.Items.Add do
          begin
            data := fInstrument.Components [i];
            ImageIndex := Ord (PatchType);
            caption := IntToStr (BankNo);
            SubItems.Add (IntToStr (PatchNo));
            SubItems.Add (PatchName)
          end
        end;
  finally
    elvPatches.SortType := stData;
    elvPatches.Items.EndUpdate
  end;
  RefreshEditButtons;
end;

procedure TInstrumentsForm.RefreshEditButtons;
begin
  btnEdit.Enabled := elvPatches.Selected <> Nil;
  btnDelete.Enabled := elvPatches.Selected <> Nil;
  btnAdd.Enabled := edInstrumentFileName.Text <> ''
end;

procedure TInstrumentsForm.btnBrowseClick(Sender: TObject);
begin
  if OpenInstrumentDialog.Execute then
  begin
    FileName := ExpandFileName (OpenInstrumentDialog.FileName);
    ActiveControl := edInstrumentFileName;
  end
end;

procedure TInstrumentsForm.edInstrumentFileNameExit(Sender: TObject);
var s : string;
begin
  s := edInstrumentFileName.Text;
  if Pos ('.', s) = 0 then
    s := s + '.ppi';
  FileName := ExpandFileName (s)
end;

procedure TInstrumentsForm.FormShow(Sender: TObject);
begin
  RefreshEditButtons
end;

procedure TInstrumentsForm.btnAddClick(Sender: TObject);
var patch : TPatch;
begin
  with TPatchDetailsForm.Create (self) do
  try
    if ShowModal = mrOk then
    begin
      patch := TPatch.Create (fInstrument);
      with patch do
      begin
        BankNo := StrToInt (edBankNo.Text);
        PatchNo := StrToInt (edPatchNo.Text);
        PatchName := edPatchName.Text;
        Comment := edComment.Text;
        PatchType := SelectedPatchType;
        with elvPatches.Items.Add do
        begin
          data := patch;
          caption := IntToStr (BankNo);
          ImageIndex := Ord (PatchType);
          SubItems.Add (IntToStr (PatchNo));
          SubItems.Add (PatchName)
        end
      end
    end
  finally
    Free
  end
end;

procedure TInstrumentsForm.edInstrumentFileNameChange(Sender: TObject);
begin
  btnAdd.Enabled := edInstrumentFileName.Text <> ''
end;

procedure TInstrumentsForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  if ModalResult = mrOk then with TFileStream.Create (fFileName, fmOpenWrite or fmCreate) do
  try
    fInstrument.name := 'Fred';
    fInstrument.fBankChangeRec.bcType := TBankChangeType (rgBankSelection.ItemIndex);
    WriteComponent (fInstrument);
  finally
    free
  end
end;

procedure TInstrumentsForm.btnEditClick(Sender: TObject);
var
  Patch : TPatch;
begin
  if not Assigned (elvPatches.Selected) then Exit;
  with elvPatches do patch := TPatch (selected.data);
  with TPatchDetailsForm.Create (self) do
  try
    with patch do
    begin
      edBankNo.Text := IntToStr (BankNo);
      edPatchNo.Text := IntToStr (PatchNo);
      edPatchName.Text := PatchName;
      edComment.Text := Comment;
      SelectedPatchType := PatchType;
      if ShowModal = mrOk then
      begin
        BankNo := StrToInt (edBankNo.Text);
        PatchNo := StrToInt (edPatchNo.Text);
        PatchName := edPatchName.Text;
        Comment := edComment.Text;
        PatchType := SelectedPatchType;
        elvPatches.Items.Delete (elvPatches.selected.index);
        with elvPatches.Items.Add do
        begin
          data := patch;  // Use this for the sort order...
          caption := IntToStr (BankNo);
          ImageIndex := Ord (PatchType);
          SubItems.Add (IntToStr (PatchNo));
          SubItems.Add (PatchName)
        end
      end
    end
  finally
    Free
  end
end;

procedure TInstrumentsForm.btnDeleteClick(Sender: TObject);
var
  patch : TPatch;
begin
  patch := TPatch (elvPatches.selected.data);
  if Application.MessageBox (PChar ('Are you sure you want to delete ' + patch.PatchName), 'Delete Patch', MB_YESNO or MB_ICONQUESTION) = IDYES then
  begin
    patch.Free;
    elvPatches.items.Delete (elvPatches.selected.index)
  end
end;

procedure TInstrumentsForm.elvPatchesChange(Sender: TObject;
  Item: TListItem; Change: TItemChange);
begin
  RefreshEditButtons
end;

procedure TInstrumentsForm.elvPatchesCompare(Sender: TObject; Item1,
  Item2: TListItem; Data: Integer; var Compare: Integer);
var
  val1, val2 : Integer;
begin
  with TPatch (Item1.Data) do val1 := BankNo * 256 + PatchNo;
  with TPatch (Item2.Data) do val2 := BankNo * 256 + PatchNo;

  if val1 < val2 then
    Compare := -1
  else
    if val2 < val1 then
      Compare := 1
    else
      Compare := 0
end;

end.