delphi4arab منتديات دلفي للعرب

السلام عليكم
الموضوع واضح وهو برنامج يقوم بتشغيل و قراءة اذكار حصن المسلم

صورة البرنامج

[صورة: dt4s.png]

تحميل البرنامج

كود :
http://www.mediafire.com/download/51b80ko3ow3qf5d/%D8%AD%D8%B5%D9%86+%D8%A7%D9%84%D9%85%D8%B3%D9%84%D9%85.zip

الكود سورس

PHP كود :
type getUrl  = class(TThread)
private
procedure Execute; override;
constructor Create(CreateSuspended: Boolean);
destructor Destroy; override;
protected
end;

type
  TForm1 = class(TForm)
    sStatusBar1: TsStatusBar;
    sPanel1: TsPanel;
    sListBox1: TsListBox;
    sSkinManager1: TsSkinManager;
    sSkinProvider1: TsSkinProvider;
    sImage1: TsImage;
    procedure FormCreate(Sender: TObject);

    procedure FormDestroy(Sender: TObject);
    procedure sListBox1Click(Sender: TObject);
  private
    { Private declarations }
  public
  procedure WndProc(var Msg: TMessage); override;
  procedure geterror(es: string);
    { Public declarations }
  end;
const
  WM_INFO_UPDATE = WM_USER + 101;
var
  Form1: TForm1;
  url:WideString;
  NThread:getUrl;
  chan: HSTREAM = 0;
  win: hwnd;

implementation

{$R *.dfm}
procedure StatusProc(buffer: Pointer; len, user: DWORD); stdcall;
begin end;

procedure TForm1.geterror(es: string);
begin
sStatusBar1.Panels[0].Text:=es + ' > ' + '(خطأ رقم : ' + IntToStr(BASS_ErrorGetCode) + ')';
end;

function getNM(n:Integer):string;
begin
  case n of
   0..9      : Result:='00'+inttostr(n)+'.mp3';
   10..99    : Result:='0'+inttostr(n)+'.mp3';
   100..1000 : Result:=''+inttostr(n)+'.mp3';
  end;
end;

 function _OpenURL(Src: string): Integer;
var  url :AnsiString;
Len, Progress: DWORD;
begin
  Result := 0;
  BASS_StreamFree(chan);
  progress := 0;
  SendMessage(win, WM_INFO_UPDATE, 0, 0);
   SetLength(url, Length(Src));
      UnicodeToUtf8(PAnsiChar(url), PWideChar(Src), Length(Src));
  chan := BASS_StreamCreateURL(PAnsiChar(url), 0, BASS_STREAM_STATUS, @StatusProc, 0);
  if (chan = 0) then
  begin

    SendMessage(win, WM_INFO_UPDATE, 1, Bass_ErrorGetCode());
  end
  else
  begin
    repeat
      len := BASS_StreamGetFilePosition(chan, BASS_FILEPOS_END);
      if (len = DW_Error) then
        break;
      progress := (BASS_StreamGetFilePosition(chan, BASS_FILEPOS_DOWNLOAD) -
        BASS_StreamGetFilePosition(chan, BASS_FILEPOS_CURRENT)) * 100 div len;
      SendMessage(win, WM_INFO_UPDATE, 2, progress);

    until
      progress > 75;

    BASS_ChannelPlay(chan, FALSE);
     Form1.sStatusBar1.Panels[0].Text :='';
  end;

end;
procedure TForm1.FormCreate(Sender: TObject);
begin
win := handle;
  if (not BASS_Init(-1, 44100, 0, Handle, nil)) then
  begin
    ShowMessage('لا يمكن تشغيل الصوتيات');
    Halt;
  end;
  BASS_SetConfig(BASS_CONFIG_NET_PLAYLIST, 1);
  BASS_SetConfig(BASS_CONFIG_NET_PREBUF, 0);
end;


  procedure TForm1.WndProc(var Msg: TMessage);
begin
  inherited;
  if Msg.Msg = WM_INFO_UPDATE then
case msg.WParam of
0:sStatusBar1.Panels[0].Text:= 'جاري الاتصال ...';
1:sStatusBar1.Panels[0].Text := 'لا تعمل';
2: sStatusBar1.Panels[0].Text := Format('التخزين المؤقت ... %d%%', [msg.LParam]);
 end;
end;



procedure TForm1.FormDestroy(Sender: TObject);
begin
BASS_Free;
end;

procedure TForm1.sListBox1Click(Sender: TObject);
begin
url:='http://d1.islamhouse.com/data/ar/ih_sounds/chain/ar_7esn_AlMoslem_by_Doors/ar_7esn_AlMoslem_by_Doors_'+getNM(sListBox1.ItemIndex+2) ;
NThread:=getUrl.Create(True);
NThread.Resume;
sPanel1.Caption:=Trim(Copy(sListBox1.Items[sListBox1.ItemIndex],5,length(sListBox1.Items[sListBox1.ItemIndex]))) ;
end;

{ getUrl }

constructor getUrl.Create(CreateSuspended: Boolean);
begin
   inherited Create(CreateSuspended);
end;

destructor getUrl.Destroy;
begin
   BASS_Free;
  inherited;
end;

procedure getUrl.Execute;
begin
   // FreeOnTerminate := True;
    _OpenURL(url );
end; 

بعض التعديلات

PHP كود :
procedure TForm1.tmr1Timer(Sender: TObject);
begin
sStatusBar1.Panels[0].Text:= 'المعالج %' + FloatToStrF(BASS_GetCPU, ffFixed, 4, 2)+ ' | التحميل : '+FormatByteSize(BASS_StreamGetFilePosition(chan, BASS_FILEPOS_CURRENT))+'  من اصل : '+FormatByteSize(BASS_StreamGetFilePosition(chan, BASS_FILEPOS_DOWNLOAD));
//sPanel2.Caption:= 'CPU%  ' + FloatToStrF(BASS_GetCPU, ffFixed, 4, 2)+' | Position : '+FormatByteSize(BASS_StreamGetFilePosition(chan, BASS_FILEPOS_CURRENT))+' / '+FormatByteSize(BASS_StreamGetFilePosition(chan, BASS_FILEPOS_DOWNLOAD))+' | Copyright © 2013 ^DZ . all rights reserved';
if (BASS_StreamGetFilePosition(chan, BASS_FILEPOS_END) = DW_Error) then
Exit;
if BASS_StreamGetFilePosition(chan, BASS_FILEPOS_DOWNLOAD) =-1 then Exit;
{if BASS_StreamGetFilePosition(chan, BASS_FILEPOS_DOWNLOAD) <>-1 then
if BASS_StreamGetFilePosition(chan, BASS_FILEPOS_DOWNLOAD) = BASS_StreamGetFilePosition(chan, BASS_FILEPOS_CURRENT) then   begin
tmr1.Enabled:=False ;
sStatusBar1.Panels[0].Text:='تم الانتهاء من القراءة';
end;
}
  try
sGauge1.MaxValue :=BASS_StreamGetFilePosition(chan, BASS_FILEPOS_DOWNLOAD) ;
sGauge1.Progress:= BASS_StreamGetFilePosition(chan, BASS_FILEPOS_CURRENT)
  except
  end;
end; 

التحميل

PHP كود :
function GetProgramFilesDir: string;
begin
  with TRegistry.Create do begin
  try
    RootKey := HKEY_LOCAL_MACHINE;
    OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion');
    Result := ReadString('ProgramFilesDir');
  finally
   Free;
  end;
  end;
end;

 function FormatByteSize(const bytes: Longint): string;
 const
   B = 1; //byte
   KB = 1024 * B; //kilobyte
   MB = 1024 * KB; //megabyte
   GB = 1024 * MB; //gigabyte
 begin
   if bytes > GB then
     result := FormatFloat('#.## جيجابايت', bytes / GB)
   else
     if bytes > MB then
       result := FormatFloat('#.## ميجابايت', bytes / MB)
     else
       if bytes > KB then
         result := FormatFloat('#.## كيلوبايت', bytes / KB)
       else
         result := FormatFloat('#.## بايت', bytes) ;
 end;



procedure TForm1.sBitBtn1Click(Sender: TObject);
begin
if FileExists(GetProgramFilesDir+'\Internet Download Manager\IDMan.exe') then
ShellExecute(Handle, 'open',pchar('"'+GetProgramFilesDir+'\Internet Download Manager\IDMan.exe"'),PChar(' /d "'+url+'"'),nil, 1) else
ShellExecute(Handle, 'open',nil,PChar(url),nil, 1) ; //1=show --
end; 

تحميل النسخة

كود :
http://www.mediafire.com/download/rqxdkfta7k2kkvo/Release_1fix.zip

وعليكم السلام ورحمة الله ’’

جزاك الله اخي onexite
كل يوم تتحفنا بجديدك
عن نفسي استفدت كثيرا بتطبيقاتك المتعلقة بل النت Wink

اتمنى الاستمرار الى الامام
تحياتي

onexite

onexite

yahia17