wwdbdatetimepicker.pas

胜天进销存源码,国产优秀的进销存

end;

(*
Function wwGetGridOptions(dtp:TwwDBCustomDateTimePicker): TwwDBGridOptions;
// var opt : TwwDBGridOptions;
//    PropInfo: PPropInfo;
begin
   if dtp.parent is TwwDBGrid then
   begin
       Result:= TwwDBGrid(dtp.parent).options;
   end
{
     if wwIsClass(dtp.Parent.classType, 'TwwDBGrid') then
     begin
        PropInfo:= Typinfo.GetPropInfo(dtp.Parent.ClassInfo,'Options');
        if PropInfo<>Nil then PChar(@opt)^:= Char(GetOrdProp(dtp.Parent, PropInfo));
        result:= opt;
     end
     }
end;
*)

{************************************* TwwPopupCalendar **************************************}
constructor TwwPopupCalendar.Create(AOwner: TComponent);
begin
   FCombo := TwwDBDateTimePicker(AOwner); // 9/27/98 - Avoid runtime error if subclassing from TwwDBCustomDateTimePIcker
   inherited Create(AOwner);
   ControlStyle := ControlStyle + [csReplicatable];
end;

procedure TwwPopupCalendar.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := Style or WS_BORDER;
    ExStyle := WS_EX_TOOLWINDOW;
    WindowClass.Style := CS_SAVEBITS;
  end;
end;

procedure TwwPopupCalendar.CreateWnd;
begin
  inherited CreateWnd;
//  Windows.SetParent(Handle, 0);
 { Trick of Setting parent to 0 causes resource leak so use desktop window instead }
  Windows.SetParent(Handle, GetDesktopWindow);
  CallWindowProc(DefWndProc, Handle, wm_SetFocus, 0, 0);
end;

{procedure TwwPopupCalendar.WMLButtonDown(var Message: TWMLButtonDown);
begin
  inherited;
  if not PtinRect(ClientRect,Point(Message.xpos,Message.ypos)) then
     FCombo.Closeup(True);
end;
}
procedure TwwPopupCalendar.WMLButtonUp(var Message: TWMLButtonUp);
const
    MCM_GETCURRENTVIEW  = MCM_FIRST + 22;
var Info: TMCHitTestInfo;
    closeflag:Boolean;
    Index:Integer;
    view: integer;
begin
  inherited;

  FillChar(Info, SizeOf(TMCHitTestInfo), 0);
  Info.Pt.X := Message.Pos.X;
  Info.Pt.Y := Message.Pos.Y;
  Info.cbsize := sizeof(TMCHitTestInfo);

  closeflag := False;
  Index := MonthCal_HitTest(WindowHandle,Info);
  if Index >= 0 then begin
    view:= SendMessage(WindowHandle, MCM_GETCURRENTVIEW, 0, 0);
    if (view<>0) and (Info.uHit=MCHT_CALENDARDATE) then closeFlag:=false // Not selecting day - vista support
    else if ((Info.uHit AND MCHT_CALENDAR)<>0) then closeflag := True;
    if ((Info.uHit AND MCHT_CALENDARDAY)=MCHT_CALENDARDAY) then closeflag := False;
    if CloseFlag then begin
       FCombo.CloseUp(True);
    end;
  end;
end;

procedure TwwPopupCalendar.GetFocus;
begin
end;

procedure TwwPopupCalendar.Change;
begin
  inherited Change;
  if FCombo.CanEdit then begin
     FCombo.EnableEdit;
     FCombo.SetModified(True);
     FCombo.SetModifiedInChangeEvent:=True; // 7/31/00 - Makes sure modified is set in combo's change
     FCombo.Date := Date;
     FCombo.SetModifiedInChangeEvent:=False;
  end;
end;

procedure TwwPopupCalendar.KeyDown(var Key: Word; Shift: TShiftState);
begin
//  FCombo.EnableEdit; { Ask Paul }
  inherited KeyDown(Key, Shift);
end;

{************************************ TwwDBDateTimePicker *************************************}

procedure TwwDBCustomDateTimePicker.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style :=(Params.Style and not (ES_AUTOVSCROLL or ES_WANTRETURN) or
                   WS_CLIPCHILDREN);  {!!!}
  if (BorderStyle = bsNone) then Params.Style:= Params.Style or ES_MULTILINE;
  {$ifdef wwdelphi4up}
  if UseRightToLeftAlignment and ShowButton and (not isTimeOnlyField) then
    Params.Style:= Params.Style or ES_MULTILINE;
  {$endif}
  if IsTransparentEffective and Frame.CreateTransparent then
  begin
     Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;
  end;

end;

procedure TwwDBCustomDateTimePicker.WndProc(var Message: TMessage);
begin
  if Message.Msg = WM_DATEPICKER_DESTROYCALENDAR then begin { 6/8/00 }
     if not FFocused then // 4/19/01 - Don't free if we still have focus
     begin
       FCalendar.Free;
       FCalendar:=nil;
     end
  end
  else case Message.Msg of
    wm_KeyDown, wm_SysKeyDown, wm_Char:
      with TWMKey(Message) do
      begin
        if (isDroppedDown and
           (Message.Msg=wm_KeyDown)) then begin  { Update Date when dropped down }

           HandleDropDownKeys(CharCode, KeyDataToShiftState(KeyData));
           if (CharCode <> 0) then
           begin
             with TMessage(Message) do
                SendMessage(FCalendar.Handle, Msg, WParam, LParam);

             if CanEdit then begin
                EnableEdit;
                SetModified(True);
                if FCalendar<>Nil then Date := FCalendar.Date; { 9/1/98 - Check for nil}
             end
           end;
        end;
      end
  end;

  inherited WndProc(Message);
end;

procedure TwwDBCustomDateTimePicker.CMGetDataLink(var Message: TMessage);
begin
  Message.Result := Integer(FDataLink);
end;

procedure TwwDBCustomDateTimePicker.CMCancelMode(var Message: TCMCancelMode);
begin
  { RSW - allow clicking on control to close-up pop-up calendar }
  if {(Message.Sender <> Self) and }
     (Message.Sender <> FCalendar)
  and (Message.Sender <> Button) then
      CloseUp(True)
  else begin
     if FinDigitEdit then begin
        InDigitEditUpdateRecord;
     end;
  end;
end;

procedure TwwDBCustomDateTimePicker.WMKillFocus(var Message: TMessage);
begin
  inherited;
  CloseUp(True);
end;

procedure TwwDBCustomDateTimePicker.WMCut(var Message: TMessage);
begin
  EnableEdit;
  inherited;
  if (CanEdit) then begin
    DateTime := 0.0;
    Text := '';
    Update;
    ShowCaret(Handle);
    FPos := 1;
    FIsCleared := True;
    SetModified(True);
  end;
end;

procedure TwwDBCustomDateTimePicker.WMPaste(var Message: TMessage);
var prevText: string;
    val: TDateTime;
begin
  PrevText:= Text;

  if not CanEdit then begin
     exit;
  end;

  FDataLink.Edit;
  {!!!!!Only allow paste over entire text }
  selstart := 0;
  sellength := length(Text);

  inherited;
  try
     if isTimeOnlyField then begin
        val:= wwStrToTimeVal(Text);
        if val<>0 then DateTime:= Val;
     end
     else begin
        val := wwStrToDateTimeVal(Text);  // Try to convert to a date
        if Trunc(val)=0 then val := wwStrToDateVal(Text);  // Try to convert to a date
        if Trunc(val)<>0 then DateTime:= Val;
     end
  except
     Text := PrevText;
  end;
  RefreshText;
  HighlightToken(DateTime);
  SetModified(True);
end;

Function wwGetDisplayFormat(component: TComponent): String;
var PropInfo: PPropInfo;
begin
   Result:= '';
   PropInfo:= Typinfo.GetPropInfo(component.ClassInfo, 'DisplayFormat');
   if PropInfo<>Nil then
      result:= GetStrProp(component, PropInfo);
end;

Function wwGetDataType(component: TComponent): TFieldType;
var PropInfo: PPropInfo;
begin
   Result:= ftUnknown;

   // 7/18/05 - Don't use reflection to resolve DataType as it prevents DateTimePicker from working
   if(component is TField) then
   begin
     result := TField(component).DataType;
     exit;
   end;

   PropInfo:= Typinfo.GetPropInfo(component.ClassInfo, 'DataType');
   if PropInfo<>Nil then
      result:= TFieldType(GetOrdProp(component, PropInfo));
end;

