tflatcheckboxunit.pas

vod点歌系统,DELPHI的通用软件 会有帮助

      Result := 1;
    end
    else
      if (CharCode = VK_SPACE) and Focused then
      begin
        if Checked then
          Checked := False
        else
          Checked := True;
      end
      else
        inherited;
end;

procedure TFlatCheckBox.CNCommand (var Message: TWMCommand);
begin
  if Message.NotifyCode = BN_CLICKED then Click;
end;

procedure TFlatCheckBox.WMSetFocus (var Message: TWMSetFocus);
begin
  inherited;
  if Enabled then
  begin
    Focused := True;
    DrawCheckRect;
  end;
end;

procedure TFlatCheckBox.WMKillFocus (var Message: TWMKillFocus);
begin
  inherited;
  if Enabled then
  begin
    FMouseInControl := False;
    Focused := False;
    DrawCheckRect;
  end;
end;

procedure TFlatCheckBox.CMSysColorChange (var Message: TMessage);
begin
  if FUseAdvColors then
  begin
    ParentColor := True;
    CalcAdvColors;
  end;
  Invalidate;
end;

procedure TFlatCheckBox.CMParentColorChanged (var Message: TWMNoParams);
begin
  inherited;
  if FUseAdvColors then
  begin
    ParentColor := True;
    CalcAdvColors;
  end;
  Invalidate;
end;

procedure TFlatCheckBox.DoEnter;
begin
  inherited DoEnter;
  Focused := True;
  DrawCheckRect;
end;

procedure TFlatCheckBox.DoExit;
begin
  inherited DoExit;
  Focused := False;
  DrawCheckRect;
end;

procedure TFlatCheckBox.MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if (Button = mbLeft) and Enabled then
  begin
    SetFocus;
    MouseIsDown := true;
    DrawCheckRect;
    inherited MouseDown(Button, Shift, X, Y);
  end;
end;

procedure TFlatCheckBox.MouseUp (Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if (Button = mbLeft) and Enabled then
  begin
    MouseIsDown := false;
    if FMouseInControl then
      if Checked then
        Checked := False
      else
        Checked := True;
    DrawCheckRect;
    inherited MouseUp(Button, Shift, X, Y);
  end;
end;

procedure TFlatCheckBox.MouseMove (Shift: TShiftState; X, Y: Integer);
var
  P: TPoint;
begin
  inherited;
  // mouse is in control ?
  P := ClientToScreen(Point(X, Y));
  if (MouseInControl <> Self) and (FindDragTarget(P, True) = Self) then
  begin
    if Assigned(MouseInControl) then
      MouseInControl.MouseLeave;
    // the application is active ?
    if (GetActiveWindow <> 0) then
    begin
      if MouseTimer.Enabled then
        MouseTimer.Enabled := False;
      MouseInControl := Self;
      MouseTimer.OnTimer := MouseTimerHandler;
      MouseTimer.Enabled := True;
      MouseEnter;
    end;
  end;
end;

procedure TFlatCheckBox.CreateWnd;
begin
  inherited CreateWnd;
  SendMessage(Handle, BM_SETCHECK, Cardinal(FChecked), 0);
end;

procedure TFlatCheckBox.DrawCheckRect;
var
  CheckboxRect: TRect;
begin
  case FLayout of
    checkboxLeft:
      CheckboxRect := Rect(ClientRect.Left + 1, ClientRect.Top + 3, ClientRect.Left + 12, ClientRect.Top + 14);
    checkboxRight:
      CheckboxRect := Rect(ClientRect.Right - 12, ClientRect.Top + 3, ClientRect.Right - 1, ClientRect.Top + 14);
  end;

  canvas.pen.style := psSolid;
  canvas.pen.width := 1;
  // Background
  if Focused or FMouseInControl then
    if not MouseIsDown then
    begin
      canvas.brush.color := FFocusedColor;
      canvas.pen.color := FFocusedColor;
    end
    else
    begin
      canvas.brush.color := FDownColor;
      canvas.brush.color := FDownColor;
    end
  else
  begin
    canvas.brush.color := Color;
    canvas.pen.color := Color;
  end;
  canvas.FillRect(CheckboxRect);
  // Tick
  if Checked then
  begin
    if Enabled then
      canvas.pen.color := FCheckColor
    else
      canvas.pen.color := clBtnShadow;
    canvas.penpos := Point(CheckboxRect.left+2, CheckboxRect.top+4);
    canvas.lineto(CheckboxRect.left+6, CheckboxRect.top+8);
    canvas.penpos := Point(CheckboxRect.left+2, CheckboxRect.top+5);
    canvas.lineto(CheckboxRect.left+5, CheckboxRect.top+8);
    canvas.penpos := Point(CheckboxRect.left+2, CheckboxRect.top+6);
    canvas.lineto(CheckboxRect.left+5, CheckboxRect.top+9);
    canvas.penpos := Point(CheckboxRect.left+8, CheckboxRect.top+2);
    canvas.lineto(CheckboxRect.left+4, CheckboxRect.top+6);
    canvas.penpos := Point(CheckboxRect.left+8, CheckboxRect.top+3);
    canvas.lineto(CheckboxRect.left+4, CheckboxRect.top+7);
    canvas.penpos := Point(CheckboxRect.left+8, CheckboxRect.top+4);
    canvas.lineto(CheckboxRect.left+5, CheckboxRect.top+7);
  end;
  // Border
  canvas.brush.color := FBorderColor;
  canvas.FrameRect(CheckboxRect);
end;

procedure TFlatCheckBox.DrawCheckText;
var
  TextBounds: TRect;
  Format: UINT;
begin
  Format := DT_WORDBREAK;
  case FLayout of
    checkboxLeft:
    begin
      TextBounds := Rect(ClientRect.Left + 16, ClientRect.Top + 1, ClientRect.Right - 1, ClientRect.Bottom - 1);
      Format := Format or DT_LEFT;
    end;
    checkboxRight:
    begin
      TextBounds := Rect(ClientRect.Left + 1, ClientRect.Top + 1, ClientRect.Right - 16, ClientRect.Bottom - 1);
      Format := Format or DT_RIGHT;
    end;
  end;

  with Canvas do
  begin
    Brush.Style := bsClear;
    Font := Self.Font;
    if not Enabled then
    begin
      OffsetRect(TextBounds, 1, 1);
      Font.Color := clBtnHighlight;
      DrawText(Handle, PChar(Caption), Length(Caption), TextBounds, Format);
      OffsetRect(TextBounds, -1, -1);
      Font.Color := clBtnShadow;
      DrawText(Handle, PChar(Caption), Length(Caption), TextBounds, Format);
    end
    else
      DrawText(Handle, PChar(Caption), Length(Caption), TextBounds, Format);
  end;
end;

procedure TFlatCheckBox.Paint;
begin
  if FTransparent then
    DrawParentImage(Self, Self.Canvas);
  DrawCheckRect;
  DrawCheckText;
end;

procedure TFlatCheckBox.MouseTimerHandler (Sender: TObject);
var
  P: TPoint;
begin
  GetCursorPos (P);
  if FindDragTarget(P, True) <> Self then
    MouseLeave;
end;

procedure TFlatCheckBox.RemoveMouseTimer;
begin
  if MouseInControl = Self then
  begin
    MouseTimer.Enabled := False;
    MouseInControl := nil;
  end;
end;

procedure TFlatCheckBox.SetTransparent(const Value: Boolean);
begin
  FTransparent := Value;
  Invalidate;
end;

procedure TFlatCheckBox.WMMove(var Message: TWMMove);
begin
  inherited;
  if FTransparent then
    Invalidate;
end;

procedure TFlatCheckBox.WMSize(var Message: TWMSize);
begin
  inherited;
  if FTransparent then
    Invalidate;
end;

{$IFDEF DFS_COMPILER_4_UP}
procedure TFlatCheckBox.SetBiDiMode(Value: TBiDiMode);
begin
  inherited;
  if BidiMode = bdRightToLeft then
    Layout := checkboxRight
  else
    Layout := checkboxLeft;
end;
{$ENDIF}

end.