| 1 | unit ORDtTm;
 | 
|---|
| 2 | 
 | 
|---|
| 3 | {$O-}
 | 
|---|
| 4 | 
 | 
|---|
| 5 | interface
 | 
|---|
| 6 | 
 | 
|---|
| 7 | uses
 | 
|---|
| 8 |   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons,
 | 
|---|
| 9 |   Grids, Calendar, ExtCtrls, ORFn, ORNet, ORDtTmCal, Mask, ComCtrls, OR2006Compatibility,
 | 
|---|
| 10 |   ORCtrls, VAClasses;
 | 
|---|
| 11 | 
 | 
|---|
| 12 | type
 | 
|---|
| 13 |   TORfrmDtTm = class(Tfrm2006Compatibility)
 | 
|---|
| 14 |     bvlFrame: TBevel;
 | 
|---|
| 15 |     lblDate: TPanel;
 | 
|---|
| 16 |     txtTime: TEdit;
 | 
|---|
| 17 |     lstHour: TListBox;
 | 
|---|
| 18 |     lstMinute: TListBox;
 | 
|---|
| 19 |     cmdOK: TButton;
 | 
|---|
| 20 |     cmdCancel: TButton;
 | 
|---|
| 21 |     calSelect: TORCalendar;
 | 
|---|
| 22 |     pnlPrevMonth: TPanel;
 | 
|---|
| 23 |     pnlNextMonth: TPanel;
 | 
|---|
| 24 |     imgPrevMonth: TImage;
 | 
|---|
| 25 |     imgNextMonth: TImage;
 | 
|---|
| 26 |     bvlRButton: TBevel;
 | 
|---|
| 27 |     cmdToday: TButton;
 | 
|---|
| 28 |     cmdNow: TButton;
 | 
|---|
| 29 |     cmdMidnight: TButton;
 | 
|---|
| 30 |     procedure FormCreate(Sender: TObject);
 | 
|---|
| 31 |     procedure calSelectChange(Sender: TObject);
 | 
|---|
| 32 |     procedure cmdTodayClick(Sender: TObject);
 | 
|---|
| 33 |     procedure txtTimeChange(Sender: TObject);
 | 
|---|
| 34 |     procedure lstHourClick(Sender: TObject);
 | 
|---|
| 35 |     procedure lstMinuteClick(Sender: TObject);
 | 
|---|
| 36 |     procedure cmdNowClick(Sender: TObject);
 | 
|---|
| 37 |     procedure cmdOKClick(Sender: TObject);
 | 
|---|
| 38 |     procedure cmdCancelClick(Sender: TObject);
 | 
|---|
| 39 |     procedure imgPrevMonthClick(Sender: TObject);
 | 
|---|
| 40 |     procedure imgNextMonthClick(Sender: TObject);
 | 
|---|
| 41 |     procedure imgPrevMonthMouseDown(Sender: TObject; Button: TMouseButton;
 | 
|---|
| 42 |       Shift: TShiftState; X, Y: Integer);
 | 
|---|
| 43 |     procedure imgNextMonthMouseDown(Sender: TObject; Button: TMouseButton;
 | 
|---|
| 44 |       Shift: TShiftState; X, Y: Integer);
 | 
|---|
| 45 |     procedure imgPrevMonthMouseUp(Sender: TObject; Button: TMouseButton;
 | 
|---|
| 46 |       Shift: TShiftState; X, Y: Integer);
 | 
|---|
| 47 |     procedure imgNextMonthMouseUp(Sender: TObject; Button: TMouseButton;
 | 
|---|
| 48 |       Shift: TShiftState; X, Y: Integer);
 | 
|---|
| 49 |     procedure cmdMidnightClick(Sender: TObject);
 | 
|---|
| 50 |   private
 | 
|---|
| 51 |     FFromSelf: Boolean;
 | 
|---|
| 52 |     FNowPressed:  Boolean;
 | 
|---|
| 53 |     TimeIsRequired: Boolean;
 | 
|---|
| 54 |   protected
 | 
|---|
| 55 |     procedure Loaded; override;
 | 
|---|
| 56 |   end;
 | 
|---|
| 57 | 
 | 
|---|
| 58 |   { TORDateTimeDlg }
 | 
|---|
| 59 | 
 | 
|---|
| 60 |   TORDateTimeDlg = class(TComponent)
 | 
|---|
| 61 |   private
 | 
|---|
| 62 |     FDateTime:     TDateTime;
 | 
|---|
| 63 |     FDateOnly:     Boolean;
 | 
|---|
| 64 |     FRequireTime:  Boolean;
 | 
|---|
| 65 |     FRelativeTime: string;
 | 
|---|
| 66 |     function GetFMDateTime: TFMDateTime;
 | 
|---|
| 67 |     procedure SetDateOnly(Value: Boolean);
 | 
|---|
| 68 |     procedure SetFMDateTime(Value: TFMDateTime);
 | 
|---|
| 69 |     procedure SetRequireTime(Value: Boolean);
 | 
|---|
| 70 |   public
 | 
|---|
| 71 |     constructor Create(AOwner: TComponent); override;
 | 
|---|
| 72 |     function Execute: Boolean;
 | 
|---|
| 73 |     property RelativeTime: string     read FRelativeTime;
 | 
|---|
| 74 |   published
 | 
|---|
| 75 |     property FMDateTime:  TFMDateTime read GetFMDateTime   write SetFMDateTime;
 | 
|---|
| 76 |     property DateOnly:    Boolean     read FDateOnly       write SetDateOnly;
 | 
|---|
| 77 |     property RequireTime: Boolean     read FRequireTime    write SetRequireTime;
 | 
|---|
| 78 |   end;
 | 
|---|
| 79 | 
 | 
|---|
| 80 |   // 508 class
 | 
|---|
| 81 |   TORDateButton = class (TBitBtn);
 | 
|---|
| 82 | 
 | 
|---|
| 83 |   { TORDateBox }
 | 
|---|
| 84 | 
 | 
|---|
| 85 |   TORDateEdit = class(TEdit)
 | 
|---|
| 86 |   protected
 | 
|---|
| 87 |     procedure CreateParams(var Params: TCreateParams); override;
 | 
|---|
| 88 |   end;
 | 
|---|
| 89 | 
 | 
|---|
| 90 |   TORDateBox = class(TORDateEdit, IVADynamicProperty, IORBlackColorModeCompatible)
 | 
|---|
| 91 |   private
 | 
|---|
| 92 |     FFMDateTime: TFMDateTime;
 | 
|---|
| 93 |     FDateOnly: Boolean;
 | 
|---|
| 94 |     FRequireTime: Boolean;
 | 
|---|
| 95 |     FButton: TORDateButton;
 | 
|---|
| 96 |     FFormat: string;
 | 
|---|
| 97 |     FTimeIsNow: Boolean;
 | 
|---|
| 98 |     FTemplateField: boolean;
 | 
|---|
| 99 |     FCaption: TStaticText;
 | 
|---|
| 100 |     FBlackColorMode: boolean;
 | 
|---|
| 101 |     procedure ButtonClick(Sender: TObject);
 | 
|---|
| 102 |     function GetFMDateTime: TFMDateTime;
 | 
|---|
| 103 |     function GetRelativeTime: string;
 | 
|---|
| 104 |     procedure SetDateOnly(Value: Boolean);
 | 
|---|
| 105 |     procedure SetFMDateTime(Value: TFMDateTime);
 | 
|---|
| 106 |     procedure SetEditRect;
 | 
|---|
| 107 |     procedure SetRequireTime(Value: Boolean);
 | 
|---|
| 108 |     procedure UpdateText;
 | 
|---|
| 109 |     procedure WMSize(var Message: TWMSize); message WM_SIZE;
 | 
|---|
| 110 |     procedure SetTemplateField(const Value: boolean);
 | 
|---|
| 111 |     procedure SetCaption(const Value: string);
 | 
|---|
| 112 |     function  GetCaption(): string;
 | 
|---|
| 113 |   protected
 | 
|---|
| 114 |     procedure Change; override;
 | 
|---|
| 115 |     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
 | 
|---|
| 116 |     property DateButton: TORDateButton read FButton;
 | 
|---|
| 117 |   public
 | 
|---|
| 118 |     constructor Create(AOwner: TComponent); override;
 | 
|---|
| 119 |     function IsValid: Boolean;
 | 
|---|
| 120 |     procedure Validate(var ErrMsg: string);
 | 
|---|
| 121 |     procedure SetBlackColorMode(Value: boolean);
 | 
|---|
| 122 |     function SupportsDynamicProperty(PropertyID: integer): boolean;
 | 
|---|
| 123 |     function GetDynamicProperty(PropertyID: integer): string;
 | 
|---|
| 124 |     property Format: string read FFormat write FFormat;
 | 
|---|
| 125 |     property RelativeTime: string     read GetRelativeTime;
 | 
|---|
| 126 |     property TemplateField: boolean read FTemplateField write SetTemplateField;
 | 
|---|
| 127 |   published
 | 
|---|
| 128 |     property FMDateTime:  TFMDateTime read GetFMDateTime  write SetFMDateTime;
 | 
|---|
| 129 |     property DateOnly:    Boolean     read FDateOnly    write SetDateOnly;
 | 
|---|
| 130 |     property RequireTime: Boolean     read FRequireTime write SetRequireTime;
 | 
|---|
| 131 |     property Caption: string read GetCaption write SetCaption;
 | 
|---|
| 132 |   end;
 | 
|---|
| 133 | 
 | 
|---|
| 134 |   // 508 classes
 | 
|---|
| 135 |   TORDayCombo = class (TORComboBox);
 | 
|---|
| 136 |   TORMonthCombo = class (TORComboBox);
 | 
|---|
| 137 |   TORYearEdit = class(TMaskEdit)
 | 
|---|
| 138 |   private
 | 
|---|
| 139 |     FTemplateField: boolean;
 | 
|---|
| 140 |     procedure SetTemplateField(const Value: boolean);
 | 
|---|
| 141 |   protected
 | 
|---|
| 142 |     property TemplateField: boolean read FTemplateField write SetTemplateField;
 | 
|---|
| 143 |   end;
 | 
|---|
| 144 | 
 | 
|---|
| 145 |   TORYearEditClass = Class of TORYearEdit;
 | 
|---|
| 146 | 
 | 
|---|
| 147 |   TORDateCombo = class(TCustomPanel, IORBlackColorModeCompatible)
 | 
|---|
| 148 |   private
 | 
|---|
| 149 |     FYearChanging: boolean;
 | 
|---|
| 150 |     FMonthCombo: TORMonthCombo;
 | 
|---|
| 151 |     FDayCombo: TORDayCombo;
 | 
|---|
| 152 |     FYearEdit: TORYearEdit;
 | 
|---|
| 153 |     FYearUD: TUpDown;
 | 
|---|
| 154 |     FCalBtn: TORDateButton;
 | 
|---|
| 155 |     FIncludeMonth: boolean;
 | 
|---|
| 156 |     FIncludeDay: boolean;
 | 
|---|
| 157 |     FIncludeBtn: boolean;
 | 
|---|
| 158 |     FLongMonths: boolean;
 | 
|---|
| 159 |     FMonth: integer;
 | 
|---|
| 160 |     FDay: integer;
 | 
|---|
| 161 |     FYear: integer;
 | 
|---|
| 162 |     FCtrlsCreated: boolean;
 | 
|---|
| 163 |     FOnChange: TNotifyEvent;
 | 
|---|
| 164 |     FRebuilding: boolean;
 | 
|---|
| 165 |     FTemplateField: boolean;
 | 
|---|
| 166 |     FBlackColorMode: boolean;
 | 
