flatbtns.pas

风格控件。。支持数据库和界面风格优化

  UpdateTracking;
  Invalidate;
end;

procedure TDefineButton.CMButtonPressed(var Message: TMessage);
var
  Sender: TDefineButton;
begin
  if Message.WParam = FGroupIndex then
  begin
    Sender := TDefineButton(Message.LParam);
    if Sender <> Self then
    begin
      if Sender.Down and FDown then
      begin
        FDown := False;
        FState := bsUp;
        Invalidate;
      end;
      FAllowAllUp := Sender.AllowAllUp;
    end;
  end;
end;

procedure TDefineButton.CMDialogKey(var Message: TCMDialogKey);
begin
  with Message do
    if ((CharCode = VK_RETURN) and FMouseIn) and
       (KeyDataToShiftState(Message.KeyData) = []) and Enabled then
    begin
      Click;
      Result := 1;
    end else
      inherited;
end;

procedure TDefineButton.CMDialogChar(var Message: TCMDialogChar);
begin
  with Message do
    if IsAccel(CharCode, Caption) and Enabled then begin
      if GroupIndex <> 0 then
         SetDown(true);
      Click;
      Result := 1;
    end;
end;

procedure TDefineButton.CMFontChanged(var Message: TMessage);
begin
  Invalidate;
end;

procedure TDefineButton.CMTextChanged(var Message: TMessage);
begin
  Invalidate;
end;

procedure TDefineButton.CMSysColorChange(var Message: TMessage);
begin
  inherited;
  if (Parent <> nil)and(ParentColor) then
      Color := TDefineButton(Parent).Color;
  Invalidate;
end;

procedure TDefineButton.CMParentColorChanged(var Message: TWMNoParams);
begin
  inherited;
  if (Parent <> nil)and(not ParentColor) then
      Color := TDefineButton(Parent).Color;
  Invalidate;
end;

procedure TDefineButton.MouseEnter;
begin
  if Enabled and not FMouseIn then
  begin
    FMouseIn := True;
    Invalidate;
  end;
end;

procedure TDefineButton.MouseLeave;
begin
  if Enabled and FMouseIn and not FDragging then
  begin
    FMouseIn := False;
    Invalidate;
  end;
end;

procedure TDefineButton.SetDefault(const Value: Boolean);
var
 {$IFDEF DFS_COMPILER_2}
  Form: TForm;
 {$ELSE}
  Form: TCustomForm;
 {$ENDIF}
begin
  FDefault := Value;
  if HandleAllocated then
  begin
    Form := GetParentForm(Self);
    if Form <> nil then
      Form.Perform(CM_FOCUSCHANGED, 0, Longint(Form.ActiveControl));
  end;
  Invalidate;
end;

procedure TDefineButton.WMKillFocus(var Message: TWMKillFocus);
begin
  inherited;
  MouseLeave;
end;

procedure TDefineButton.WMSetFocus(var Message: TWMSetFocus);
begin
  inherited;
  if Enabled then
  begin
     FMouseIn := True;
     Invalidate;
  end;
end;

procedure TDefineButton.WMKeyDown(var Message: TWMKeyDown);
var CharCode:Word;
begin
  CharCode := Message.CharCode;
  if CharCode = VK_SPACE then
  begin
    if GroupIndex = 0 then
       FState := bsDown
    else
       SetDown(true);
    Invalidate;
  end;
end;

procedure TDefineButton.WMKeyUp(var Message: TWMKeyUp);
var CharCode:Word;
begin
  CharCode := Message.CharCode;
  if  CharCode = VK_SPACE then  begin
    if GroupIndex = 0 then
       FState := bsUp
    else
       SetDown(false);
    Click;
    Invalidate;
  end;
end;

procedure TDefineButton.SetTransparent(const Value: TTransparentMode);
begin
  FTransparent := Value;
  Invalidate;
end;

procedure TDefineButton.WMMove(var Message: TWMMove);
begin
  inherited;
  if not (FTransparent = tmNone) then
    Invalidate;
end;

procedure TDefineButton.WMSize(var Message: TWMSize);
begin
  inherited;
  if not (FTransparent = tmNone) then
    Invalidate;
end;

procedure TDefineButton.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  if Assigned(FOnMouseEnter) then
     FOnMouseEnter(Self)
  else if not(csDesigning in ComponentState) then
     MouseEnter;
end;

procedure TDefineButton.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  if Assigned(FOnMouseLeave) then
     FOnMouseLeave(Self)
  else if not(csDesigning in ComponentState) then
     MouseLeave;
end;

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

{ TDefineSpin }

constructor TDefineSpin.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle - [csAcceptsControls, csSetCaption] + [csFramed, csOpaque]; 
  FUpButton    := CreateButton;
  FDownButton  := CreateButton;
  UpGlyph      := nil;
  DownGlyph    := nil;
  FFocusedButton := FUpButton;
  SetBounds(0,0,21,10);
end;

function TDefineSpin.CreateButton: TDefineTimer;
begin
  Result := TDefineTimer.Create(Self);
  Result.OnClick := BtnClick;
  Result.OnMouseDown := BtnMouseDown;
  Result.Visible := True;
  Result.Enabled := True;
  Result.TimeBtnState := [tbAllowTimer];
  Result.Parent := Self;
end;

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

procedure TDefineSpin.AdjustSize(var W, H: Integer);
begin
  if (FUpButton = nil) or (csLoading in ComponentState) then Exit;
  FUpButton.SetBounds(0, 0, 15, H);
  FDownButton.SetBounds(16, 0, 15, H);
end;

procedure TDefineSpin.SetBounds (ALeft, ATop, AWidth, AHeight: Integer);
var
  W, H: Integer;