function TwwDBCustomDateTimePicker.GetEffectiveDisplayFormat(ExpandNativeFormat: boolean): string;
var formatstr:string;
begin
  formatstr := FDisplayFormat;

  // If this is a bound field and we don't know the format string yet, then...
  if (formatStr='') and (FDatalink.Field <> nil) and
     (wwGetDisplayFormat(FDataLink.Field)<>'') then
     formatstr := wwGetDisplayFormat(FDataLink.Field);

  if ExpandNativeFormat and (formatstr = '') then begin
     if ((FDatalink.Field <> nil) and (wwGetDataType(FDataLink.Field) = ftTime)) or
        ((FDatalink.Field = nil) and (FUnboundDataType = wwDTEdtTime)) then begin
        if DateFormat = dfShort then
           formatstr := shorttimeformat
        else formatstr := longtimeformat;
     end
     else if ((FDatalink.Field <> nil) and (wwGetDataType(FDataLink.Field) = ftDate)) or
             ((FDatalink.Field = nil) and (FUnboundDataType = wwDTEdtDate)) then begin
        if DateFormat = dfShort then
           formatstr := shortdateformat
        else formatstr := longdateformat;
     end
     else begin
        if DateFormat = dfShort then
           formatstr := 'c'
        else formatstr := longdateformat+' '+longtimeformat;
     end;
  end;
  result := formatstr;
end;

{Get the current date/time format string for the wwdbdatetimepicker}
function TwwDBCustomDateTimePicker.GetFormatStr:String;
var formatstr:string;
begin
  formatstr := GetEffectiveDisplayFormat(True);
  formatstr := ReplaceStrWithStr(formatstr,'c',shortdateformat+' '+longtimeformat);
  formatstr := ReplaceStrWithStr(formatstr,'dddddd',longdateformat);
  formatstr := ReplaceStrWithStr(formatstr,'ddddd',shortdateformat);
  formatstr := ReplaceStrWithStr(formatstr,'tt',longtimeformat);
  formatstr := ReplaceStrWithStr(formatstr,'t',shorttimeformat);
  Result := formatstr;
end;

{GetCompleteToken retrieves the rest of the token and returns the full token
 string and advances the position in the DateTime format string to the end of
 the token string}
procedure TwwDBCustomDateTimePicker.GetCompleteToken
   (val:char;formatstr:string;var s:string;var pos:integer);
var MinuteFlag:Boolean;
begin
  if AnsiUpperCase(String(val)) = 'A' then begin
  {Handle A/P DateTime DisplayFormat}
     if (length(formatstr)>=pos+2) and (formatstr[pos+1] = '/') and
        (AnsiUpperCase(String(formatstr[pos+2])) = 'P') then
        begin
          s:=copy(formatstr,pos,3);
          pos:=pos+1;
        end
  {Handle Am/Pm DateTime DisplayFormat}
     else if (length(formatstr)>=pos+4) and
        (AnsiUpperCase(String(formatstr[pos+1])) = 'M') and
        (formatstr[pos+2] = '/') and
        (AnsiUpperCase(String(formatstr[pos+3])) = 'P') and
        (AnsiUpperCase(String(formatstr[pos+4])) = 'M') then
        begin
          s:=copy(formatstr,pos,5);
          pos:=pos+3;
        end
  {Handle AmPm DateTime DisplayFormat}
     else if (length(formatstr)>=pos+3) and
        (AnsiUpperCase(String(formatstr[pos+1])) = 'M') and
        (AnsiUpperCase(String(formatstr[pos+2])) = 'P') and
        (AnsiUpperCase(String(formatstr[pos+3])) = 'M') then
        begin
          s:=copy(formatstr,pos,4);
          pos:=pos+3;
        end;
  end
  else begin
     s:=val;

     MinuteFlag:=False;

     if (Pos-length(TimeSeparator)-1 >= 0) then begin {9/10/98 - Handle range check errors}
           {Check to See if this is a minute token with m's instead of n's}
                 {9/10/98 - Also check for capital h token}
         if (formatstr[Pos-length(TimeSeparator)-1]='h') or
            (formatstr[Pos-length(TimeSeparator)-1]='H')
           then
            MinuteFlag := True;
     end;

     while (pos+1<=length(formatstr)) and
        (AnsiUpperCase(formatstr[pos+1])[1]=AnsiUpperCase(String(val))) do
     begin
        s:= s+val;
        pos:= pos+1;
     end;

     if MinuteFlag then
     begin              {Translate m's to n's (minutes)}
        if (s='mm') then s:='nn'
        else if (s='m') then s:='n';
     end;
  end;
end;