|---|
| 167 |     FORYearEditClass: TORYearEditClass;
 | 
|---|
| 168 |     procedure SetIncludeBtn(const Value: boolean);
 | 
|---|
| 169 |     procedure SetIncludeDay(Value: boolean);
 | 
|---|
| 170 |     procedure SetIncludeMonth(const Value: boolean);
 | 
|---|
| 171 |     procedure SetLongMonths(const Value: boolean);
 | 
|---|
| 172 |     procedure SetDay(Value: integer);
 | 
|---|
| 173 |     procedure SetMonth(Value: integer);
 | 
|---|
| 174 |     procedure SetYear(const Value: integer);
 | 
|---|
| 175 |     function GetFMDate: TFMDateTime;
 | 
|---|
| 176 |     procedure SetFMDate(const Value: TFMDateTime);
 | 
|---|
| 177 |     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
 | 
|---|
| 178 |     procedure SetTemplateField(const Value: boolean);
 | 
|---|
| 179 |   protected
 | 
|---|
| 180 |     procedure Rebuild; virtual;
 | 
|---|
| 181 |     function InitDays(GetSize: boolean): integer;
 | 
|---|
| 182 |     function InitMonths(GetSize: boolean): integer;
 | 
|---|
| 183 |     function GetYearSize: integer;
 | 
|---|
| 184 |     procedure DoChange;
 | 
|---|
| 185 |     procedure MonthChanged(Sender: TObject);
 | 
|---|
| 186 |     procedure DayChanged(Sender: TObject);
 | 
|---|
| 187 |     procedure YearChanged(Sender: TObject);
 | 
|---|
| 188 |     procedure BtnClicked(Sender: TObject);
 | 
|---|
| 189 |     procedure YearUDChange(Sender: TObject; var AllowChange: Boolean;
 | 
|---|
| 190 |                            NewValue: Smallint; Direction: TUpDownDirection);
 | 
|---|
| 191 |     procedure YearKeyPress(Sender: TObject; var Key: Char);
 | 
|---|
| 192 |     procedure CheckDays;
 | 
|---|
| 193 |     procedure Loaded; override;
 | 
|---|
| 194 |     procedure Paint; override;
 | 
|---|
| 195 |     procedure Resized(Sender: TObject);
 | 
|---|
| 196 |     property MonthCombo: TORMonthCombo read FMonthCombo;
 | 
|---|
| 197 |     property DayCombo: TORDayCombo read FDayCombo;
 | 
|---|
| 198 |     property YearEdit: TORYearEdit read FYearEdit;
 | 
|---|
| 199 |     property YearUD: TUpDown read FYearUD;
 | 
|---|
| 200 |     property CalBtn: TORDateButton read FCalBtn;
 | 
|---|
| 201 |     property ORYearEditClass: TORYearEditClass read FORYearEditClass write FORYearEditClass;
 | 
|---|
| 202 |   public
 | 
|---|
| 203 |     constructor Create(AOwner: TComponent); override;
 | 
|---|
| 204 |     destructor Destroy; override;
 | 
|---|
| 205 |     function DateText: string;
 | 
|---|
| 206 |     procedure SetBlackColorMode(Value: boolean);
 | 
|---|
| 207 |     property TemplateField: boolean read FTemplateField write SetTemplateField;
 | 
|---|
| 208 |     property FMDate: TFMDateTime read GetFMDate write SetFMDate;
 | 
|---|
| 209 |   published
 | 
|---|
| 210 |     function Text: string;
 | 
|---|
| 211 |     property IncludeBtn: boolean read FIncludeBtn write SetIncludeBtn;
 | 
|---|
| 212 |     property IncludeDay: boolean read FIncludeDay write SetIncludeDay;
 | 
|---|
| 213 |     property IncludeMonth: boolean read FIncludeMonth write SetIncludeMonth;
 | 
|---|
| 214 |     property LongMonths: boolean read FLongMonths write SetLongMonths default FALSE;
 | 
|---|
| 215 |     property Month: integer read FMonth write SetMonth;
 | 
|---|
| 216 |     property Day: integer read FDay write SetDay;
 | 
|---|
| 217 |     property Year: integer read FYear write SetYear;
 | 
|---|
| 218 |     property OnChange: TNotifyEvent read FOnChange write FOnChange;
 | 
|---|
| 219 |     property Anchors;
 | 
|---|
| 220 |     property Enabled;
 | 
|---|
| 221 |     property Font;
 | 
|---|
| 222 |     property ParentColor;
 | 
|---|
| 223 |     property ParentFont;
 | 
|---|
| 224 |     property TabOrder;
 | 
|---|
| 225 |     property TabStop;
 | 
|---|
| 226 |     property Visible;
 | 
|---|
| 227 |   end;
 | 
|---|
| 228 | 
 | 
|---|
| 229 | function IsLeapYear(AYear: Integer): Boolean;
 | 
|---|
| 230 | function DaysPerMonth(AYear, AMonth: Integer): Integer;
 | 
|---|
| 231 | 
 | 
|---|
| 232 | procedure Register;
 | 
|---|
| 233 | 
 | 
|---|
| 234 | implementation
 | 
|---|
| 235 | 
 | 
|---|
| 236 | {$R *.DFM}
 | 
|---|
| 237 | {$R ORDtTm}
 | 
|---|
| 238 | 
 | 
|---|
| 239 | const
 | 
|---|
| 240 |   FMT_DATETIME = 'mmm d,yyyy@hh:nn';
 | 
|---|
| 241 |   FMT_DATEONLY = 'mmm d,yyyy';
 | 
|---|
| 242 |   (*
 | 
|---|
| 243 |   HOURS_AMPM: array[0..23] of string[3] =
 | 
|---|
| 244 |     ('12a','  1','  2','  3','  4','  5','  6','  7','  8','  9','10 ','11 ',
 | 
|---|
| 245 |      '12p','  1','  2','  3','  4','  5','  6','  7','  8','  9','10 ','11 ');
 | 
|---|
| 246 |   HOURS_MIL:  array[0..23] of string[2] =
 | 
|---|
| 247 |     ('00','01','02','03','04','05','06','07','08','09','10','11',
 | 
|---|
| 248 |      '12','13','14','15','16','17','18','19','20','21','22','23');
 | 
|---|
| 249 |   *)
 | 
|---|
| 250 |   AdjVertSize = 8;
 | 
|---|
| 251 |   FontHeightText = 'BEFHILMSTVWXZfgjmpqtyk';
 | 
|---|
| 252 | 
 | 
|---|
| 253 | var
 | 
|---|
| 254 |   uServerToday: TFMDateTime;
 | 
|---|
| 255 | 
 | 
|---|
| 256 | { Server-dependent functions ---------------------------------------------------------------- }
 | 
|---|
| 257 | 
 | 
|---|
| 258 | function ActiveBroker: Boolean;
 | 
|---|
| 259 | begin
 | 
|---|
| 260 |   Result := False;
 | 
|---|
| 261 |   if (RPCBrokerV <> nil) and RPCBrokerV.Connected then Result := True;
 | 
|---|
| 262 | end;
 | 
|---|
| 263 | 
 | 
|---|
| 264 | function ServerFMNow: TFMDateTime;
 | 
|---|
| 265 | begin
 | 
|---|
| 266 |   if ActiveBroker
 | 
|---|
| 267 |     then Result := StrToFloat(sCallV('ORWU DT', ['NOW']))
 | 
|---|
| 268 |     else Result := DateTimeToFMDateTime(Now);
 | 
|---|
| 269 | end;
 | 
|---|
| 270 | 
 | 
|---|
| 271 | function ServerNow: TDateTime;
 | 
|---|
| 272 | begin
 | 
|---|
| 273 |   if ActiveBroker
 | 
|---|
| 274 |     then Result := FMDateTimeToDateTime(ServerFMNow)
 | 
|---|
| 275 |     else Result := Now;
 | 
|---|
| 276 | end;
 | 
|---|
| 277 | 
 | 
|---|
| 278 | function ServerToday: TDateTime;
 | 
|---|
| 279 | begin
 | 
|---|
| 280 |   if uServerToday = 0 then uServerToday := Int(ServerFMNow);
 | 
|---|
| 281 |   Result := FMDateTimeToDateTime(uServerToday);
 | 
|---|
| 282 | end;
 | 
|---|
| 283 | 
 | 
|---|
| 284 | (*
 | 
|---|
| 285 | function ServerFMToday: TFMDateTime;    // never referenced in this unit
 | 
|---|
| 286 | begin
 | 
|---|
| 287 |   if uServerToday = 0 then uServerToday := Int(ServerFMNow);
 | 
|---|
| 288 |   Result := uServerToday;
 | 
|---|
| 289 | end;
 | 
|---|
| 290 | *)
 | 
|---|
| 291 | 
 | 
|---|
| 292 | function ServerParseFMDate(const AString: string): TFMDateTime;
 | 
|---|
| 293 | begin
 | 
|---|
| 294 |   if ActiveBroker
 | 
|---|
| 295 |     then Result := StrToFloat(sCallV('ORWU DT', [AString, 'TSX']))
 | 
|---|
| 296 |     else Result := 0;
 | 
|---|
| 297 | end;
 | 
|---|
| 298 | 
 | 
|---|
| 299 | function RelativeDateTime(ADateTime: TDateTime): string;
 | 
|---|
| 300 | var
 | 
|---|
| 301 |   Offset: Integer;
 | 
|---|
| 302 |   h,n,s,l: Word;
 | 
|---|
| 303 |   ATime: string;
 | 
|---|
| 304 | begin
 | 
|---|
| 305 |   Offset := Trunc(Int(ADateTime) - Int(ServerToday));
 | 
|---|
| 306 |   if Offset < 0 then Result := 'T' + IntToStr(Offset)
 | 
|---|
| 307 |   else if Offset = 0 then Result := 'T'
 | 
|---|
| 308 |   else Result := 'T+' + IntToStr(Offset);
 | 
|---|
| 309 |   DecodeTime(ADateTime, h, n, s, l);
 | 
|---|
| 310 |   ATime := Format('@%.2d:%.2d', [h, n]);
 | 
|---|
| 311 |   if ATime <> '@00:00' then Result := Result + ATime;
 | 
|---|
| 312 | end;
 | 
|---|
| 313 | 
 | 
|---|
| 314 | procedure LoadEllipsis(bitmap: TBitMap; BlackColorMode: boolean);
 | 
|---|
| 315 | var
 | 
|---|
| 316 |   ResName: string;
 | 
|---|
| 317 | begin
 | 
|---|
| 318 |   if BlackColorMode then
 | 
|---|
| 319 |     ResName := 'BLACK_BMP_ELLIPSIS'
 | 
|---|
| 320 |   else
 | 
|---|
| 321 |     ResName := 'BMP_ELLIPSIS';
 | 
|---|
| 322 |   bitmap.LoadFromResourceName(hInstance, ResName);
 | 
|---|
| 323 | end;
 | 
|---|
| 324 | 
 | 
|---|
| 325 | { TfrmORDtTm -------------------------------------------------------------------------------- }
 | 
|---|
| 326 | 
 | 
|---|
| 327 | procedure TORfrmDtTm.FormCreate(Sender: TObject);
 | 
|---|
| 328 | begin
 | 
|---|
| 329 |   ResizeAnchoredFormToFont(self);
 | 
|---|
| 330 |   //FormStyle := fsStayOnTop;
 | 
|---|
| 331 |   lstHour.TopIndex := 6;
 | 
|---|
| 332 |   FFromSelf := False;
 | 
|---|
| 333 |   calSelectChange(Self);
 | 
