wwdbdatetimepicker.pas

InfoPower_Studio 2007 v5.0.1.3 banben

//                else AMString := formatstr[4]+formatstr[5];
                if (hour < 12) then {!!!!}
                   AMString := s[1]+s[2]
                else AMString := s[4]+s[5];
              end
              else if (length(s) = 4) then {Handle AMPM DateTime DisplayFormat}
              begin
                if (Hour <= 12) then
                   AMString := TimeAMString
                else AMString := TimePMString;
              end;

              len := length(AMString);
              TotalStr := TotalStr + AMString;

              if isDateTimeField or isTimeOnlyField then begin
                 tokenct:= tokenct+1;
                 if tokenct = index then break;
              end
              else begin
                 s:='';
              end;

              pos:=pos+length(AMString);
           end;
        else begin
               pos:=pos+1;
               totalstr := totalstr+formatstr[i];
             end;
        end;
        i:=i+1;
      end;
      if tokenct <> index then totalstr := '';
      result := totalstr;
end;

{This Function determines if the Time Portion of a TDateTimeField is visible
 when it has the C format}
function TwwDBCustomDateTimePicker.TimeShowing:boolean;
var tempstr,token:string;
    i,startpos,tlength:integer;
begin
   Result := True;
   i:=getMaxTokens(GetFormatStr);
   tempstr := getdatetimetoken(Datetime,i,startpos,tlength,token);

   if IsCFormat and (Length(tempstr)>Length(text)) then
      Result := False;
end;

{C display format displays shortdateformat and longTimeformat on a DateTime field}
function TwwDBCustomDateTimePicker.IscFormat:boolean;
begin
  result := False;
  if (FDatalink.Field <> nil) then begin
     if ((IsDateTimeField and 
         (GetEffectiveDisplayFormat(False)='')) or
         (wwGetDisplayFormat(FDataLink.Field) = 'c')) then
        result := True;
  end
  else if IsDateTimeField and ((DisplayFormat = 'c') or ((DisplayFormat = '') and (DateFormat = dfShort))) then
     result := True;
end;

{This function gets the maximum number of visible tokens for the shortdateformat
 This only applies for a TDateTimeField and a 'c' displayformat}
function TwwDBCustomDateTimePicker.GetMaxVisibleToken:Integer;
var tempstr,token:string;
    i,startpos,tlength: integer;
begin
    if not isCFormat then begin
      result := GetMaxTokens(GetFormatStr);
      exit;
    end;

    i:=1;
    repeat
       tempstr := getdatetimetoken(datetime,i,startpos,tlength,token);

       if (Length(tempstr)>=Length(text)) then begin
          break;
       end;

       i:=i+1;
     until tempstr = '';

   result := i;
end;

{This routine updates the highlighted token}
procedure TwwDBCustomDateTimePicker.HighlightToken(mDateTime:TDateTime);
var startpos,tokenlength:integer;
    s,token:string;
begin
  if CanEdit then begin
     if not (DroppedDown) then begin
       s := getdatetimetoken(mDateTime,FPos,startpos,tokenlength,token);
       selstart:=startpos;
       sellength := tokenlength;
     end
     else begin
       selstart := 0;
       sellength := 0;
     end;
  end
  else begin
    SelectAll;
  end;
//  if (not HandleAllocated) or (GetFocus<>Handle) then exit;

  ShowCaret(Handle);
  HideCaret(Handle);
end;

procedure TwwDBCustomDateTimePicker.WMLButtonDown(var Message: TWMLButtonDown);
var mDateTime : TDateTime;
    startpos,tlength,i:integer;
    tempstr,token:string;
