wwdbedit.pas

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

end;

Function TwwDBCustomEdit.AllSelected: boolean;
begin
   result:= (selStart=0) and (selLength=length(Text));
end;

Function TwwDBCustomEdit.DoAutoFillDate(var Key: char): boolean;
var NowYear, NowMonth, NowDay: word;
    NowHour, NowMin, NowSec, NowMSec: word;
    dateCursor: TwwDateTimeSelection;
    curText: string;
    tempYear: integer;

    procedure AddDateSeparator;
    begin
        if (length(curText)>0) and (curText[length(curText)]<>DateSeparator) then
           if strCount(curText, DateSeparator)<2 then
              curText:= curText+ DateSeparator;
    end;

    procedure AddTimeSeparator;
    begin
        curText:= curText + TimeSeparator;
    end;

    Function DateComplete: boolean;
    begin
       if (strCount(curText, DateSeparator)>=2) and
          (curText[length(curText)]<>DateSeparator) then result:= True
       else result:= False
    end;

    Function TimeSecondComplete: boolean;
    begin
          if (strCount(curText, TimeSeparator)>=2) and
             (curText[length(curText)]<>TimeSeparator) then result:= True
          else result:= False
    end;

    Function TimeAMPMComplete: boolean;
    begin
       if TimeAMString='' then result:= TimeSecondComplete
       else begin
          // 2/12/06 - Use AnsiUpperCase
          result:=
             (pos(AnsiUppercase(TimeAMString[1]), AnsiUppercase(curText))>0) or
             (pos(AnsiUppercase(TimePMString[1]), AnsiUppercase(curText))>0)
       end
    end;

    Function Make2DigitStr(val: integer): string;
    begin
        if val < 10 then result:= '0' + inttostr(val)
        else result:= inttostr(val);
    end;

begin
   result:= False;
   if inherited ReadOnly then exit; { 10/3/96 }
                                    { Add TimeField support }
   if not (isDateField or isDateTimeField or isTimeField) then exit;
{   if not ((Field is TDateField) or (Field is TDateTimeField) and not (Field is TTimeField)) then exit;}
   if (selStart<length(Text)) and not AllSelected then exit;

   if ReadOnly then MessageBeep(0)
   else begin
      result:= True;

      if not AllSelected then curText:= Text
      else curText:= '';

      DecodeDate(Now, NowYear, NowMonth, NowDay);
      DecodeTime(Now, NowHour, NowMin, NowSec, NowMSec);
      Key:= #0;
      if PreventEdit then exit;
      DataLink.Edit;

      if (not isTimeField) then begin      {Add TimeField Support}
      if AllSelected then
         case wwGetDateOrder(ShortDateFormat) of
           doYMD: DateCursor:= wwdsYear;
           doMDY: DateCursor:= wwdsMonth;
           doDMY: DateCursor:= wwdsDay;
           else DateCursor:= wwdsMonth; { Make compiler happy}
         end
      else begin
         if not DateComplete and (curText[length(curText)]<>DateSeparator) then
         begin
            Text:= curText + DateSeparator;
            SelStart:= length(Text);
            exit;
         end;
         dateCursor:= wwGetDateTimeCursorPosition(SelStart, curText, false);
      end;
      end
      else begin  {Add TimeField Support}
         dateCursor:= wwGetTimeCursorPosition(SelStart, curText);
      end;


      if (DateComplete or isTimeField) and (DateCursor in [wwdsDay, wwdsYear, wwdsMonth]) then
         DateCursor:= wwdsHour;

      case DateCursor of
         wwdsDay: begin
               if pos('dd', lowercase(ShortDateFormat))>0 then
                  curText:= curText + Make2DigitStr(NowDay)
               else curText:= curText + inttostr(NowDay);
               AddDateSeparator;
             end;

         wwdsYear: begin
               if pos('yyyy', ShortDateFormat)>0 then
                  curText:= curText + inttostr(NowYear)
               else begin { 2 digit year }
                  tempYear:= NowYear mod 100;
                  curText:= curText + Make2DigitStr(tempYear);
               end;
               AddDateSeparator;
            end;

         wwdsMonth: begin
               if pos('mm', lowercase(ShortDateFormat))>0 then
                  curText:= curText + Make2DigitStr(NowMonth)
               else curText:= curText + inttostr(NowMonth);
               AddDateSeparator;
            end;
      end;

      if (not (isDateField)) and (not TimeAMPMComplete) and
{      if (not (Field is TDateField)) and (not TimeAMPMComplete) and}
         (DateCursor in [wwdsHour, wwdsMinute, wwdsSecond, wwdsAMPM]) then
      begin
         if TimeSecondComplete and (DateCursor=wwdsSecond) then DateCursor:=  wwdsAMPM;

         if (DateCursor =wwdsHour) and (not isTimeField) then begin {Added for TimeField support}
            if (curText[length(curText)]<>' ') then
            begin
               Text:= curText + ' ';
               SelStart:= length(Text);
               exit;
            end;
         end
         else if (DateCursor=wwdsMinute) and (curText[length(curText)]<>TimeSeparator) then
         begin
            Text:= curText + TimeSeparator;
            SelStart:= length(Text);
            exit;
         end;

         case DateCursor of
            wwdsHour:  begin
                  if TimeAMString<>'' then begin
                     NowHour:= NowHour mod 12;
                     if NowHour=0 then NowHour:=12;  {2/23/97}
                  end;
                  curText:= curText + inttostr(NowHour);
                  AddTimeSeparator;
               end;
            wwdsMinute: begin
                   curText:= curText + Make2DigitStr(NowMin);
                   AddTimeSeparator;
               end;
            wwdsSecond: begin
                   curText:= curText + Make2DigitStr(NowSec);
               end;
            wwdsAMPM: begin
                   if curText[length(curText)]<>' ' then
                      curText:= curText + ' ';
                   if (NowHour>=12) then
                      curText:= curText + 'PM'
                   else
                      curText:= curText + 'AM'
               end;
         end
      end;

      Text:= curText;
      SelStart:= length(curText);
      SetModified(True);
   end;