|---|
| 334 | end;
 | 
|---|
| 335 | 
 | 
|---|
| 336 | procedure TORfrmDtTm.calSelectChange(Sender: TObject);
 | 
|---|
| 337 | begin
 | 
|---|
| 338 |   lblDate.Caption := FormatDateTime('mmmm d, yyyy', calSelect.CalendarDate);
 | 
|---|
| 339 |   FNowPressed := False;
 | 
|---|
| 340 | end;
 | 
|---|
| 341 | 
 | 
|---|
| 342 | procedure TORfrmDtTm.imgPrevMonthMouseDown(Sender: TObject;
 | 
|---|
| 343 |   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
 | 
|---|
| 344 | begin
 | 
|---|
| 345 |   pnlPrevMonth.BevelOuter := bvLowered;
 | 
|---|
| 346 | end;
 | 
|---|
| 347 | 
 | 
|---|
| 348 | procedure TORfrmDtTm.imgNextMonthMouseDown(Sender: TObject;
 | 
|---|
| 349 |   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
 | 
|---|
| 350 | begin
 | 
|---|
| 351 |   pnlNextMonth.BevelOuter := bvLowered;
 | 
|---|
| 352 | end;
 | 
|---|
| 353 | 
 | 
|---|
| 354 | procedure TORfrmDtTm.imgPrevMonthClick(Sender: TObject);
 | 
|---|
| 355 | begin
 | 
|---|
| 356 |   calSelect.PrevMonth;
 | 
|---|
| 357 | end;
 | 
|---|
| 358 | 
 | 
|---|
| 359 | procedure TORfrmDtTm.imgNextMonthClick(Sender: TObject);
 | 
|---|
| 360 | begin
 | 
|---|
| 361 |   calSelect.NextMonth;
 | 
|---|
| 362 | end;
 | 
|---|
| 363 | 
 | 
|---|
| 364 | procedure TORfrmDtTm.imgPrevMonthMouseUp(Sender: TObject;
 | 
|---|
| 365 |   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
 | 
|---|
| 366 | begin
 | 
|---|
| 367 |   pnlPrevMonth.BevelOuter := bvRaised;
 | 
|---|
| 368 | end;
 | 
|---|
| 369 | 
 | 
|---|
| 370 | procedure TORfrmDtTm.imgNextMonthMouseUp(Sender: TObject;
 | 
|---|
| 371 |   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
 | 
|---|
| 372 | begin
 | 
|---|
| 373 |    pnlNextMonth.BevelOuter := bvRaised;
 | 
|---|
| 374 | end;
 | 
|---|
| 375 | 
 | 
|---|
| 376 | procedure TORfrmDtTm.cmdTodayClick(Sender: TObject);
 | 
|---|
| 377 | begin
 | 
|---|
| 378 |   calSelect.CalendarDate := ServerToday;
 | 
|---|
| 379 |   lstHour.ItemIndex := -1;
 | 
|---|
| 380 |   lstMinute.ItemIndex := -1;
 | 
|---|
| 381 |   txtTime.Text := '';
 | 
|---|
| 382 | end;
 | 
|---|
| 383 | 
 | 
|---|
| 384 | procedure TORfrmDtTm.txtTimeChange(Sender: TObject);
 | 
|---|
| 385 | begin
 | 
|---|
| 386 |   if not FFromSelf then
 | 
|---|
| 387 |   begin
 | 
|---|
| 388 |     lstHour.ItemIndex := -1;
 | 
|---|
| 389 |     lstMinute.ItemIndex := -1;
 | 
|---|
| 390 |   end;
 | 
|---|
| 391 |   FNowPressed := False;
 | 
|---|
| 392 | end;
 | 
|---|
| 393 | 
 | 
|---|
| 394 | procedure TORfrmDtTm.lstHourClick(Sender: TObject);
 | 
|---|
| 395 | begin
 | 
|---|
| 396 |   if lstHour.ItemIndex = 0 then lstMinute.Items[0] := ':01  --' else lstMinute.Items[0] := ':00  --'; //<------ NEW CODE
 | 
|---|
| 397 |   if lstMinute.ItemIndex < 0 then lstMinute.ItemIndex := 0;
 | 
|---|
| 398 |   lstMinuteClick(Self);
 | 
|---|
| 399 | end;
 | 
|---|
| 400 | 
 | 
|---|
| 401 | procedure TORfrmDtTm.lstMinuteClick(Sender: TObject);
 | 
|---|
| 402 | var
 | 
|---|
| 403 |   AnHour, AMinute: Integer;
 | 
|---|
| 404 | //  AmPm: string;
 | 
|---|
| 405 | begin
 | 
|---|
| 406 |   if lstHour.ItemIndex < 0 then Exit;
 | 
|---|
| 407 | 
 | 
|---|
| 408 |   // if ampm time -
 | 
|---|
| 409 |   //case lstHour.ItemIndex of
 | 
|---|
| 410 |   //    0: AnHour := 12;
 | 
|---|
| 411 |   //1..12: AnHour := lstHour.ItemIndex;
 | 
|---|
| 412 |   //else   AnHour := lstHour.ItemIndex - 12;
 | 
|---|
| 413 |   //end;
 | 
|---|
| 414 |   //if lstHour.ItemIndex > 11 then AmPm := 'PM' else AmPm := 'AM';
 | 
|---|
| 415 | 
 | 
|---|
| 416 |   // if military time
 | 
|---|
| 417 |   AnHour := lstHour.ItemIndex;
 | 
|---|
| 418 | 
 | 
|---|
| 419 |   AMinute := lstMinute.ItemIndex * 5;
 | 
|---|
| 420 |   if (AnHour = 0) and (AMinute = 0) then AMinute := 1;  //<-------------- NEW CODE
 | 
|---|
| 421 |   FFromSelf := True;
 | 
|---|
| 422 |   // if ampm time -
 | 
|---|
| 423 |   //txtTime.Text := Format('%d:%.2d ' + AmPm, [AnHour, AMinute]);
 | 
|---|
| 424 | 
 | 
|---|
| 425 |   // if military time
 | 
|---|
| 426 |   txtTime.Text := Format('%.2d:%.2d ', [AnHour, AMinute]);
 | 
|---|
| 427 | 
 | 
|---|
| 428 |   FFromSelf := False;
 | 
|---|
| 429 | end;
 | 
|---|
| 430 | 
 | 
|---|
| 431 | procedure TORfrmDtTm.cmdNowClick(Sender: TObject);
 | 
|---|
| 432 | begin
 | 
|---|
| 433 |   calSelect.CalendarDate := ServerToday;
 | 
|---|
| 434 |   //txtTime.Text := FormatDateTime('h:nn ampm', ServerNow);  // if ampm time
 | 
|---|
| 435 |   txtTime.Text := FormatDateTime('hh:nn', ServerNow);        // if ampm time
 | 
|---|
| 436 |   FNowPressed := True;
 | 
|---|
| 437 | end;
 | 
|---|
| 438 | 
 | 
|---|
| 439 | procedure TORfrmDtTm.cmdMidnightClick(Sender: TObject);
 | 
|---|
| 440 | begin
 | 
|---|
| 441 |   //txtTime.Text := '11:59 PM';  // if ampm time
 | 
|---|
| 442 |   txtTime.Text := '23:59';      // if military time
 | 
|---|
| 443 | end;
 | 
|---|
| 444 | 
 | 
|---|
| 445 | procedure TORfrmDtTm.cmdOKClick(Sender: TObject);
 | 
|---|
| 446 | var
 | 
|---|
| 447 |   x: string;
 | 
|---|
| 448 | begin
 | 
|---|
| 449 |   if TimeIsRequired and (Length(txtTime.Text) = 0) then
 | 
|---|
| 450 |   begin
 | 
|---|
| 451 |     InfoBox('An entry for time is required.', 'Missing Time', MB_OK);
 | 
|---|
| 452 |     Exit;
 | 
|---|
| 453 |   end;
 | 
|---|
| 454 |   if Length(txtTime.Text) > 0 then
 | 
|---|
| 455 |   begin
 | 
|---|
| 456 |     x := Trim(txtTime.Text);
 | 
|---|
| 457 |     //if (x='00:00') or (x='0:00') or (x='00:00:00') or (x='0:00:00') then x := '00:00:01';
 | 
|---|
| 458 |     if (x='00:00') or (x='0:00') or (x='00:00:00') or (x='0:00:00') then x := '00:01';  //<------- CHANGED CODE
 | 
|---|
| 459 |     StrToTime(x);
 | 
|---|
| 460 |     txtTime.Text := x;
 | 
|---|
| 461 |   end;
 | 
|---|
| 462 |   ModalResult := mrOK;
 | 
|---|
| 463 | end;
 | 
|---|
| 464 | 
 | 
|---|
| 465 | procedure TORfrmDtTm.cmdCancelClick(Sender: TObject);
 | 
|---|
| 466 | begin
 | 
|---|
| 467 |   ModalResult := mrCancel;
 | 
|---|
| 468 | end;
 | 
|---|
| 469 | 
 | 
|---|
| 470 | procedure TORfrmDtTm.Loaded;
 | 
|---|
| 471 | begin
 | 
|---|
| 472 |   inherited Loaded;
 | 
|---|
| 473 |   UpdateColorsFor508Compliance(Self);
 | 
|---|
| 474 | end;
 | 
|---|
| 475 | 
 | 
|---|
| 476 | { TORDateTimeDlg }
 | 
|---|
| 477 | 
 | 
|---|
| 478 | constructor TORDateTimeDlg.Create(AOwner: TComponent);
 | 
|---|
| 479 | begin
 | 
|---|
| 480 |   inherited Create(AOwner);
 | 
|---|
| 481 |   if not (csDesigning in ComponentState)
 | 
|---|
| 482 |     then FDateTime := ServerToday
 | 
|---|
| 483 |     else FDateTime  := SysUtils.Date;
 | 
|---|
| 484 | end;
 | 
|---|
| 485 | 
 | 
|---|
| 486 | function TORDateTimeDlg.Execute: Boolean;
 | 
|---|
| 487 | const
 | 
|---|
| 488 |   HORZ_SPACING = 8;
 | 
|---|
| 489 | var
 | 
|---|
| 490 |   frmDtTm: TORfrmDtTm;
 | 
|---|
| 491 | begin
 | 
|---|
| 492 |   frmDtTm := TORfrmDtTm.Create(Application);
 | 
|---|
| 493 |   try
 | 
|---|
| 494 |     with frmDtTm do
 | 
|---|
| 495 |     begin
 | 
|---|
| 496 |       calSelect.CalendarDate := Int(FDateTime);
 | 
|---|
| 497 |       if Frac(FDateTime) > 0
 | 
|---|
| 498 |         //then txtTime.Text := FormatDateTime('h:nn ampm', FDateTime);  // if ampm time
 | 
|---|
| 499 |         then txtTime.Text := FormatDateTime('hh:nn', FDateTime);        // if military time
 | 
|---|
| 500 |       if RequireTime then TimeIsRequired := True;
 | 
|---|
| 501 |       if DateOnly then
 | 
|---|
| 502 |       begin
 | 
|---|
| 503 |         txtTime.Visible     := False;
 | 
|---|
| 504 |         lstHour.Visible     := False;
 | 
|---|
| 505 |         lstMinute.Visible   := False;
 | 
|---|
| 506 |         cmdNow.Visible      := False;
 | 
|---|
| 507 |         cmdMidnight.Visible := False;
 | 
|---|
| 508 |         bvlFrame.Width := bvlFrame.Width - txtTime.Width - HORZ_SPACING;
 | 
|---|
| 509 |         cmdOK.Left := cmdOK.Left - txtTime.Width - HORZ_SPACING;
 | 
|---|
| 510 |         cmdCancel.Left := cmdOK.Left;
 | 
|---|
| 511 |         ClientWidth := ClientWidth - txtTime.Width - HORZ_SPACING;
 | 
|---|
| 512 |       end;
 | 
|---|
| 513 |       Result := (ShowModal = IDOK);
 | 
|---|
| 514 |       if Result then
 | 
|---|
| 515 |       begin
 | 
|---|
| 516 |         FDateTime := Int(calSelect.CalendarDate);
 | 
|---|
| 517 |         if Length(txtTime.Text) > 0 then FDateTime := FDateTime + StrToTime(txtTime.Text);
 | 
|---|
| 518 |         if FNowPressed
 | 
|---|
| 519 |           then FRelativeTime := 'NOW'
 | 
|---|
| 520 |           else FRelativeTime := RelativeDateTime(FDateTime);
 | 
|---|
| 521 |       end;
 | 
|---|
| 522 |     end;
 | 
|---|
| 523 |   finally
 | 
|---|
| 524 |     frmDtTm.Free;
 | 
|---|
| 525 |   end;
 | 
|---|
| 526 | end;
 | 
|---|
| 527 | 
 | 
|---|
| 528 | function TORDateTimeDlg.GetFMDateTime: TFMDateTime;
 | 
|---|
| 529 | begin
 | 
|---|
| 530 |   Result := DateTimeToFMDateTime(FDateTime);
 | 
|---|
| 531 | end;
 | 
|---|
| 532 | 
 | 
|---|
| 533 | procedure TORDateTimeDlg.SetDateOnly(Value: Boolean);
 | 
|---|
| 534 | begin
 | 
|---|
| 535 |   FDateOnly := Value;
 | 
|---|
| 536 |   if FDateOnly then
 | 
|---|
| 537 |   begin
 | 
|---|
| 538 |     FRequireTime := False;
 | 
|---|
| 539 |     FDateTime := Int(FDateTime);
 | 
|---|
| 540 |   end;
 | 
|---|
| 541 | end;
 | 
|---|
| 542 | 
 | 
|---|
| 543 | procedure TORDateTimeDlg.SetFMDateTime(Value: TFMDateTime);
 | 
|---|
| 544 | begin
 | 
|---|
| 545 |   if Value > 0 then FDateTime := FMDateTimeToDateTime(Value);
 | 
|---|
| 546 | end;
 | 
|---|
| 547 | 
 | 
|---|
| 548 | procedure TORDateTimeDlg.SetRequireTime(Value: Boolean);
 | 
|---|
| 549 | begin
 | 
|---|
| 550 |   FRequireTime := Value;
 | 
|---|
| 551 |   if FRequireTime then FDateOnly := False;
 | 
|---|
| 552 | end;
 | 
|---|
| 553 | 
 | 
|---|
| 554 | { TORDateEdit ----------------------------------------------------------------------------- }
 | 
|---|
| 555 | 
 | 
|---|
| 556 | procedure TORDateEdit.CreateParams(var Params: TCreateParams);
 | 
|---|
| 557 | { sets a one line edit box to multiline style so the editing rectangle can be changed }
 | 
|---|
| 558 | begin
 | 
|---|
| 559 |   inherited CreateParams(Params);
 | 
|---|
| 560 |   Params.Style := Params.Style or ES_MULTILINE or WS_CLIPCHILDREN;
 | 
|---|
| 561 | end;
 | 
|---|
| 562 | 
 | 
|---|
| 563 | 
 | 
|---|
| 564 | { TORDateBox -------------------------------------------------------------------------------- }
 | 
|---|
| 565 | 
 | 
|---|
| 566 | constructor TORDateBox.Create(AOwner: TComponent);
 | 
|---|
| 567 | begin
 | 
|---|
| 568 |   inherited Create(AOwner);
 | 
|---|
| 569 |   FButton := TORDateButton.Create(Self);
 | 
|---|
| 570 |   FButton.Parent := Self;
 | 
|---|
| 571 |   FButton.Width := 18;
 | 
|---|
| 572 |   FButton.Height := 17;
 | 
|---|
| 573 |   FButton.OnClick := ButtonClick;
 | 
|---|
| 574 |   FButton.TabStop := False;
 | 
|---|
| 575 |   FBlackColorMode := False;
 | 
|---|
| 576 |   LoadEllipsis(FButton.Glyph, FALSE);
 | 
|---|
| 577 |   FButton.Visible := True;
 | 
|---|
| 578 |   FFormat := FMT_DATETIME;
 | 
|---|
| 579 | end;
 | 
|---|
| 580 | 
 | 
|---|
| 581 | procedure TORDateBox.WMSize(var Message: TWMSize);
 | 
|---|
| 582 | var
 | 
|---|
| 583 |   ofs: integer;
 | 
|---|
| 584 | 
 | 
|---|
| 585 | begin
 | 
|---|
| 586 |   inherited;
 | 
|---|
| 587 |   if assigned(FButton) then
 | 
|---|
| 588 |   begin
 | 
|---|
| 589 |     if BorderStyle = bsNone then
 | 
|---|
| 590 |       ofs := 0
 | 
|---|
| 591 |     else
 | 
|---|
| 592 |       ofs := 4;
 | 
|---|
| 593 |     FButton.SetBounds(Width - FButton.Width - ofs, 0, FButton.Width, Height - ofs);
 | 
|---|
| 594 |   end;
 | 
|---|
| 595 |   SetEditRect;
 | 
|---|
| 596 | end;
 | 
|---|
| 597 | 
 | 
|---|
| 598 | procedure TORDateBox.SetTemplateField(const Value: boolean);
 | 
|---|
| 599 | var
 | 
|---|
| 600 |   Y: integer;
 | 
|---|
| 601 | 
 | 
|---|
| 602 | begin
 | 
|---|
| 603 |   if(FTemplateField <> Value) then
 | 
|---|
| 604 |   begin
 | 
|---|
| 605 |     FTemplateField := Value;
 | 
|---|
| 606 |     Y := TextHeightByFont(Font.Handle, FontHeightText);
 | 
|---|
| 607 |     if Value then
 | 
|---|
| 608 |     begin
 | 
|---|
| 609 |       FButton.Width := Y+2;
 | 
|---|
| 610 |       Height := Y;
 | 
|---|
| 611 |       BorderStyle := bsNone;
 | 
|---|
| 612 |     end
 | 
|---|
| 613 |     else
 | 
|---|
| 614 |     begin
 | 
|---|
| 615 |       FButton.Width := 18;
 | 
|---|
| 616 |       Height := y + AdjVertSize;
 | 
|---|
| 617 |       BorderStyle := bsSingle;
 | 
|---|
| 618 |     end;
 | 
|---|
| 619 |   end;
 | 
|---|
| 620 | end;
 | 
|---|
| 621 | 
 | 
|---|
| 622 | function TORDateBox.SupportsDynamicProperty(PropertyID: integer): boolean;
 | 
|---|
| 623 | begin
 | 
|---|
| 624 |   Result := (PropertyID = DynaPropAccesibilityCaption);
 | 
|---|
| 625 | end;
 | 
|---|
| 626 | 
 | 
|---|
| 627 | procedure TORDateBox.ButtonClick(Sender: TObject);
 | 
|---|
| 628 | var
 | 
|---|
| 629 |   DateDialog: TORDateTimeDlg;
 | 
|---|
| 630 |   ParsedDate: TFMDateTime;
 | 
|---|
| 631 | begin
 | 
|---|
| 632 |   DateDialog := TORDateTimeDlg.Create(Application);
 | 
|---|
| 633 |   if Length(Text) > 0 then
 | 
|---|
| 634 |   begin
 | 
|---|
| 635 |     ParsedDate := ServerParseFMDate(Text);
 | 
|---|
| 636 |     if ParsedDate > -1 then FFMDateTime := ParsedDate else FFMDateTime := 0;
 | 
|---|
| 637 |   end;
 | 
|---|
| 638 |   DateDialog.DateOnly := FDateOnly;
 | 
|---|
| 639 |   DateDialog.FMDateTime := FFMDateTime;
 | 
|---|
| 640 |   DateDialog.RequireTime := FRequireTime;
 | 
|---|
| 641 |   if DateDialog.Execute then
 | 
|---|
| 642 |   begin
 | 
|---|
| 643 |     FFMDateTime := DateDialog.FMDateTime;
 | 
|---|
| 644 |     UpdateText;
 | 
|---|
| 645 |     FTimeIsNow := DateDialog.RelativeTime = 'NOW';
 | 
|---|
| 646 |   end;
 | 
|---|
| 647 |   DateDialog.Free;
 | 
|---|
| 648 |   if Visible and Enabled then //Some events may hide the component
 | 
|---|
| 649 |     SetFocus;
 | 
|---|
| 650 | end;
 | 
|---|
| 651 | 
 | 
|---|
| 652 | procedure TORDateBox.Change;
 | 
|---|
| 653 | begin
 | 
|---|
| 654 |   inherited Change;
 | 
|---|
| 655 |   FTimeIsNow := False;
 | 
|---|
| 656 | end;
 | 
|---|
| 657 | 
 | 
|---|
| 658 | procedure TORDateBox.KeyDown(var Key: Word; Shift: TShiftState);
 | 
|---|
| 659 | begin
 | 
|---|
| 660 |   inherited KeyDown(Key, Shift);
 | 
|---|
| 661 |   if (Key = VK_RETURN) then begin
 | 
|---|
| 662 |     FButton.Click;
 | 
|---|
| 663 |     Key := 0;
 | 
|---|
| 664 |   end;
 | 
|---|
| 665 | end;
 | 
|---|
| 666 | 
 | 
|---|
| 667 | function TORDateBox.GetFMDateTime: TFMDateTime;
 | 
|---|
| 668 | begin
 | 
|---|
| 669 |   Result := 0;
 | 
|---|
| 670 |   if Length(Text) > 0 then Result := ServerParseFMDate(Text);
 | 
|---|
| 671 |   FFMDateTime := Result;
 | 
|---|
| 672 | end;
 | 
|---|
| 673 | 
 | 
|---|
| 674 | function TORDateBox.GetRelativeTime: string;
 | 
|---|
| 675 | begin
 | 
|---|
| 676 |   Result := '';
 | 
|---|
| 677 |   if FTimeIsNow then Result := 'NOW'
 | 
|---|
| 678 |   else if UpperCase(Text) = 'NOW' then Result := 'NOW'
 | 
|---|
| 679 |   else if Length(Text) > 0 then
 | 
|---|
| 680 |   begin
 | 
|---|
| 681 |     FFMDateTime := ServerParseFMDate(Text);
 | 
|---|
| 682 |     if FFMDateTime > 0 then Result := RelativeDateTime(FMDateTimeToDateTime(FFMDateTime));
 | 
|---|
| 683 |   end;
 | 
|---|
| 684 | end;
 | 
|---|
| 685 | 
 | 
|---|
| 686 | procedure TORDateBox.SetDateOnly(Value: Boolean);
 | 
|---|
| 687 | begin
 | 
|---|
| 688 |   FDateOnly := Value;
 | 
|---|
| 689 |   if FDateOnly then
 | 
|---|
| 690 |   begin
 | 
|---|
| 691 |     FRequireTime := False;
 | 
|---|
| 692 |     FFMDateTime := Int(FFMDateTime);
 | 
|---|
| 693 |     if FFormat = FMT_DATETIME then FFormat := FMT_DATEONLY;
 | 
|---|
| 694 |   end;
 | 
|---|
| 695 |   UpdateText;
 | 
|---|
| 696 | end;
 | 
|---|
| 697 | 
 | 
|---|
| 698 | procedure TORDateBox.SetFMDateTime(Value: TFMDateTime);
 | 
|---|
| 699 | begin
 | 
|---|
| 700 |   FFMDateTime := Value;
 | 
|---|
| 701 |   UpdateText;
 | 
|---|
| 702 | end;
 | 
|---|
| 703 | 
 | 
|---|
| 704 | procedure TORDateBox.SetRequireTime(Value: Boolean);
 | 
|---|
| 705 | begin
 | 
|---|
| 706 |   FRequireTime := Value;
 | 
|---|
| 707 |   if FRequireTime then
 | 
|---|
| 708 |   begin
 | 
|---|
| 709 |     if FFormat = FMT_DATEONLY then FFormat := FMT_DATETIME;
 | 
|---|
| 710 |     SetDateOnly(False);
 | 
|---|
| 711 |   end;
 | 
|---|
| 712 | end;
 | 
|---|
| 713 | 
 | 
|---|
| 714 | procedure TORDateBox.SetEditRect;
 | 
|---|
| 715 | { change the edit rectangle to not hide the calendar button - taken from SPIN.PAS sample }
 | 
|---|
| 716 | var
 | 
|---|
| 717 |   Loc: TRect;
 | 
|---|
| 718 | begin
 | 
|---|
| 719 |   SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc));
 | 
|---|
| 720 |   Loc.Bottom := ClientHeight + 1;               // +1 is workaround for windows paint bug
 | 
|---|
| 721 |   Loc.Right  := FButton.Left - 2;
 | 
|---|
| 722 |   Loc.Top    := 0;
 | 
|---|
| 723 |   Loc.Left   := 0;
 | 
|---|
| 724 |   SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@Loc));
 | 
