flatedits.pas

相信大家已经找很长时间了

    if Message.DC = 0 then EndPaint(Handle, PS);
  end;
end;

procedure TFlatDBEdit.CMGetDataLink(var Message: TMessage);
begin
 // Message.Result := Integer(FDataLink);
  Message.Result := SizeOf(FDataLink);
end;

function TFlatDBEdit.GetTextMargins: TPoint;
var
  DC: HDC;
  SaveFont: HFont;
  I: Integer;
  SysMetrics, Metrics: TTextMetric;
begin
  if NewStyleControls then
  begin
    if BorderStyle = bsNone then I := 0 else
      if Ctl3D then I := 1 else I := 2;
    Result.X := SendMessage(Handle, EM_GETMARGINS, 0, 0) and $0000FFFF + I;
    Result.Y := I;
  end else
  begin
    if BorderStyle = bsNone then I := 0 else
    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;
      I := I div 4;
    end;
    Result.X := I;
    Result.Y := I;
  end;
end;

function TFlatDBEdit.ExecuteAction(Action: TBasicAction): Boolean;
begin
  Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
    FDataLink.ExecuteAction(Action);
end;

function TFlatDBEdit.UpdateAction(Action: TBasicAction): Boolean;
begin
  Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
    FDataLink.UpdateAction(Action);
end;          

destructor TCustomFlatEdit.Destroy;
begin
  fLabel.Free;
  inherited destroy;
end;

procedure TCustomFlatEdit.LabelMouseEnter(Sender: TObject);
begin
  if not(csDesigning in ComponentState) then begin
     fLabel.Visible := false;
     self.SetFocus;
  end;
end;

procedure TCustomFlatEdit.SeTBEPosition(const Value: TLabelPosition);
var
  P: TPoint;
begin
  if FEditLabel = nil then exit;
  FLabelPosition := Value;
  case Value of
    lpAbove: P := Point(Left, Top - FEditLabel.Height - FLabelSpacing);
    lpBelow: P := Point(Left, Top + Height + FLabelSpacing);
    lpLeft : P := Point(Left - FEditLabel.Width - FLabelSpacing,
                        Top + ((Height - FEditLabel.Height) div 2));
    lpRight: P := Point(Left + Width + FLabelSpacing,
                        Top + ((Height - FEditLabel.Height) div 2));
  end;
  FEditLabel.SetBounds(P.x, P.y, FEditLabel.Width, FEditLabel.Height);
end;

procedure TCustomFlatEdit.SetLabelSpacing(const Value: Integer);
begin
  FLabelSpacing := Value;
  SeTBEPosition(FLabelPosition);
end;

procedure TCustomFlatEdit.SetupInternalLabel;
begin
  if not(csDesigning in ComponentState) then begin
     fLabel           := TLabel.Create(Self);
     fLabel.Parent    := self;
     fLabel.OnClick   := LabelMouseEnter;
     fLabel.AutoSize  := false;
     fLabel.Visible   := false;
     fLabel.Transparent  := True;
     fLabel.FocusControl := self;
     fLabel.Font.Assign(Font);
  end;
  if Assigned(FEditLabel) then exit;
  FEditLabel := TFlatLabel.Create(Self);
  FEditLabel.FreeNotification(Self);
  FEditLabel.Transparent  := True;
  FEditLabel.FocusControl := Self;
end;

procedure TCustomFlatEdit.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  SeTBEPosition(FLabelPosition);
end;

procedure TCustomFlatEdit.SetParent(AParent: TWinControl);
begin
  inherited SetParent(AParent);
  if FEditLabel = nil then exit;
  FEditLabel.Parent  := AParent;
  FEditLabel.Visible := Visible;
end;

procedure TCustomFlatEdit.CMBidimodechanged(var Message: TMessage);
begin
  inherited;
  FEditLabel.BiDiMode := BiDiMode;
end;

procedure TCustomFlatEdit.CMVisiblechanged(var Message: TMessage);
begin
  inherited;
  FEditLabel.Visible := Visible;
end;

procedure TCustomFlatEdit.SetName(const Value: TComponentName);
begin
  if (csDesigning in ComponentState) and ((FEditlabel.GetTextLen = 0) or
     (CompareText(FEditLabel.Caption, Name) = 0)) then
    FEditLabel.Caption := Value;
  inherited SetName(Value);
  if csDesigning in ComponentState then
     Text := '';
end;

procedure TCustomFlatEdit.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = FEditLabel) and (Operation = opRemove) then
     FEditLabel := nil;
end;

{ TFlatLabel }

constructor TFlatLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Name := 'Label';  { do not localize }
  SetSubComponent(True);
  if Assigned(AOwner) then
     Caption := AOwner.Name;
end;

procedure TFlatLabel.AdjustBounds;
begin
  inherited AdjustBounds;
  if Owner is TCustomFlatEdit then begin
    with Owner as TCustomFlatEdit do
         SetBEPosition(LabelPosition);
  end;
  if Owner is TCustomFlatMask then begin
    with Owner as TCustomFlatMask do
         SetBMPosition(LabelPosition);
  end;
end;

function TFlatLabel.GetHeight: Integer;
begin
  Result := inherited Height;
end;

function TFlatLabel.GetLeft: Integer;
begin
  Result := inherited Left;
end;

function TFlatLabel.GetTop: Integer;
begin
  Result := inherited Top;
end;

function TFlatLabel.GetWidth: Integer;
begin
  Result := inherited Width;
end;

procedure TFlatLabel.SetHeight(const Value: Integer);
begin
  SetBounds(Left, Top, Width, Value);
end;

procedure TFlatLabel.SetWidth(const Value: Integer);
begin
  SetBounds(Left, Top, Value, Height);
end;

{ TFlatInteger }

constructor TFlatInteger.Create (AOwner: TComponent);
begin
  inherited Create(AOwner);
  FButton              := TFlatSpinButton.Create (Self);
  FButton.Parent       := Self;
  FButton.Width        := 22;
  FButton.Height       := 10;
  FButton.Visible      := True;
  FButton.FocusControl := Self;
  FButton.OnUpClick    := UpClick;
  FButton.OnDownClick  := DownClick;
  Value                := 0;
  ControlStyle         := ControlStyle - [csSetCaption];
  FIncrement           := 1;
  FEditorEnabled       := True;
end;

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

procedure TFlatInteger.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 TFlatInteger.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 TFlatInteger.IsValidChar(Key: Char): Boolean;
begin
  Result := (Key in ['0'..'9',#8,#13]);
  if not FEditorEnabled and Result then
    Result := False;
end;

procedure TFlatInteger.CreateParams (var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style or ES_MULTILINE or WS_CLIPCHILDREN;
end;

procedure TFlatInteger.SetEditRect;
var
  Loc: TRect;
begin
  SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc));
  Loc := Rect(0, 0, ClientWidth - FButton.Width - 3, ClientHeight);
  SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@Loc));
  SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc));
end;

procedure TFlatInteger.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
      FButton.SetBounds(Width - FButton.Width - 5, 0, FButton.Width, Height - 6);
      SetEditRect;
    end;
end;

function TFlatInteger.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 TFlatInteger.UpClick (Sender: TObject);
begin
  if ReadOnly then
    MessageBeep(0)
  else
    Value := GetValue + FIncrement;
end;

procedure TFlatInteger.DownClick (Sender: TObject);
begin
  if ReadOnly then
    MessageBeep(0)
  else
    Value := GetValue - FIncrement;
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
  try
    Result := StrToInt(Text);
  except
    Result := FMinValue;
  end;
end;

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

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

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

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

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

{ TFlatFloat }

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

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

procedure TFla