rm_ctrls.pas

这是一个功能强大

end;

procedure TRMSpinEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  if ArrowKeys and (Key in [VK_UP, VK_DOWN]) then
  begin
    if Key = VK_UP then
      UpClick(Self)
    else if Key = VK_DOWN then
      DownClick(Self);
    Key := 0;
  end;
end;

procedure TRMSpinEdit.Change;
begin
  if not FChanging then
    inherited Change;
end;

procedure TRMSpinEdit.KeyPress(var Key: Char);
begin
  if not IsValidChar(Key) then
  begin
    Key := #0;
    MessageBeep(0)
  end;
  if Key <> #0 then
  begin
    inherited KeyPress(Key);
    if (Key = Char(VK_RETURN)) or (Key = Char(VK_ESCAPE)) then
    begin
      { must catch and remove this, since is actually multi-line }
      GetParentForm(Self).Perform(CM_DIALOGKEY, Byte(Key), 0);
      if Key = Char(VK_RETURN) then
        Key := #0;
    end;
  end;
end;

function TRMSpinEdit.IsValidChar(Key: Char): Boolean;
var
  ValidChars: set of Char;
begin
  ValidChars := ['+', '-', '0'..'9'];
  if ValueType = rmvtFloat then
  begin
    if Pos(DecimalSeparator, Text) = 0 then
      ValidChars := ValidChars + [DecimalSeparator];
    if Pos('E', AnsiUpperCase(Text)) = 0 then
      ValidChars := ValidChars + ['e', 'E'];
  end;
  Result := (Key in ValidChars) or (Key < #32);
  if not FEditorEnabled and Result and ((Key >= #32) or
    (Key = Char(VK_BACK)) or (Key = Char(VK_DELETE))) then
    Result := False;
end;

procedure TRMSpinEdit.CreateParams(var Params: TCreateParams);
const
{$IFDEF COMPILER4_UP}
  Alignments: array[Boolean, TAlignment] of DWORD =
  ((ES_LEFT, ES_RIGHT, ES_CENTER), (ES_RIGHT, ES_LEFT, ES_CENTER));
{$ELSE}
  Alignments: array[TAlignment] of Longint = (ES_LEFT, ES_RIGHT, ES_CENTER);
{$ENDIF}
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style or ES_MULTILINE or WS_CLIPCHILDREN or
{$IFDEF COMPILER4_UP}
  Alignments[UseRightToLeftAlignment, FAlignment];
{$ELSE}
  Alignments[FAlignment];
{$ENDIF}
end;

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

procedure TRMSpinEdit.SetEditRect;
var
  Loc: TRect;
begin
{$IFDEF COMPILER4_UP}
  if (BiDiMode = bdRightToLeft) then
    SetRect(Loc, GetButtonWidth + 1, 0, ClientWidth - 1,
      ClientHeight + 1)
  else
{$ENDIF}
    SetRect(Loc, 0, 0, ClientWidth - GetButtonWidth - 2, ClientHeight + 1);
  SendMessage(Handle, EM_SETRECTNP, 0, Longint(@Loc));
end;

procedure TRMSpinEdit.SetAlignment(Value: TAlignment);
begin
  if FAlignment <> Value then
  begin
    FAlignment := Value;
    RecreateWnd;
  end;
end;

procedure TRMSpinEdit.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
  begin
    ResizeButton;
    SetEditRect;
  end;
end;

procedure TRMSpinEdit.GetTextHeight(var SysHeight, Height: Integer);
var
  DC: HDC;
  SaveFont: HFont;
  SysMetrics, Metrics: TTextMetric;
begin
  DC := GetDC(Handle);
  GetTextMetrics(DC, SysMetrics);
  SaveFont := SelectObject(DC, Font.Handle);
  GetTextMetrics(DC, Metrics);
  SelectObject(DC, SaveFont);
  ReleaseDC(Handle, DC);
  SysHeight := SysMetrics.tmHeight;
  Height := Metrics.tmHeight;
end;

function TRMSpinEdit.GetMinHeight: Integer;
var
  I, H: Integer;
begin
  GetTextHeight(I, H);
  if I > H then
    I := H;
  Result := H + (GetSystemMetrics(SM_CYBORDER) * 4) + 1;
end;

procedure TRMSpinEdit.UpClick(Sender: TObject);
var
  OldText: string;
begin
  if ReadOnly then
    MessageBeep(0)
  else
  begin
    FChanging := True;
    try
      OldText := inherited Text;
      Value := Value + FIncrement;
    finally
      FChanging := False;
    end;
    if CompareText(inherited Text, OldText) <> 0 then
    begin
      Modified := True;
      Change;
    end;
    if Assigned(FOnTopClick) then
      FOnTopClick(Self);
  end;
end;

procedure TRMSpinEdit.DownClick(Sender: TObject);
var
  OldText: string;
begin
  if ReadOnly then
    MessageBeep(0)
  else
  begin
    FChanging := True;
    try
      OldText := inherited Text;
      Value := Value - FIncrement;
    finally
      FChanging := False;
    end;
    if CompareText(inherited Text, OldText) <> 0 then
    begin
      Modified := True;
      Change;
    end;
    if Assigned(FOnBottomClick) then
      FOnBottomClick(Self);
  end;
end;

{$IFDEF COMPILER4_UP}

procedure TRMSpinEdit.CMBiDiModeChanged(var Message: TMessage);
begin
  inherited;
  ResizeButton;
  SetEditRect;
end;
{$ENDIF}

procedure TRMSpinEdit.CMFontChanged(var Message: TMessage);
begin
  inherited;
  ResizeButton;
  SetEditRect;
end;

procedure TRMSpinEdit.CMCtl3DChanged(var Message: TMessage);
begin
  inherited;
  ResizeButton;
  SetEditRect;
end;

procedure TRMSpinEdit.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
  if FUpDown <> nil then
  begin
    FUpDown.Enabled := Enabled;
    ResizeButton;
  end;
  if FButton <> nil then
    FButton.Enabled := Enabled;
end;

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

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

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

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

function TRMSpinEdit.GetValue: Extended;
begin
  try
    if (Text <> '') and (Text <> '-') then
    begin
      if ValueType = rmvtFloat then
        Result := StrToFloat(Text)
      else
        Result := StrToInt(Text);
    end
    else
      Result := 0;
  except
    if ValueType = rmvtFloat then
      Result := FMinValue
    else
      Result := Trunc(FMinValue);
  end;
end;

procedure TRMSpinEdit.SetValue(NewValue: Extended);
begin
  if ValueType = rmvtFloat then
    Text := FloatToStrF(CheckValue(NewValue), ffFixed, 15, FDecimal)
  else
    Text := IntToStr(Round(CheckValue(NewValue)));
end;

function TRMSpinEdit.GetAsInteger: Longint;
begin
  Result := Trunc(GetValue);
end;

procedure TRMSpinEdit.SetAsInteger(NewValue: Longint);
begin
  SetValue(NewValue);
end;

procedure TRMSpinEdit.SetValueType(NewType: TRMValueType);
begin
  if FValueType <> NewType then
  begin
    FValueType := NewType;
    Value := GetValue;
    if FValueType in [rmvtInteger] then
    begin
      FIncrement := Round(FIncrement);
      if FIncrement = 0 then
        FIncrement := 1;
    end;
  end;
end;

function TRMSpinEdit.IsIncrementStored: Boolean;
begin
  Result := FIncrement <> 1.0;
end;

function TRMSpinEdit.IsValueStored: Boolean;
begin
  Result := (GetValue <> 0.0);
end;

procedure TRMSpinEdit.SetDecimal(NewValue: Byte);
begin
  if FDecimal <> NewValue then
  begin
    FDecimal := NewValue;
    Value := GetValue;
  end;
end;

function TRMSpinEdit.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;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMColorPickerButton}

{$IFDEF USE_INTERNAL_JVCL}
const
  LineColorButtonCount = 8;
  SubColorButtonColors: array[0..MaxColorButtonNumber - 1] of TColor = (
    $000000, $003399, $003333, $003300, $663300, $800000, $993333, $333333,
    $000080, $0066FF, $008080, $008000, $808000, $FF0000, $996666, $808080,
    $0000FF, $0099FF, $00CC99, $669933, $CCCC33, $FF6633, $800080, $999999,
    $FF00FF, $00CCFF, $00FFFF, $00FF00, $FFFF00, $FFCC00, $663399, $C0C0C0,
    $CC99FF, $99CCFF, $99FFFF, $CCFFCC, $FFFFCC, $FFCC99, $FF99CC, $FFFFFF);

procedure TRMColorSpeedButton.Paint;
var
  C, S, X, Y: integer;
  R: TRect;
begin
  inherited Paint;

  R := Rect(0, 0, Width - 1, Height - 1);
  with Canvas do
  begin
    if Glyph.Handle <> 0 then
    begin
{$IFDEF USE_TB2K}
      X := ((Width + 1) div 2) - 8 + Integer(FState in [TButtonState(bsDown)]);
      Y := ((Height + 1) div 2) + 4 + Integer(FState in [TButtonState(bsDown)]);
{$ELSE}
      X := ((Width + 1) div 2) - 8 + Integer(FState in [bsDown]);
      Y := ((Height + 1) div 2) + 4 + Integer(FState in [bsDown]);
{$ENDIF}
      if Enabled then
      begin
        Pen.Color := CurColor;
        Brush.Color := CurColor;
      end
      else
      begin
        Pen.Color := clInactiveCaption;
        Brush.Color := clInactiveCaption;
      end;
      Rectangle(X, Y, X + 16, Y + 4);
    end
    else if Caption = '' then
    begin
      C := (R.Bottom - R.Top) div 6 + 1;
      if Enabled then
      begin
        Pen.Color := clGray;
        Brush.Color := CurColor;
      end
      else
      begin
        Pen.Color := clInactiveCaption;
        Brush.Color := clBtnFace;
      end;
      Brush.Style := bsSolid;
      Rectangle(R.Left + C, R.Top + C, R.Right - C + 1, R.Bottom - C + 1);
    end
    else
    begin
      C := (R.Bottom - R.Top) div 6 + 3;
      S := (R.Bottom - R.Top) div 7;
      if Enabled then
        Pen.Color := clGray
      else
        Pen.Color := clInactiveCaption;
      Brush.Style := bsClear;
      Polygon([Point(R.Left + S, R.Top + S), Point(R.Right - S, R.Top + S), Point(R.Right - S, R.Bottom - S), Point(R.Left + S, R.Bottom - S)]);
      if Enabled then
      begin
        Pen.Color := clGray;
        Brush.Color := CurColor;
      end
      else
      begin
        Pen.Color := clInactiveCaption;
        Brush.Color := clBtnFace;
      end;
      Brush.Style := bsSolid;

      Rectangle(R.Left + C + 1, R.Top + C, R.Bottom - C + 2 + 1, R.Bottom - C + 2);
    end;
  end;
end;

constructor TRMColorPickerButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FPopup := nil;
{$IFNDEF USE_TB2K}
  DropdownCombo := True;
  DropdownAlways := True;
{$ENDIF}
  FCurrentColor := clDefault;
  FColorType := rmptFill;
  FAutoColor := clDefault;
  FAutoCaption := RMLoadStr(STransparent);

  FColorDialog := TColorDialog.Create(Self);
  FColorDialog.Options := [cdFullOpen, cdSolidColor, cdAnyColor];

  FButtonHeight := 22;
  FColorSize := 18;
  FColorSpace := 0;
  FColorSpaceTop := 4;
  FColorSpaceBottom := 4;
  FTopMargin := 2;
  FBottomMargin := 4;
  FHoriMargin := 7;
end;

destructor TRMColorPickerButton.Destroy;
begin
  FreeAndNil(FPopup);
  inherited Destroy;
end;

procedure TRMColorPickerButton.DrawButtonGlyph(aColor: TColor);
begin
  Glyph.Canvas.Brush.Color := aColor;
  Glyph.Canvas.Brush.Style := bsSolid;
  Glyph.Canvas.FillRect(Rect(0, 12, 15, 15));

  Invalidate;
end;

procedure TRMColorPickerButton.ColorButtonClick(Sender: TObject);
begin
  if TRMToolbarButton(Sender).Tag = FOtherButton.Tag then // Other Button
  begin
    FColorDialog.Color := FCurrentColor;
    if FColorDialog.Execute then
    begin
      SetSelectedColor(FCol