ajtimeedit.pas

FileBrowser, source code for delphi

  end; {with}
end; {DrawButton}

{--------------------------------------------------------------------------------------------------}
{                                       TajTimeEdit                                                }
{--------------------------------------------------------------------------------------------------}

constructor TajTimeEdit.Create(AOwner : TComponent);
begin
  inherited;
  fSelIndex       := cSelHours;                                           // Initial selected field is hours.
  fDateTime       := Now;                                                 // Set the time (and date) to now.
  fUpButton       := TajButton.Create(Self, tUpButton  );                 // Create the up button.
  fDownButton     := TajButton.Create(Self, tDownButton);                 // Create the down button.
  fTimer          := TTimer.Create(Self);                                 // Create the auto repeat timer.
  fTimer.Enabled  := false;                                               // Don't need it yet.
  fTimer.Interval := 500;                                                 // Set the initial delay to 0.5 secs.
  fTimer.OnTimer  := RepeatClick;                                         // Connect its event handler.
  fOldWindowProc  := WindowProc;                                          // Keep a copy of the old WindowProc ...
  WindowProc      := NewWindowProc;                                       // and give it a new one.
  Text            := '00:00:00:000';                                      // Set the text to its default.
end; {constructor}

{--------------------------------------------------------------------------------------------------}

destructor TajTimeEdit.Destroy;
begin
  WindowProc  := fOldWindowProc;                                          // Restore the old WindowProc.
  fUpButton.Free;                                                         // Free the buttons.
  fDownButton.Free;
  inherited;
end; {destructor}

{--------------------------------------------------------------------------------------------------}

procedure TajTimeEdit.CreateWnd;
begin
  inherited;
  Perform(EM_SETMARGINS, EC_RIGHTMARGIN, (cButtonWidth + 2) shl 16);      // Reserve space for the buttons.
end; {CreateWnd}

{--------------------------------------------------------------------------------------------------}

procedure TajTimeEdit.NewWindowProc(var Message : TMessage);
begin
  case Message.Msg of
    WM_CHAR           : pWMChar(TWMKey(Message));
    WM_KEYDOWN        : pWMKeyDown(TWMKey(Message));
    WM_LBUTTONUP      : pWMLButtonUp(TWMMouse(Message));
    WM_MOUSEMOVE      : pWMMove(TWMMouse(Message));
    WM_LBUTTONDOWN    : pWMLButtonDown(TWMMouse(Message));
    WM_LBUTTONDBLCLK  : pWMLButtonClick(TWMMouse(Message));
    WM_PAINT          : pWMPaint(Message);
    WM_RBUTTONDOWN,
    WM_SETCURSOR      : ;                                                 // Swallow these ... we don't want them !
  else begin
      if (Message.Msg = WM_NCHITTEST) then
        HideCaret(0);
      if (Message.Msg = EM_SETSEL) then begin                             // Intercept and set our selected text.
        Message.WParam  := cSelText[fSelIndex].SelStart;
        Message.LParam  := cSelText[fSelIndex].SelStart + cSelText[fSelIndex].SelLength;
      end; {if}
      fOldWindowProc(Message);                                            // Pass these and others onward.
    end; {if}
  end; {case}
end; {NewWindowProc}

{--------------------------------------------------------------------------------------------------}

procedure TajTimeEdit.pWMLButtonUp(Message : TWMMouse);
begin
  ReleaseCapture;                                                         // Release mouse capture.
  fUpButton.Down          := false;                                       // Set button up - redraws if it was down.
  fUpButton.HasCapture    := false;                                       // Button no longer has capture.
  fDownButton.Down        := false;                                       // Set button up - redraws if it was down.
  fDownButton.HasCapture  := false;                                       // Button no longer has capture.
  fTimer.Enabled          := false;                                       // Turn the timer off.
  fTimer.Interval         := 500;                                         // Reset the intial interval to 0.5 secs.
end; {pWMLButtonUp}

{--------------------------------------------------------------------------------------------------}

procedure TajTimeEdit.pWMMove(Message : TWMMouse);
begin
  fUpButton.Down    := fUpButton.HasCapture   and PtInRect(fUpButton.Bounds,   Point(Message.XPos, Message.YPos));
  fDownButton.Down  := fDownButton.HasCapture and PtInRect(fDownButton.Bounds, Point(Message.XPos, Message.YPos));
end; {pWMMove}

{--------------------------------------------------------------------------------------------------}

procedure TajTimeEdit.RepeatClick(Sender : TObject);
begin
  if fUpButton.Down then
    SetSelValue(StrToInt(SelText) + 1)
  else if fDownButton.Down then
    SetSelValue(StrToInt(SelText) - 1);
  fTimer.Interval := 100;                                                 // Make the interval shorter.
end; {RepeatClick}

{--------------------------------------------------------------------------------------------------}