|---|
| 725 | end;
 | 
|---|
| 726 | 
 | 
|---|
| 727 | procedure TORDateBox.UpdateText;
 | 
|---|
| 728 | begin
 | 
|---|
| 729 |   if FFMDateTime > 0 then
 | 
|---|
| 730 |   begin
 | 
|---|
| 731 |     if (FFormat =FMT_DATETIME) and (Frac(FFMDateTime) = 0)
 | 
|---|
| 732 |       then Text := FormatFMDateTime(FMT_DATEONLY, FFMDateTime)
 | 
|---|
| 733 |       else Text := FormatFMDateTime(FFormat, FFMDateTime);
 | 
|---|
| 734 |   end;
 | 
|---|
| 735 | end;
 | 
|---|
| 736 | 
 | 
|---|
| 737 | procedure TORDateBox.Validate(var ErrMsg: string);
 | 
|---|
| 738 | begin
 | 
|---|
| 739 |   ErrMsg := '';
 | 
|---|
| 740 |   if Length(Text) > 0 then
 | 
|---|
| 741 |   begin
 | 
|---|
| 742 |     FFMDateTime := ServerParseFMDate(Text);
 | 
|---|
| 743 |     if FFMDateTime <= 0 then Errmsg := 'Invalid Date/Time';
 | 
