flatctrls.pas

comerose_flatstyle_v4.42.9.0_d7.rar

      if NewValue > FMaxValue then
         Result := FMaxValue;
  end;
end;

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

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

procedure TFlatInteger.CMExit(var Message: TCMExit);
begin
  inherited;
  if Text = '' then
     Value := 0;
  if CheckValue(Value) <> Value then
     SetValue(Value)
  else
     SetValue(Value);
end;

function TFlatInteger.GetValue: LongInt;
begin
  if Text = '' then
     Text := '0';
  try
    result := StrToInt(Text);
  except
    result := FMinValue;
  end;
end;

procedure TFlatInteger.SetValue(NewValue: LongInt);
begin
  Text := IntToStr(CheckValue(NewValue));
end;

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

procedure TFlatInteger.Loaded;
begin
  SetEditRect(Handle, Clientwidth, ClientHeight, FButton.Width);
  FButton.SetBounds(Width - FButton.Width - 5, 0, FButton.Width, Height - 6);
  inherited;
end;

procedure TFlatInteger.CreateWnd;
begin
  inherited;
  SetEditRect(Handle, Clientwidth, ClientHeight, FButton.Width);
  FButton.SetBounds(Width - FButton.Width - 5, 0, FButton.Width, Height - 6);
end;

procedure TFlatInteger.CMTextChanged(var Message: TMessage);
begin
  inherited;
  if Text = '' then begin
     Text := '0';
  end;
  Value := CheckValue(StrToInt(Text));
end;

{ TFlatFloat }

constructor TFlatFloat.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle         := ControlStyle - [csSetCaption];
  FButton              := TDefineSpin.Create (Self);
  FButton.Parent       := Self;
  FButton.Width        := 32;
  FButton.Height       := 10;
  FButton.Visible      := True;
  FButton.FocusControl := Self;
  FButton.OnUpClick    := UpClick;
  FButton.OnDownClick  := DownClick;
  Text := '0' + DecimalSeparator + '00';
  FDigits              := 2;
  FPrecision           := 9;
  FIncrement           := 0.5;
  FEditorEnabled       := True;
end;

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

procedure TFlatFloat.KeyDown(var Key: Word; Shift: TShiftState);
begin
  case Key of
      VK_UP: UpClick(Self);
    VK_DOWN: DownClick(Self);
  end;
  inherited KeyDown(Key, Shift);
end;

procedure TFlatFloat.KeyPress(var Key: Char);
begin
  if (not IsValidChar(Key))or((key='.') and (pos('.',Text)>0)) then begin
    Key := #0;
    MessageBeep(0)
  end;

  if Key <> #0 then
  inherited KeyPress(Key);
end;

function TFlatFloat.IsValidChar(Key: Char): Boolean;
begin
  Result := (Key in [DecimalSeparator, '0'..'9',#8,#13,#46]);
  if not FEditorEnabled and Result then
    Result := False;
end;

procedure TFlatFloat.WMSize(var Message: TWMSize);
var
  MinHeight: Integer;
begin
  inherited;
  MinHeight := GetMinHeight;
  if Height < MinHeight then
    Height := MinHeight
  else
    if FButton <> nil then
    begin
      FButton.SetBounds(Width - FButton.Width - 5, 0, FButton.Width, Height - 6);
      SetEditRect(Handle, Clientwidth, ClientHeight, FButton.Width);
    end;
end;

function TFlatFloat.CheckValue(Value: Extended): Extended;
begin
  Result := Value;
  if (FMaxValue <> FMinValue) then begin
    if Value < FMinValue then
       Result := FMinValue
    else
      if Value > FMaxValue then
        Result := FMaxValue;
  end;
end;

function TFlatFloat.GetMinHeight: Integer;
var
  DC: HDC;
  SaveFont: HFont;
  SysMetrics, Metrics: TTextMetric;
begin
  DC := GetDC(0);
  GetTextMetrics(DC, SysMetrics);
  SaveFont := SelectObject(DC, Font.Handle);
  GetTextMetrics(DC, Metrics);
  SelectObject(DC, SaveFont);
  ReleaseDC(0, DC);
  Result := Metrics.tmHeight + 7;
end;

procedure TFlatFloat.UpClick(Sender: TObject);
begin
  if ReadOnly then
    MessageBeep(0)
  else
    Value := Value + FIncrement;
end;

procedure TFlatFloat.DownClick(Sender: TObject);
begin
  if ReadOnly then
    MessageBeep(0)
  else
    Value := Value - FIncrement;
end;

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

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

procedure TFlatFloat.CMExit(var Message: TCMExit);
begin
  inherited;
  if (Text = '')or(Text = '￥')or(Text = '.') then
     Value := 0;
  if CheckValue(Value) <> Value then
     SetValue(Value)
  else
     SetValue(Value);
end;

function TFlatFloat.GetValue: Extended;
var
  s: string;
begin
  try
    s := Text;
    while Pos(CurrencyString, S) > 0 do
      Delete(S, Pos(CurrencyString, S), Length(CurrencyString));
    while Pos(#32, S) > 0 do
      Delete(S, Pos(#32, S), 1);
    while Pos(ThousandSeparator, S) > 0 do
      Delete(S, Pos(ThousandSeparator, S), Length(ThousandSeparator));

    //Delete negative numbers in format Currency
    if Pos('(', S) > 0 then
    begin
      Delete(S, Pos('(', S), 1);
      if Pos(')', S) > 0 then
        Delete(S, Pos(')', S), 1);
      Result := StrToFloat(S)*-1;
    end
    else
      Result := StrToFloat(S);
  except
    Result := FMinValue;
  end;
end;

procedure TFlatFloat.SetFloatFormat(Value: TFloatFormat);
begin
  FFloatFormat := Value;
  Text := FloatToStrF(CheckValue(GetValue), FloatFormat, Precision, Digits);
end;

procedure TFlatFloat.SetDigits(Value: Integer);
begin
  FDigits := Value;
  Text := FloatToStrF(CheckValue(GetValue), FloatFormat, Precision, Digits);
end;

procedure TFlatFloat.SetPrecision(Value: Integer);
begin
  FPrecision := Value;
  Text := FloatToStrF(CheckValue(GetValue), FloatFormat, Precision, Digits);
end;

procedure TFlatFloat.SetValue(Value: Extended);
begin
  Text := FloatToStrF(CheckValue(Value), FloatFormat, Precision, Digits);
end;

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

procedure TFlatFloat.Loaded;
begin
  SetEditRect(Handle, Clientwidth, ClientHeight, FButton.Width);
  FButton.SetBounds(Width - FButton.Width - 5, 0, FButton.Width, Height - 6);
  inherited;
end;

procedure TFlatFloat.CreateWnd;
begin
  inherited;
  SetEditRect(Handle, Clientwidth, ClientHeight, FButton.Width);
  FButton.SetBounds(Width - FButton.Width - 5, 0, FButton.Width, Height - 6);
end;

procedure TFlatFloat.CMTextChanged(var Message: TMessage);
begin
  inherited;
  if Text = '' then begin
     Text := '0';
  end;
  Value := GetValue;
end;

{ TDefineMemo }
constructor TDefineMemo.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle  := ControlStyle - [csFramed];
  ParentFont    := True;
  AutoSize      := False;
  Ctl3D         := False;
  BorderStyle   := bsNone;
  FFocusColor   := clWhite;
  FBorderColor  := DefaultBorderColor;
  FFlatColor    := DefaultFlatColor;
  FParentColor  := True;
  FMouseIn      := False;
end;

procedure TDefineMemo.RedrawBorder(const Clip: HRGN);
var
  Attrib:TBorderAttrib;
begin
  with Attrib do
  begin
   Ctrl        := self;
   FocusColor  := ColorFocused;
   BorderColor := ColorBorder;
   FlatColor   := ColorFlat;
   MouseState  := FMouseIn;
   FocusState     := Focused;
   DesignState    := ComponentState;
   HasBars     := ScrollBars = ssBoth;
  end;
  Color := DrawEditBorder(Attrib,Clip);
end;

procedure TDefineMemo.SetParentColor(Value: Boolean);
begin
  if Value <> FParentColor then
  begin
    FParentColor := Value;
    if FParentColor then
    begin
      if Parent <> nil then
        FFlatColor := TForm(Parent).Color;
      RedrawBorder(0);
    end;
  end;
end;       

procedure TDefineMemo.CMSysColorChange(var Message: TMessage);
begin
    if (Parent <> nil)and(FParentColor) then
      FFlatColor := TForm(Parent).Color;
    RedrawBorder(0);
end;

procedure TDefineMemo.CMParentColorChanged(var Message: TWMNoParams);
begin
    if (Parent <> nil)and(FParentColor) then
       FFlatColor := TForm(Parent).Color;
    RedrawBorder(0);
end;

procedure TDefineMemo.SetColors(Index: Integer; Value: TColor);
begin
  case Index of
    0: FFocusColor    := Value;
    1: FBorderColor   := Value;
    2: begin
         FFlatColor   := Value;
         FParentColor := False;
       end;
  end;
  RedrawBorder(0);
end;

procedure TDefineMemo.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  if (GetActiveWindow <> 0) then
  begin
    FMouseIn := True;
    RedrawBorder(0);
  end;
end;

procedure TDefineMemo.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  FMouseIn := False;
  RedrawBorder(0);
end;

procedure TDefineMemo.CMEnabledChanged(var Message: TMessage);
const
  EnableColors: array[Boolean] of TColor = (clBtnFace, clWindow);
begin
  inherited;
  Color := EnableColors[Enabled];
  RedrawBorder(0);
end;

procedure TDefineMemo.WMSetFocus(var Message: TWMSetFocus);
begin
  inherited;
  if not(csDesigning in ComponentState) then
    RedrawBorder(0);
end;

procedure TDefineMemo.WMKillFocus(var Message: TWMKillFocus);
begin
  inherited;
  if not(csDesigning in ComponentState) then
    RedrawBorder(0);
end;

procedure TDefineMemo.WMNCCalcSize(var Message: TWMNCCalcSize);
begin
  inherited;
  InflateRect(Message.CalcSize_Params^.rgrc[0], -3, -3);
end;

procedure TDefineMemo.WMNCPaint(var Message: TMessage);
begin
  inherited;
  RedrawBorder(HRGN(Message.WParam));
end;