procedure TajTimeEdit.pWMLButtonDown(Message : TWMMouse);
begin

  SetFocus;
  SetCapture(Handle);

  SelStart  := cSelText[fSelIndex].SelStart;
  SelLength := cSelText[fSelIndex].SelLength;

  with Message do begin
    if PtInRect(fUpButton.Bounds, Point(XPos, YPos)) then begin

      fUpButton.Down          := true;
      fUpButton.HasCapture    := true;
      fTimer.Enabled          := true;
      SetSelValue(StrToInt(SelText) + 1);

    end else if PtInRect(fDownButton.Bounds, Point(XPos, YPos)) then begin

      fDownButton.Down        := true;
      fDownButton.HasCapture  := true;
      fTimer.Enabled          := true;
      SetSelValue(StrToInt(SelText) - 1);

    end else if (Msg <> WM_LBUTTONDBLCLK) and                             // Don't come in here clicking away ...
      (XPos < ClientWidth - cButtonWidth) then begin                      // Ignore the pixel high gap between the buttons.

      fOldWindowProc(TMessage(Message));                                  // Need to let the TEdit position the SelStart.

      case SelStart of
        0..2  : fSelIndex := cSelHours;
        3..5  : fSelIndex := cSelMins;
        6..8  : fSelIndex := cSelSecs;
        9..12 : fSelIndex := cSelmSecs;
      end; {case}

      SelStart  := cSelText[fSelIndex].SelStart;
      SelLength := cSelText[fSelIndex].SelLength;

    end; {if}
  end; {with}

end; {pWMLButtonDown}

{--------------------------------------------------------------------------------------------------}

procedure TajTimeEdit.pWMLButtonClick(Message : TWMMouse);
begin
  pWMLButtonUp  (Message);                                                // Forgot clicks ... do up and
  pWMLButtonDown(Message);                                                // then down ... seems the wrong
end; {pWMLButtonClick}                                                    // way round - but it works.

{--------------------------------------------------------------------------------------------------}

procedure TajTimeEdit.pWMPaint(Message : TMessage);
begin
  fOldWindowProc(Message);                                                // Let it draw what it needs to.
  fUpButton.Draw;                                                         // Now draw the buttons.
  fDownButton.Draw;
end; {pWMPaint}

{--------------------------------------------------------------------------------------------------}

procedure TajTimeEdit.SetSelValue(Value : integer);
var
  NumText : string;
begin
  case fSelIndex of
    cSelHours           : if (Value < 0) then
                            Value := Value + 24
                          else if (Value > 23) then
                            Value := Value - (Value div 10) * 10;         // Too big, so just use the units.

    cSelMins, cSelSecs  : if (Value < 0) then
                            Value := Value + 60
                          else if (Value > 59) then
                            Value := Value - (Value div 10) * 10;         // Too big, so just use the units.

    cSelmSecs           : if (Value < 0) then
                            Value := Value + 1000
                          else if (Value > 999) then
                            Value := Value - 1000;
  end; {case}
  NumText   := IntToStr(Value);
  while (Length(NumText) < cSelText[fSelIndex].SelLength) do
    NumText := '0' + NumText;
  SelText   := NumText;
  SelStart  := cSelText[fSelIndex].SelStart;
  SelLength := cSelText[fSelIndex].SelLength;
  if Assigned(fTimeChange) then                                           // Fire the time change event if assigned.
    fTimeChange(Self);
end; {SetSelValue}

{--------------------------------------------------------------------------------------------------}

procedure TajTimeEdit.pWMChar(Message : TWMChar);
begin
  if chr(Message.CharCode) in ['0'..'9'] then
    SetSelValue(StrToInt(Copy(SelText + chr(Message.CharCode), 2, Length(SelText))));
end; {pWMChar}

{--------------------------------------------------------------------------------------------------}

procedure TajTimeEdit.pWMKeyDown(Message : TWMChar);
begin
  case Message.CharCode of
    VK_LEFT   : fSelIndex := (fSelIndex + 3) mod 4;
    VK_RIGHT  : fSelIndex := (fSelIndex + 1) mod 4;
    VK_UP     : SetSelValue(StrToInt(SelText) + 1);
    VK_DOWN   : SetSelValue(StrToInt(SelText) - 1);
  end; {case}
  SelStart  := cSelText[fSelIndex].SelStart;
  SelLength := cSelText[fSelIndex].SelLength;
end; {pWMKeyDown}

{--------------------------------------------------------------------------------------------------}

procedure TajTimeEdit.ClearTime;
begin
  Text  := '00:00:00:000';
end; {ClearTime}

{--------------------------------------------------------------------------------------------------}

function TajTimeEdit.GetTime : TDateTime;
var
  Hour, Mins, Secs, MSecs : Word;
begin
  Hour    := StrToInt(Copy(Text,  1, 2));
  Mins    := StrToInt(Copy(Text,  4, 2));
  Secs    := StrToInt(Copy(Text,  7, 2));
  MSecs   := StrToInt(Copy(Text, 10, 3));
  Result  := Trunc(fDateTime) + EncodeTime(Hour, Mins, Secs, MSecs);
end; {GetTime}

{--------------------------------------------------------------------------------------------------}

procedure TajTimeEdit.SetTime(Value : TDateTime);
begin
  fDateTime := Value;
  Text      := FormatDateTime('hh:mm:ss:zzz', Value);
end; {SetTime}

{--------------------------------------------------------------------------------------------------}
{ajTimeEdit}
end.