|---|
| 744 |     if FRequireTime and (Frac(FFMDateTime) = 0) then ErrMsg := 'Time Required';
 | 
|---|
| 745 |     if FDateOnly    and (Frac(FFMDateTime) > 0) then ErrMsg := 'Time not Required';
 | 
|---|
| 746 |   end;
 | 
|---|
| 747 | end;
 | 
|---|
| 748 | 
 | 
|---|
| 749 | function TORDateBox.IsValid: Boolean;
 | 
|---|
| 750 | var
 | 
|---|
| 751 |   x: string;
 | 
|---|
| 752 | begin
 | 
|---|
| 753 |   Validate(x);
 | 
|---|
| 754 |   if Length(x) = 0 then Result := True else Result := False;
 | 
|---|
| 755 |   if Length(Text) = 0 then Result := False;
 | 
|---|
| 756 | end;
 | 
|---|
| 757 | 
 | 
|---|
| 758 | procedure TORDateBox.SetBlackColorMode(Value: boolean);
 | 
|---|
| 759 | begin
 | 
|---|
| 760 |   if FBlackColorMode <> Value then
 | 
|---|
| 761 |   begin
 | 
|---|
| 762 |     FBlackColorMode := Value;
 | 
|---|
| 763 |     LoadEllipsis(FButton.Glyph, FBlackColorMode);
 | 
|---|
| 764 |   end;
 | 
|---|
| 765 | end;
 | 
|---|
| 766 | 
 | 
|---|
| 767 | procedure TORDateBox.SetCaption(const Value: string);
 | 
|---|
| 768 | begin
 | 
|---|
| 769 |     if not Assigned(FCaption) then begin
 | 
|---|
| 770 |        FCaption := TStaticText.Create(self);
 | 
|---|
| 771 |        FCaption.AutoSize := False;
 | 
|---|
| 772 |        FCaption.Height := 0;
 | 
|---|
| 773 |        FCaption.Width  := 0;
 | 
|---|
| 774 |        FCaption.Visible := True;
 | 
|---|
| 775 |        FCaption.Parent := Parent;
 | 
|---|
| 776 |        FCaption.BringtoFront;
 | 
|---|
| 777 |     end;
 | 
|---|
| 778 |     FCaption.Caption := Value;
 | 
|---|
| 779 | end;
 | 
|---|
| 780 | 
 | 
|---|
| 781 | function TORDateBox.GetCaption(): string;
 | 
|---|
| 782 | begin
 | 
|---|
| 783 |     result := FCaption.Caption;
 | 
|---|
| 784 | end;
 | 
|---|
| 785 | 
 | 
|---|
| 786 | function TORDateBox.GetDynamicProperty(PropertyID: integer): string;
 | 
|---|
| 787 | begin
 | 
|---|
| 788 |   if PropertyID = DynaPropAccesibilityCaption then
 | 
|---|
| 789 |     Result := GetCaption
 | 
|---|
| 790 |   else
 | 
|---|
| 791 |     Result := '';
 | 
|---|
| 792 | end;
 | 
|---|
| 793 | 
 | 
|---|
| 794 | function IsLeapYear(AYear: Integer): Boolean;
 | 
|---|
| 795 | begin
 | 
|---|
| 796 |   Result := (AYear mod 4 = 0) and ((AYear mod 100 <> 0) or (AYear mod 400 = 0));
 | 
|---|
| 797 | end;
 | 
|---|
| 798 | 
 | 
|---|
| 799 | function DaysPerMonth(AYear, AMonth: Integer): Integer;
 | 
|---|
| 800 | const
 | 
|---|
| 801 |   DaysInMonth: array[1..12] of Integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
 | 
|---|
| 802 | 
 | 
|---|
| 803 | begin
 | 
|---|
| 804 |   if(AYear < 1) or (AMonth < 1) then
 | 
|---|
| 805 |     Result := 0
 | 
|---|
| 806 |   else
 | 
|---|
| 807 |   begin
 | 
|---|
| 808 |     Result := DaysInMonth[AMonth];
 | 
|---|
| 809 |     if (AMonth = 2) and IsLeapYear(AYear) then Inc(Result); { leap-year Feb is special }
 | 
|---|
| 810 |   end;
 | 
|---|
| 811 | end;
 | 
|---|
| 812 | 
 | 
|---|
| 813 | { TORDateCombo ------------------------------------------------------------------------- }
 | 
|---|
| 814 | 
 | 
|---|
| 815 | const
 | 
|---|
| 816 |   ComboBoxAdjSize = 24;
 | 
|---|
| 817 |   EditAdjHorzSize = 8;
 | 
|---|
| 818 |   DateComboCtrlGap = 2;
 | 
|---|
| 819 |   FirstYear = 1800;
 | 
|---|
| 820 |   LastYear = 2200;
 | 
|---|
| 821 | 
 | 
|---|
| 822 | { TORDateComboEdit }
 | 
|---|
| 823 | 
 | 
|---|
| 824 | procedure TORYearEdit.SetTemplateField(const Value: boolean);
 | 
|---|
| 825 | begin
 | 
|---|
| 826 |   if(FTemplateField <> Value) then
 | 
|---|
| 827 |   begin
 | 
|---|
| 828 |     FTemplateField := Value;
 | 
|---|
| 829 |     if Value then
 | 
|---|
| 830 |       BorderStyle := bsNone
 | 
|---|
| 831 |     else
 | 
|---|
| 832 |       BorderStyle := bsSingle;
 | 
|---|
| 833 |   end;
 | 
|---|
| 834 | end;
 | 
|---|
| 835 | 
 | 
|---|
| 836 | { TORDateCombo }
 | 
|---|
| 837 | 
 | 
|---|
| 838 | constructor TORDateCombo.Create(AOwner: TComponent);
 | 
|---|
| 839 | begin
 | 
|---|
| 840 |   inherited;
 | 
|---|
| 841 |   ControlStyle := ControlStyle - [csSetCaption, csAcceptsControls];
 | 
|---|
| 842 |   BevelOuter := bvNone;
 | 
|---|
| 843 |   FIncludeMonth := TRUE;
 | 
|---|
| 844 |   FIncludeDay := TRUE;
 | 
|---|
| 845 |   FIncludeBtn := TRUE;
 | 
|---|
| 846 |   OnResize := Resized;
 | 
|---|
| 847 |   FORYearEditClass := TORYearEdit;
 | 
|---|
| 848 | end;
 | 
|---|
| 849 | 
 | 
|---|
| 850 | destructor TORDateCombo.Destroy;
 | 
|---|
| 851 | begin
 | 
|---|
| 852 |   KillObj(@FMonthCombo);
 | 
|---|
| 853 |   KillObj(@FDayCombo);
 | 
|---|
| 854 |   KillObj(@FYearEdit);
 | 
|---|
| 855 |   KillObj(@FYearUD);
 | 
|---|
| 856 |   KillObj(@FCalBtn);
 | 
|---|
| 857 |   inherited;
 | 
|---|
| 858 | end;
 | 
|---|
| 859 | 
 | 
|---|
| 860 | function TORDateCombo.GetYearSize: integer;
 | 
|---|
| 861 | begin
 | 
|---|
| 862 |   Result := TextWidthByFont(Font.Handle, '8888') + EditAdjHorzSize;
 | 
|---|
| 863 | end;
 | 
|---|
| 864 | 
 | 
|---|
| 865 | function TORDateCombo.InitDays(GetSize: boolean): integer;
 | 
|---|
| 866 | var
 | 
|---|
| 867 |   dy: integer;
 | 
|---|
| 868 | 
 | 
|---|
| 869 | begin
 | 
|---|
| 870 |   Result := 0;
 | 
|---|
| 871 |   if(assigned(FDayCombo)) then
 | 
|---|
| 872 |   begin
 | 
|---|
| 873 |     dy := DaysPerMonth(FYear, FMonth) + 1;
 | 
|---|
| 874 |     while (FDayCombo.Items.Count < dy) do
 | 
|---|
| 875 |     begin
 | 
|---|
| 876 |       if(FDayCombo.Items.Count = 0) then
 | 
|---|
| 877 |         FDayCombo.Items.Add(' ')
 | 
|---|
| 878 |       else
 | 
|---|
| 879 |         FDayCombo.Items.Add(inttostr(FDayCombo.Items.Count));
 | 
|---|
| 880 |     end;
 | 
|---|
| 881 |     while (FDayCombo.Items.Count > dy) do
 | 
|---|
| 882 |       FDayCombo.Items.Delete(FDayCombo.Items.Count-1);
 | 
|---|
| 883 |     if(GetSize) then
 | 
