?? tflatcheckboxunit.pas
字號:
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.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -