Page 1 of 1

A man come here please

Posted: Fri Aug 14, 2009 2:44 pm
by A M S
Hello to all PB Users
I am a new user here, i use a script lng it's name : A M S (AutoPlay Media Studio 7.0)http://www.indigorose.com/
well, it is good for a person with no knowledge in programming .
whenever i have not a function in A M S, i use from PB function by DLL sharing .
i know a little PB, no good no bad, but dont know any about VB6

This code:

Code: Select all

Attribute VB_Name = "Module1"


Option Explicit

Private Month_Name, Spring_Fall
Private Time_Difference, Time_Client
Private Base_Year

'--- Farsi Date Convertor --------------------'

Private Sub Get_Date(ByVal Days, Sal, Mah, Rooz)
   Dim Years, Year_Length
   Do While Days >= 0
     If Kabiseh(Years) Then
        Year_Length = 366
     Else
        Year_Length = 365
     End If
     If Days - Year_Length >= 0 Then
        Years = Years + 1
        Days = Days - Year_Length
     Else
        Sal = Base_Year + Years
        If Days <= 185 Then
           Mah = 1 + (Days \ 31)
           Rooz = 1 + (Days Mod 31)
        Else
           Days = Days - 186
           Mah = 7 + (Days \ 30)
           Rooz = 1 + (Days Mod 30)
        End If
        Exit Sub
     End If
   Loop
End Sub
Private Function Kabiseh(ByVal Years)
   Dim Temp
   Kabiseh = False
   Temp = (Base_Year + Years) - 1309
   If (((Temp Mod 32) - (Temp \ 32)) Mod 4) = 0 Then Kabiseh = True
End Function
Public Property Let SFhour(x)
   Spring_Fall = x
End Property
Public Property Let Time_Diff(ByVal t)
   Time_Difference = t
End Property
Public Property Let state(ByVal S)
   Month_Name = S
