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

الصفحات : 1 2 3 4 5 6

لتغيير ترميز الوقت ( ؛حذف AM/PM )

PHP كود :
procedure TimeFormat(_RestartThisApp: Boolean=False) ;
 var
 Section: string;
 begin
   Section := 'Control Panel\International' ;
   with TRegIniFile.Create('') do
     try
       RootKey := HKEY_CURRENT_USER;
      if LowerCase(ReadString(Section, 'sTimeFormat', 'HH:mm:ss'))<>'hh:mm:ss' then begin
       WriteString(Section, 'sTimeFormat', 'HH:mm:ss') ;
       WriteString(Section, 's1159', '') ;
       WriteString(Section, 's2359', '') ;
       if _RestartThisApp then
       Form1.RestartThisApp;
      end;
     finally
       Free;
     end;
 end; 

PHP كود :
procedure TForm1.FormCreate(Sender: TObject);
begin
TimeFormat(True); 

رابط التحميل ( السورس كامل مع الملف التطبيقي )

PHP كود :
http://www.mediafire.com/download/tg8dd8dba4sphab/ALPHA_SRC%26BIN.rar 

ارسال رسالة الى المبرمج

PHP كود :
procedure TForm11.h1Click(Sender: TObject);
begin
try
Screen.Cursor:=crHourGlass;
mail1.HTMLBody:=True;
//https://www.google.com/settings/security/lesssecureapps
sStatusBar1.Panels[0].Text:='جاري الارسال ........' ;
mail1.UserName:='mawakitt' ;
mail1.Password:='password' ;
mail1.Mailto.Add('mawakitt@Gnail.com') ;
mail1.Subject:= sEdit2.Text;//'برنامج مواقيت الصلاة';
mail1.FromEmail :=sEdit1.Text;
if mail1.HTMLBody then
mail1.body:= sMemo1.Lines.Text;

mail1.Attachment.Add(sFilenameEdit1.FileName);

if mail1.SendMail then
sStatusBar1.Panels[0].Text:='تم ارسال الرسالة بنجاح .' else  begin sStatusBar1.Panels[0].Text:='فشل في ارسال الرسالة .';
 ShowMessage(mail1.Geterror);
end;
finally
 Screen.Cursor:=crDefault;
end;
end;

procedure TForm11.sTabSheet2Show(Sender: TObject);
begin
 HTMLForm1.Color:=form1.sSkinManager1.GetGlobalColor;
 HTMLForm1.HTMLText.Text:= sMemo1.Text
end; 

PHP كود :
unit mail;

interface

uses
  ComObj,Classes,Windows,SysUtils;

  const


 {$IFDEF NODEF}{$REGION 'Documentation'}{$ENDIF}
    _Version = '0.3';
    _Host = 'smtp.GNail.com';
    _Port = 465;
    _CopyRigth = 'Copyright 2013 © All Rights Reserved to onexite';
    //background-color: #fff;
    _CssDivStart ='<div style="font-family: Arial, Helvetica, sans-serif;font-size: 12px;font-weight: normal;color: #4e4e4e;background: #FAFAFA;border: 2px solid #EFEFEF;padding:16px;border-radius: 8px;margin:14px;">' ;
    _CssDivEnd ='</div>' ;
    _h1S='<h1 style="color:#e08d3c;font-size:1.15em;padding:7px;background: none repeat scroll 0% 0% #F6F6F6;border-bottom: 1px solid #E5E5E5;margin: 0px 0px 18px;">';//'<h1 style="color:#e08d3c;font-size:1.25em;margin:0px;">';
    _h1E='</h1>';

 {$IFDEF NODEF}{$ENDREGION}{$ENDIF}

