+- delphi4arab منتديات دلفي للعرب (https://delphi4arab.net/forum)
+-- قسم : منتديات دلفي للعرب التعليمية (https://delphi4arab.net/forum/forumdisplay.php?fid=3)
+--- قسم : مصادر دلفي مفتوحة تعليمية (https://delphi4arab.net/forum/forumdisplay.php?fid=14)
+--- الموضوع : قراءة اذكار حصن المسلم (/showthread.php?tid=6067)
قراءة اذكار حصن المسلم - onexite - 08-04-2014
السلام عليكم
الموضوع واضح وهو برنامج يقوم بتشغيل و قراءة اذكار حصن المسلم
صورة البرنامج
![[صورة: dt4s.png]](http://img855.imageshack.us/img855/6750/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;
قراءة اذكار حصن المسلم - onexite - 09-04-2014
![[صورة: 6ft1.png]](http://img834.imageshack.us/img834/6132/6ft1.png)
بعض التعديلات
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قراءة اذكار حصن المسلم - yahia17 - 09-04-2014
وعليكم السلام ورحمة الله ’’
جزاك الله اخي onexite
كل يوم تتحفنا بجديدك
عن نفسي استفدت كثيرا بتطبيقاتك المتعلقة بل النت
اتمنى الاستمرار الى الامام
تحياتي