⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 jvdbdatetimepicker.pas

📁 East make Tray Icon in delphi
💻 PAS
📖 第 1 页 / 共 2 页
字号:
//Return Value : String
//Description  : The function retrieve for fieldname from specified
//               datasource
//Revision     : August 30, 2000
//Author       : -ekosbg-
///////////////////////////////////////////////////////////////////////////

function TJvDBDateTimePicker.GetDataField: string;
begin
  Result := FDataLink.FieldName;
end;

///////////////////////////////////////////////////////////////////////////
//function TJvDBDateTimePicker.GetDataSource
//Return Value : TDataSource
//Description  : The function retrieve DataSource from specified Table
//               To make connection with database
//Revision     : August 30, 2000
//Author       : -ekosbg-
///////////////////////////////////////////////////////////////////////////

function TJvDBDateTimePicker.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

function TJvDBDateTimePicker.GetReadOnly: Boolean;
begin
  Result := FDataLink.ReadOnly;
end;

function TJvDBDateTimePicker.IsDateAndTimeField: Boolean;
begin
  with FDataLink do
    Result := (Field <> nil) and
      (Field.DataType in [ftDateTime {$IFDEF COMPILER6_UP}, ftTimeStamp {$ENDIF}]) and
      not TrimValue;
end;

///////////////////////////////////////////////////////////////////////////
//procedure TJvDBDateTimePicker.KeyDown
//Parameter   : Key as Word by references,
//              ShiftState as TShiftState, this is enumeration type
//Description : Handling user action what should to do ? The control should
//              tell to datalink that they should change mode to edit doing
//              an action such as delete, insert or...you guess it
//Revision    : August 30, 2000
//Author      : -ekosbg-
///////////////////////////////////////////////////////////////////////////

procedure TJvDBDateTimePicker.KeyDown(var Key: Word; Shift: TShiftState);
const
  cAllowedKeysWhenReadOnly = [VK_LEFT, VK_RIGHT];