|---|
| 884 |       Result := TextWidthByFont(Font.Handle, '88') + ComboBoxAdjSize;
 | 
|---|
| 885 |     if(FDay > (dy-1)) then
 | 
|---|
| 886 |       SetDay(dy-1);
 | 
|---|
| 887 |   end;
 | 
|---|
| 888 | end;
 | 
|---|
| 889 | 
 | 
|---|
| 890 | function TORDateCombo.InitMonths(GetSize: boolean): integer;
 | 
|---|
| 891 | var
 | 
|---|
| 892 |   i, Size: integer;
 | 
|---|
| 893 | 
 | 
|---|
| 894 | begin
 | 
|---|
| 895 |   Result := 0;
 | 
|---|
| 896 |   if(assigned(FMonthCombo)) then
 | 
|---|
| 897 |   begin
 | 
|---|
| 898 |     FMonthCombo.Items.Clear;
 | 
|---|
| 899 |     FMonthCombo.Items.Add(' ');
 | 
|---|
| 900 |     for i := 1 to 12 do
 | 
|---|
| 901 |     begin
 | 
|---|
| 902 |       if FLongMonths then
 | 
|---|
| 903 |         FMonthCombo.Items.Add(LongMonthNames[i])
 | 
|---|
| 904 |       else
 | 
|---|
| 905 |         FMonthCombo.Items.Add(ShortMonthNames[i]);
 | 
|---|
| 906 |       if(GetSize) then
 | 
|---|
| 907 |       begin
 | 
|---|
| 908 |         Size := TextWidthByFont(Font.Handle, FMonthCombo.Items[i]);
 | 
|---|
| 909 |         if(Result < Size) then
 | 
|---|
| 910 |           Result := Size;
 | 
|---|
| 911 |       end;
 | 
|---|
| 912 |     end;
 | 
|---|
| 913 |     if(GetSize) then
 | 
|---|
| 914 |       inc(Result, ComboBoxAdjSize);
 | 
|---|
| 915 |   end;
 | 
|---|
| 916 | end;
 | 
|---|
| 917 | 
 | 
|---|
| 918 | procedure TORDateCombo.Rebuild;
 | 
|---|
| 919 | var
 | 
|---|
| 920 |   Wide, X, Y: integer;
 | 
|---|
| 921 | 
 | 
|---|
| 922 | begin
 | 
|---|
| 923 |   if(not FRebuilding) then
 | 
|---|
| 924 |   begin
 | 
|---|
| 925 |     FRebuilding := TRUE;
 | 
|---|
| 926 |     try
 | 
|---|
| 927 |       ControlStyle := ControlStyle + [csAcceptsControls];
 | 
|---|
| 928 |       try
 | 
|---|
| 929 |         Y := TextHeightByFont(Font.Handle, FontHeightText);
 | 
|---|
| 930 |         if not FTemplateField then
 | 
|---|
| 931 |           inc(Y,AdjVertSize);
 | 
|---|
| 932 |         X := 0;
 | 
|---|
| 933 |         if(FIncludeMonth) then
 | 
|---|
| 934 |         begin
 | 
|---|
| 935 |           if(not assigned(FMonthCombo)) then
 | 
|---|
| 936 |           begin
 | 
|---|
| 937 |             FMonthCombo := TORMonthCombo.Create(Self);
 | 
|---|
| 938 |             FMonthCombo.Parent := Self;
 | 
|---|
| 939 |             FMonthCombo.Top := 0;
 | 
|---|
| 940 |             FMonthCombo.Left := 0;
 | 
|---|
| 941 |             FMonthCombo.Style := orcsDropDown;
 | 
|---|
| 942 |             FMonthCombo.DropDownCount := 13;
 | 
|---|
| 943 |             FMonthCombo.ListItemsOnly := True;
 | 
|---|
| 944 |             FMonthCombo.OnChange := MonthChanged;
 | 
|---|
| 945 |           end;
 | 
|---|
| 946 |           FMonthCombo.Font := Font;
 | 
|---|
| 947 |           FMonthCombo.TemplateField := FTemplateField;
 | 
|---|
| 948 |           Wide := InitMonths(TRUE);
 | 
|---|
| 949 |           FMonthCombo.Width := Wide;
 | 
|---|
| 950 |           FMonthCombo.Height := Y;
 | 
|---|
| 951 |           FMonthCombo.ItemIndex := FMonth;
 | 
|---|
| 952 |           inc(X, Wide + DateComboCtrlGap);
 | 
|---|
| 953 | 
 | 
|---|
| 954 |           if(FIncludeDay) then
 | 
|---|
| 955 |           begin
 | 
|---|
| 956 |             if(not assigned(FDayCombo)) then
 | 
|---|
| 957 |             begin
 | 
|---|
| 958 |               FDayCombo := TORDayCombo.Create(Self);
 | 
|---|
| 959 |               FDayCombo.Parent := Self;
 | 
|---|
| 960 |               FDayCombo.Top := 0;
 | 
|---|
| 961 |               FDayCombo.Style := orcsDropDown;
 | 
|---|
| 962 |               FDayCombo.ListItemsOnly := True;
 | 
|---|
| 963 |               FDayCombo.OnChange := DayChanged;
 | 
|---|
| 964 |               FDayCombo.DropDownCount := 11;
 | 
|---|
| 965 |             end;
 | 
|---|
| 966 |             FDayCombo.Font := Font;
 | 
|---|
| 967 |             FDayCombo.TemplateField := FTemplateField;
 | 
|---|
| 968 |             Wide := InitDays(TRUE);
 | 
|---|
| 969 |             FDayCombo.Width := Wide;
 | 
|---|
| 970 |             FDayCombo.Height := Y;
 | 
|---|
| 971 |             FDayCombo.Left := X;
 | 
|---|
| 972 |             FDayCombo.ItemIndex := FDay;
 | 
|---|
| 973 |             inc(X, Wide + DateComboCtrlGap);
 | 
|---|
| 974 |           end
 | 
|---|
| 975 |           else
 | 
|---|
| 976 |             KillObj(@FDayCombo);
 | 
|---|
| 977 |         end
 | 
|---|
| 978 |         else
 | 
|---|
| 979 |         begin
 | 
|---|
| 980 |           KillObj(@FDayCombo);
 | 
|---|
| 981 |           KillObj(@FMonthCombo);
 | 
|---|
| 982 |         end;
 | 
|---|
| 983 |         if(not assigned(FYearEdit)) then
 | 
|---|
| 984 |         begin
 | 
|---|
| 985 |           FYearEdit := FORYearEditClass.Create(Self);
 | 
|---|
| 986 |           FYearEdit.Parent := Self;
 | 
|---|
| 987 |           FYearEdit.Top := 0;
 | 
|---|
| 988 |           FYearEdit.EditMask := '9999;1; ';
 | 
|---|
| 989 |           FYearEdit.OnKeyPress := YearKeyPress;
 | 
|---|
| 990 |           FYearEdit.OnChange := YearChanged;
 | 
|---|
| 991 |         end;
 | 
|---|
| 992 |         FYearEdit.Font := Font;
 | 
|---|
| 993 |         FYearEdit.TemplateField := FTemplateField;
 | 
|---|
| 994 |         Wide := GetYearSize;
 | 
|---|
| 995 |         FYearEdit.Width := Wide;
 | 
|---|
| 996 |         FYearEdit.Height := Y;
 | 
|---|
| 997 |         FYearEdit.Left := X;
 | 
|---|
| 998 |         inc(X, Wide);
 | 
|---|
| 999 |         if(not assigned(FYearUD)) then
 | 
|---|
| 1000 |         begin
 | 
|---|
| 1001 |           FYearUD := TUpDown.Create(Self);
 | 
|---|
| 1002 |           FYearUD.Parent := Self;
 | 
|---|
| 1003 |           FYearUD.Thousands := FALSE;
 | 
|---|
| 1004 |           FYearUD.Min := FirstYear-1;
 | 
|---|
| 1005 |           FYearUD.Max := LastYear;
 | 
|---|
| 1006 |           FYearUD.OnChangingEx := YearUDChange;
 | 
|---|
| 1007 |         end;
 | 
|---|
| 1008 |         FYearEdit.TabOrder := 0;
 | 
|---|
| 1009 |         FYearUD.Top := 0;
 | 
|---|
| 1010 |         FYearUD.Left := X;
 | 
|---|
| 1011 |         FYearUD.Height := Y;
 | 
|---|
| 1012 |         FYearUD.Position := FYear;
 | 
|---|
| 1013 |         inc(X, FYearUD.Width + DateComboCtrlGap);
 | 
|---|
| 1014 |         if(FIncludeBtn) then
 | 
|---|
| 1015 |         begin
 | 
|---|
| 1016 |           if(not assigned(FCalBtn)) then
 | 
|---|
| 1017 |           begin
 | 
|---|
| 1018 |             FCalBtn := TORDateButton.Create(Self);
 | 
|---|
| 1019 |             FCalBtn.TabStop := FALSE;
 | 
|---|
| 1020 |             FCalBtn.Parent := Self;
 | 
|---|
| 1021 |             FCalBtn.Top := 0;
 | 
|---|
| 1022 |             LoadEllipsis(FCalBtn.Glyph, FBlackColorMode);
 | 
|---|
| 1023 |             FCalBtn.OnClick := BtnClicked;
 | 
|---|
| 1024 |           end;
 | 
|---|
| 1025 |           Wide := FYearEdit.Height;
 | 
|---|
| 1026 |           if(Wide > Y) then Wide := Y;
 | 
|---|
| 1027 |           FCalBtn.Width := Wide;
 | 
|---|
| 1028 |           FCalBtn.Height := Wide;
 | 
|---|
| 1029 |           FCalBtn.Left := X;
 | 
|---|
| 1030 |           inc(X, Wide + DateComboCtrlGap);
 | 
|---|
| 1031 |         end
 | 
|---|
| 1032 |         else
 | 
|---|
| 1033 |           KillObj(@FCalBtn);
 | 
|---|
| 1034 |         Self.Width := X - DateComboCtrlGap;
 | 
|---|
| 1035 |         Self.Height := Y;
 | 
|---|
| 1036 |         CheckDays;
 | 
|---|
| 1037 |         FCtrlsCreated := TRUE;
 | 
|---|
| 1038 |         DoChange;
 | 
|---|
| 1039 |       finally
 | 
|---|
| 1040 |         ControlStyle := ControlStyle - [csAcceptsControls];
 | 
|---|
| 1041 |       end;
 | 
|---|
| 1042 |     finally
 | 
|---|
| 1043 |       FRebuilding := FALSE;
 | 
|---|
| 1044 |     end;
 | 
|---|
| 1045 |   end;
 | 
|---|
| 1046 | end;
 | 
|---|
| 1047 | 
 | 
|---|
| 1048 | procedure TORDateCombo.SetBlackColorMode(Value: boolean);
 | 
|---|
| 1049 | begin
 | 
|---|
| 1050 |   if FBlackColorMode <> Value then
 | 
|---|
| 1051 |   begin
 | 
|---|
| 1052 |     FBlackColorMode := Value;
 | 
|---|
| 1053 |     if assigned(FCalBtn) then    
 | 
|---|
| 1054 |       LoadEllipsis(FCalBtn.Glyph, FBlackColorMode);
 | 
|---|
| 1055 |   end;
 | 
|---|
| 1056 | end;
 | 
|---|
| 1057 | 
 | 
|---|
| 1058 | procedure TORDateCombo.SetDay(Value: integer);
 | 
|---|
| 1059 | begin
 | 
|---|
| 1060 |   if(not assigned(FDayCombo)) and (not (csLoading in ComponentState)) then
 | 
