home *** CD-ROM | disk | FTP | other *** search
/ Chip 1997 October / Chip_1997-10_cd.bin / tema / sw602 / wintext / disk1 / data.1 / SETDATE.TXT < prev    next >
Text File  |  1996-12-17  |  5KB  |  184 lines
  1. //***********************************************************************
  2. //*
  3. //*       Nßzev makra:   
  4. //*             Autor:   
  5. //*   Datum vytvo°enφ:   
  6. //*
  7. //*     Nßzev souboru:   
  8. //*    Nßzev programu:   
  9. //*              Tisk:    
  10. //*
  11. //*             Popis:   
  12. //*                      
  13. //*
  14. //***********************************************************************
  15. program Datum_a_Φas;
  16.  
  17. const
  18.   COUNT_F_DATE    = 10;
  19.   COUNT_F_TIME    =  7;
  20.  
  21.  
  22. type
  23.   tSystemTime = record
  24.     wYear, wMonth, wDayOfWeek, wDay,
  25.     wHours, wMinutes, wSeconds, wMilliseconds : short;
  26.   end;
  27.  
  28.   tFormat = record
  29.     iDate, iTime : short;
  30.   end;
  31.  
  32.   strTxt = string[30];
  33.  
  34.  
  35. var
  36.   sd : array[1..COUNT_F_DATE] of strTxt;
  37.   st : array[1..COUNT_F_TIME] of strTxt;
  38.   sMonth : array[1..12] of string[9];
  39.   sDay : array[0..6] of string[9];
  40.  
  41.  
  42. function w2s( w : short ) : string[5];
  43. begin
  44.   w2s := int2str(w);
  45. end;
  46.  
  47.  
  48. function addZero( w : short ) : string[2];
  49. var s : string[2];
  50. begin
  51.   s := int2str(w);
  52.   if (strlength(s) = 1) then s := "0" + s;
  53.   addZero := s;
  54. end;
  55.  
  56.  
  57. procedure init;
  58. var
  59.   s : string[1];
  60.   t : tSystemTime;
  61.   dt : date;
  62.   tm : time;
  63.   frm : tFormat;
  64.   sYear2, sH, sM, sS, sH2 : string[2];
  65.   sOD : string[5];
  66.   len : short;
  67. begin
  68.   sMonth[1]  := 'leden';
  69.   sMonth[2]  := '·nor';
  70.   sMonth[3]  := 'b°ezen';
  71.   sMonth[4]  := 'duben';
  72.   sMonth[5]  := 'kv∞ten';
  73.   sMonth[6]  := 'Φerven';
  74.   sMonth[7]  := 'Φervenec';
  75.   sMonth[8]  := 'srpen';
  76.   sMonth[9]  := 'zß°φ';
  77.   sMonth[10] := '°φjen';
  78.   sMonth[11] := 'listopad';
  79.   sMonth[12] := 'prosinec';
  80.  
  81.   sDay[0] := 'ned∞le';
  82.   sDay[1] := 'pond∞lφ';
  83.   sDay[2] := '·ter²';
  84.   sDay[3] := 'st°eda';
  85.   sDay[4] := 'Φtvrtek';
  86.   sDay[5] := 'pßtek';
  87.   sDay[6] := 'sobota';
  88.  
  89. //  GetLocalTime( st );
  90.   dt := today;
  91.   tm := now;
  92.   t.wYear := Year(dt);
  93.   t.wMonth := Month(dt);
  94.   t.wDayOfWeek := Day_Of_week(dt);
  95.   t.wDay := Day(dt);
  96.   t.wHours := Hours(tm);
  97.   t.wMinutes := Minutes(tm);
  98.   t.wSeconds := Seconds(tm);
  99.   sYear2 := StrCopy(w2s(t.wYear), 3, 2);
  100.   sH := addZero(t.wHours);
  101.   if (t.wHours > 12)
  102.     then begin sH2 := int2str(t.wHours-12); sOD := ' odp.'; end
  103.     else begin sH2 := int2str(t.wHours); sOD := ' dop.'; end;
  104.   sM := addZero(t.wMinutes);
  105.   sS := addZero(t.wSeconds);
  106.   len := strlength(sMonth[t.wMonth]);
  107.   sd[1]  := '';
  108.   sd[2]  := w2s(t.wDay) + "." + w2s(t.wMonth) + "." + w2s(t.wYear);
  109.   sd[3]  := w2s(t.wDay) + "." + w2s(t.wMonth) + "." + sYear2;
  110.   sd[4]  := w2s(t.wMonth) + "." + w2s(t.wYear);
  111.   sd[5]  := w2s(t.wDay) + "." + w2s(t.wMonth) + ".";
  112.   sd[6]  := w2s(t.wDay) + ". " + sMonth[t.wMonth] + " " + sYear2;
  113.   sd[7]  := w2s(t.wDay) + ". " + sMonth[t.wMonth] + " " + w2s(t.wYear);
  114.   s := ' ';
  115.   s := sMonth[t.wMonth][1];
  116.   sd[8]  := UpCase(s) +
  117.             StrCopy(sMonth[t.wMonth],2,len-1) + " ''" + sYear2;
  118.   sd[9]  := sDay[t.wDayOfWeek] + " " + w2s(t.wDay) + ". " +
  119.             sMonth[t.wMonth] + " " + w2s(t.wYear);
  120.   sd[10] := sDay[t.wDayOfWeek] + " " + w2s(t.wDay) + ". " +
  121.             sMonth[t.wMonth] + " " + sYear2;
  122.  
  123.   st[1] := '';
  124.   st[2] := sH + ":" + sM + ":" + sS;
  125.   st[3] := sH + ":" + sM;
  126.   st[4] := int2str(t.wHours) + ":" + sM + ":" + sS;
  127.   st[5] := int2str(t.wHours) + ":" + sM;
  128.   st[6] := sH2 + ":" + sM + ":" + sS + sOD;
  129.   st[7] := sH2 + ":" + sM + sOD;
  130. end;
  131.  
  132.  
  133. function DoDlgFormat( var frm : tFormat ) : boolean;
  134. const
  135.   idlDate  = 101;
  136.   idlTime  = 102;
  137. var
  138.   dlg, id, i : short;
  139.   bResult : boolean;
  140. begin
  141.   bResult := false;
  142.   { vytvo°enφ dialogu : }
  143.   dlg := DialogCreate( 30, 40, 260, 110, 'Vlo₧enφ data a Φasu' );
  144.   DlgText( dlg, 'Formßt &data:', 201,  10, 10, 90 );
  145.   DlgListbox( dlg, false, idlDate,  10, 20, 90, 85 );
  146.   DlgText( dlg, 'Formßt Φ&asu:', 202, 110, 10, 90 );
  147.   DlgListbox( dlg, false, idlTime, 110, 20, 90, 85 );
  148.   DlgBtnOk( dlg, 210, 20, 40 );
  149.   DlgBtnCancel( dlg, 210, 40, 40 );
  150.   DlgButtonDefPush( dlg, IDOK, true );
  151.   { napln∞nφ listbox∙ : }
  152.   DlgStrBoxAdd(dlg, idlDate, 1, '[₧ßdn²]');
  153.   DlgStrBoxAdd(dlg, idlTime, 1, '[₧ßdn²]');
  154.   for i:=2 to COUNT_F_DATE do DlgStrBoxAdd(dlg, idlDate, i, sd[i]);
  155.   for i:=2 to COUNT_F_TIME do DlgStrBoxAdd(dlg, idlTime, i, st[i]);
  156.   DlgStrBoxSetVal(dlg, idlDate, 2);
  157.   DlgStrBoxSetVal(dlg, idlTime, 2);
  158.  
  159.   if (DialogRun( dlg ) = IDOK) then begin
  160.     frm.iDate := DlgStrBoxGetVal( dlg, idlDate );
  161.     frm.iTime := DlgStrBoxGetVal( dlg, idlTime );
  162.     bResult := true;
  163.   end;
  164.  
  165.   DoDlgFormat := bResult;
  166. end;
  167.  
  168.  
  169. procedure run;
  170. var frm : tFormat;
  171. begin
  172.   if (DoDlgFormat(frm)) then begin
  173.     if (frm.iDate <> 1) and (frm.iTime <> 1) then
  174.       sd[frm.iDate] := sd[frm.iDate] + " ";
  175.     InsertText( sd[frm.iDate] );
  176.     InsertText( st[frm.iTime] );
  177.   end;
  178. end;
  179.  
  180.  
  181. begin
  182.   init;
  183.   run;
  184. end.