home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kompon / d123456 / MOON20.ZIP / AH_IDE.PAS < prev    next >
Pascal/Delphi Source File  |  2001-07-06  |  4KB  |  145 lines
  1. unit ah_ide;
  2. { Copyright 1997 Andreas H÷rstemeier               Version 1.0 of 1998-05-13 }
  3. { this file is public domain - please check the file readme.txt for          }
  4. { more detailed info on usage and distributing                               }
  5.  
  6.  {$i ah_def.inc }
  7. (*@/// interface *)
  8. interface
  9.  
  10. (*@/// uses *)
  11. uses
  12. (*$ifndef delphi_1 *)
  13.   windows,
  14. (*$else *)
  15.   winprocs,
  16.   wintypes,
  17. (*$endif *)
  18.   messages,
  19.   graphics,
  20.   classes,
  21.   controls,
  22.   extctrls,
  23.   (*$ifdef delphi_ge_6 *)
  24.   designintf,
  25.   DesignEditors,
  26.   (*$else *)
  27.   dsgnintf,
  28.   (*$endif *)
  29.   sysutils;
  30. (*@\\\0000000D01*)
  31.  
  32. type
  33. (*@///   t_ah_datetimeproperty=class(TFloatProperty) *)
  34. t_ah_datetimeproperty=class(TFloatProperty)
  35. protected
  36.   function parsespecialvalue(const s:string; var return:TDateTime):boolean;
  37. public
  38.   procedure edit; override;
  39.   function getattributes:TPropertyAttributes; override;
  40.   function GetValue:string; override;
  41.   procedure GetValues(Proc:TGetStrProc); override;
  42.   procedure SetValue(const value:string); override;
  43.   procedure Initialize; override;
  44.   function AllEqual:boolean; override;
  45.   end;
  46. (*@\\\0000000B01*)
  47. (*@\\\0000000701*)
  48. (*@/// implementation *)
  49. implementation
  50.  
  51. type
  52.   T_Specialdates=(sd_Now,sd_Midnight,sd_Midday,sd_Tomorrow,sd_Yesterday);
  53. const
  54.   specialvalues: array[sd_Now..sd_Yesterday] of string =
  55.     ( 'Now', 'Midnight', 'Midday', 'Tomorrow', 'Yesterday');
  56. (*@/// class t_ah_datetimeproperty(TFloatProperty) *)
  57. (*@/// procedure t_ah_datetimeproperty.edit; *)
  58. procedure t_ah_datetimeproperty.edit;
  59. begin
  60.   end;
  61. (*@\\\0000000301*)
  62. (*@/// function t_ah_datetimeproperty.getattributes:TPropertyAttributes; *)
  63. function t_ah_datetimeproperty.getattributes:TPropertyAttributes;
  64. begin
  65.   result:=[paMultiSelect,paValueList,paSortlist];
  66.   end;
  67. (*@\\\0000000301*)
  68. (*@/// function t_ah_datetimeproperty.GetValue:string; *)
  69. function t_ah_datetimeproperty.GetValue:string;
  70. begin
  71.   result:=DateTimeToStr(GetFloatValue);
  72.   end;
  73. (*@\\\0000000301*)
  74. (*@/// procedure t_ah_datetimeproperty.GetValues(Proc:TGetStrProc); *)
  75. procedure t_ah_datetimeproperty.GetValues(Proc:TGetStrProc);
  76. var
  77.   i: T_Specialdates;
  78. begin
  79.   for i:=low(specialvalues) to high(specialvalues) do
  80.     proc(specialvalues[i]);
  81.   end;
  82. (*@\\\0000000501*)
  83. (*@/// function t_ah_datetimeproperty.parsespecialvalue(const s:string;...):boolean; *)
  84. function t_ah_datetimeproperty.parsespecialvalue(const s:string; var return:TDateTime):boolean;
  85. var
  86.   i: T_Specialdates;
  87. begin
  88.   result:=false;
  89.   for i:=low(specialvalues) to high(specialvalues) do
  90.     if lowercase(s)=lowercase(specialvalues[i]) then begin
  91.       result:=true;
  92.       case i of
  93.         sd_Now:       return:=now;
  94.         sd_Midnight:  return:=trunc(now);
  95.         sd_Midday:    return:=trunc(now)+0.5;
  96.         sd_Tomorrow:  return:=now+1.0;
  97.         sd_Yesterday: return:=now-1.0;
  98.         end;
  99.       BREAK;
  100.       end;
  101.   end;
  102. (*@\\\0000000730*)
  103. (*@/// procedure t_ah_datetimeproperty.SetValue(const value:string); *)
  104. procedure t_ah_datetimeproperty.SetValue(const value:string);
  105. var
  106.   dt: TdateTime;
  107. begin
  108.   if not parsespecialvalue(value,dt) then
  109.     dt:=StrToDateTime(value);
  110.   SetFloatValue(dt);
  111.   end;
  112. (*@\\\0000000505*)
  113. (*@/// procedure t_ah_datetimeproperty.Initialize; *)
  114. procedure t_ah_datetimeproperty.Initialize;
  115. begin
  116.   inherited Initialize;
  117. (*$ifdef delphi_1 *)
  118.   GetFormatSettings;   { The Delphi 1 VCL isn't prepared for changing locale }
  119.                        { settings, so this makes an update everytime the     }
  120.                        {  editor pops up                                     }
  121. (*$endif *)
  122.   end;
  123. (*@\\\0030000503000513000703*)
  124. (*@/// function t_ah_datetimeproperty.AllEqual:boolean; *)
  125. function t_ah_datetimeproperty.AllEqual:boolean;
  126. var
  127.   i: integer;
  128.   dt: TdateTime;
  129. begin
  130.   result:=true;
  131.   dt:=getfloatvalue;
  132.   for i:=0 to propcount-1 do
  133.     if dt<>getfloatvalueat(i) then begin
  134.       result:=false;
  135.       BREAK;
  136.       end;
  137.   end;
  138. (*@\\\0000000901*)
  139. (*@\\\0000000701*)
  140.  
  141.  
  142. (*@\\\0002000A01000A01*)
  143. end.
  144. (*@\\\000D000201000201000011000805*)
  145.