wwdbspin.pas

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

unit Wwdbspin;
{
//
// Components : TwwDBSpinEdit
//
// Copyright (c) 1995-2001 by Woll2Woll Software
//
// 8/3/97 - Adjust top spinbutton so that its offset is at the top when
//          embedded in the grid.  Gives the bitmap more room to display properly.
//
// 10/2/97 - Fix bug with blank text for bound date
// 11/7/98 - Set modified if text needs to be ensured its in the range
// 6/7/00 - Add UpClick and DownClick events
// 9/21/00 - Fix spin transparent button problem
}

interface

{$i wwIfDef.pas}

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, db, dbtables, wwdbedit, Menus, Mask, wwdatsrc,
  wwspin, wwframe, wwtypes;

type
  TwwDBSpinEdit = class(TwwDBCustomEdit)
  private
     FMinValue: Double;
     FMaxValue: Double;
     FIncrement: Double;
     FButton: TwwSpinButton;
     FEditorEnabled: Boolean;
     FButtonEffects: TwwButtonEffects;
//     FFlatButton: boolean;
//     FFlatButtonTransparent: boolean;
     FLimitEditRect: boolean;
     FBeforeUpClick: TNotifyEvent;
     FBeforeDownClick: TNotifyEvent;
     FAfterUpClick: TNotifyEvent;
     FAfterDownClick: TNotifyEvent;

     procedure WMSize(var Message: TWMSize);  message WM_SIZE;

     procedure WMPaste(var Message: TWMPaste);   message WM_PASTE;
     procedure WMCut(var Message: TWMCut);   message WM_CUT;
     procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
     procedure CMExit(var Message: TCMExit); message CM_EXIT;

     function GetValue: Double;
     function CheckValue (NewValue: Double): Double;
     procedure SetValue (NewValue: Double);
     {$ifdef wwDelphi4Up}
     procedure WMPaint(var Message: TMessage); message WM_PAINT;
     {$endif}

//     procedure SetFlatButtonTransparent(val: boolean);
//     procedure SetFlatButton(val: boolean);
//     function GetFlatButton: boolean;

  protected

//    procedure RefreshNumericText; override;
    procedure SetDisplayFormat(val: string); override;
    function IsValidChar(Key: Char): Boolean; virtual;
    procedure UpClick (Sender: TObject); dynamic;
    procedure DownClick (Sender: TObject); dynamic;

    procedure KeyPress(var Key: Char); override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    Function GetIconIndent: integer; override;
    Function GetIconLeft: integer; override;
    function GetShowButton: boolean; override;
    procedure Loaded; override;
    procedure SetEditRect; override;

  public
    SkipUpdate: boolean;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    property HasFocus : boolean read FFocused;

  published
    property Controller;
    property DisableThemes;
    {$ifdef wwDelphi4Up}
    property Anchors;
    property BiDiMode;
    property Constraints;
    {$endif}

    property EditAlignment;  // Define early before window created
    property EditorEnabled: Boolean read FEditorEnabled write FEditorEnabled default True;
    property Increment: Double read FIncrement write FIncrement;
    property MaxValue: Double read FMaxValue write FMaxValue;
    property MinValue: Double read FMinValue write FMinValue;
    property Value: Double read GetValue write SetValue;
    property AutoFillDate;
    property AutoSelect;
    property AutoSize;
    property BorderStyle;
    property CharCase;
    property Color;
    property Ctl3D;
    property DataField;
    property DataSource;
    property DragCursor;
    property DragMode;
    property Enabled;
    property ButtonEffects: TwwButtonEffects read FButtonEffects write FButtonEffects;
//    property ButtonTransparent: boolean read FFlatButtonTransparent write SetFlatButtonTransparent default false;
//    property ButtonFlat : boolean read GetFlatButton write SetFlatButton default False;
    property Font;
    property Frame;
    property LimitEditRect: boolean read FLimitEditRect write FLimitEditRect default False;
    {$ifdef wwDelphi3Up}
    property ImeMode;
    property ImeName;
    {$endif}
    property MaxLength;
    {$ifdef wwDelphi4Up}
    property ParentBiDiMode;  { 2/18/99 - Case sensitive name for Builder 4 }
    {$endif}
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property Picture;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property UnboundDataType;
    property UsePictureMask;
    property Visible;

    property OnChange;
    property OnCheckValue;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property AfterUpClick : TNotifyEvent read FAfterUpClick write FAfterUpClick; { 8/2/00 - Events incorrect before }
    property AfterDownClick : TNotifyEvent read FAfterDownClick write FAfterDownClick;
    property BeforeUpClick : TNotifyEvent read FBeforeUpClick write FBeforeUpClick;
    property BeforeDownClick : TNotifyEvent read FBeforeDownClick write FBeforeDownClick;


  end;