//    y,m,d: word;
begin
  if Text = '' then begin
    inherited;
    exit;
  end;

  if (not FIsCleared) or (Text <> '') then begin
          {PW - The following few lines of code are necessary to handle the OnClick event
           and come from TControls WMLButtonDown procedure}
    SendCancelMode(Self);
    if csCaptureMouse in ControlStyle then MouseCapture := True;
    if csClickEvents in ControlStyle then Click;
    if not (csNoStdEvents in ControlStyle) then
       with Message do
          MouseDown(mbLeft, KeysToShiftState(Keys) + [], XPos, YPos);

    if not focused then Setfocus;  {!!!pw because inherited messes up selection}


    if CurrentDigitEditDateTime<>0 then { 8/16/00 }
    begin
       FDateTime:= CurrentDigitEditDateTime;
       RefreshText;
       CurrentDigitEditDateTime:=0;
       FInDigitEdit:= False;
    end;

    if (isDroppedDown) then
       mDateTime := FCalendar.Time
    else
       mDateTime := DateTime;


    if FinDigitEdit then InDigitEditUpdateRecord;
(*    if FinDigitEdit then begin { RSW - Base mouse on updated text }
       { If editing year, need to map to 4 digit year }
       tempstr := getdatetimetoken(mdatetime,fpos,startpos,tlength,token);
       if (AnsiUpperCase(token[1])[1]='Y') and (selStart-startPos<3) then
       begin
          DecodeDate(FDateTime, y, m, d);
          if selStart>startPos then
             y := Get4DigitFrom2DigitYear(
                strtoint(copy(Text, startpos+1, selStart-startPos)),
                m,d,FEpoch);
          FDateTime:= EncodeDate(y,m,d);
       end;

       RefreshText;
       FInDigitEdit:= False;
       HideCaret(Handle);
    end;
*)
    i:=1;
    Button.Glyph.canvas.font.assign(font);
    repeat
       tempstr := getdatetimetoken(mdatetime,i,startpos,tlength,token);

       { RSW - Click after all text }
       if startpos+tlength>=length(text) then
       begin
          FPos:=i;
          break;
       end;

       if Message.XPos < Button.Glyph.Canvas.TextWidth(tempstr) then
       begin
            FPos:=i;
            break;
       end;

       if IsCFormat and (Length(tempstr)>=Length(text)) then begin
          FPos:=i;
          break;
       end;

       i:=i+1;
     until tempstr = '';

    HighlightToken(mDateTime);
  end
  else begin
    ShowCaret(Handle);
    inherited;
  end;
{  else
    NonEditMouseDown (Message);}
end;

{Test to see if year is a valid 2 digit year.  Currently this function appends
 the current millenium for the centuries.}
function TwwDBCustomDateTimePicker.isvalid2year(newnum:integer):boolean;
var possibledate:TDateTime;
    test:integer;
begin
    result := False;
//    test := getcurmillenium;
    { 7/31/99 - RSW - Fix bug where 00 cannot be entered into year if MinDate is greater than 1900}
    if (newnum*10) >= (FEpoch mod 100) then
       test:= (FEpoch div 100)
    else
       test:= ((FEpoch div 100)+1);

    possibledate := EncodeDate(Test*100+(10*newnum)+9,12,31);
    if LessThanOrEqual(MinDate,PossibleDate) then
    begin
       result := True;
    end;
end;

Function TwwDBCustomDateTimePicker.GetValidMaxDate:TDate;
begin
   Result := MaxDate;
   if (Trunc(MaxDate) = 0) then
      Result := Trunc(EncodeDate(9999,12,31));
end;

Function TwwDBCustomDateTimePicker.GetValidMinDate:TDate;
begin
   Result := MinDate;
   if (Trunc(MinDate) = 0) then
      Result := Trunc(EncodeDate(1899,12,31));
end;

{Re - Encode the DateTime to the new values.}
procedure TwwDBCustomDateTimePicker.ReEncodeDateTime(y,m,d,h,n,sec,msec:word);
var maxday:integer;
    TempDateTime:TDateTime;
    amaxdate,amindate:TDate;