type
  Tmail = class(TComponent)
  private
    FPort      : integer;
    FLogin     : string;
    FPassword  : string;
    FEmail     : string;
    FBody      : UTF8String;
    FHost      : string;
    FSubject   : string;
    Fto        : TStringList;
    FAttachment: TStringList ;
    FCopyRigth : string;
    FHTML      : Boolean;
    FError     : string;
    public
    constructor Create(AOwner: TComponent);override;
    destructor Destroy;override;
    function SendMail(): Boolean;
    function Geterror():string;
    protected
    function GetActive: Boolean; virtual;
    procedure SetActive(const Value: Boolean); virtual;
    published
    property UserName: string read FLogin write FLogin;
    property Mailto: TStringList read fto write Fto;
    property Subject:string Read FSubject write FSubject;
    property Password: string read FPassword write FPassword;
    property Host: string read FHost write FHost;
    property FromEmail: string read FEmail write FEmail;
    property body: UTF8String read FBody write FBody;
    property Port: integer read FPort write FPort;
    property Attachment: TStringList read FAttachment write FAttachment;
    property CopyRigth :string read FCopyRigth;
    property Test: Boolean read GetActive write SetActive default False;
    property HTMLBody: Boolean read FHTML write FHTML default False;
end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Mail-DZ',[Tmail]);
end;


constructor Tmail.Create(AOwner: TComponent);
begin
  inherited;
  FHost      :=_Host;
  FPort      :=_Port;
  //active     :=False;
  fCopyRigth :=_CopyRigth ;
  fAttachment:=TStringList.Create;
  Fto:=TStringList.Create;
  FError:='';
end;

destructor Tmail.Destroy;
begin
  inherited;
  SetActive(False);
  FAttachment.Free;
  Fto.Free;
end;


function Tmail.SendMail(): Boolean;
const
_Cdo='http://schemas.microsoft.com/cdo/configuration/';
var
_Message,_Config:OleVariant;

i:Word;
strMailto:string;
begin
  //_Config Object

  _Message:= CreateOleObject('CDO.Message');
  _Config:= CreateOleObject('CDO.Configuration');

  try
    _Config.Fields(_Cdo+'sendusername'):= UserName;
    _Config.Fields(_Cdo+'sendpassword'):= Password;
    _Config.Fields(_Cdo+'sendusing'):= 2;
    _Config.Fields(_Cdo+'smtpserver'):= Host;
    _Config.Fields(_Cdo+'smtpserverport'):=Port;
    _Config.Fields(_Cdo+'smtpconnectiontimeout'):= 60;
    _Config.Fields(_Cdo+'smtpauthenticate'):= 1;
    _Config.Fields(_Cdo+'smtpusessl'):= True; // use SSL
    _Config.Fields.Update;

    _Message.Configuration:= _Config;

    for i:=0 to Mailto.Count-1 do
      strMailto := Mailto.Strings[i]+';'  ;

    _Message.BodyPart.charset := 'unicode-1-1-utf-8';
    _Message.To       := strMailto;
    _Message.From     :=FromEmail;
    _Message.Subject  := Subject;

    for i:=0 to  Attachment.Count-1 do
    if FileExists(Attachment.Strings[i]) then
    _Message.AddAttachment(Attachment.Strings[i]);

     if HTMLBody=True then
    _Message.HTMLBody := _CssDivStart+_h1S+Subject+_h1E+Body +_CssDivend
    else
    _Message.TextBody := Body;

    try

      try
    _Message.Send;
    finally
          Attachment.Clear;
      end;

    Result:=True;
    except on err:Exception do begin
    Result:=False;
    FError:=err.Message;
    end;
    end;

  finally
    VarClear(_Message);
    VarClear(_Config);
  end;
end;

function Tmail.GetActive: Boolean;
begin
Result:=False;
end;

procedure Tmail.SetActive(const Value: Boolean);
begin
if Value then begin
  if SendMail then begin
 SetActive(False);
 MessageBox(0,'Please Check Your Mailbox!!!', 'IMPORTANT', MB_OK);
 end else  MessageBox(0,'Message not sent!', 'Error', MB_OK);
end
else
Exit;
end;

function Tmail.Geterror: string;
begin
Result:=FError;
end;

