mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-06 19:18:13 +02:00
446 lines
11 KiB
PHP
446 lines
11 KiB
PHP
{%MainUnit ../stdctrls.pp}
|
|
{
|
|
*****************************************************************************
|
|
* *
|
|
* This file is part of the Lazarus Component Library (LCL) *
|
|
* *
|
|
* See the file COPYING.modifiedLGPL, included in this distribution, *
|
|
* for details about the copyright. *
|
|
* *
|
|
* This program is distributed in the hope that it will be useful, *
|
|
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
|
* *
|
|
*****************************************************************************
|
|
}
|
|
|
|
{$IFNDef NewCheckBox}
|
|
|
|
|
|
{$ENDIF}
|
|
|
|
{$IFDef NewCheckBox}
|
|
Procedure TCheckbox.DoAutoSize;
|
|
var
|
|
R : TRect;
|
|
DC : hDC;
|
|
begin
|
|
If AutoSizing or not AutoSize then
|
|
Exit;
|
|
if (not HandleAllocated) or ([csLoading,csDestroying]*ComponentState<>[]) then
|
|
exit;
|
|
AutoSizing := True;
|
|
DC := GetDC(Handle);
|
|
Try
|
|
R := Rect(0,0, Width, Height);
|
|
DrawText(DC, PChar(Caption), Length(Caption), R,
|
|
DT_CalcRect or DT_NOPrefix);
|
|
If R.Right > Width then
|
|
Width := R.Right + 25;
|
|
If R.Bottom > Height then
|
|
Height := R.Bottom + 2;
|
|
Finally
|
|
ReleaseDC(Handle, DC);
|
|
AutoSizing := False;
|
|
end;
|
|
end;
|
|
|
|
Function TCheckBox.GetChecked : Boolean;
|
|
begin
|
|
Result := (State = cbChecked);
|
|
end;
|
|
|
|
Procedure TCheckBox.SetChecked(Value : Boolean);
|
|
begin
|
|
If Value then
|
|
State := cbChecked
|
|
else
|
|
State := cbUnchecked
|
|
end;
|
|
|
|
procedure TCheckBox.SetCheckBoxStyle(Value : TCheckBoxStyle);
|
|
begin
|
|
FCheckBoxStyle := Value;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCheckBox.SetAttachTextToBox(Value : Boolean);
|
|
begin
|
|
FAttachTextToBox := Value;
|
|
Invalidate;
|
|
end;
|
|
|
|
Procedure TCheckbox.SetAlignment(Value : TCBAlignment);
|
|
begin
|
|
FAlignment := Value;
|
|
Invalidate;
|
|
end;
|
|
|
|
Procedure TCheckbox.SetState(Value : TCheckBoxState);
|
|
begin
|
|
If Value = cbGrayed then begin
|
|
If AllowGrayed then
|
|
FState := Value
|
|
else
|
|
FState := cbUnchecked;
|
|
end
|
|
else
|
|
FState := Value;
|
|
Invalidate;
|
|
end;
|
|
|
|
Procedure TCheckbox.CMMouseEnter(var Message: TLMMouse);
|
|
begin
|
|
if not MouseInControl
|
|
and Enabled and (GetCapture = 0)
|
|
then begin
|
|
FMouseInControl := True;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TCheckbox.CMMouseLeave(var Message: TLMMouse);
|
|
begin
|
|
if MouseInControl
|
|
and Enabled and (GetCapture = 0)
|
|
and not MouseIsDragging
|
|
then begin
|
|
FMouseInControl := False;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
Procedure TCheckbox.WMMouseDown(var Message : TLMMouseEvent);
|
|
begin
|
|
if Enabled then
|
|
If not MouseInControl then
|
|
FMouseInControl := True;
|
|
if MouseInControl and Enabled then begin
|
|
FMouseIsDragging := True;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
Procedure TCheckbox.WMMouseUp(var Message : TLMMouseEvent);
|
|
begin
|
|
If MouseInControl and Enabled then begin
|
|
FMouseIsDragging := False;
|
|
Case State of
|
|
cbUnchecked :
|
|
begin
|
|
If AllowGrayed then
|
|
State := cbGrayed
|
|
else
|
|
State := cbChecked;
|
|
end;
|
|
cbGrayed :
|
|
State := cbChecked;
|
|
cbChecked :
|
|
State := cbUnchecked;
|
|
end;
|
|
Click;
|
|
end;
|
|
end;
|
|
|
|
Procedure TCheckbox.WMKeyDown(var Message : TLMKeyDown);
|
|
begin
|
|
Exclude(FControlState, csClicked);
|
|
Case Message.CharCode of
|
|
32:
|
|
begin
|
|
FMouseInControl := True;
|
|
Invalidate;
|
|
end;
|
|
27:
|
|
If MouseInControl then begin
|
|
FMouseInControl := False;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
Message.Result := 1
|
|
end;
|
|
|
|
Procedure TCheckbox.WMKeyUp(var Message : TLMKeyUp);
|
|
begin
|
|
Case Message.CharCode of
|
|
32:
|
|
begin
|
|
If MouseInControl then begin
|
|
FMouseInControl := False;
|
|
Case State of
|
|
cbUnchecked :
|
|
begin
|
|
If AllowGrayed then
|
|
State := cbGrayed
|
|
else
|
|
State := cbChecked;
|
|
end;
|
|
cbGrayed :
|
|
State := cbChecked;
|
|
cbChecked :
|
|
State := cbUnchecked;
|
|
end;
|
|
Click;
|
|
end;
|
|
end;
|
|
end;
|
|
Message.Result := 1
|
|
end;
|
|
|
|
Procedure TCheckBox.PaintCheck(var PaintRect: TRect);
|
|
|
|
Procedure DrawBorder(Highlight, Shadow : TColor; Rect : TRect; Down : Boolean);
|
|
begin
|
|
With Canvas, Rect do begin
|
|
Pen.Style := psSolid;
|
|
If Down then
|
|
Pen.Color := shadow
|
|
else
|
|
Pen.Color := Highlight;
|
|
MoveTo(Left, Top);
|
|
LineTo(Right - 1,Top);
|
|
MoveTo(Left, Top);
|
|
LineTo(Left,Bottom - 1);
|
|
If Down then
|
|
Pen.Color := Highlight
|
|
else
|
|
Pen.Color := shadow;
|
|
MoveTo(Left,Bottom - 1);
|
|
LineTo(Right - 1,Bottom - 1);
|
|
MoveTo(Right - 1, Top);
|
|
LineTo(Right - 1,Bottom);
|
|
end;
|
|
end;
|
|
|
|
var
|
|
FD1, FD2 : TPoint;
|
|
BD1, BD2 : TPoint;
|
|
APaintRect : TRect;
|
|
DrawFlags : Longint;
|
|
begin
|
|
If CheckBoxStyle <> cbsSystem then begin
|
|
If (State = cbGrayed) or (not Enabled) then begin
|
|
If (MouseInControl and MouseIsDragging) or (not Enabled) then
|
|
Canvas.Brush.Color := clBtnFace
|
|
else
|
|
Canvas.Brush.Color := clBtnHighlight;
|
|
Canvas.FillRect(CheckBoxRect);
|
|
Canvas.Pen.Color := clBtnShadow;
|
|
end
|
|
else begin
|
|
If MouseInControl and MouseIsDragging then
|
|
Canvas.Brush.Color := clBtnFace
|
|
else
|
|
Canvas.Brush.Color := clWindow;
|
|
Canvas.FillRect(CheckBoxRect);
|
|
Canvas.Pen.Color := clWindowText;
|
|
end;
|
|
If State <> cbUnchecked then begin
|
|
Case CheckBoxStyle of
|
|
cbsCrissCross:
|
|
begin
|
|
Canvas.Pen.Width := 1;
|
|
|
|
{Backward Diagonal}
|
|
BD1 := Point(CheckBoxRect.Left + 3,CheckBoxRect.Top + 3);
|
|
BD2 := Point(CheckBoxRect.Right - 3,CheckBoxRect.Bottom - 3);
|
|
|
|
Canvas.MoveTo(BD1.X + 1, BD1.Y);
|
|
Canvas.LineTo(BD2.X, BD2.Y - 1);{Top Line}
|
|
Canvas.MoveTo(BD1.X, BD1.Y);
|
|
Canvas.LineTo(BD2.X, BD2.Y);{Center Line}
|
|
Canvas.MoveTo(BD1.X, BD1.Y + 1);
|
|
Canvas.LineTo(BD2.X - 1, BD2.Y);{Bottom Line}
|
|
|
|
{Forward Diagonal}
|
|
FD1 := Point(CheckBoxRect.Left + 3,CheckBoxRect.Bottom - 4);
|
|
FD2 := Point(CheckBoxRect.Right - 3,CheckBoxRect.Top + 2);
|
|
|
|
Canvas.MoveTo(FD1.X, FD1.Y - 1);
|
|
Canvas.LineTo(FD2.X - 1, FD2.Y);{Top Line}
|
|
Canvas.MoveTO(FD1.X, FD1.Y);
|
|
Canvas.LineTo(FD2.X, FD2.Y);{Center Line}
|
|
Canvas.MoveTo(FD1.X + 1, FD1.Y);
|
|
Canvas.LineTo(FD2.X, FD2.Y + 1);{Bottom Line}
|
|
|
|
Canvas.Pen.Width := 0;
|
|
end;
|
|
cbsCheck:
|
|
begin
|
|
Canvas.Pen.Width := 1;
|
|
|
|
{Short Diagonal}
|
|
BD1 := Point(CheckBoxRect.Left + 4,CheckBoxRect.Bottom - 8);
|
|
BD2 := Point(CheckBoxRect.Left + 4,CheckBoxRect.Bottom - 5);
|
|
|
|
Canvas.MoveTO(BD1.X - 1, BD1.Y);
|
|
Canvas.LineTo(BD2.X - 1, BD2.Y);{Left Line}
|
|
Canvas.MoveTo(BD1.X, BD1.Y + 1);
|
|
Canvas.LineTo(BD2.X, BD2.Y + 1);{Right Line}
|
|
|
|
{Long Diagonal}
|
|
FD1 := Point(CheckBoxRect.Left + 5,CheckBoxRect.Bottom - 6);
|
|
FD2 := Point(CheckBoxRect.Right - 3,CheckBoxRect.Top + 2);
|
|
|
|
Canvas.MoveTo(FD1.X,FD1.Y);
|
|
Canvas.LineTo(FD2.X, FD2.Y);{Top Line}
|
|
Canvas.MoveTo(FD1.X, FD1.Y + 1);
|
|
Canvas.LineTo(FD2.X, FD2.Y + 1);{Center Line}
|
|
Canvas.MoveTo(FD1.X, FD1.Y + 2);
|
|
Canvas.LineTo(FD2.X, FD2.Y + 2);{Bottom Line}
|
|
|
|
Canvas.Pen.Width := 0;
|
|
end;
|
|
end;
|
|
end;
|
|
DrawBorder(clBtnHighlight, clBtnShadow, CheckBoxRect, True);
|
|
InflateRect(APaintRect, -1, -1);
|
|
DrawBorder(clBtnFace, clBlack, APaintRect, True);
|
|
end
|
|
else begin
|
|
DrawFlags:=DFCS_BUTTONPUSH + DFCS_FLAT;
|
|
If MouseInControl and Enabled then
|
|
Inc(DrawFlags,DFCS_CHECKED);
|
|
DrawFrameControl(Canvas.Handle, PaintRect, DFC_BUTTON, DrawFlags);
|
|
|
|
DrawFlags:=DFCS_BUTTONCHECK;
|
|
if Checked or (State = cbGrayed) then inc(DrawFlags,DFCS_PUSHED);
|
|
if not Enabled then inc(DrawFlags,DFCS_INACTIVE);
|
|
If MouseInControl and Enabled then
|
|
Inc(DrawFlags,DFCS_CHECKED);
|
|
|
|
APaintRect := CheckBoxRect;
|
|
DrawFrameControl(Canvas.Handle, APaintRect, DFC_BUTTON, DrawFlags);
|
|
end;
|
|
end;
|
|
|
|
Procedure TCheckBox.PaintText(var PaintRect: TRect);
|
|
var
|
|
Sz : Integer;
|
|
AR : TRect;
|
|
dish, dis : TColor;
|
|
|
|
Procedure DoDrawText(theRect : TRect);
|
|
var
|
|
TextStyle : TTextStyle;
|
|
begin
|
|
With TextStyle do begin
|
|
Layout := tlCenter;
|
|
SingleLine := False;
|
|
Clipping := True;
|
|
ExpandTabs := False;
|
|
ShowPrefix := False;
|
|
Wordbreak := Wordwrap;
|
|
Opaque := False;
|
|
SystemFont := CheckBoxStyle = cbsSystem;
|
|
end;
|
|
|
|
Case Alignment of
|
|
alLeftJustify:
|
|
begin
|
|
If not FAttachTextToBox then begin
|
|
TextStyle.Alignment := taLeftJustify;
|
|
end
|
|
else
|
|
TextStyle.Alignment := taRightJustify;
|
|
end;
|
|
alRightJustify:
|
|
begin
|
|
If not FAttachTextToBox then begin
|
|
TextStyle.Alignment := taRightJustify;
|
|
end
|
|
else
|
|
TextStyle.Alignment := taLeftJustify;
|
|
end;
|
|
end;
|
|
Canvas.TextRect(theRect, ARect.Left, ARect.Top, Caption, TextStyle);
|
|
end;
|
|
|
|
Procedure DoDisabledTextRect(Rect : TRect; Highlight, Shadow : TColor);
|
|
var
|
|
FC : TColor;
|
|
begin
|
|
FC := Canvas.Font.Color;
|
|
Canvas.Font.Color := Highlight;
|
|
OffsetRect(Rect, 1, 1);
|
|
DoDrawText(Rect);
|
|
Canvas.Font.Color := Shadow;
|
|
OffsetRect(Rect, -1, -1);
|
|
DoDrawText(Rect);
|
|
Canvas.Font.Color := FC;
|
|
end;
|
|
|
|
begin
|
|
If Caption = '' then
|
|
exit;
|
|
Sz := CheckBoxRect.Right - CheckBoxRect.Left;
|
|
AR.Top := PaintRect.Top;
|
|
AR.Bottom := PaintRect.Bottom;
|
|
If Alignment = alRightJustify then begin
|
|
AR.Left := PaintRect.Left + Sz + 6;
|
|
AR.Right := PaintRect.Right;
|
|
end
|
|
else begin
|
|
AR.Left := PaintRect.Left;
|
|
AR.Right := PaintRect.Right - Sz - 6;
|
|
end;
|
|
dish := clBtnHighlight;
|
|
dis := clBtnShadow;
|
|
Canvas.Font := Self.Font;
|
|
If Enabled then begin
|
|
If CheckBoxStyle = cbsSystem then
|
|
Canvas.Font.Color := clBtnText;
|
|
DoDrawText(AR)
|
|
end
|
|
else
|
|
DoDisabledTextRect(AR,dish,dis);
|
|
end;
|
|
|
|
procedure TCheckbox.Paint;
|
|
var
|
|
PaintRect: TRect;
|
|
begin
|
|
PaintRect := Rect(0, 0, Width, Height);
|
|
Canvas.Color := clBtnFace;
|
|
|
|
Canvas.Brush.Style := bsSolid;
|
|
Canvas.FillRect(ClientRect);
|
|
PaintCheck(PaintRect);
|
|
PaintText(PaintRect);
|
|
end;
|
|
|
|
Constructor TCheckbox.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
controlstyle := controlstyle - [csAcceptsControls];
|
|
Alignment := alRightJustify;
|
|
FAttachTextToBox := True
|
|
end;
|
|
|
|
Function TCheckBox.CheckBoxRect : TRect;
|
|
var
|
|
Sz : Integer;
|
|
begin
|
|
Sz := 13;
|
|
Result.Top := (Height div 2) - (Sz div 2);
|
|
Result.Bottom := Result.Top + Sz;
|
|
If Alignment = alRightJustify then begin
|
|
Result.Left := 2;
|
|
Result.Right := Result.Left + Sz;
|
|
end
|
|
else begin
|
|
Result.Right := Width - 2;
|
|
Result.Left := Result.Right - Sz;
|
|
end;
|
|
end;
|
|
|
|
procedure TCheckBox.Click;
|
|
begin
|
|
If Assigned(OnClick) then
|
|
OnClick(Self);
|
|
end;
|
|
{$EndIf NewCheckbox}
|
|
|
|
// included by stdctrls.pp
|
|
|