rvspinedit.pas

richviewaction 1.58 需要richview 1.9.46

  end;
end;
{------------------------------------------------------------------------------}
procedure TRVSpinEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if not Enabled then exit;
  case Key of
  VK_UP, VK_DOWN, VK_NEXT, VK_PRIOR:
    if ReadOnly then
      MessageBeep(0)
    else
      case Key of
        VK_UP:
          Value := Value+Increment;
        VK_DOWN:
          Value := Value-Increment;
        VK_NEXT:
          Value := Value-Increment*10;
        VK_PRIOR:
          Value := Value+Increment*10;
      end;
  end;
  inherited KeyDown(Key, Shift);
end;
{------------------------------------------------------------------------------}
procedure TRVSpinEdit.KeyPress(var Key: Char);
begin
  if not Enabled then exit;
  if not IsValidChar(Key) then begin
    Key := #0;
    MessageBeep(0)
  end;
  if (Key <> #0) then
    inherited KeyPress(Key);
end;
{------------------------------------------------------------------------------}
function TRVSpinEdit.GetValue: Extended;
begin
  try
    if Text<>'' then
      Result := StrToFloat (Text)
    else
      Result := CheckValue(0);
  except
    Result := CheckValue(0);
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVSpinEdit.SetValue(NewValue: Extended);
begin
  if IntegerValue or (Digits=0) then
    Text := FloatToStr (CheckValue (NewValue))
  else
    Text := FloatToStrF (CheckValue (NewValue), ffFixed, 18, Digits);
end;
{------------------------------------------------------------------------------}
{$IFNDEF USERVKSDEVTE}
procedure TRVSpinEdit.UpDownClick(Sender: TObject; Button: TUDBtnType);
begin
  FButton.Position := 0;
end;
{------------------------------------------------------------------------------}
procedure TRVSpinEdit.UpDownClickEx(Sender: TObject; Delta: Integer);
begin
  if ReadOnly then
  begin
    MessageBeep(0);
    exit;
  end;
  Value := Value + Increment*Delta;
end;
{$ELSE}
procedure TRVSpinEdit.UpDownClick(Sender: TObject; var AllowChange: Boolean);
var
  Delta: integer;
begin
  if FUpdating then
    exit;
  if ReadOnly then
  begin
    MessageBeep(0);
    Exit;
  end;
  Delta := FButton.Position - FOldButtonPos;
  Value := Value + Increment * Delta;
  if not Indeterminate then begin
    FUpdating := True;
    try
      FButton.Position := AsInteger;
      FOldButtonPos := AsInteger;
    finally
      FUpdating := False;
    end;
  end;
end;
{$ENDIF}
{------------------------------------------------------------------------------}
function TRVSpinEdit.DoMouseWheelDown(Shift: TShiftState;
  MousePos: TPoint): Boolean;
begin
  if not ReadOnly then
    Value := Value - FIncrement;
  Result := True;
end;
{------------------------------------------------------------------------------}
function TRVSpinEdit.DoMouseWheelUp(Shift: TShiftState;
  MousePos: TPoint): Boolean;
begin
  if not ReadOnly then
    Value := Value + FIncrement;
  Result := True;
end;
{------------------------------------------------------------------------------}
function TRVSpinEdit.GetIndeterminate: Boolean;
begin
  Result := Trim(Text)='';
end;
{------------------------------------------------------------------------------}
procedure TRVSpinEdit.SetIndeterminate(const NewIndeterminate: Boolean);
begin
  if NewIndeterminate then
    Text := ''
  else if Text='' then
    Value := CheckValue(0);
end;
{------------------------------------------------------------------------------}
function TRVSpinEdit.AsInteger: Integer;
begin
  Result := Round(Value);
end;
{------------------------------------------------------------------------------}
procedure TRVSpinEdit.CMEnabledChanged(var Msg: TMessage);
begin
  inherited;
  FButton.Enabled := Enabled;
end;
{------------------------------------------------------------------------------}
procedure TRVSpinEdit.CMBiDiModeChanged(var Msg: TMessage);
begin
   inherited;
   AdjustItself;
end;
{------------------------------------------------------------------------------}
procedure TRVSpinEdit.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
  Message.Result := DLGC_WANTARROWS;
end;

{$IFDEF USERVKSDEVTE}
procedure TRVSpinEdit.DoPaint;
var
  MyDC: HDC;
  TempDC: HDC;
  OldBmp, TempBmp: HBITMAP;
begin
  if Parent = nil then Exit;
  if not HandleAllocated then Exit;

  FPainting := True;

  HideCaret(Handle);
  
  MyDC := GetDC(Handle);
  try
    TempDC := CreateCompatibleDC(MyDC);
    try
      TempBmp := CreateCompatibleBitmap(MyDC, Succ(ClientWidth), Succ(ClientHeight));
      try
        OldBmp := SelectObject(TempDC, TempBmp);

        PaintTo(TempDC, 0, 0);

        if BorderStyle = bsSingle then
          BitBlt(MyDC, 0, 0, ClientWidth, ClientHeight, TempDC, 2, 2, SRCCOPY)
        else
          BitBlt(MyDC, 0, 0, ClientWidth, ClientHeight, TempDC, 0, 0, SRCCOPY);

        SelectObject(TempDC, OldBmp);
      finally
        DeleteObject(TempBmp);
      end;
    finally
      DeleteDC(TempDC);
    end;
  finally
    ReleaseDC(Handle, MyDC);

    ShowCaret(Handle);
  end;

  FPainting := False;
end;

procedure TRVSpinEdit.SNMThemeMessage(var Msg: TMessage);
var
  R: TRect;
begin
  if not HandleAllocated then Exit;
  case Msg.wParam of
    SMP_REPAINT, SMP_APPLYTHEME, SMP_CHANGETHEME, SMP_REMOVETHEME:
      begin
        SendMessage(Handle, WM_NCPAINT, 0, 0);
        R := GetClientRect;
        InvalidateRect(Handle, @R, true);
      end;
  end;
end;

procedure TRVSpinEdit.WndProc(var Message: TMessage);
var
  Canvas: TCanvas;
  R: TRect;
begin
  case Message.Msg of
    CN_CTLCOLOREDIT, CN_CTLCOLORSTATIC:
      begin
        inherited ;
        SetBkMode(THandle(Message.wParam), TRANSPARENT);
      end;
    WM_NCPAINT:
      begin
        GetWindowRect(Handle, R);
        OffsetRect(R, -R.Left, -R.Top);

        if BorderStyle = bsNone then
          InflateRect(R, 2, 2);

        Canvas := TCanvas.Create;
        Canvas.Handle := GetWindowDC(Handle);

        ExcludeClipRect(Canvas.Handle, R.Left + 2, R.Top + 2, R.Left + 2 + ClientWidth, R.Top + 2 + ClientHeight);

        PaintBorder(Canvas, R);

        ReleaseDC(Handle, Canvas.Handle);
        Canvas.Handle := 0;
        Canvas.Free;
        Message.Result := 0;
      end;
    WM_ERASEBKGND:
      begin
        Canvas := TCanvas.Create;
        Canvas.Handle := THandle(Message.wParam);

        if Canvas.Handle <> 0 then
        begin
          R := Rect(0, 0, Width, Height);
          InflateRect(R, 2, 2);

          PaintBuffer(Canvas, R);
        end;

        Canvas.Handle := 0;
        Canvas.Free;

        Message.Result := 1;
        Exit;
      end;
    WM_PAINT:
      begin
        inherited ;

        Canvas := TCanvas.Create;
        Canvas.Handle := GetDC(Handle);

        if not FPainting then
          DoPaint;

        ReleaseDC(Handle, Canvas.Handle);
        Canvas.Handle := 0;
        Canvas.Free;
      end;
  else
    inherited ;
  end;
end;

procedure TRVSpinEdit.PaintBorder(Canvas: TCanvas; ARect: TRect);
var
  Theme: HTheme;
  Part, ThemeState: integer;
  DrawState: TTeEditDrawState;
begin
  if IsObjectDefined(kescEdit) then
  begin
    if not Enabled then
      DrawState := kedsDisabled
    else
      if Focused then
        DrawState := kedsFocused
      else
        DrawState := kedsNormal;

    CurrentTheme.EditDraw(kescEdit, Canvas, EditInfo(ARect, DrawState));
  end
  else
    if UseThemes and (BorderStyle = bsSingle) then
    begin
      Theme := OpenThemeData(0, 'Edit');
      Part := integer(EP_EDITText);

      if not Enabled then
        ThemeState := integer(ETS_DISABLED)
      else
        if Focused then
          ThemeState := integer(ETS_SELECTED)
        else
          ThemeState := integer(ETS_NORMAL);

      DrawThemeBackground(Theme, Canvas.Handle, Part, ThemeState, ARect, nil);

      CloseThemeData(Theme);
    end
    else
    begin
      DrawEdge(Canvas, ARect, clBtnShadow, clBtnHighlight);
      InflateRect(ARect, -1, -1);
      DrawEdge(Canvas, ARect, cl3DDkShadow, clBtnFace);
    end;
end;

procedure TRVSpinEdit.PaintBuffer(Canvas: TCanvas; ARect: TRect);
var
  Theme: HTheme;
  Part, ThemeState: integer;
  DrawState: TTeEditDrawState;
begin
  if IsObjectDefined(kescEdit) then
  begin
    if not Enabled then
      DrawState := kedsDisabled
    else
      if Focused then
        DrawState := kedsFocused
      else
        DrawState := kedsNormal;

    CurrentTheme.EditDraw(kescEdit, Canvas, EditInfo(ARect, DrawState));
  end
  else
    if not UseThemes then
    begin
      { Default drawing }
      FillRect(Canvas, ARect, Color);
    end
    else
    begin
      { XP style }
      Theme := OpenThemeData(0, 'Edit');
      Part := integer(EP_EDITText);
      if not Enabled then
        ThemeState := integer(ETS_DISABLED)
      else
        if Focused then
          ThemeState := integer(ETS_SELECTED)
        else
          ThemeState := integer(ETS_NORMAL);
      DrawThemeBackground(Theme, Canvas.Handle, Part, ThemeState, ARect, nil);
      CloseThemeData(Theme);
    end;
end;

procedure TRVSpinEdit.Change;
begin
  DoPaint;
  inherited Change;
end;

{$ENDIF}

end.