|---|
| 1061 |     Value := 0;
 | 
|---|
| 1062 |   if(Value > DaysPerMonth(FYear, FMonth)) then
 | 
|---|
| 1063 |     Value := 0;
 | 
|---|
| 1064 |   if(FDay <> Value) then
 | 
|---|
| 1065 |   begin
 | 
|---|
| 1066 |     FDay := Value;
 | 
|---|
| 1067 |     if(assigned(FDayCombo)) then
 | 
|---|
| 1068 |     begin
 | 
|---|
| 1069 |       if(FDayCombo.Items.Count <= FDay) then
 | 
|---|
| 1070 |         InitDays(FALSE);
 | 
|---|
| 1071 |       FDayCombo.ItemIndex := FDay;
 | 
|---|
| 1072 |     end;
 | 
|---|
| 1073 |     DoChange;
 | 
|---|
| 1074 |   end;
 | 
|---|
| 1075 | end;
 | 
|---|
| 1076 | 
 | 
|---|
| 1077 | procedure TORDateCombo.SetIncludeBtn(const Value: boolean);
 | 
|---|
| 1078 | begin
 | 
|---|
| 1079 |   if(FIncludeBtn <> Value) then
 | 
|---|
| 1080 |   begin
 | 
|---|
| 1081 |     FIncludeBtn := Value;
 | 
|---|
| 1082 |     Rebuild;
 | 
|---|
| 1083 |   end;
 | 
|---|
| 1084 | end;
 | 
|---|
| 1085 | 
 | 
|---|
| 1086 | procedure TORDateCombo.SetIncludeDay(Value: boolean);
 | 
|---|
| 1087 | begin
 | 
|---|
| 1088 |   if(Value) and (not FIncludeMonth) then
 | 
|---|
| 1089 |     Value := FALSE;
 | 
|---|
| 1090 |   if(FIncludeDay <> Value) then
 | 
|---|
| 1091 |   begin
 | 
|---|
| 1092 |     FIncludeDay := Value;
 | 
|---|
| 1093 |     if(not Value) then FDay := 0;
 | 
|---|
| 1094 |     Rebuild;
 | 
|---|
| 1095 |   end;
 | 
|---|
| 1096 | end;
 | 
|---|
| 1097 | 
 | 
|---|
| 1098 | procedure TORDateCombo.SetIncludeMonth(const Value: boolean);
 | 
|---|
| 1099 | begin
 | 
|---|
| 1100 |   if(FIncludeMonth <> Value) then
 | 
|---|
| 1101 |   begin
 | 
|---|
| 1102 |     FIncludeMonth := Value;
 | 
|---|
| 1103 |     if(not Value) then
 | 
|---|
| 1104 |     begin
 | 
|---|
| 1105 |       FIncludeDay := FALSE;
 | 
|---|
| 1106 |       FMonth := 0;
 | 
|---|
| 1107 |       FDay := 0;
 | 
|---|
| 1108 |     end;
 | 
|---|
| 1109 |     Rebuild;
 | 
|---|
| 1110 |   end;
 | 
|---|
| 1111 | end;
 | 
|---|
| 1112 | 
 | 
|---|
| 1113 | procedure TORDateCombo.SetMonth(Value: integer);
 | 
|---|
| 1114 | begin
 | 
|---|
| 1115 |   if(not assigned(FMonthCombo)) and (not (csLoading in ComponentState)) then
 | 
|---|
| 1116 |     Value := 0;
 | 
|---|
| 1117 |   if(Value <0) or (Value > 12) then
 | 
|---|
| 1118 |     Value := 0;
 | 
|---|
| 1119 |   if(FMonth <> Value) then
 | 
|---|
| 1120 |   begin
 | 
|---|
| 1121 |     FMonth := Value;
 | 
|---|
| 1122 |     if(assigned(FMonthCombo)) then
 | 
|---|
| 1123 |       FMonthCombo.ItemIndex := FMonth;
 | 
|---|
| 1124 |     CheckDays;
 | 
|---|
| 1125 |     DoChange;
 | 
|---|
| 1126 |   end;
 | 
|---|
| 1127 | end;
 | 
|---|
| 1128 | 
 | 
|---|
| 1129 | procedure TORDateCombo.SetLongMonths(const Value: boolean);
 | 
|---|
| 1130 | begin
 | 
|---|
| 1131 |   if(FLongMonths <> Value) then
 | 
|---|
| 1132 |   begin
 | 
|---|
| 1133 |     FLongMonths := Value;
 | 
|---|
| 1134 |     Rebuild;
 | 
|---|
| 1135 |   end;
 | 
|---|
| 1136 | end;
 | 
|---|
| 1137 | 
 | 
|---|
| 1138 | procedure TORDateCombo.SetYear(const Value: integer);
 | 
|---|
| 1139 | begin
 | 
|---|
| 1140 |   if(FYear <> Value) then
 | 
|---|
| 1141 |   begin
 | 
|---|
| 1142 |     FYear := Value;
 | 
|---|
| 1143 |     if(FYear < FirstYear) or (FYear > LastYear) then
 | 
|---|
| 1144 |       FYear := 0;
 | 
|---|
| 1145 |     if(not FYearChanging) and (assigned(FYearEdit)) and (assigned(FYearUD)) then
 | 
|---|
| 1146 |     begin
 | 
|---|
| 1147 |       FYearChanging := TRUE;
 | 
|---|
| 1148 |       try
 | 
|---|
| 1149 |         if(FYear = 0) then
 | 
|---|
| 1150 |         begin
 | 
|---|
| 1151 |           FYearEdit.Text := '    ';
 | 
|---|
| 1152 |           FYearUD.Position := FirstYear-1
 | 
|---|
| 1153 |         end
 | 
|---|
| 1154 |         else
 | 
|---|
| 1155 |         begin
 | 
|---|
| 1156 |           FYearEdit.Text := IntToStr(FYear);
 | 
|---|
| 1157 |           FYearUD.Position := FYear;
 | 
|---|
| 1158 |         end;
 | 
|---|
| 1159 |       finally
 | 
|---|
| 1160 |         FYearChanging := FALSE;
 | 
|---|
| 1161 |       end;
 | 
|---|
| 1162 |     end;
 | 
|---|
| 1163 |     if(FMonth = 2) then
 | 
|---|
| 1164 |       InitDays(FALSE);
 | 
|---|
| 1165 |     CheckDays;
 | 
|---|
| 1166 |     DoChange;
 | 
|---|
| 1167 |   end;
 | 
|---|
| 1168 | end;
 | 
|---|
| 1169 | 
 | 
|---|
| 1170 | procedure TORDateCombo.DayChanged(Sender: TObject);
 | 
|---|
| 1171 | begin
 | 
|---|
| 1172 |   FDay := FDayCombo.ItemIndex;
 | 
|---|
| 1173 |   if(FDay < 0) then
 | 
|---|
| 1174 |     FDay := 0;
 | 
|---|
| 1175 |   CheckDays;
 | 
|---|
| 1176 |   DoChange;
 | 
|---|
| 1177 | end;
 | 
|---|
| 1178 | 
 | 
|---|
| 1179 | procedure TORDateCombo.MonthChanged(Sender: TObject);
 | 
|---|
| 1180 | begin
 | 
|---|
| 1181 |   FMonth := FMonthCombo.ItemIndex;
 | 
|---|
| 1182 |   if(FMonth < 0) then
 | 
|---|
| 1183 |     FMonth := 0;
 | 
|---|
| 1184 |   InitDays(FALSE);
 | 
|---|
| 1185 |   CheckDays;
 | 
|---|
| 1186 |   DoChange;
 | 
|---|
| 1187 | end;
 | 
|---|
| 1188 | 
 | 
|---|
| 1189 | procedure TORDateCombo.YearChanged(Sender: TObject);
 | 
|---|
| 1190 | begin
 | 
|---|
| 1191 |   if FYearChanging then exit;
 | 
|---|
| 1192 |   FYearChanging := TRUE;
 | 
|---|
| 1193 |   try
 | 
|---|
| 1194 |     FYear := StrToIntDef(FYearEdit.Text, 0);
 | 
|---|
| 1195 |     if(FYear < FirstYear) or (FYear > LastYear) then
 | 
|---|
| 1196 |       FYear := 0;
 | 
|---|
| 1197 |     if(FYear = 0) then
 | 
|---|
| 1198 |       FYearUD.Position := FirstYear-1
 | 
|---|
| 1199 |     else
 | 
|---|
| 1200 |       FYearUD.Position := FYear;
 | 
|---|
| 1201 |     if(FMonth = 2) then
 | 
|---|
| 1202 |       InitDays(FALSE);
 | 
|---|
| 1203 |     CheckDays;
 | 
|---|
| 1204 |     DoChange;
 | 
|---|
| 1205 |   finally
 | 
|---|
| 1206 |     FYearChanging := FALSE;
 | 
|---|
| 1207 |   end;
 | 
|---|
| 1208 | end;
 | 
|---|
| 1209 | 
 | 
|---|
| 1210 | procedure TORDateCombo.CheckDays;
 | 
|---|
| 1211 | var
 | 
|---|
| 1212 |   MaxDays: integer;
 | 
|---|
| 1213 | 
 | 
|---|
| 1214 | begin
 | 
|---|
| 1215 |   if(FIncludeMonth and assigned(FMonthCombo)) then
 | 
|---|
| 1216 |   begin
 | 
|---|
| 1217 |     FMonthCombo.Enabled := (FYear > 0);
 | 
|---|
| 1218 |     if (FYear = 0) then
 | 
|---|
| 1219 |       SetMonth(0); 
 | 
|---|
| 1220 |     if(FIncludeMonth and FIncludeDay and assigned(FDayCombo)) then
 | 
|---|
| 1221 |     begin
 | 
|---|
| 1222 |       FDayCombo.Enabled := ((FYear > 0) and (FMonth > 0));
 | 
|---|
| 1223 |       MaxDays := DaysPerMonth(FYear, FMonth);
 | 
|---|
| 1224 |       if(FDay > MaxDays) then
 | 
|---|
| 1225 |         SetDay(MaxDays);
 | 
|---|
| 1226 |     end;
 | 
|---|
| 1227 |   end;
 | 
|---|
| 1228 | end;
 | 
|---|
| 1229 | 
 | 
|---|
| 1230 | procedure TORDateCombo.Loaded;
 | 
|---|
| 1231 | begin
 | 
|---|
| 1232 |   inherited;
 | 
|---|
| 1233 |   if(not FCtrlsCreated) then
 | 
|---|
| 1234 |     Rebuild;
 | 
|---|
| 1235 | end;
 | 
|---|
| 1236 | 
 | 
|---|
| 1237 | procedure TORDateCombo.Paint;
 | 
|---|
| 1238 | begin
 | 
|---|
| 1239 |   if(not FCtrlsCreated) then
 | 
|---|
| 1240 |     Rebuild;
 | 
|---|
| 1241 |   inherited;
 | 
|---|
| 1242 | end;
 | 
|---|
| 1243 | 
 | 
|---|
| 1244 | procedure TORDateCombo.BtnClicked(Sender: TObject);
 | 
|---|
| 1245 | var
 | 
|---|
| 1246 |   mm, dd, yy: integer;
 | 
|---|
| 1247 |   m, d, y: word;
 | 
|---|
| 1248 |   DateDialog: TORDateTimeDlg;
 | 
|---|
| 1249 | 
 | 
|---|
| 1250 | begin
 | 
|---|
| 1251 |   DateDialog := TORDateTimeDlg.Create(self);
 | 
|---|
| 1252 |   try
 | 
|---|
| 1253 |     mm := FMonth;
 | 