End Property
Public Function To_Hejri(ByVal what_date, Optional Month_Name)
   Dim Days, Day_Name, Day_Number, Temp_Days, Months
   Spring_Fall = False
   If IsMissing(Month_Name) Then Month_Name = 0

   Time_Difference = #12:00:00 AM#
   Base_Year = 1332

   Months = Array("فروردين", "ارديبهشت", "خرداد", "تير", "مرداد", "شهريور", "مهر", "آبان", "آذر", "دي", "بهمن", "اسفند")

   Day_Name = Array("يکشنبه", "دوشنبه", "سه شنبه", "چهارشنبه", "پنجشنبه", "جمعه", "شنبه")
   Days = DateDiff("d", #3/21/1953#, what_date)
   Day_Number = Weekday(what_date)
   Dim Year_Length, Sal, Mah, Rooz, temp_date
   If FormatDateTime(what_date + Time_Difference, vbShortDate) <> FormatDateTime(what_date, vbShortDate) Then
      Days = Days + 1
      Day_Number = (Day_Number + 1)
      If Day_Number = 8 Then Day_Number = 1
   End If
   Time_Client = FormatDateTime(what_date + Time_Difference, vbLongTime)
   Call Get_Date(Days, Sal, Mah, Rooz)
   If ((Mah >= 1 And Mah <= 6) And Not ((Mah = 1 And Rooz = 1) Or (Mah = 6 And Rooz = 31))) And Spring_Fall = True Then
      If FormatDateTime(what_date + Time_Difference + #1:00:00 AM#, vbShortDate) <> FormatDateTime(what_date + Time_Difference, vbShortDate) Then
         Temp_Days = Days + 1
         Day_Number = (Day_Number + 1)
         If Day_Number = 8 Then Day_Number = 1
      Else
         Temp_Days = Days
      End If
      Time_Client = FormatDateTime(what_date + Time_Difference + #1:00:00 AM#, vbLongTime)
      If Temp_Days <> Days Then
         Days = Temp_Days
         If Rooz = 30 And Mah = 6 Then
            If DateDiff("n", Time_Client, #1:00:00 AM#) <= 60 And DateDiff("n", Time_Client, #1:00:00 AM#) >= 0 Then
               Time_Client = FormatDateTime(what_date + Time_Difference, vbLongTime)
               Days = Days - 1
               If Day_Number = 1 Then
                  Day_Number = 7
               Else
                  Day_Number = Day_Number - 1
               End If
            End If
         End If
         Call Get_Date(Days, Sal, Mah, Rooz)
      End If
   End If
   If Month_Name = 0 Then
      If Rooz < 10 Then Rooz = "0" & Rooz
      If Mah < 10 Then Mah = "0" & Mah
      To_Hejri = Sal & "/" & Mah & "/" & Rooz
   ElseIf Month_Name = 1 Then
      To_Hejri = Rooz & " " & Months(Mah - 1) & " " & Sal
   ElseIf Month_Name = 2 Then
      To_Hejri = Day_Name(Day_Number - 1) & " " & Sal & "/" & Mah & "/" & Rooz
   ElseIf Month_Name = 3 Then
      To_Hejri = Day_Name(Day_Number - 1) & "  " & Rooz & "  " & Months(Mah - 1) & "  " & Sal
   End If
End Function
Public Function To_Time(what_date)
   Call To_Hejri(what_date)
   To_Time = Time_Client
End Function
Private Sub Class_Initialize()
   Spring_Fall = False
   Month_Name = 0
   Time_Difference = #12:00:00 AM#
   Base_Year = 1332
End Sub


will be useful for Afghan, Pakistan, Iran, Iraq country for convert Date to national date .
I'm entreaty please a man convert this code to PB then i able make a dll for A M S (and other lng by other users maybe).

my English is very bad, sorry :oops:

Posted: Fri Aug 14, 2009 3:35 pm
by eddy
There's a VBPB converter but I don't remember where it is.

Posted: Fri Aug 14, 2009 3:46 pm
by A M S
Ok, i find it here:
http://www.purebasic.fr/english/viewtop ... 694#295694
Download Link is broken now (It's old) :roll:

Posted: Fri Aug 14, 2009 4:17 pm
by DevilDog
AMS,
I wrote the original VBtoPB program and I'm sorry that the original download link is broken. I think PureStorage (which is where the download was kept) closed it's website.

I'm working on converting the code you posted to PureBasic for you. I may have some questions for you if I don't understand something.

DevilDog

Posted: Fri Aug 14, 2009 4:30 pm
by A M S
Hi DevilDog
to thank god, You surprise me whit come here, thank you very much DevilDog
i ready to reply
I can be connect to 3h after this time, night is near and my parent is hard with time to bed. then after 3h tomorrow i come back here.

Posted: Fri Aug 14, 2009 9:36 pm
by DevilDog
AMS,
Here's my first attempt at converting the code. Please be aware that I have only converted it enough to get it to compile cleanly and I have not really gone through the logic to see that it works correctly.

You will have to step throught it yourself and verify or make changes where needed.

You can start it by calling the procedure To_hejri() and pass it the parameter(s).


Code: Select all

Month_Name.s = ""
Spring_Fall = 0
Time_Difference = 0
Time_Client  =0
Base_Year = 0

; Public Property Let SFhour(x)
  ; Spring_Fall = x
; End Property
; 
; Public Property Let Time_Diff(ByVal t)
  ; Time_Difference = t
; End Property
; 
; Public Property Let state(ByVal S)
  ; Month_Name = S
; End Property

Structure TimeDiff 
  totaldays.l 
  Years.l 
  Months.l 
  daysremaining.l 
  hours.l 
  minutes.l 
  seconds.l 
EndStructure 

;'--- Farsi Date Convertor --------------------'

Procedure Kabiseh(Years)
  Temp.l = 0
  Kabiseh.l = 0
  Temp = (Base_Year + Years) - 1309
  If (((Temp % 32) - (Temp / 32)) % 4) = 0 
    Kabiseh = 1
  EndIf
  ProcedureReturn Kabiseh
EndProcedure

Procedure Get_Date(Days, Sal.s, Mah.s, Rooz.s)
  Years = 0
  Year_Length = 0
    
    While Days >= 0
      If Kabiseh(Years) 
        Year_Length = 366
      Else
        Year_Length = 365
      EndIf
          
      If Days - Year_Length >= 0 
        Years = Years + 1
        Days = Days - Year_Length
      Else
        Sal = Str(Base_Year + Years)
        If Days <= 185 
          Mah = Str(1 + (Days / 31))
          Rooz = Str(1 + (Days % 31))
        Else
          Days = Days - 186
          Mah = Str(7 + (Days / 30))
          Rooz = Str(1 + (Days % 30))
        EndIf
        Break
      EndIf
    Wend
EndProcedure
              
Procedure Class_Initialize()
    Spring_Fall = False
    Month_Name = 0
    Time_Difference.s = "12:00:00 AM"
    Base_Year = 1332
EndProcedure
  
Procedure DateDiff(p_dateearly.s, p_datelate.s, *diff.TimeDiff) 
  
  Protected totaldays,Years,Months,daysremaining,hours,minutes,seconds 
  
  dateearly = ParseDate("%mm/%dd/%yyyy", p_dateearly) 
  datelate = ParseDate("%mm/%dd/%yyyy", p_datelate) 
  
  curdate = dateearly 
  testdate = dateearly 
  startday = Day(dateearly) 
  totaldays = 0 
  daysremaining = 0 
  
  While testdate <= datelate 
    testdate = AddDate(curdate, #PB_Date_Day, 1) 
    If testdate <= datelate 
      curdate = testdate 
      totaldays+1 
      daysremaining+1 
      If Day(curdate) = startday 
        Months+1 
        daysremaining=0 
      EndIf 
    EndIf 
  Wend 
  
  testdate = curdate 
  hours = 0 
  While testdate<datelate 
    testdate = AddDate(curdate, #PB_Date_Hour, 1) 
    If testdate <= datelate 
      curdate = testdate 
      hours+1 
    EndIf 
  Wend 
  
  testdate = curdate 
  minutes = 0 
  While testdate<datelate 
    testdate = AddDate(curdate, #PB_Date_Minute, 1) 
    If testdate <= datelate 
      curdate = testdate 
      minutes+1 
    EndIf 
  Wend 
  
  testdate = curdate 
  seconds = 0 
  While testdate<datelate 
    testdate = AddDate(curdate, #PB_Date_Second, 1) 
    If testdate <= datelate 
      curdate = testdate 
      seconds+1 
    EndIf 
  Wend 
  
  Years = Months/12 
  If Years 
    Months % 12 
  EndIf 
  
  *diff\totaldays = totaldays 
  *diff\Years = Years 
  *diff\Months = Months 
  *diff\daysremaining = daysremaining 
  *diff\hours = hours 
  *diff\minutes = minutes 
  *diff\seconds = seconds 
  
EndProcedure 

Procedure To_Hejri(p_what_date.s, Month_Name)
  Days=0
  
  Dim Day_Name.s(6)
  Day_Name(0)="??????"
  Day_Name(1)="??????"
  Day_Name(2)="?? ????"
  Day_Name(3)="????????"
  Day_Name(4)="???????"
  Day_Name(5)="????"
  Day_Name(6)="????"
  
  Day_Number=0
  Temp_Days=0
  
  Dim Months.s(11)
  Months(0)="???????"
  Months(1)="????????"
  Months(2)="?????"
  Months(3)="???"
  Months(4)="?????"
  Months(5)="??????"
  Months(6)="???"
  Months(7)="????"
  Months(8)="???"
  Months(9)="??"
  Months(10)="????"
  Months(11)="?????"
  
  Spring_Fall = 0
  
  ; If Month_Name = ""
  ; Month_Name = 0
  ; EndIf
  
  Time_Difference.s = "12:00:00 AM"
  Base_Year = 1332
  EarlyDate.s = "03/21/1953"
  
  Days = DateDiff(EarlyDate, p_what_date, @MyDiff)
  Day_Number = DayOfWeek(what_date)+1
  
  Year_Length=0
  Global Sal.s=""
  Global Mah.s=""
  Global Rooz.s=""
  temp_date=0
  
  ; %yyyy: Will be replaced by the year Value, on 4 digits.
  ; %yy: Will be replaced by the year Value, on 2 digits.
  ; %mm: Will be replaced by the month Value, on 2 digits.
  ; %dd: Will be replaced by the day Value, on 2 digits.
  ; %hh: Will be replaced by the hour Value, on 2 digits.
  ; %ii: Will be replaced by the minute Value, on 2 digits.
  ; %ss: Will be replaced by the second Value, on 2 digits.
  ; Debug FormatDate("Y=%yyyy, M= %mm, D=%dd", Date()) ; Will display the actual date in the form "Y=2002, M=10, D=03"
  ; Debug FormatDate("%hh:%ii:%ss", Date())
  
  If ParseDate("%mm/%dd/%yyyy %hh:%ii:%ss", p_what_date + " " + Time_Difference) <> ParseDate("%mm/%dd/%yyyy %hh:%ii:%ss", p_what_date)
    Days = Days + 1
    Day_Number = (Day_Number + 1)
    If Day_Number = 8 
      Day_Number = 1
    EndIf
    
    Time_Client = ParseDate("%mm/%dd/%yyyy %hh:%ii:%ss", p_what_date + " " + Time_Difference)
    Get_Date(Days, Sal, Mah, Rooz)
    
    If ((Val(Mah) >= 1 And Val(Mah) <= 6) And Not ((Val(Mah) = 1 And Val(Rooz) = 1) Or (Val(Mah) = 6 And Val(Rooz) = 31))) And Spring_Fall = 1
      
      If ParseDate("%mm/%dd/%yyyy %hh:%ii:%ss", p_what_date + " 1:00:00 AM") <> ParseDate("%mm/%dd/%yyyy %hh:%ii:%ss", p_what_date + " " + Time_Difference)
        Temp_Days = Days + 1
        Day_Number = (Day_Number + 1)
        If Day_Number = 8
          Day_Number = 1
        Else
          Temp_Days = Days
        EndIf
        
        Time_Client = ParseDate("%mm/%dd/%yyyy %hh:%ii:%ss", p_what_date + " 1:00:00 AM")
        If Temp_Days <> Days
          Days = Temp_Days
          If Val(Rooz) = 30 And Val(Mah) = 6

            ; **** NOTE BELOW *****
            ; I'm not clear on what the next line of code does so I'm not sure how to convert it. I'm not familear enough witht he Islamic calendar 
            ; to know what to do. You will probably need to help explain this or convert this line yourself.
            
            If 1; DateDiff("n", Time_Client, "1:00:00 AM") <= 60 And DateDiff("n", Time_Client, "1:00:00 AM") >= 0 
              Time_Client = ParseDate("%mm/%dd/%yyyy %hh:%ii:%ss", p_what_date + " " + Time_Difference)
              Days = Days - 1
              If Day_Number = 1
                Day_Number = 7
              Else
                Day_Number = Day_Number - 1
              EndIf
            EndIf 
          EndIf
          Get_Date(Days, Sal, Mah, Rooz)
        EndIf
      EndIf
      
      If Month_Name = 0 
        If Val(Rooz) < 10 
          Rooz = "0" + Rooz
          If Val(Mah) < 10 
            Mah = "0" + Mah
            To_Hejri.s = Sal + "/" + Mah + "/" + Rooz
          Else
            If Month_Name = 1
              To_Hejri.s = Rooz + " " + Str(Val(Mah) - 1) + " " + Sal
            Else
              If Month_Name = 2
                To_Hejri.s = Day_Name(Day_Number - 1) + " " + Sal + "/" + Mah + "/" + Rooz
              Else
                If Month_Name = 3
                  To_Hejri.s = Day_Name(Day_Number - 1) + "  " + Rooz + "  " + Str(Val(Mah) - 1) + "  " + Sal
                EndIf
              EndIf
            EndIf
          EndIf 
        EndIf 
      EndIf 
    EndIf
  EndIf
  
EndProcedure

; NOTE: not sure what this code does. so I left it to you to look it over and decide.
; Procedure To_Time(what_date)
  ; To_Hejri(what_date)
  ; To_Time = Time_Client
; EndProcedure
        

Posted: Sat Aug 15, 2009 11:27 am
by A M S
thank you very much DevilDog :D
i never forget this your please me really
I try test it and reply here, have best times.

Posted: Sat Aug 15, 2009 6:14 pm
by A M S
After many test, i dont success to get a return from To_Hejri(p_what_date.s, Month_Name)

i add a line for return:

Code: Select all

ProcedureReturn To_Hejri
to end of Procedure.s

and try : e.g Debug To_hejri("2009/08/15", 0)

can you help me with a example for start? :roll: