wwdbspin.pas

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

               else
                  Value:= tempTime;
         end;

         wwSetDateTimeCursorSelection(dateCursor, self, TimeOnly);

      end
      else begin
         Value := Value - FIncrement;
      end;
   end;
   SetModified(True);

   If Assigned(FAfterDownClick) then FAfterDownClick(self);
end;

procedure TwwDBSpinEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if (parent<>nil) and wwIsClass(parent.classtype, 'TwwCustomDBGrid') then begin
//  if Parent is TwwCustomDBGrid then begin
    { 6/10/98 - Support spins in grid if alt is pressed }
     if (not AllSelected) or (ssAlt in Shift) then begin
        if Key = VK_UP then UpClick (Self)
        else if Key = VK_DOWN then DownClick(Self);
        if (Key=VK_UP) or (Key=VK_DOWN) then Key:= 0;
     end
  end
  else begin
     if (Key = VK_UP) then UpClick (Self)
     else if (Key = VK_DOWN) then DownClick (Self);
     if (Key=VK_UP) or (Key=VK_DOWN) then Key:= 0;
  end;
  inherited KeyDown(Key, Shift);
  if (key=vk_delete) and (not FEditorEnabled) then begin { 7/3/97 - Ignore delete }
    key:= 0;
    MessageBeep(0)
  end;
end;

procedure TwwDBSpinEdit.KeyPress(var Key: Char);
begin
  if not IsValidChar(Key) then
  begin
    Key := #0;
    MessageBeep(0)
  end;
  if Key <> #0 then inherited KeyPress(Key);
end;

function TwwDBSpinEdit.IsValidChar(Key: Char): Boolean;
begin
   { 7/3/97 - Check EditorEnabled in all cases }
   if isDateTimeField or ((Field=Nil) and isDateField)
                      or ((Field=Nil) and isTimeField) then
      result:= True
   else
      Result := (Key in [DecimalSeparator, '+', '-', '0'..'9']) or
        ((Key < #32));  {changed vk_return is valid }
   if not FEditorEnabled and Result and ((Key >= #32) or
       (Key = Char(VK_BACK)) or (Key = Char(VK_DELETE))) then
      Result := False;
end;

procedure TwwDBSpinEdit.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style :=(Params.Style and not (ES_AUTOVSCROLL or ES_WANTRETURN) or
                   WS_CLIPCHILDREN {or ES_MULTILINE});

  if UseRightToLeftAlignment or LimitEditRect or (EditAlignment = eaRightAlignEditing) then
    Params.Style:= Params.Style or ES_MULTILINE;
  if ButtonEffects.Transparent or ButtonEffects.Flat then
     Params.Style:= Params.Style and not WS_CLIPCHILDREN;
end;

procedure TwwDBSpinEdit.CreateWnd;
begin
  inherited CreateWnd;
  SetEditRect;
end;

procedure TwwDBSpinEdit.SetEditRect;
var
  Loc: TRect;
begin
{  if Frame.IsFrameEffective then begin
     inherited;
     exit;
  end;}
  SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc));
  Loc.Bottom := ClientHeight;
  Loc.Right := ClientWidth - FButton.Width - 2;
  if Frame.IsFrameEffective then
    Loc.Right:= Loc.Right-1;
  if BorderStyle = bsNone then begin
     Loc.Top := 2;
     Loc.Left := 2;
  end
  else begin
     Loc.Top := 0;
     Loc.Left := 0;
  end;
  SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@Loc));
end;

procedure TwwDBSpinEdit.WMSize(var Message: TWMSize);
var offset: integer;
begin
  inherited;

  if FButton <> nil then
  begin
    if (parent<>nil) and wwIsClass(parent.classtype, 'TwwCustomDBGrid') then offset:=0 else offset:=1;
//    if (parent is TwwCustomDBGrid) then offset:= 0 else offset:= 1;

    if (not NewStyleControls) or (BorderStyle = bsNone) or (not Ctl3d) then
    begin
       if Frame.IsFrameEffective then
          Fbutton.SetBounds (Width - FButton.Width - offset-1, 1, FButton.Width, ClientHeight-3)
       else
          Fbutton.SetBounds (Width - FButton.Width - offset, offset, FButton.Width, ClientHeight-offset*2);
//       FButton.SetBounds (Width - FButton.Width, offset, FButton.Width, Height-offset)
    end
    else FButton.SetBounds (Width - FButton.Width - 4, 0, FButton.Width, Height-3);
    SetEditRect;
  end;
end;

Function TwwDBSpinEdit.GetIconIndent: integer;
begin
   result:= FButton.Width;
end;

Function TwwDBSpinEdit.GetIconLeft: integer;
begin
   result:= FButton.Left - 1;
end;


procedure TwwDBSpinEdit.WMPaste(var Message: TWMPaste);
begin
  if not FEditorEnabled or ReadOnly then Exit;
  inherited;
end;

procedure TwwDBSpinEdit.WMCut(var Message: TWMPaste);
begin
  if not FEditorEnabled or ReadOnly then Exit;
  inherited;
end;

function TwwDBSpinEdit.GetValue: Double;
var Date: TDateTime;
//    TempText: string;
    FloatValue: Extended;

    { 11/7/97 - Support displayformat property and still allow spinning }
    function NumericText: string;
    var TempText: string;
        pos, endpos: integer;
    begin
      TempText:= Text;
      pos:= 1;
      while (pos<=length(TempText)) and
             not (TempText[pos] in ['0'..'9', DecimalSeparator, ThousandSeparator]) do inc(pos);
      endPos:= pos;
      while (endpos<=length(TempText)) and
            (TempText[endpos] in ['0'..'9', DecimalSeparator, ThousandSeparator]) do inc(endpos);
      result:= copy(TempText, pos, endPos-pos);
    end;

begin

  if (Field is TFloatField) or (GetDisplayFormat<>'') then begin
     if (Text='') then result:= FMinValue
     else if wwStrToFloat2(Text, FloatValue, GetDisplayFormat) then
        result:= FloatValue
     else result:= FMinValue
{     else if (not wwStrToFloat(Text)) then
     begin
        TempText:= NumericText;
        TempText:= strReplaceCharWithStr(TempText, ThousandSeparator, '');
        if not (wwStrToFloat(TempText)) then
           result:= FMinValue
        else Result:= StrToFloat(TempText)
     end
     else Result := StrToFloat(Text);}
  end
  else if (Field is TIntegerField) then begin
     if (Text='') then result:= FMinValue
     else if wwStrToFloat2(Text, FloatValue, GetDisplayFormat) then
        result:= FloatValue
     else result:= FMinValue
{     if (Text='') then result:= FMinValue
     else if (not wwStrToInt(Text)) then
     begin
        TempText:= NumericText;
        TempText:= strReplaceCharWithStr(TempText, ThousandSeparator, '');
        if not (wwStrToInt(TempText)) then
           result:= FMinValue
        else Result:= StrToInt(tempText)
     end
     else Result := StrToInt(Text);
}
  end
  else if isDateField then begin
     if (Text='') or (not wwStrToDate(Text)) then
        result:= FMinValue
     else Result := StrToDate(Text);
  end
  else if isTimeField then begin
      if (Text='') or (not wwStrToTime(Text)) then
        result:= FMinValue
     else Result := StrToTime(Text);
  end
  else if isDateTimeField then begin
     if (Text='') then result:= FMinValue
     else if (not wwStrToDateTime(Text)) and (wwStrToDate(Text)) then
        Result:= StrToDate(Text)
     else if wwStrToDateTime(Text) then
        Result:= wwStrToDateTimeVal(Text)
     else if wwScanDate(Text, Date) then
        result:= Date
     else
        result:= FMinValue
  end
  else if (Text='') or (not wwStrToFloat(Text)) then begin
     result:= FMinValue;
  end
  else begin
    Result := StrToFloat(Text);
  end;

//**
{
  if isDateField then begin
     if (Text='') or (not wwStrToDate(Text)) then
        result:= FMinValue
     else Result := StrToDate(Text);
  end
  else if isTimeField then begin
      if (Text='') or (not wwStrToTime(Text)) then
        result:= FMinValue
     else Result := StrToTime(Text);
  end
  else if isDateTimeField then begin
     if (Text='') then result:= FMinValue
     else if (not wwStrToDateTime(Text)) and (wwStrToDate(Text)) then
        Result:= StrToDate(Text)
     else if wwStrToDateTime(Text) then
        Result:= wwStrToDateTimeVal(Text)
     else if wwScanDate(Text, Date) then
        result:= Date
     else
        result:= FMinValue
  end
  else if (Text='') then result:= FMinValue
  else if wwStrToFloat2(Text, FloatValue, DisplayFormat) then
     result:= FloatValue
  else result:= FMinValue;
}


end;

procedure TwwDBSpinEdit.SetValue (NewValue: Double);
var FloatValue: Extended;
begin
  if ((DataLink.Field is TIntegerField) or
     (DataLink.Field is TFloatField)) and
    (GetDisplayFormat<>'') then
  begin
     FloatValue:= CheckValue(NewValue);
     Text:=  FormatFloat(GetDisplayFormat, FloatValue);
     if HandleAllocated then SelectAll;
  end
  else if Field is TFloatField then
     Text := FloatToStr (CheckValue (NewValue))
  else if Field is TIntegerField then
     Text := IntToStr (Trunc(CheckValue (NewValue)))
  else if isDateField then
     Text := DateToStr (CheckValue(NewValue))
  else if isTimeField then
     Text := TimeToStr (CheckValue(NewValue))
  else if isDateTimeField then
  begin
     { DateTimeToStr does not show time if it is 0 }
     if (Field=Nil) and (NewValue=trunc(NewValue)) then
     begin
        Text:= DateToStr(NewValue) + ' '  + TimeToStr(0);
     end
     else Text := DateTimeToStr (CheckValue(NewValue))
  end
  else begin
     FloatValue:= CheckValue(NewValue);
     if (GetDisplayFormat<>'') then
       Text:=  FormatFloat(GetDisplayFormat, FloatValue)
     else
       Text := FloatToStr (FloatValue);
  end;
  if not ((csLoading in ComponentState) or (csDesigning in ComponentState)) then
     SetModified(True); { 11/9/98 }
end;

function TwwDBSpinEdit.CheckValue (NewValue: Double): Double;
begin
  Result := NewValue;
  if (FMaxValue <> FMinValue) or ((FMinValue<>0) or (FMaxValue<>0)) then
  begin
    if NewValue < FMinValue then
      Result := FMinValue
    else if NewValue > FMaxValue then
      Result := FMaxValue;
  end;
end;

procedure TwwDBSpinEdit.CMEnter(var Message: TCMGotFocus);
begin
{  if AutoSelect and not (csLButtonDown in ControlState) then
    SelectAll; }
  inherited;
   if ButtonEffects.Flat then FButton.invalidate;
//  FButton.Flat:= ButtonEffects.Flat and ButtonEffects.Transparent;
end;

function TwwDBSpinEdit.GetShowButton: boolean;
begin
   result:= FButton.visible;
end;

{10/2/97 - Fix bug with blank text for bound date }
procedure TwwDBSpinEdit.Loaded;
begin
  inherited Loaded;
  if (Field=Nil) and (Text='0') and
     (isDateField or isDateTimeField or isTimeField) then
     Text:= '';
end;

{$ifdef wwDelphi4Up}
procedure TwwDBSpinEdit.WMPaint(var Message: TMessage);
begin
  inherited;
  FButton.Invalidate;
  FButton.Update;
end;
{$endif}

{procedure TwwDBSpinEdit.SetFlatButtonTransparent(val: boolean);
begin
   if FFlatButtonTransparent<>val then
   begin
      FFlatButtonTransparent:= val;
      FButton.Flat:= FFlatButton or FFlatButtonTransparent;
      FButton.Invalidate;
   end;
end;

procedure TwwDBSpinEdit.SetFlatButton(val: boolean);
begin
   if FFlatButton<>val then
   begin
      FFlatButton:= val;
      FButton.Flat:= FFlatButton or FFlatButtonTransparent;
      FButton.Invalidate;
   end;
end;

function TwwDBSpinEdit.GetFlatButton: boolean;
begin
   result:= FFlatButton;
end;
}

{procedure TwwDBSpinEdit.RefreshNumericText;
var FloatValue: Extended;
begin
      if DataType in [wwEdtCurrency, wwEdtNumeric] then
      begin
          FloatValue:= CheckValue(Value);
          if DisplayFormat<>'' then
             Text:=  FormatFloat(DisplayFormat, FloatValue)
          else begin
             if DataType = wwEdtCurrency then
                 Text := FloatToStrF(FloatValue, ffCurrency, 15, CurrencyDecimals)
             else
                 Text := FloatToStr (FloatValue);
          end;
      end;
end;

}

procedure TwwDBSpinEdit.SetDisplayFormat(val: string);
begin
   inherited SetDisplayFormat(val);
   SetValue (CheckValue(Value));
end;

procedure Register;
begin
{  RegisterComponents('InfoPower', [TwwDBSpinEdit]);}
end;

end.