مرجع توابع دلفی

**دلفــي** · شنبه 24 آذر 1403, 10:39 صبح





function MyExitWindows(MyParam: Longword): Boolean;

var

TTokenHd: THandle;

TTokenPvg: TTokenPrivileges;

cbtpPrevious: DWORD;

rTTokenPvg: TTokenPrivileges;

pcbtpPreviousRequired: DWORD;

tpResult: Boolean;

const

SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';

begin

if Win32Platform = VER_PLATFORM_WIN32_NT then

begin

tpResult := OpenProcessToken(GetCurrentProcess(),

TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,

TTokenHd);

if tpResult then

begin

tpResult := LookupPrivilegeValue(nil,

SE_SHUTDOWN_NAME,

TTokenPvg.Privileges[0].Luid);

TTokenPvg.PrivilegeCount := 1;

TTokenPvg.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;

cbtpPrevious := SizeOf(rTTokenPvg);

pcbtpPreviousRequired := 0;

if tpResult then

Winapi.Windows.AdjustTokenPrivileges(TTokenHd,

False,

TTokenPvg,

cbtpPrevious,

rTTokenPvg,

pcbtpPreviousRequired);

end;

end;

Result := ExitWindowsEx(MyParam, 0);

end;





// Example to shutdown Windows:





procedure TForm1.Button1Click(Sender: TObject);

begin

MyExitWindows(EWX_POWEROFF or EWX_FORCE);

end;





// Example to reboot Windows:





procedure TForm1.Button1Click(Sender: TObject);

begin

MyExitWindows(EWX_REBOOT or EWX_FORCE);

end;





// Example to logoff Windows:





procedure TForm1.Button1Click(Sender: TObject);

begin

MyExitWindows(EWX_LOGOFF or EWX_FORCE);

end;

**دلفــي** · سه شنبه 26 فروردین 1404, 12:53 عصر



uses Math;



function DateToHijer(day: word; month: word; year: word): string;

var

  ayear, cdays, leap, HMO, cmonth: word;

  myear, cyear, cday, HDAY, Precise, mday: real;





  function Pcision(F: real): real;

  var

    Status: boolean;

    Dn: integer;

    jDn, Fn, Fn2: real;





    function Moon(jd: real): real;

    var

      T, mE, mA, SmA, D, S, M, phaseAngle, iiF: real;





      function r(Input: real): real;

      var

        Output: real;

      Begin

        if (Input >= 0) Then

          Output := Input - Floor(Input / 360) * 360

        else

          Output := Input - Ceil((Input / 360) * 360 + 360);

        Result := (Output);

      End;





      function radd(angle: real): real;

      Begin

        Result := (r(angle) * PI / 180);

      End;





      function sinn(angle: real): real;

      Begin

        Result := (sin(radd(angle)));

      End;





      function coss(angle: real): real;

      Begin

        Result := (cos(radd(angle)));

      End;





    Begin

      T := (jd - 2451545) / 36525.0;

      mE := 297.8502042 + 445267.1115168 * T - 0.0016300 * (T * T) + (T * T * T)

        / 545868.0 - (T * T * T * T) / 113065000;

      mA := 134.9634114 + 477198.8676313 * T + 0.0089970 * (T * T) + (T * T * T)

        / 69699.0 - (T * T * T * T) / 863310000.0;

      SmA := 357.5291092 + (35999.0502909 * T) - (0.0001536 * T * T) +

        ((T * T * T) / 24490000);

      D := r(mE);

      S := r(SmA);

      M := r(mA);

      phaseAngle := 180 - D - 6.289 * sinn(M) + 2.1 * sinn(S) - 1.274 *

        sinn(r(2 * D) - M) - 0.658 * sinn(2 * D);

      phaseAngle := phaseAngle + (-0.214 * sinn(2 * M));

      phaseAngle := phaseAngle + (-0.110 * sinn(1 * D));

      iiF := (1 + coss(phaseAngle)) / 2 * (phaseAngle / abs(phaseAngle));

      Result := (iiF);

    End;





  Begin

    Status := true;

    Dn := 0;

    jDn := F;

    if (Moon(jDn - 1) <= 0) Then

    Begin

      jDn := jDn - 1;

      Dn := Dn + 1;

    End;

    while (Status = true) do

    Begin

      Fn := Moon(jDn);

      Fn2 := Moon(jDn - 1);

      if (((Fn / abs(Fn)) * (Fn2 / abs(Fn2))) = 1) Then

      Begin

        Dn := Dn + 1;

        jDn := jDn - 1;

      End

      else

      Begin

        if (abs(Fn * Fn2) < 0.2) Then

          Status := false

        else

        Begin

          Dn := Dn + 1;

          jDn := jDn - 1;

        End;

      End;

    End;

    Result := (Dn);

  End;





  procedure call(HdayN: real);

  var

    Gyear, GyearDf, Hyear, Hdayf, Hhday: real;

    l, Hmonth: word;

    Gday: integer;

  Begin

    Gyear := cyear * 0.970224044 + 621.574981435;

    GyearDf := Gyear - Floor(Gyear);

    Gyear := Gyear - GyearDf;

    l := 0;

    if (Gyear / 4 = Floor(Gyear / 4)) Then

    Begin

      l := 1;

    End;

    if (Gyear / 100 = Floor(Gyear / 100)) Then

    Begin

      if (Gyear / 400 <> Floor(Gyear / 400)) Then

      Begin

        l := 0;

      End;

    End;

    Gday := Floor((365 + l) * GyearDf) + 1;

    Gyear := Gyear + Gday / (365 + l);

    Hyear := (Gyear - 621.574981435) / 0.970224044;

    Hdayf := Hyear - Floor(Hyear);

    Hhday := Hdayf * 10631 / 30 + 1;

    Hmonth := 1;

    Hdayf := 1;

    while (Hdayf < HdayN) Do

    Begin

      Hhday := Hhday + 1;

      Hdayf := Hdayf + 1;

      if (Hhday >= 29.53058796) Then

      Begin

        Hhday := Hhday - 29.53058796;

        Hmonth := Hmonth + 1;

      End;

    End;

    HDAY := Floor(Hhday) + 1;

    HMO := Hmonth;

  End;





  function JulianDay(Gyear: integer; gMonth: word; Gday: word): real;

  var

    dayAndTime, jdd: real;

    A: integer;

  Begin

    if (gMonth <= 2) Then

    Begin

      Gyear := Gyear - 1;

      gMonth := gMonth + 12;

    End;

    A := Floor(Gyear / 100);

    A := Floor(2 - A + (A / 4));

    dayAndTime := Gday + 0.8125;

    jdd := Floor(365.25 * (Gyear + 4712)) + Floor(30.6001 * (gMonth + 1)) +

      dayAndTime + A - 63.5;

    Result := (jdd);

  End;