begin
  W := AWidth;
  H := AHeight;
  AdjustSize (W, H);
  inherited SetBounds (ALeft, ATop, W, H);
end;

procedure TDefineSpin.WMSize(var Message: TWMSize);
var
  W, H: Integer;
begin
  inherited;

  // check for minimum size
  W := Width;
  H := Height;
  AdjustSize (W, H);
  if (W <> Width) or (H <> Height) then
    inherited SetBounds(Left, Top, W, H);
  Message.Result := 0;
end;

procedure TDefineSpin.WMSetFocus(var Message: TWMSetFocus);
begin
  FFocusedButton.TimeBtnState := FFocusedButton.TimeBtnState + [tbFocusRect];
  FFocusedButton.Invalidate;
end;

procedure TDefineSpin.WMKillFocus(var Message: TWMKillFocus);
begin
  FFocusedButton.TimeBtnState := FFocusedButton.TimeBtnState - [tbFocusRect];
  FFocusedButton.Invalidate;
end;

procedure TDefineSpin.KeyDown(var Key: Word; Shift: TShiftState);
begin
  case Key of
    VK_UP:
      begin
        SetFocusBtn(FUpButton);
        FUpButton.Click;
      end;
    VK_DOWN:
      begin
        SetFocusBtn(FDownButton);
        FDownButton.Click;
      end;
    VK_SPACE:
      FFocusedButton.Click;
  end;
end;

procedure TDefineSpin.BtnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
  begin
    SetFocusBtn (TDefineTimer(Sender));
    if (FFocusControl <> nil) and FFocusControl.TabStop and 
        FFocusControl.CanFocus and (GetFocus <> FFocusControl.Handle) then
      FFocusControl.SetFocus
    else if TabStop and (GetFocus <> Handle) and CanFocus then
      SetFocus;
  end;
end;

procedure TDefineSpin.BtnClick(Sender: TObject);
begin
  if Sender = FUpButton then
    if Assigned(FOnUpClick) then
      FOnUpClick(Self);
  if Sender = FDownButton then
    if Assigned(FOnDownClick) then
      FOnDownClick(Self);
end;

procedure TDefineSpin.SetFocusBtn (Btn: TDefineTimer);
begin
  if TabStop and CanFocus and  (Btn <> FFocusedButton) then
  begin
    FFocusedButton.TimeBtnState := FFocusedButton.TimeBtnState - [tbFocusRect];
    FFocusedButton := Btn;
    if (GetFocus = Handle) then 
    begin
       FFocusedButton.TimeBtnState := FFocusedButton.TimeBtnState + [tbFocusRect];
       Invalidate;
    end;
  end;
end;

procedure TDefineSpin.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
  Message.Result := DLGC_WANTARROWS;
end;

procedure TDefineSpin.Loaded;
var
  W, H: Integer;
begin
  inherited Loaded;
  W := Width;
  H := Height;
  AdjustSize (W, H);
  if (W <> Width) or (H <> Height) then
    inherited SetBounds(Left, Top, Width, Height);
end;

function TDefineSpin.GetUpGlyph: TBitmap;
begin
  Result := FUpButton.Glyph;
end;

procedure TDefineSpin.SetUpGlyph(Value: TBitmap);
begin
  if Value <> nil then
    FUpButton.Glyph := Value
  else
  begin
    FUpButton.Glyph.Handle := LoadBitmap(HInstance, 'FlatUp');
    FUpButton.NumGlyphs := 1;
    FUpButton.Margin := 2;
    FUpButton.Invalidate;
    FUpButton.Layout := blGlyphTop;
  end;
end;

function TDefineSpin.GetUpNumGlyphs: TNumGlyphs;
begin
  Result := FUpButton.NumGlyphs;
end;

procedure TDefineSpin.SetUpNumGlyphs(Value: TNumGlyphs);
begin
  FUpButton.NumGlyphs := Value;
end;

function TDefineSpin.GetDownGlyph: TBitmap;
begin
  Result := FDownButton.Glyph;
end;

procedure TDefineSpin.SetDownGlyph(Value: TBitmap);
begin
  if Value <> nil then
    FDownButton.Glyph := Value
  else
  begin
    FDownButton.Glyph.Handle := LoadBitmap(HInstance, 'FlatDown');
    FDownButton.NumGlyphs := 1;
    FDownButton.Margin := 2;
    FDownButton.Invalidate;
    FDownButton.Layout := blGlyphBottom;
  end;
end;

function TDefineSpin.GetDownNumGlyphs: TNumGlyphs;
begin
  Result := FDownButton.NumGlyphs;
end;

procedure TDefineSpin.SetDownNumGlyphs(Value: TNumGlyphs);
begin
  FDownButton.NumGlyphs := Value;
end;

{TDefineTimer}

constructor TDefineTimer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Cursor := crHandPoint;
end;

destructor TDefineTimer.Destroy;
begin
  if FRepeatTimer <> nil then
     FRepeatTimer.Free;
  inherited Destroy;
end;

procedure TDefineTimer.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  if tbAllowTimer in FTimeBtnState then
  begin
    if FRepeatTimer = nil then
       FRepeatTimer := TTimer.Create(Self);

    FRepeatTimer.OnTimer  := TimerExpired;
    FRepeatTimer.Interval := InitRepeatPause;
    FRepeatTimer.Enabled  := True;
  end;
end;

procedure TDefineTimer.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  if FRepeatTimer <> nil then
     FRepeatTimer.Enabled  := False;
end;

procedure TDefineTimer.TimerExpired(Sender: TObject);
begin
  FRepeatTimer.Interval := RepeatPause;
  if (FState = bsDown) and MouseCapture then
  begin
    try
      Click;
    except
      FRepeatTimer.Enabled := False;
      raise;
    end;
  end;
end;

end.