end. 

الموقع الرسمي للبرنامج
تجدون فيه اخر تحديث

إقتباس :تجدون فيه اخر تحديث

تثبيت البرنامج يكون بمجلد Adan_Alpha ومن الاحسن ان يكون بالاسم الجديد mawakitt
وهنا كان من الاحسن استخدام اسم اخر لانه يوجد برنامج اخرى تسمى Mawakit

عند أول تنفيذ تظهر الرسالة:
هل تريد اضافة البرنامج الى برامج بدأ التشغيل
اجيب بعدم الموافقة، لكن الرسالة تتكرر كل مرة انفذ البرنامج ! مع ذلك عند اعادة تشغيل الجهاز ينفد البرنامج تلقائيا وتعود الرسالة للظهور !
عند النقر على زر حالة الطقس تظهر نافذة وعند النقر عليه اكثر من مرة تظهر اكثر من نافذة!

B.M.AbdelAziZ كتب :تثبيت البرنامج يكون بمجلد Adan_Alpha ومن الاحسن ان يكون بالاسم الجديد mawakitt
وهنا كان من الاحسن استخدام اسم اخر لانه يوجد برنامج اخرى تسمى Mawakit

عند أول تنفيذ تظهر الرسالة:
هل تريد اضافة البرنامج الى برامج بدأ التشغيل
اجيب بعدم الموافقة، لكن الرسالة تتكرر كل مرة انفذ البرنامج ! مع ذلك عند اعادة تشغيل الجهاز ينفد البرنامج تلقائيا وتعود الرسالة للظهور !
عند النقر على زر حالة الطقس تظهر نافذة وعند النقر عليه اكثر من مرة تظهر اكثر من نافذة!

بخصوص تعدد النوافذ فليست بالمشكلة اعلم بذلك الحل بسيط ShowModal
اما مشكلة الرجستري فتمت معالجتها
اما اسم البرنامج فهي اخر شيء افكر فيه !! هل من اسم مقترح ؟

PHP كود :
unit UnitRegistry;
//outhor : onexite
interface
 uses  ShlObj, SysUtils, Windows,DSiWin32;

function TimeFormatWriteRegistry():Boolean;
function TimeFormatReadRegistry(title:string):string;

function StartupDeleteRegistryValue(Title: string):Boolean;
function StartupReadRegistry(title:string):string ;
function StartupRegistryValueExists(title:string):Boolean;
function StartupWriteRegistry(Title,ExeName:string):Boolean;
function RegisterFileType(cMyExt, cMyFileType, cMyDescription, ExeName: string; IcoIndex: integer; DoUpdate: boolean = false):Boolean;
implementation

function RegisterFileType(cMyExt, cMyFileType, cMyDescription, ExeName: string; IcoIndex: integer; DoUpdate: boolean = false):Boolean;
begin
    result:=DSiWriteRegistry(cMyExt, '', cMyFileType ,HKEY_CLASSES_ROOT, KEY_WRITE OR KEY_WOW64_64KEY) and
        DSiWriteRegistry(cMyFileType, '',cMyDescription ,HKEY_CLASSES_ROOT, KEY_WRITE OR KEY_WOW64_64KEY) and
        DSiWriteRegistry(cMyFileType + '\DefaultIcon', '', ExeName + ',' + IntToStr(IcoIndex) ,HKEY_CLASSES_ROOT, KEY_WRITE OR KEY_WOW64_64KEY) and
        DSiWriteRegistry(cMyFileType + '\Shell\Open', '', '&Open' ,HKEY_CLASSES_ROOT, KEY_WRITE OR KEY_WOW64_64KEY)and
        DSiWriteRegistry(cMyFileType + '\Shell\Open\Command', '', '"' + ExeName + '" "%1"' ,HKEY_CLASSES_ROOT, KEY_WRITE OR KEY_WOW64_64KEY) ;
    if DoUpdate then SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
end;