begin
  { Only allow left and right arrow when read-only, don't care about Shift }
  if not (Key in cAllowedKeysWhenReadOnly) and FIsReadOnly and not FDataLink.CanModify then
  begin
    if BeepOnError then
      Beep;
    Key := 0;
    Exit;
  end;

  // we still parent code
  inherited KeyDown(Key, Shift);
  // Is it Delete key, insert key or shiftstate ...
  case Key of
    VK_DELETE:
      if Shift * KeyboardShiftStates = [] then
      begin
        FDataLink.Edit;
        if Kind = dtkDate then
        begin
          if IsDateAndTimeField then
            DateTime := NullDate
          else
            DateTime := Trunc(NullDate);
        end
        else
        begin
          if IsDateAndTimeField then
            DateTime := NullDate
          else
            DateTime := Frac(NullDate);
        end;
        CheckNullValue;
        UpdateData(Self);
      end;
    VK_INSERT:
      if (Shift * KeyboardShiftStates = [ssShift]) then
        FDataLink.Edit;
    else
      FDataLink.Edit;
  end;
end;

///////////////////////////////////////////////////////////////////////////
//procedure TJvDBDateTimePicker.KeyPress
//Parameter   : Key as Char by references when the key changes it will
//              reflect to the sender parameter variable.
//Description : Handling user action what should to do ?
//              Hmmm... ok, first of all the character that user typed
//              should be checked, if it is invalid ignored the character.
//              Otherwise, tell to datalink that the mode should change
//              to edit.
//Revision    : August 30, 2000
//Author      : -ekosbg-
///////////////////////////////////////////////////////////////////////////

procedure TJvDBDateTimePicker.KeyPress(var Key: Char);
begin
  if FIsReadOnly and not FDataLink.CanModify then
  begin
    if BeepOnError then
      Beep;
    Key := #0;
    Exit;
  end;

  inherited KeyPress(Key);
  if (Key in [#32..#255]) and ((FDataLink.Field <> nil) and
    not (FDataLink.Field.IsValidChar(Key))) then
  begin
    if BeepOnError then
      Beep;
    Key := #0;
  end;
  case Key of
    #32..#255:
      FDataLink.Edit;
    Esc:
      begin
        FDataLink.Reset;
        SetFocus;
      end;
  end;
end;

procedure TJvDBDateTimePicker.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FDataLink <> nil) and (AComponent = DataSource) then
     DataSource := nil;
end;

///////////////////////////////////////////////////////////////////////////
//procedure TJvDBDateTimePicker.SetDataField
//Parameter    : Value as String
//Description  : The procedure is handling the capability to set the
//               DataField property
//Revision     : August 30, 2000
//Author       : -ekosbg-
///////////////////////////////////////////////////////////////////////////

procedure TJvDBDateTimePicker.SetDataField(Value: string);
begin
  FDataLink.FieldName := Value;
end;

///////////////////////////////////////////////////////////////////////////
//procedure TJvDBDateTimePicker.SetDataSource
//Parameter    : Value as TDataSource
//Description  : The procedure is handling the capability to set the
//               DataSource property
//Revision     : August 30, 2000
//Author       : -ekosbg-
///////////////////////////////////////////////////////////////////////////

procedure TJvDBDateTimePicker.SetDataSource(Value: TDataSource);
begin
  FDataLink.DataSource := Value;
end;

procedure TJvDBDateTimePicker.SetReadOnly(Value: Boolean);
begin
  FDataLink.ReadOnly := Value;
end;

///////////////////////////////////////////////////////////////////////////
//procedure TJvDBDateTimePicker.UpdateDate
//Parameter   :
//Description : We should change the value in datalink, and this is the
//              procedure to handle that event. It will assign with
//              event property Datalink, that is OnUpdateData
//Revision    : August 30, 2000
//Author      : -ekosbg-
///////////////////////////////////////////////////////////////////////////

procedure TJvDBDateTimePicker.UpdateData(Sender: TObject);
begin
  // update value in datalink with date value in control, not from system
  if not FDataLink.Editing then
    Exit;
  if Kind = dtkDate then
  begin
    if Trunc(NullDate) = Trunc(DateTime) then
      FDataLink.Field.Value := Null
    else
    if IsDateAndTimeField then
      FDataLink.Field.AsDateTime := DateTime
    else
      FDataLink.Field.AsDateTime := Trunc(DateTime);
  end
  else
  begin
    if Frac(NullDate) = Frac(DateTime) then
      FDataLink.Field.Value := Null
    else
    if IsDateAndTimeField then
      FDataLink.Field.AsDateTime := DateTime
    else
      FDataLink.Field.AsDateTime := Frac(DateTime);
  end;
end;

procedure TJvDBDateTimePicker.WMPaint(var Msg: TWMPaint);
var
  D: TDateTime;
  ST: TSystemTime;
begin
  if not (csPaintCopy in ControlState) then
    inherited
  else
  begin
    if Kind = dtkDate then
    begin
      if IsDateAndTimeField then
        D := FDataLink.Field.AsDateTime
      else
        D := Trunc(FDataLink.Field.AsDateTime);
    end
    else
    begin
      if IsDateAndTimeField then
        D := FDataLink.Field.AsDateTime
      else
        D := Frac(FDataLink.Field.AsDateTime);
    end;

    DateTimeToSystemTime(D, ST);
    DateTime_SetSystemTime(FPaintControl.Handle, GDT_VALID, ST);
    SendMessage(FPaintControl.Handle, WM_ERASEBKGND, Msg.DC, 0);
    SendMessage(FPaintControl.Handle, WM_PAINT, Msg.DC, 0);
  end;
end;

procedure TJvDBDateTimePicker.WMLButtonDown(var Msg: TWMLButtonDown);
begin
  if FIsReadOnly and not FDataLink.CanModify then
  begin
    SendCancelMode(Self);
    SetFocus;
  end
  else
    inherited;
end;

procedure TJvDBDateTimePicker.CNNotify(var Msg: TWMNotify);
begin
  case Msg.NMHdr^.code of
    MCN_LAST:
      FDataLink.Edit;
  end;
  inherited;
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -