spinse.pas

FlexGraphics是一套创建矢量图形的VCL组件

procedure TCustomUpDownSE.Paint;
var DC: HDC;
    UpSize, DownPos: integer;
    {$IFDEF XPTHEMES}
    Details: TThemedElementDetails;
    {$ENDIF}
    FillBrush: HBrush;
    State: cardinal;
    Range: TRect;
    IsEnabled: boolean;
begin
 DC := Canvas.Handle;
 UpSize := Height div 2;
 DownPos := UpSize;
 if Height and 1 <> 0 then begin
  FillBrush := CreateSolidBrush(ColorToRGB(clBtnFace));
  FillRect(DC, Rect(0, UpSize, Width, UpSize+1), FillBrush);
  DeleteObject(FillBrush);
  inc(DownPos);
 end;
 if Assigned(FFocusControl) and (FFocusControl is TCustomSpinEditSE)
   {$IFDEF XPTHEMES}
   and ThemeServices.ThemesEnabled
   {$ENDIF}
  then Range := Rect(0, -1, Width + 1, Height + 1)
  else Range := Rect(0, 0, Width, Height);
 IsEnabled := Enabled and
   (not Assigned(FFocusControl) or FFocusControl.Enabled);
 {$IFDEF XPTHEMES}
 if ThemeServices.ThemesEnabled then with ThemeServices do begin
  if not IsEnabled then
   Details := GetElementDetails(tsUpDisabled)
  else
  if FPressed = udbUp then
   Details := GetElementDetails(tsUpPressed)
  else
  if (FHighlighted = udbUp) and (FPressed = udbNone) then
   Details := GetElementDetails(tsUpHot)
  else
   Details := GetElementDetails(tsUpNormal);
  DrawElement(DC, Details, Rect(Range.Left, Range.Top, Range.Right, UpSize));
  if not IsEnabled then
   Details := GetElementDetails(tsDownDisabled)
  else
  if FPressed = udbDown then
   Details := GetElementDetails(tsDownPressed)
  else
  if (FHighlighted = udbDown) and (FPressed = udbNone) then
   Details := GetElementDetails(tsDownHot)
  else
   Details := GetElementDetails(tsDownNormal);
  DrawElement(DC, Details, Rect(Range.Left, DownPos, Range.Right, Range.Bottom));
 end else
 {$ENDIF}
 begin
  if FPressed = udbUp
   then State := DFCS_SCROLLUP or DFCS_PUSHED
   else State := DFCS_SCROLLUP;
  if Assigned(FFocusControl) and not FFocusControl.Enabled then
   State := State or DFCS_INACTIVE;
  DrawFrameControl(DC, Rect(Range.Left, Range.Top, Range.Right, UpSize),
    DFC_SCROLL, State);
  if FPressed = udbDown
   then State := DFCS_SCROLLDOWN or DFCS_PUSHED
   else State := DFCS_SCROLLDOWN;
  if not IsEnabled then State := State or DFCS_INACTIVE;
  DrawFrameControl(DC, Rect(Range.Left, DownPos, Range.Right, Range.Bottom),
    DFC_SCROLL, State);
 end;
end;

procedure TCustomUpDownSE.DoDownClick;
begin
 if Assigned(FOnDownClick) then FOnDownClick(Self);
end;

procedure TCustomUpDownSE.DoUpClick;
begin
 if Assigned(FOnUpClick) then FOnUpClick(Self);
end;

// TCustomSpinEditSE /////////////////////////////////////////////////////////

constructor TCustomSpinEditSE.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FButton := TUpDownSE.Create(Self);
  {$IFDEF XPTHEMES}
  if ThemeServices.ThemesEnabled then FButton.Width := 16 else
  {$ENDIF}
  FButton.Width := 15;
  FButton.Height := 17;
  FButton.Visible := True;
  FButton.Parent := Self;
  FButton.FocusControl := Self;
  FButton.OnUpClick := UpClick;
  FButton.OnDownClick := DownClick;
  //Text := '0';
  SetValue(0.0);
  ControlStyle := ControlStyle - [csSetCaption];
  FIncrement := 1;
  FEditorEnabled := True;
  {$IFDEF DELPHI7_UP}
  ParentBackground := False;
  {$ENDIF}
end;

destructor TCustomSpinEditSE.Destroy;
begin
  FButton := nil;
  inherited Destroy;
end;

procedure TCustomSpinEditSE.GetChildren(Proc: TGetChildProc; Root: TComponent);
begin
end;

procedure TCustomSpinEditSE.SetDigitsOnly(const Value: boolean);
var i: integer;
    s: string;
begin
 if Value = FDigitsOnly then exit;
 FDigitsOnly := Value;
 if FDigitsOnly then begin
  // Remove all non-digits chars from text
  s := Text;
  for i:=Length(s) downto 1 do
   if (s[i] < '0') or (s[i] > '9') then Delete(s, i, 1);
 end;
end;

procedure TCustomSpinEditSE.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if Key = VK_UP then UpClick (Self)
  else if Key = VK_DOWN then DownClick (Self);
  inherited KeyDown(Key, Shift);
end;

procedure TCustomSpinEditSE.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 TCustomSpinEditSE.IsValidChar(Key: Char): Boolean;
begin
 Result := (Key < #32) and (Key <> Chr(VK_RETURN));
 if not Result then begin
   Result := (Key >= '0') and (Key <= '9');
   if not Result and not FDigitsOnly then
     Result := (Key = DecimalSeparator) or (Key = '+') or (Key = '-');
 end;
 if not FEditorEnabled and Result and ((Key >= #32) or
   (Key = Char(VK_BACK)) or (Key = Char(VK_DELETE))) then Result := False;
 if Assigned(FOnIsCharValid) then FOnIsCharValid(Self, Key, Result);
end;

procedure TCustomSpinEditSE.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
{  Params.Style := Params.Style and not WS_BORDER;  }
  Params.Style := Params.Style or ES_MULTILINE or WS_CLIPCHILDREN;
end;

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

procedure TCustomSpinEditSE.SetEditRect;
var
  Loc: TRect;
begin
  SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc));
  Loc.Bottom := ClientHeight + 1;  {+1 is workaround for windows paint bug}
  Loc.Right := ClientWidth - FButton.Width - 2;
  Loc.Top := 0;  
  Loc.Left := 0;  
  SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@Loc));
  SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc));  {debug}
end;

procedure TCustomSpinEditSE.WMSize(var Message: TWMSize);
var MinHeight: Integer;
begin
 inherited;
 MinHeight := GetMinHeight;
 { text edit bug: if size to less than minheight, then edit ctrl does
   not display the text }
 if Height < MinHeight then
   Height := MinHeight
 else
 if FButton <> nil then begin
  if NewStyleControls and Ctl3D then begin
   {if ThemeServices.ThemesEnabled then
    FButton.SetBounds(Width - FButton.Width - 3, -1, FButton.Width, Height - 2)
   else }
    FButton.SetBounds(Width - FButton.Width - 4, 0, FButton.Width, Height - 4);
  end else
   FButton.SetBounds (Width - FButton.Width, 1, FButton.Width, Height - 3);
  SetEditRect;
 end;
end;

function TCustomSpinEditSE.GetMinHeight: Integer;
var
  DC: HDC;
  SaveFont: HFont;
  I: Integer;
  SysMetrics, Metrics: TTextMetric;
begin
  DC := GetDC(0);
  GetTextMetrics(DC, SysMetrics);
  SaveFont := SelectObject(DC, Font.Handle);
  GetTextMetrics(DC, Metrics);
  SelectObject(DC, SaveFont);
  ReleaseDC(0, DC);
  I := SysMetrics.tmHeight;
  if I > Metrics.tmHeight then I := Metrics.tmHeight;
  Result := Metrics.tmHeight + I div 4 + GetSystemMetrics(SM_CYBORDER) * 4 + 1;//2;
end;

procedure TCustomSpinEditSE.UpClick(Sender: TObject);
var NewValue: extended;
begin
 if ReadOnly then
  MessageBeep(0)
 else begin
  NewValue := Value + FIncrement;
  DoUpClick(NewValue);
  Value := NewValue;
 end;
end;

procedure TCustomSpinEditSE.DownClick (Sender: TObject);
var NewValue: extended;
begin
 if ReadOnly then
  MessageBeep(0)
 else begin
  NewValue := Value - FIncrement;
  DoDownClick(NewValue);
  Value := NewValue;
 end;
end;

procedure TCustomSpinEditSE.DoDownClick(var NewValue: extended);
begin
 if Assigned(FOnUpClick) then FOnUpClick(Self, NewValue);
end;

procedure TCustomSpinEditSE.DoUpClick(var NewValue: extended);
begin
 if Assigned(FOnDownClick) then FOnDownClick(Self, NewValue);
end;

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

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

procedure TCustomSpinEditSE.CMEnter(var Message: TCMGotFocus);
begin
  if AutoSelect and not (csLButtonDown in ControlState) then
    SelectAll;
  inherited;
end;

procedure TCustomSpinEditSE.CMExit(var Message: TCMExit);
begin
  inherited;
  if CheckValue (Value) <> Value then
    SetValue (Value);
end;

procedure TCustomSpinEditSE.CMEnabledChanged(var Message: TMessage);
begin
 inherited;
 FButton.Invalidate;
end;

function TCustomSpinEditSE.GetValue: extended;
var s: string;
begin
 // Result := StrToFloatDef(Text, FMinValue);
 s := Text;
 if not TextToFloat(PChar(s), Result, fvExtended) then
  Result := FMinValue;
end;

procedure TCustomSpinEditSE.SetValue(NewValue: extended);
begin
 Text := FloatToStrF(CheckValue(NewValue), ffFixed, 15, FDecimal);
end;

function TCustomSpinEditSE.CheckValue(NewValue: extended): extended;
begin
  Result := NewValue;
  if (FMaxValue <> FMinValue) then
  begin
    if NewValue < FMinValue then
      Result := FMinValue
    else if NewValue > FMaxValue then
      Result := FMaxValue;
  end;
end;

function TCustomSpinEditSE.GetIntValue: integer;
begin
 Result := Trunc(Value);
end;

procedure TCustomSpinEditSE.SetIntValue(const Value: integer);
begin
 Self.Value := Value;
end;

procedure TCustomSpinEditSE.SetDecimal(const Value: integer);
begin
 if Value = FDecimal then exit;
 FDecimal := Value;
 Self.Value := Self.Value;
end;

end.