Source Code Delphi Samples with Sources

emailx45 · Apr 20, 2020

my sample: How to Insert MP3/MP4 file or other like a Resource into your executable and Play it in MediaPlayer (FireMonkey / VCL)

NOTE1: Dont forget, in Android/iOS you need privilegies like: read/write resource in Storages (internal or external), play some, etc.. study about use of "privilegies" in your apps!

NOTE2: Bad pratice insert a big file in your executable!

View attachment 954

[SHOWTOGROUPS=4,20]

Code:

unit uFormMain;

interface

uses
  System.SysUtils,
  System.Types,
  System.UITypes,
  System.Classes,
  System.Variants,
  FMX.Types,
  FMX.Controls,
  FMX.Forms,
  FMX.Graphics,
  FMX.Dialogs,
  FMX.Media,
  FMX.Controls.Presentation,
  FMX.StdCtrls,
  FMX.Layouts,
  FMX.ListBox,
  FMX.ScrollBox,
  FMX.Memo;

type
  TfrmFormMain = class(TForm)
    MediaPlayer1: TMediaPlayer;
    btnReading_MP3_on_Resources: TButton;
    mmMyLogs: TMemo;
    btn_MediaPlayer_Stop: TButton;
    procedure btnReading_MP3_on_ResourcesClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btn_MediaPlayer_StopClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmFormMain: TfrmFormMain;

implementation

{$R *.fmx}

uses
  System.IOUtils,
  FMX.DialogService;

var
  lMyPathToResouces: string;

function fncMyExceptions(lMyExcept: Exception): string;
begin
  // here, I dont worry about override my resulted ok!!!
  if lMyExcept is EResNotFound then
    result := '[my error EResNotFound class]';
  if lMyExcept is Exception then
    result := '[my error generic threat]';
  if lMyExcept is EFCreateError then
    result := '[my error EFCreateError class]';
  if lMyExcept is EMediaException then
    result := '[my error EMediaException class]';
  if lMyExcept is Exception then
    result := '[my error generic threat]' + #13#10;
  //
  result := result + #13#10 + lMyExcept.ClassName + #13#10 + lMyExcept.Message;
end;

procedure TfrmFormMain.btnReading_MP3_on_ResourcesClick(Sender: TObject);
var
  lMyStream: TResourceStream;
begin
  // SysInit.pas HInstance: HINST; { Handle of this instance }
  // { Handle of the main(.EXE) HInstance }
  //
  try
    lMyStream := nil; // avoid errors below!!!
    //
    // RT_Data = Application-defined resource (raw data)!!
    // lMyStream := TResourceStream.CreateFromID( HInstance, 0, RT_RCDATA); // only if your res was indetifyed by number
    lMyStream := TResourceStream.Create(HInstance, 'Musica_001', RT_RCDATA); // only if your res was indetifyed by "string"
  except
    on E: Exception do
    begin
      mmMyLogs.Lines.Add( fncMyExceptions(E) );
      // exit;
    end;
  end;
  //
  if not(lMyStream = nil) then
  begin
    //
    try
      // saving my resource like a MP3 file to play it!
      // NOTE: Tags stay like original file source!
      //
      // needs save in a file to play in TMediaPlayer
      // FMX.Media.pas, line 1633
      lMyStream.SaveToFile('MyResourceSaved.mp3');
      //
      try
        // use DisposeOf and nil to new project Cross-Platform, or, use FreeAndNil(lMyStream) to MSWindows only!!!
        lMyStream.DisposeOf;
        lMyStream := nil; // avoid errors below!!
        //
        if FileExists(lMyPathToResouces + 'MyResourceSaved.mp3', false) then { MSWindows and POSIX }
        begin
          MediaPlayer1.FileName := lMyPathToResouces + 'MyResourceSaved.mp3'; // EMediaException can occurr here!!!
          MediaPlayer1.Play;
        end
        else
          mmMyLogs.Lines.Add('--> ' + lMyPathToResouces + 'MyResourceSaved.mp3, Dont exist!!!');
      except
        on E: Exception do
          mmMyLogs.Lines.Add( fncMyExceptions(E) )
        // exit;
      end;
    finally
      if Assigned(lMyStream) then
      begin // FreeAndNil(lMyStream)
        lMyStream.DisposeOf;
        lMyStream := nil;
      end;
    end;
  end;