|---|
| 1254 |     dd := FDay;
 | 
|---|
| 1255 |     yy := FYear;
 | 
|---|
| 1256 |     DecodeDate(Now, y, m, d);
 | 
|---|
| 1257 |     if(FYear = 0) then FYear := y;
 | 
|---|
| 1258 |     if(FYear = y) then
 | 
|---|
| 1259 |     begin
 | 
|---|
| 1260 |       if((FMonth = 0) or (FMonth = m)) and (FDay = 0) then
 | 
|---|
| 1261 |       begin
 | 
|---|
| 1262 |         FMonth := m;
 | 
|---|
| 1263 |         FDay := d;
 | 
|---|
| 1264 |       end;
 | 
|---|
| 1265 |     end;
 | 
|---|
| 1266 |     if(FMonth = 0) then
 | 
|---|
| 1267 |       FMonth := 1;
 | 
|---|
| 1268 |     if(FDay = 0) then
 | 
|---|
| 1269 |       FDay := 1;
 | 
|---|
| 1270 |     DateDialog.FMDateTime := GetFMDate;
 | 
|---|
| 1271 |     DateDialog.DateOnly := TRUE;
 | 
|---|
| 1272 |     DateDialog.RequireTime := FALSE;
 | 
|---|
| 1273 |     if DateDialog.Execute then
 | 
|---|
| 1274 |     begin
 | 
|---|
| 1275 |       FYear := 0;
 | 
|---|
| 1276 |       FMonth := 0;
 | 
|---|
| 1277 |       FDay := 0;
 | 
|---|
| 1278 |       SetFMDate(DateDialog.FMDateTime);
 | 
|---|
| 1279 |     end
 | 
|---|
| 1280 |     else
 | 
|---|
| 1281 |     begin
 | 
|---|
| 1282 |       SetYear(yy);
 | 
|---|
| 1283 |       SetMonth(mm);
 | 
|---|
| 1284 |       SetDay(dd);
 | 
|---|
| 1285 |     end;
 | 
|---|
| 1286 |   finally
 | 
|---|
| 1287 |     DateDialog.Free;
 | 
|---|
| 1288 |   end;
 | 
|---|
| 1289 | end;
 | 
|---|
| 1290 | 
 | 
|---|
| 1291 | procedure TORDateCombo.YearUDChange(Sender: TObject; var AllowChange: Boolean;
 | 
|---|
| 1292 |                                     NewValue: Smallint; Direction: TUpDownDirection);
 | 
|---|
| 1293 | var
 | 
|---|
| 1294 |   y, m, d: word;
 | 
|---|
| 1295 | 
 | 
|---|
| 1296 | begin
 | 
|---|
| 1297 |   if FYearChanging then exit;
 | 
|---|
| 1298 |   FYearChanging := TRUE;
 | 
|---|
| 1299 |   try
 | 
|---|
| 1300 |     if FYearUD.Position = (FirstYear-1) then
 | 
|---|
| 1301 |     begin
 | 
|---|
| 1302 |       DecodeDate(Now, y, m, d);
 | 
|---|
| 1303 |       FYear := y;
 | 
|---|
| 1304 |       FYearUD.Position := y;
 | 
|---|
| 1305 |       AllowChange := FALSE;
 | 
|---|
| 1306 |     end
 | 
|---|
| 1307 |     else
 | 
|---|
| 1308 |       FYear := NewValue;
 | 
|---|
| 1309 |     if(FYear < FirstYear) or (FYear > LastYear) then
 | 
|---|
| 1310 |       FYear := 0;
 | 
|---|
| 1311 |     if(FYear = 0) then
 | 
|---|
| 1312 |       FYearEdit.Text := '    '
 | 
|---|
| 1313 |     else
 | 
|---|
| 1314 |       FYearEdit.Text := IntToStr(FYear);
 | 
|---|
| 1315 |     if(FMonth = 2) then
 | 
|---|
| 1316 |       InitDays(FALSE);
 | 
|---|
| 1317 |     CheckDays;
 | 
|---|
| 1318 |     DoChange;
 | 
|---|
| 1319 |   finally
 | 
|---|
| 1320 |     FYearChanging := FALSE;
 | 
|---|
| 1321 |   end;
 | 
|---|
| 1322 | end;
 | 
|---|
| 1323 | 
 | 
|---|
| 1324 | procedure TORDateCombo.YearKeyPress(Sender: TObject; var Key: Char);
 | 
|---|
| 1325 | begin
 | 
|---|
| 1326 |   if(Key in ['0'..'9']) and (FYearEdit.Text = '    ') then
 | 
|---|
| 1327 |   begin
 | 
|---|
| 1328 |     FYearEdit.Text := Key + '   ';
 | 
|---|
| 1329 |     Key := #0;
 | 
|---|
| 1330 |     FYearEdit.SelStart := 1;
 | 
|---|
| 1331 |     FYearEdit.SelText := '';
 | 
|---|
| 1332 |   end;
 | 
|---|
| 1333 | end;
 | 
|---|
| 1334 | 
 | 
|---|
| 1335 | function TORDateCombo.GetFMDate: TFMDateTime;
 | 
|---|
| 1336 | begin
 | 
|---|
| 1337 |   if(FYear < FirstYear) then
 | 
|---|
| 1338 |     Result := 0
 | 
|---|
| 1339 |   else
 | 
|---|
| 1340 |     Result := ((FYear - 1700) * 10000 + FMonth * 100 + FDay);
 | 
|---|
| 1341 | end;
 | 
|---|
| 1342 | 
 | 
|---|
| 1343 | procedure TORDateCombo.SetFMDate(const Value: TFMDateTime);
 | 
|---|
| 1344 | var
 | 
|---|
| 1345 |   ival, mo, dy: integer;
 | 
|---|
| 1346 |               
 | 
|---|
| 1347 | begin
 | 
|---|
| 1348 |   if(Value = 0) then
 | 
|---|
| 1349 |   begin
 | 
|---|
| 1350 |     SetYear(0);
 | 
|---|
| 1351 |     SetMonth(0);
 | 
|---|
| 1352 |   end
 | 
|---|
| 1353 |   else
 | 
|---|
| 1354 |   begin
 | 
|---|
| 1355 |     ival := trunc(Value);
 | 
|---|
| 1356 |     if(length(inttostr(ival)) <> 7) then
 | 
|---|
| 1357 |       exit;
 | 
|---|
| 1358 |     dy := (ival mod 100);
 | 
|---|
| 1359 |     ival := ival div 100;
 | 
|---|
| 1360 |     mo := ival mod 100;
 | 
|---|
| 1361 |     ival := ival div 100;
 | 
|---|
| 1362 |     SetYear(ival + 1700);
 | 
|---|
| 1363 |     SetMonth(mo);
 | 
|---|
| 1364 |     InitDays(FALSE);
 | 
|---|
| 1365 |     SetDay(dy);
 | 
|---|
| 1366 |   end;
 | 
|---|
| 1367 | end;
 | 
|---|
| 1368 | 
 | 
|---|
| 1369 | function TORDateCombo.DateText: string;
 | 
|---|
| 1370 | begin
 | 
|---|
| 1371 |   Result := '';
 | 
|---|
| 1372 |   if(FYear > 0) then
 | 
|---|
| 1373 |   begin
 | 
|---|
| 1374 |     if(FMonth > 0) then
 | 
|---|
| 1375 |     begin
 | 
|---|
| 1376 |       if FLongMonths then
 | 
|---|
| 1377 |         Result := LongMonthNames[FMonth]
 | 
|---|
| 1378 |       else
 | 
|---|
| 1379 |         Result := ShortMonthNames[FMonth];
 | 
|---|
| 1380 |       if(FDay > 0) then
 | 
|---|
| 1381 |         Result := Result + ' ' + IntToStr(FDay);
 | 
|---|
| 1382 |       Result := Result + ', ';
 | 
|---|
| 1383 |     end;
 | 
|---|
| 1384 |     Result := Result + IntToStr(FYear);
 | 
|---|
| 1385 |   end;
 | 
|---|
| 1386 | end;
 | 
|---|
| 1387 | 
 | 
|---|
| 1388 | procedure TORDateCombo.DoChange;
 | 
|---|
| 1389 | begin
 | 
|---|
| 1390 |   if assigned(FOnChange) then
 | 
|---|
| 1391 |     FOnChange(Self);
 | 
|---|
| 1392 | end;
 | 
|---|
| 1393 | 
 | 
|---|
| 1394 | procedure TORDateCombo.Resized(Sender: TObject);
 | 
|---|
| 1395 | begin
 | 
|---|
| 1396 |   Rebuild;
 | 
|---|
| 1397 | end;
 | 
|---|
| 1398 | 
 | 
|---|
| 1399 | procedure TORDateCombo.CMFontChanged(var Message: TMessage);
 | 
|---|
| 1400 | begin
 | 
|---|
| 1401 |   inherited;
 | 
|---|
| 1402 |   Rebuild;
 | 
|---|
| 1403 | end;
 | 
|---|
| 1404 | 
 | 
|---|
| 1405 | function TORDateCombo.Text: string;
 | 
|---|
| 1406 | var
 | 
|---|
| 1407 |   tmp, fmt, m: string;
 | 
|---|
| 1408 | 
 | 
|---|
| 1409 | begin
 | 
|---|
| 1410 |   Result := '';
 | 
|---|
| 1411 |   tmp := FloatToStr(FMDate);
 | 
|---|
| 1412 |   if(tmp <> '') and (tmp <> '0') and (length(Tmp) >= 7) then
 | 
|---|
| 1413 |   begin
 | 
|---|
| 1414 |     if FLongMonths then
 | 
|---|
| 1415 |       m := 'mmmm'
 | 
|---|
| 1416 |     else
 | 
|---|
| 1417 |       m := 'mmm';
 | 
|---|
| 1418 |     if(copy(tmp,4,4) = '0000') then
 | 
|---|
| 1419 |       fmt := 'yyyy'
 | 
|---|
| 1420 |     else
 | 
|---|
| 1421 |     if(copy(tmp,6,2) = '00') then
 | 
|---|
| 1422 |       fmt := m + ', YYYY'
 | 
|---|
| 1423 |     else
 | 
|---|
| 1424 |       fmt := m + ' D, YYYY';
 | 
|---|
| 1425 |     Result := FormatFMDateTimeStr(fmt, tmp)
 | 
|---|
| 1426 |   end;
 | 
|---|
| 1427 | end;
 | 
|---|
| 1428 | 
 | 
|---|
| 1429 | 
 | 
|---|
| 1430 | procedure Register;
 | 
|---|
| 1431 | { used by Delphi to put components on the Palette }
 | 
|---|
| 1432 | begin
 | 
|---|
| 1433 |   RegisterComponents('CPRS', [TORDateTimeDlg, TORDateBox, TORDateCombo]);
 | 
|---|
| 1434 | end;
 | 
|---|
| 1435 | 
 | 
|---|
| 1436 | procedure TORDateCombo.SetTemplateField(const Value: boolean);
 | 
|---|
| 1437 | begin
 | 
|---|
| 1438 |   if FTemplateField <> Value then
 | 
|---|
| 1439 |   begin
 | 
|---|
| 1440 |     FTemplateField := Value;
 | 
|---|
| 1441 |     Rebuild;
 | 
|---|
| 1442 |   end;
 | 
|---|
| 1443 | end;
 | 
|---|
| 1444 | 
 | 
|---|
| 1445 | initialization
 | 
|---|
| 1446 |   uServerToday := 0;
 | 
|---|
| 1447 | 
 | 
|---|
| 1448 | end.
 | 
|---|