Begin

  ayear := year;

  cdays := day;

  leap := 0;

  if (month > 11) then

    cdays := cdays + 30;

  if (month > 10) then

    cdays := cdays + 31;

  if (month > 9) then

    cdays := cdays + 30;

  if (month > 8) then

    cdays := cdays + 31;

  if (month > 7) then

    cdays := cdays + 31;

  if (month > 6) then

    cdays := cdays + 30;

  if (month > 5) then

    cdays := cdays + 31;

  if (month > 4) then

    cdays := cdays + 30;

  if (month > 3) then

    cdays := cdays + 31;

  if (month > 2) then

    cdays := cdays + 28;

  if (month > 1) then

    cdays := cdays + 31;

  if (ayear / 4 = Floor(ayear / 4)) Then

    leap := 1;

  if (ayear / 100 = Floor(ayear / 100)) Then

    if (ayear / 400 <> Floor(ayear / 400)) Then

      leap := 0;

  if (leap = 1) Then

    if (month > 2) Then

      cdays := cdays + 1;

  myear := ayear + cdays / (365 + leap);

  cyear := (myear - 621.578082192) / 0.97022298;

  cyear := cyear + Floor(abs(cyear) / 3000) * 30 / 10631;

  cday := cyear - Floor(cyear);

  cyear := cyear - cday;

  if ((cday * 10631 / 30) - Floor(cday * 10631 / 30) < 0.5) Then

    cday := Floor(cday * 10631 / 30) + 1

  else

    cday := Floor(cday * 10631 / 30) + 2;

  call(cday);

  mday := HDAY;

  cmonth := HMO;

  if (cmonth = 13) Then

  Begin

    month := 1;

    cyear := cyear + 1;

  End;

  Precise := Pcision(JulianDay(ayear, month, day));

  if (mday <> Precise) Then

  Begin

    if (mday = 1) AND (Precise > 28) Then

    Begin

      cmonth := cmonth - 1;

      if (cmonth = 0) Then

      Begin

        cmonth := 12;

        cyear := cyear - 1;

      End;

    End

    else

    Begin

      if (mday > 28) AND (Precise < 3) Then

      Begin

        cmonth := cmonth + 1;

        if (cmonth = 13) Then

        Begin

          cmonth := 1;

          cyear := cyear + 1;

        End;

      End;

    End;

  End;

  mday := Precise;

  if (cyear < 1) Then

  Begin

    cyear := cyear - 1;

  End;

  Result := floattostr(mday) + '/' + inttostr(cmonth) + '/' +

    floattostr(abs(cyear))

End;

نحوه فراخوانی:



procedure TForm1.Button1Click(Sender: TObject);

begin

Label1.Caption:= DateToHijer( 01, 02, 2025) ;

end;

یا



procedure TForm1.Button1Click(Sender: TObject);

var

  Year, Month, Day: Word;

begin

  DecodeDate(DateTimePicker1.Date, Year, Month, Day);

  Label1.Caption:=  DateToHijer( Day, Month, Year) ;

end;

نام تاپیک: مرجع توابع دلفی

ابزار های تاپیک

نمایش

Shutdown / Reboot / Logoff Windows

تبدیل تاریخ میلادی به هجری قمری

قوانین ایجاد تاپیک در تالار