end;

procedure TfrmFormMain.btn_MediaPlayer_StopClick(Sender: TObject);
begin
  if MediaPlayer1.State = TMediaState.Playing then
  begin
    MediaPlayer1.Stop;
    //
    try
      DeleteFile(lMyPathToResouces + 'MyResourceSaved.mp3'); // MSWindows and POSIX
      //
      TDialogService.ShowMessage('Stopped and file deleted!'); // Verify: file is "playing" cannot be deleted!!!
    except
      on E: Exception do
        mmMyLogs.Lines.Add( fncMyExceptions(E) )
    end;
  end
  else
    TDialogService.ShowMessage('Nothing been played!');
end;

procedure TfrmFormMain.FormCreate(Sender: TObject);
begin
  mmMyLogs.Lines.Clear;
end;

initialization

lMyPathToResouces := ExtractFilePath(Paramstr(0)); // MSWindows old way!

// new Cross-Platform way!!!
// lMyPathToResouces := TPath.GetDocumentsPath + '\';
{ /storage/emulated/0/Documents }
// lMyPathToResouces := TPath.GetSharedDocumentsPath + '\';
{ /storage/emulated/0/Music }
// lMyPathToResouces := TPath.GetSharedMusicPath + '\';

finalization

end.

[/SHOWTOGROUPS]

emailx45 · Apr 29, 2020

My easy way to filling my OnCalcFields like an Array of values in DBGrid using any field on DataSet with my conditional data

View attachment 1194

NOTE: if your table had all records deleted, verify if your "initial value - your vars" should be "cleaned" too! Else, the last values will be used for next "first record"

[SHOWTOGROUPS=4,20]

Code:

object frmFormMain: TfrmFormMain
  Left = 0
  Top = 0
  Caption = 'frmFormMain'
  ClientHeight = 352
  ClientWidth = 402
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poScreenCenter
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object DBGrid1: TDBGrid
    Left = 8
    Top = 16
    Width = 385
    Height = 328
    DataSource = DataSource1
    TabOrder = 0
    TitleFont.Charset = DEFAULT_CHARSET
    TitleFont.Color = clWindowText
    TitleFont.Height = -11
    TitleFont.Name = 'Tahoma'
    TitleFont.Style = []
    Columns = <
      item
        Expanded = False
        FieldName = 'ID'
        Visible = True
      end
      item
        Expanded = False
        FieldName = 'DATA'
        Width = 150
        Visible = True
      end
      item
        Expanded = False
        FieldName = 'C1'
        Width = 50
        Visible = True
      end
      item
        Expanded = False
        FieldName = 'C2'
        Width = 50
        Visible = True
      end
      item
        Expanded = False
        FieldName = 'C3'
        Width = 50
        Visible = True
      end>
  end
  object FDMemTable1: TFDMemTable
    AfterDelete = FDMemTable1AfterDelete
    OnCalcFields = FDMemTable1CalcFields
    FieldDefs = <>
    IndexDefs = <>
    FetchOptions.AssignedValues = [evMode]
    FetchOptions.Mode = fmAll
    ResourceOptions.AssignedValues = [rvPersistent, rvSilentMode]
    ResourceOptions.Persistent = True
    ResourceOptions.SilentMode = True
    UpdateOptions.AssignedValues = [uvCheckRequired, uvAutoCommitUpdates]
    UpdateOptions.CheckRequired = False
    UpdateOptions.AutoCommitUpdates = True
    StoreDefs = True
    Left = 80
    Top = 257
    object FDMemTable1ID: TIntegerField
      DisplayWidth = 10
      FieldName = 'ID'
    end
    object FDMemTable1DATA: TStringField
      DisplayWidth = 20
      FieldName = 'DATA'
    end
    object FDMemTable1C1: TStringField
      DisplayWidth = 2
      FieldKind = fkCalculated
      FieldName = 'C1'
      Size = 1
      Calculated = True
    end
    object FDMemTable1C2: TStringField
      DisplayWidth = 2
      FieldKind = fkCalculated
      FieldName = 'C2'
      Size = 1
      Calculated = True
    end
    object FDMemTable1C3: TStringField
      DisplayWidth = 18
      FieldKind = fkCalculated
      FieldName = 'C3'
      Size = 1
      Calculated = True
    end
  end
  object FDGUIxWaitCursor1: TFDGUIxWaitCursor
    Provider = 'Forms'
    Left = 272
    Top = 192
  end
  object FDStanStorageXMLLink1: TFDStanStorageXMLLink
    Left = 128
    Top = 184
  end
  object DataSource1: TDataSource
    DataSet = FDMemTable1
    Left = 192
    Top = 256
  end
