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