function StartupDeleteRegistryValue(Title: string):Boolean;
begin
 result:= DSiDeleteRegistryValue('Software\Microsoft\Windows\CurrentVersion\Run', title ,HKEY_LOCAL_MACHINE, KEY_WRITE OR KEY_WOW64_64KEY);
end;
function StartupWriteRegistry(Title,ExeName:string):Boolean;
 begin
result:=DSiWriteRegistry('Software\Microsoft\Windows\CurrentVersion\Run', title, ExeName ,HKEY_LOCAL_MACHINE, KEY_WRITE OR KEY_WOW64_64KEY);
end;
 function StartupRegistryValueExists(title:string):Boolean;
 begin
 result:= DSiRegistryValueExists('Software\Microsoft\Windows\CurrentVersion\Run',  title,HKEY_LOCAL_MACHINE,KEY_QUERY_VALUE OR KEY_WOW64_64KEY)
 end;
 function StartupReadRegistry(title:string):string ;
 begin
 result:=  DSiReadRegistry('Software\Microsoft\Windows\CurrentVersion\Run', title, '' ,HKEY_LOCAL_MACHINE, KEY_QUERY_VALUE OR KEY_WOW64_64KEY);
 end;
 //*********************************************************************************************************************************************
 function TimeFormatReadRegistry(title:string):string;
 begin
  Result:= DSiReadRegistry('Control Panel\International', title, '' ,HKEY_CURRENT_USER, KEY_QUERY_VALUE OR KEY_WOW64_64KEY);
 end;
function TimeFormatWriteRegistry():Boolean;
 begin
result:=DSiWriteRegistry('Control Panel\International', 'sTimeFormat', 'HH:mm:ss' ,HKEY_LOCAL_MACHINE, KEY_WRITE OR KEY_WOW64_64KEY) and
        DSiWriteRegistry('Control Panel\International', 's1159', '' ,HKEY_LOCAL_MACHINE, KEY_WRITE OR KEY_WOW64_64KEY) and
        DSiWriteRegistry('Control Panel\International', 's2359', '' ,HKEY_LOCAL_MACHINE, KEY_WRITE OR KEY_WOW64_64KEY)
end;

end. 

إقتباس :تعدد النوافذ فليست بالمشكلة اعلم بذلك الحل بسيط ShowModal

لم تقم بتغييرها، جربت الان النسخة 2.6

إقتباس :هل من اسم مقترح ؟

ما رايك ب "موقوت"
[صورة: mawqot.jpg]

عند الضغط على تحديث ثم بحث
عند وجود اصدار جديد يقوم بالتحميل تلقائيا !
من المفروض يسال المستخدم ان كان يريد التحديث

الهامل الهامل كتب :السلام عليكم أريــد البرنامج كامل بارك الله فيكم

رابط مباشر
https://master-dl.sourceforge.net/projec.../Setup.exe
ولتحميل الاشكال واشياء اخرى ..
https://sourceforge.net/projects/mawakitt/files/

مراحل القمر

[صورة: GTXD7h.png]

كود جافا حولته الى الدلفي

PHP كود :
private void moonPhase(int y, int m, int d)
    {
        /*
          calculates the moon phase (0-7), accurate to 1 segment.
          0 = > new moon.
          4 => full moon.
          */
    
        double c,e;
        double jd;
        int b;
    
        if (m < 3) {
            y--;
            m += 12;
        }
        ++m;
        c =  365.25*y;
        e =  30.6*m;
        jd = c+e+d-694039.09;  /* jd is total days elapsed */
        jd /= 29.53;           /* divide by the moon cycle (29.53 days) */
        b = (int) jd;           /* int(jd) -> b, take integer part of jd */
        jd -= b;           /* subtract integer part to leave fractional part of original jd */
        b = (int) (jd*8 + 0.5);       /* scale fraction from 0-8 and round by adding 0.5 */
        b = b & 7;           /* 0 and 8 are the same so turn 8 into 0 */
        
        this.phase =b;
    } 