end;

procedure TwwDBCustomEdit.KeyPress(var Key: Char);
var tempres: string;
    OrigKey: Char;
    ClearKey: boolean;
begin
  if parent is TCustomGrid then TCheatGridCast(parent).KeyPress(Key);

  if key=#9 then begin
     key:= #0;  { Never process tabs,
                  Delphi 5 passes this to us if multi-line enabled so we need to handle it }
     exit;
  end;

  if (Key in [#32..#255]) or (ord(key)=vk_back) or ((key = #13) and WantReturns) then begin
     if {(inherited ReadOnly) and} // 6/8/01 - Fix problem where custom control in inspector ignores autoedit of datasource
        (DataSource<>Nil) and (not DataSource.autoEdit) then
        { 9/15/98 - Fix bug where Calculated fields could not be modified with AutoEdit=False}
        if (not (DataSource.state in [dsEdit, dsInsert])) then
     begin
        key:= #0;
        exit;
     end;

     // 1/21/04
     if (DataSource<>nil) and PreventEdit then
     begin
        key:= #0;
     end;

     if (DataSource=nil) then begin
        if not ReadOnly then ReadOnly:= False
        else exit;
     end
     else begin
        if (not ReadOnly) and (FDataLink.Field<>Nil) and  {7/4/97 - Support edits of non physical fields }
           (wwisNonPhysicalField(FDataLink.Field)) then
        begin
           if (FDataLink.Field.ReadOnly) or (not FDataLink.DataSet.CanModify) then exit;

           if (wwisNonPhysicalField(FDataLink.Field)) then
              // 3/14/02 - Don't refer to grid type
              if (parent<>nil) and wwIsClass(parent.classtype, 'TwwCustomDBGrid') and wwGetEditCalculated(parent) then
                 FDataLink.DataSet.Edit
              else
                 FDataLink.DataSet.Edit;
           if (inherited ReadOnly) then inherited ReadOnly:= False;;
        end
     end
  end;

  if (not (FwwPicture.AutoFill and HavePictureMask)) and AutoFillDate and (ord(key)=vk_space) then
  begin
     EnableEdit; {10/4/96}

     if GetKeyState(VK_CONTROL) >= 0 then { Skip auto-fill if Ctrl key is pressed }
        if DoAutoFillDate(key) then
        begin
           DoRefreshValidationDisplay;
           exit;
        end;
  end;

  OrigKey:= Key;
  inherited KeyPress(Key);
  ClearKey:= False;
  if (Key=#0) and (ModifiedInKeyPress) then SetModified(True) { 1/21/97 - Set modified to True }
  else if IsMasked and (Key=#0) and (OrigKey<>#0) then
  begin
     Key:= OrigKey;  {4/28/97 - Support Delphi edit mask }
     ClearKey:= True;
  end;

  // 6/11/03 - Allow code to skip key restriction
  if (not GetFieldMapText('', tempres)) and (patch[4]=False) then  { 8/22/96 - Mapping text so allow any character }
  begin
     if ((FDataLink.Field is TIntegerField) or
        (FDataLink.Field is TFloatField)) and
        (GetDisplayFormat<>'') then
//       (TNumericField(FDataLink.Field).DisplayFormat<>'') then
     begin
        if (Key in [#32..#255]) then begin
           if FDataLink.Field is TIntegerField then begin
              if not (key in ['+', '-', '0'..'9']) then
              begin
                MessageBeep(0);
                Key := #0;
              end
           end
           else begin
              if not (key in [DecimalSeparator, '+', '-', '0'..'9', 'E', 'e']) then
              begin
                MessageBeep(0);
                Key := #0;
              end
           end
        end
     end
     else if (Key in [#32..#255]) and (FDataLink.Field <> nil) and
         not FDataLink.Field.IsValidChar(Key) then
     begin
       MessageBeep(0);
       Key := #0;
     end
  end;

  case Key of
    ^H, ^V, ^X, #32..#255:
      begin
        FDataLink.Edit;
        SetModified(True); { 9/20/96 }
        if not Editable then key:= #0;
      end;
    #27:
      begin
        Reset;
        Invalidate;
        Key := #0;
        // 3/14/02 - Don't refer to grid type
        if (parent<>nil) and wwIsClass(parent.classtype, 'TwwCustomDBGrid') then begin
//        if parent is TwwCustomDBGrid then begin
           parent.setFocus;
        end;
      end;
    #13:  if (not PreventEdit) and WantReturns then begin
             FDataLink.Edit;
             SetModified(True);
          end
          else if (parent<>nil) and wwIsClass(parent.classtype, 'TwwCustomDBGrid') then Key:= #0;
//          else if (parent is TwwCustomDBGrid) then Key:= #0;

    #9: if (parent<>nil) and wwIsClass(parent.classtype, 'TwwCustomDBGrid') then Key:= #0;
//    #9: if (parent is TwwCustomDBGrid) then Key:= #0;
                                                         { 10/27/96 - Ignore tab and cr                            }
                                                         { cr needs to be eaten so that parentgrid is not confused }
                                                         { when using dgEnterToTab }
  end;

  if ClearKey then Key:= #0;   {4/28/97 - Support Delphi edit mask }

end;

procedure TwwDBCustomEdit.KeyUp(var Key: Word; Shift: TShiftState);
begin
  inherited KeyUp(Key, Shift);
{  if IsValidChar(Key) then SetModified(True);}
end;

procedure TwwDBCustomEdit.CNKeyDown(var Message: TWMKeyDown);
var shiftState: TShiftState;
    stat: integer;
begin
  if not (csDesigning in ComponentState) then
  begin
    with Message do
    begin
       shiftState:= KeyDataToShiftState(KeyData);
       if (WantReturns) and (charcode=vk_return) and { Ctrl-Enter goes to grid }
           not (ssCtrl in shiftState) then exit;

       if (charcode = VK_TAB) or (charcode = VK_RETURN) then begin
          if parent is TCustomGrid then begin
            if (charcode <> VK_TAB) or (goTabs in TCheatGridCast(parent).Options) then {7/3/97}
            begin
               parent.setFocus;
               if parent.focused then { Bug fix - Abort in validation prevents focus change }
                 TCheatGridCast(parent).KeyDown(charcode, shiftState);
               exit;
            end
          end
       end;

       { 1/4/2000 es_multiline style does not pass carriage return/line feed to form so
         we pass it ourselves }
       if (Patch[3]=False) and
          ((not Modified) or ((not WantReturns) and (charcode = vk_return))) and
          ((charcode=vk_return) or (charcode=vk_escape)) then
       begin
          if (Windows.GetWindowLong(handle, GWL_STYLE) and es_multiline)<>0 then
          begin
             // 8/22/01 - Don't call inherited if parent processed keystroke.
             // Parent could process keystroke in case of popup menu with escape key assigned
             stat:= SendMessage(GetParent(Handle), TMessage(Message).Msg,
               TMessage(Message).wParam, TMessage(Message).lParam);
             if (stat<>0) then
             begin
               // 7/9/02 - set message.result to 1 if already processed
               // Fixes problem with form events firing when they should not
               if (charcode = vk_escape) or
                  (charcode = vk_return) then
               begin
                  message.result:=1;
                  exit;
               end
             end
          end
       end

    end
  end;

  inherited;
end;

function TwwDBCustomEdit.EditCanModify: Boolean;
begin
  if FDataLink.Field<>Nil then
  begin
     Result := FDataLink.Edit;
     {9/24/97 - Support edits of non physical fields }
     if (not Result) and
        (not ReadOnly) and
        (wwisNonPhysicalField(FDataLink.Field)) and
        (not FDataLink.Field.ReadOnly) and (FDataLink.DataSet.CanModify) then
           result:= True;