begin
// Set to maxday if current day exceeds the maximum number
// of days for this month
   maxday := DaysThisMonth(m,y);
   if d>maxday then d:=maxday;
   if isTimeOnlyField then begin
      Time := EncodeTime(h,n,sec,msec);
   end
   else begin
     if (Trunc(EncodeDate(y,m,d)) >= 0) then
        TempDateTime := Trunc(EncodeDate(y,m,d)) + Frac(EncodeTime(h,n,sec,msec))
     else
        TempDateTime := Trunc(EncodeDate(y,m,d)) - Frac(EncodeTime(h,n,sec,msec));

     amaxdate:=GetValidMaxDate;
     amindate:=GetValidMinDate;

     if (Trunc(TempDateTime) <= Trunc(aMaxDate)) and
        (Trunc(TempDateTime) >= Trunc(aMinDate)) then
        DateTime := TempDateTime
     else RefreshText;
   end;
end;

procedure TwwDBCustomDateTimePicker.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
       // PW - The following few lines of code are necessary to handle the OnClick event
       //      and come from TControls WMLButtonDown procedure
  SendCancelMode(Self);
  if csCaptureMouse in ControlStyle then MouseCapture := True;
  if csClickEvents in ControlStyle then DblClick;
  if not (csNoStdEvents in ControlStyle) then
     with Message do
        MouseDown(mbLeft, KeysToShiftState(Keys) + [ssDouble], XPos, YPos);

  SelStart:=0;
  SelLength := Length(Text);
end;

procedure TwwDBCustomDateTimePicker.WMSize;
begin
  inherited;
  UpdateButtonPosition;
end;

procedure TwwDBCustomDateTimePicker.WMSetFocus(var Message: TWMSetFocus);
begin
  inherited;
  if (not Editable) or not IsInGrid(self) then begin
    if (FDatalink.Field<>nil) and (FDatalink.Field.IsNull) then exit;
    if (Text <> '') and (not FInDigitEdit) then HideCaret(Handle)
  end;
end;

procedure TwwDBCustomDateTimePicker.CMFontChanged(var Message: TMessage);
  procedure CalcTextMargin;
  var
    DC: HDC;
    SaveFont: HFont;
    I: Integer;
    SysMetrics, Metrics: TTextMetric;
  begin
    if NewStyleControls then
    begin
       FTextMargin := 1;
       exit;
    end;

    DC := GetDC(0);
    GetTextMetrics(DC, SysMetrics);
    SaveFont := SelectObject(DC, Font.Handle);
    GetTextMetrics(DC, Metrics);
    SelectObject(DC, SaveFont);
    ReleaseDC(0, DC);
    I := SysMetrics.tmHeight;
    if I > Metrics.tmHeight then I := Metrics.tmHeight;
    FTextMargin := I div 4;
  end;
begin
  inherited;
  CalcTextMargin;
  {This is needed only when changing font in the middle of editing }
  {RSW -9/10/98 - Check Owner<>Nil }
  if (Owner<>Nil) and (not (csLoading in Owner.ComponentState)) then SetEditRect;
end;

Function TwwDBCustomDateTimePicker.GetDateTimeDisplayText(ADateTime:TDateTime):string;
begin
   {10/29/98 - Make sure that control is cleared when datasource is disabled}
   if (FDatalink.Field=nil) and  ((datasource<>nil) or (datafield<>'')) then
   begin
      result:= '';
      exit;
   end;

   if (Trunc(ADateTime)=0) and not isTimeOnlyField then { RSW - Allow paint to display blank for datetime=0}
   begin
      result:= '';
      exit;
   end;
   if (GetEffectiveDisplayFormat(False)='') and
      (DateFormat=dfLong) and (Frac(ADateTime)=0) then
      result := FormatDateTime(longdateformat,ADateTime)
   else
      result := FormatDateTime(GetEffectiveDisplayFormat(True),ADateTime);
end;

{Get value that is based on database value}
Function TwwDBCustomDateTimePicker.GetDateTimeStoredText(ADateTime:TDateTime):string;
begin
   {10/29/98 - Make sure that control is cleared when datasource is disabled}
   if (FDatalink.Field=nil) and  ((datasource<>nil) or (datafield<>'')) then
   begin
      result:= '';
      exit;
   end;

   if (FDatalink.Field <> nil) and (FDatalink.Field.isnull) and
      ((FCal