PHP كود :
function  moonPhase(y: Word; m,d: byte):Byte ;
  var  c,e,jd:Real;
    b:Integer;
  begin

        if (m < 3) then begin
            y:=y-1;
            m:= m+12;

        end;
        m:=m+1 ;
        c :=  365.25*y;
        e :=  30.6*m;
        jd := c+e+d-694039.09;  //* jd is total days elapsed */
        jd := jd/29.53;           //* divide by the moon cycle (29.53 days) */
        b := Trunc(jd);           //* int(jd) -> b, take integer part of jd */
    jd :=jd- b;           //* subtract integer part to leave fractional part of original jd */
    b := Trunc(jd*8 + 0.5);       //* scale fraction from 0-8 and round by adding 0.5 */
    b := b and 7;           //* 0 and 8 are the same so turn 8 into 0 */
        result :=b;
    end; 

PHP كود :
var Year,Month,Day:Word;
   _Phase:0..8;
begin
 DecodeDate(Date,Year, Month, Day);
_Phase:=MoonPhase(Year,Month,Day) ;

sStatusBar1.Panels[0].Text:='لعام : '+inttostr(hjritime2(Date).Year) +' هجري';
sLabel2.Caption:=DateToStr(Hejry2Melady(hjritime2(Date).Year,3,12))   ;
sLabel4.Caption:=DateToStr(Hejry2Melady(hjritime2(Date).Year,7,27))   ;
sLabel6.Caption:=DateToStr(Hejry2Melady(hjritime2(Date).Year,8,15))   ;
sLabel8.Caption:=DateToStr(Hejry2Melady(hjritime2(Date).Year,9,1))   ;
sLabel10.Caption:=DateToStr(Hejry2Melady(hjritime2(Date).Year,9,21))   ;
sLabel12.Caption:=DateToStr(Hejry2Melady(hjritime2(Date).Year,9,27))   ;
sLabel14.Caption:=DateToStr(Hejry2Melady(hjritime2(Date).Year,10,1))   ;
sLabel16.Caption:=DateToStr(Hejry2Melady(hjritime2(Date).Year,12,10))   ;
sLabel18.Caption:=DateToStr(Hejry2Melady(hjritime2(Date).Year,1,10))   ;
if _Phase in [1..8] then
sAlphaImageList1.GetIcon(_Phase, sImage1.picture.Icon)
else sAlphaImageList1.GetIcon(0, sImage1.picture.Icon) ;
sPanel1.Caption:= strMoonphase[_Phase] ; 

السلام عليكم ورحمة الله تعالى وبركاته.

فيما يخص منازل القمر لهذا اليوم 31 أكتوبر 2014 تضهر القمر بشكل مقلوب مقارنة مع شكل القمر من هذا الرابط http://www.moonconnection.com/moon_phase...ndar.phtml

وإذا امكن اضافة بداية الثلث الاخير من الليل.

وجزاك الله خيرا على البرنامج.

بن دهيبة كتب :السلام عليكم ورحمة الله تعالى وبركاته.

فيما يخص منازل القمر لهذا اليوم 31 أكتوبر 2014 تضهر القمر بشكل مقلوب مقارنة مع شكل القمر من هذا الرابط http://www.moonconnection.com/moon_phase...ndar.phtml

وإذا امكن اضافة بداية الثلث الاخير من الليل.

وجزاك الله خيرا على البرنامج.

انت مخطأ تاكد من الاوان ( الابيض لا يظهر )

[صورة: Yermc9.png]

وبخصوص الثلث الاخير ستجده في الاصدار 3.5

PHP كود :
Result.ThlthAkhir:=result.Fajr-((Result.Maghrib-result.Fajr)/3);
Result.ThlthAkhir:=(Frac((Result.ThlthAkhir+Smr)/24)); 

الصفحات : 1 2 3 4 5 6

onexite

onexite

onexite

محمد عبد العزيز

onexite

محمد عبد العزيز

onexite

onexite

بن دهيبة

onexite