procedure Register;

implementation

uses wwsystem, wwstr, wwcommon;

{$IFDEF WIN32}
{$R WWSPIN32.RES}
{$ELSE}
{$R WWSPIN.RES}
{$ENDIF}

type
  TwwComboButtonEffects = class(TwwButtonEffects)
     protected
        procedure Refresh; override;
  end;

Procedure TwwComboButtonEffects.refresh;
var c: TwwDBSpinEdit;
begin
  c:= TwwDBSpinEdit(Control);
  if c.handleallocated then begin { Don't clip if transparent button }
     if (Flat or Transparent) then
        SetWindowLong(c.handle, GWL_STYLE,
                    GetWindowLong(c.handle, GWL_STYLE) and not WS_CLIPCHILDREN)
     else
        SetWindowLong(c.handle, GWL_STYLE,
                    GetWindowLong(c.handle, GWL_STYLE) or WS_CLIPCHILDREN);
  end
end;
{  Procedure TwwComboButtonEffects.refresh;
  begin
  end;
}
constructor TwwDBSpinEdit.create(AOwner: TComponent);
var i: integer;
    myOwner: TwwSpinButton;
begin
  inherited Create(AOwner);
  FButton := TwwSpinButton.Create (Self);
  FButton.Width := 15;
  FButton.Height := 17;
  FButton.Visible := True;
  FButton.Parent := Self;
  FButton.OnUpClick := UpClick;
  FButton.OnDownClick := DownClick;
  {$IFDEF WIN32}
  FButton.ControlStyle := FButton.ControlStyle + [csReplicatable] - [csFramed];
  myOwner:= FButton;
  if myOwner<>Nil then begin
     for i:= 0 to myOwner.ControlCount-1 do begin
        if myOwner.Controls[i] is TwwTimerSpeedButton then
           myOwner.Controls[i].ControlStyle:= myOwner.Controls[i].ControlStyle + [csReplicatable];
     end
  end;
  {$else}
  FButton.ControlStyle := FButton.ControlStyle - [csFramed];
  {$ENDIF}


  Text := '0';

  ControlStyle := ControlStyle - [csSetCaption];
  FIncrement := 1;
  FEditorEnabled := True;

  FButtonEffects:= TwwComboButtonEffects.create(self, FButton);

end;

destructor TwwDBSpinEdit.Destroy;
begin
   FButtonEffects.Free;
   FButton.Free;
   FButton:= Nil;

   inherited Destroy;
end;

procedure TwwDBSpinEdit.CMExit(var Message: TCmExit);
var OldText: string;
begin
  { 11/7/98 - Set modified if text needs to be ensured its in the range }
  if CheckValue (Value) <> Value then
  begin
    OldText:= Text;
    SetValue (CheckValue(Value));
    if Text<>OldText then Modified:= True;
  end;
  inherited;

  { 8/3/00 - Allows TSpeedButton MouseInControl to be reset }
  TwwTimerSpeedButton(FButton.Controls[0]).Enabled:= false;
  TwwTimerSpeedButton(FButton.Controls[0]).Enabled:= True;
  TwwTimerSpeedButton(FButton.Controls[1]).Enabled:= false;
  TwwTimerSpeedButton(FButton.Controls[1]).Enabled:= True;
  TwwTimerSpeedButton(FButton.Controls[0]).MouseInControl:= false;
  TwwTimerSpeedButton(FButton.Controls[1]).MouseInControl:= false;

  if ButtonEffects.flat or ButtonEffects.Transparent then
  begin
    TwwTimerSpeedButton(FButton.Controls[0]).Transparent:= true;
    TwwTimerSpeedButton(FButton.Controls[1]).Transparent:= true;
    { Unclip children so background is painted }
    SetWindowLong(handle, GWL_STYLE,
                GetWindowLong(handle, GWL_STYLE) and not WS_CLIPCHILDREN);
    invalidate;
  end;

   if ButtonEffects.Flat then
   begin
      FButton.invalidate;
      FButton.Perform(cm_mouseleave, 0, 0);  // 7/29/01 - Invalidates transparent button
   end;
end;

procedure TwwDBSpinEdit.UpClick (Sender: TObject);
var Year, Month, Day: word;
    Hour, Min, Sec, MSec: word;
    tempDate, tempTime: TDateTime;
    dateCursor: TwwDateTimeSelection;
    TimeOnly : boolean;
begin
{   DataLink.Edit;}
   if visible then SetFocus else exit;
   If Assigned(FBeforeUpClick) then FBeforeUpClick(self);

   TimeOnly := false;
   if (not EditCanModify) or ReadOnly or ((DataLink.Field<>Nil) and DataLink.Field.readonly) then
      MessageBeep(0)
   else begin
      if (isDateField or isDateTimeField or isTimeField) then begin

         DecodeDate(Value, Year, Month, Day);
         wwDoEncodeDate(Year, Month, Day, tempDate);

         if (isTimeField) then TimeOnly := True;
         if not TimeOnly then
            tempTime:= Value - tempDate
         else
            tempTime:= Value;

         DecodeTime(Value, Hour, Min, Sec, MSec);

         dateCursor:= wwGetDateTimeCursorPosition(SelStart, Text, TimeOnly);
         case DateCursor of
            wwdsDay: Day:= wwNextDay(Year, Month, Day);
            wwdsYear: Year:= Year + 1;
            wwdsMonth: Month:= (Month mod 12) + 1;
            wwdsHour: Hour := ((Hour+1) mod 24);
            wwdsMinute: Min:= ((Min+1) mod 60);
            wwdsSecond: Sec:= ((Sec+1) mod 60);
            wwdsAMPM: if Hour>=12 then Hour:= Hour - 12 else Hour:= Hour + 12;
         end;

         if DateCursor in [wwdsDay, wwdsYear, wwdsMonth] then begin
            while True do
            begin
               if wwDoEncodeDate(Year, Month, Day, tempDate) then begin
                  Value:= tempDate + tempTime;
                  break;
               end
               else begin
                  Day:= Day - 1;
                  if Day<28 then break;
               end
            end;
         end
         else begin
            if wwDoEncodeTime(Hour, Min, Sec, MSec, tempTime) then
               if not TimeOnly then
                  Value:= int(Value)+ tempTime
               else
                  Value:= tempTime;
         end;

         wwSetDateTimeCursorSelection(dateCursor, self, TimeOnly)

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

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

procedure TwwDBSpinEdit.DownClick (Sender: TObject);
var Year, Month, Day: word;
    Hour, Min, Sec, MSec: word;
    tempDate, tempTime: TDateTime;
    dateCursor: TwwDateTimeSelection;
    TimeOnly: boolean;
begin
{   DataLink.Edit;}
   TimeOnly := false;
   if visible then SetFocus else exit;
   If Assigned(FBeforeDownClick) then FBeforeDownClick(self);

   if (not EditCanModify) or ReadOnly or ((DataLink.Field<>Nil) and DataLink.Field.readonly) then
      MessageBeep(0)
   else begin
      if (isDateField or isDateTimeField or isTimeField) then begin

         DecodeDate(Value, Year, Month, Day);
         wwDoEncodeDate(Year, Month, Day, tempDate);

         if (isTimeField) then TimeOnly := True;
         if not TimeOnly then
            tempTime:= Value - tempDate
         else
            tempTime:= Value;

         DecodeTime(Value, Hour, Min, Sec, MSec);

         dateCursor:= wwGetDateTimeCursorPosition(SelStart, Text, TimeOnly);
         case DateCursor of
            wwdsDay: Day:= wwPriorDay(Year, Month, Day);
            wwdsYear: Year:= Year - 1;
            wwdsMonth: Month:= ((Month+10) mod 12) + 1;
            wwdsHour: Hour := ((Hour+23) mod 24);
            wwdsMinute: Min:= ((Min+59) mod 60);
            wwdsSecond: Sec:= ((Sec+59) mod 60);
            wwdsAMPM: if Hour>=12 then Hour:= Hour - 12 else Hour:= Hour + 12;
         end;
         if DateCursor in [wwdsDay, wwdsYear, wwdsMonth] then begin
            while True do
            begin
               if wwDoEncodeDate(Year, Month, Day, tempDate) then begin
                  Value:= tempDate + tempTime;
                  break;
               end
               else begin
                  Day:= Day - 1;
                  if Day<28 then break;
               end
            end;
         end
         else begin
            if wwDoEncodeTime(Hour, Min, Sec, MSec, tempTime) then
               if not TimeOnly then
                  Value:= int(Value)+ tempTime