end

Code:

var
  frmFormMain: TfrmFormMain;

implementation

{$R *.dfm}

var
  // what will be writed if the "initial value" was empty? = first record, for example!
  lC1: string = '?';
  lC2: string = '?';
  lC3: string = '?';

  { NOTE:
    if your table had all records deleted, verify if your "initial value - your vars" should be "cleaned" too!
  }

procedure TfrmFormMain.FDMemTable1AfterDelete(DataSet: TDataSet);
begin
  if DataSet.RecordCount = 0 then // for example, to re-start your vars!
  begin
    lC1 := '?';
    lC2 := '?';
    lC3 := '?';
  end;
end;

procedure TfrmFormMain.FDMemTable1CalcFields(DataSet: TDataSet);
var
  lMyArrayString: TArray<string>;
  lMyTextTmp    : string;
  lMyField      : TField;
begin
  lMyTextTmp     := '';
  lMyArrayString := nil;
  lMyField       := nil;
  //
  for lMyField in DataSet.Fields do
  begin
    if (lMyField.FieldNo = -1) then // only CalcField (FieldNo = -1) will be processed!
    begin
      lMyTextTmp := DataSet.Fields.Fields[1].AsString; // Field "DATA" it's the source!
      //
      lMyArrayString := lMyTextTmp.Split([';'], TStringSplitOptions.ExcludeEmpty);
      lMyTextTmp     := '';
      //
      for lMyTextTmp in lMyArrayString do // analizing what will be write!
      begin
        if lMyTextTmp.Contains('0=') then
        begin
          DataSet.Fields.Fields[2].AsString := lMyTextTmp.Chars[2];
          lC1                               := DataSet.Fields.Fields[2].AsString;
        end;
        //
        if lMyTextTmp.Contains('1=') then
        begin
          DataSet.Fields.Fields[3].AsString := lMyTextTmp.Chars[2];
          lC2                               := DataSet.Fields.Fields[3].AsString;
        end;
        //
        if lMyTextTmp.Contains('2=') then
        begin
          DataSet.Fields.Fields[4].AsString := lMyTextTmp.Chars[2];
          lC3                               := DataSet.Fields.Fields[4].AsString;
        end;
        //
      end;
      //
      if DataSet.Fields.Fields[2].IsNull then
        DataSet.Fields.Fields[2].AsString := lC1;
      //
      if DataSet.Fields.Fields[3].IsNull then
        DataSet.Fields.Fields[3].AsString := lC2;
      //
      if DataSet.Fields.Fields[4].IsNull then
        DataSet.Fields.Fields[4].AsString := lC3;
    end;
  end;
end;

procedure TfrmFormMain.FormCreate(Sender: TObject);
begin
  // loading my fields structure and some initial value
  FDMemTable1.ResourceOptions.PersistentFileName := '..\..\MyXMLFDMemTableData.xml';
  FDMemTable1.ResourceOptions.Persistent         := True;
  //
  FDMemTable1.LoadFromFile(FDMemTable1.ResourceOptions.PersistentFileName, sfXML);
  //
  if FDMemTable1.Active then;

end;

[/SHOWTOGROUPS]

Source Code Delphi Samples with Sources

emailx45

emailx45