📄 wwcheckbox.pas
字号:
{$ifdef wwUseThemeManager}
Details: TThemedElementDetails;
CheckboxStyle: TThemedButton;
{$endif}
begin
SaveColorbg:=Canvas.Brush.Color;
SaveColorfont:=Canvas.Font.Color;
ComputeTextRect(ARect);
// 6/29/02 - Bidi mode
if UseRightToLeftAlignment then
begin
Temp:= ARect.Left;
ARect.Left:= ClientWidth-ARect.Right;
ARect.Right:= ClientWidth-Temp;
end;
TempCaption:= GetDisplayText;
HaveText:= DynamicCaption or (TempCaption<>'');
if Focused and ShowFocusRect and HaveText and
(not (csPaintCopy in ControlState)) then // {and not (parent is TCustomGrid) }then
begin
if parent is TCustomGrid then
FocusRect:= Rect(ARect.Left - 2, ARect.Top - 1,
wwMin(ARect.Right+2, ARect.Left + Canvas.TextWidth(TempCaption) + 2),
ARect.Bottom + 1)
else
FocusRect:= Rect(ARect.Left - 2, wwMax(ARect.Top - 2, 0), // 6/29/02 - Changed from ARect.Top - 2 as focusrect cutoff from top in default case
wwMin(ARect.Right+2, ARect.Left + Canvas.TextWidth(TempCaption) + 2),
ARect.Bottom + 2);
Canvas.Brush.Color := Color;
Canvas.Font.Color := clBlack;
Canvas.FrameRect(FocusRect);
// 3/30/2002-PYW-If Highlight then focusrect colors were wrong.
if DrawHighlight then begin
Canvas.Brush.Color := clBlack;
Canvas.Font.Color := clWhite;
end
else begin
Canvas.Brush.Color := clWhite;
Canvas.Font.Color := clBlack;
end;
Canvas.DrawFocusRect(FocusRect);
// 3/30/2002-PYW-Restore Saved Canvas and Font Colors.
Canvas.Font.Color := SaveColorFont;
Canvas.Brush.Color := SaveColorBg;
end;
SetBkMode(Canvas.Handle, TRANSPARENT);
Flags:= GetDrawFlags;
if WordWrap then flags:= flags or DT_EDITCONTROL or DT_WORDBREAK;
InflateRect(ARect, 0, 2);
ARect.Top:= ARect.Top + 2;
if DrawHighlight then begin
// Canvas.Font.Color := clHighlightText;
end
else if not (csPaintCopy in ControlState) then
Canvas.Font.Color:= Font.Color;
if (not Focused) and IsTransparentEffective and
(Frame.NonFocusTransparentFontColor<>clNone) then
Canvas.Font.Color:= Frame.NonFocusTransparentFontColor
// 4/15/01
else if (not Focused) and (Frame.Enabled) and
(Frame.NonFocusFontColor<>clNone) then
Canvas.Font.Color:= Frame.NonFocusFontColor;
if (not Enabled) and not wwUseThemes(self) then
begin
OffsetRect(ARect, 1, 1);
Canvas.Font.Color:= clBtnHighlight;
if TextAlignment = taRightJustify then
begin
TempRect:= ARect;
TempRect.Right:= ClientWidth-2;
DrawTextEx(Canvas.Handle, Pchar(TempCaption), length(TempCaption), TempRect, DT_RIGHT + Flags, nil);
end
else
DrawTextEx(Canvas.Handle, Pchar(TempCaption), length(TempCaption), ARect, Flags, nil);
Canvas.Font.Color:= clGrayText;
OffsetRect(ARect, -1, -1);
end;
if wwUseThemes(self) then
begin
{$ifdef wwUseThemeManager}
CheckboxStyle:= GetCheckboxThemeStyle(False);
Details := ThemeServices.GetElementDetails(CheckboxStyle);
if TempCaption <> '' then
begin
if TextAlignment = taRightJustify then
begin
ARect.Right:= ClientWidth-2;
ThemeServices.DrawText(Canvas.Handle, Details, TempCaption, ARect, DT_RIGHT, 0);
end
else
ThemeServices.DrawText(Canvas.Handle, Details, TempCaption, ARect, DT_LEFT, 0);
end
{$endif}
end
else begin
if TextAlignment = taRightJustify then
begin
ARect.Right:= ClientWidth-2;
DrawTextEx(Canvas.Handle, Pchar(Tempcaption), length(Tempcaption), ARect, dt_right + Flags, nil);
end
else
DrawTextEx(Canvas.Handle, Pchar(Tempcaption), length(Tempcaption), ARect, Flags, nil);
end
end;
procedure PaintCheckbox;
var
DrawRect, TempRect: TRect;
FrameStateFlags, StateFlags: integer;
TempState: TCheckboxState;
{$ifdef wwUseThemeManager}
Details: TThemedElementDetails;
ExpandStyle: TThemedTreeview;
CheckboxStyle: TThemedButton;
PaintRect: TRect;
{$endif}
UseThemesForExpandButton: boolean;
begin
ComputeGlyphRect(DrawRect);
// 6/29/02 - Bidi mode
if UseRightToLeftAlignment then
begin
DrawRect.Right:= ClientWidth-DrawRect.Left;
DrawRect.Left:= DrawRect.Right-13;
end;
if csPaintCopy in ControlState then
TempState:= GetFieldState
else
TempState:= State;
if TempState=cbChecked then
StateFlags:= DFCS_BUTTONCHECK
else
StateFlags:= DFCS_BUTTON3STATE;
if (cslbuttondown in controlstate) and Focused and not (csPaintCopy in ControlState) then
begin
if IsInGrid(self) then
begin
if IsMouseInControl(True) then
StateFlags := StateFlags or DFCS_PUSHED;
end
else begin
if IsMouseInControl then
StateFlags := StateFlags or DFCS_PUSHED;
end
end;
if SpaceKeyPressed and (GetKeyState(vk_space)<0) and Focused then
StateFlags := StateFlags or DFCS_PUSHED;
if TempState=cbChecked then
StateFlags := StateFlags or DFCS_CHECKED
else if TempState = cbGrayed then
StateFlags:= StateFlags or DFCS_CHECKED;
UseThemesForExpandButton:=
wwUseThemes(self) and (GetImageList<>Images);
if UseThemesForExpandbutton then
begin
{$ifdef wwUseThemeManager}
if TempState=cbChecked then ExpandStyle:= ttGlyphOpened
else ExpandStyle:= ttGlyphClosed;
Details := ThemeServices.GetElementDetails(ExpandStyle);
TempRect:= DrawRect;
InflateRect(TempRect, 1, 1);
ThemeServices.DrawElement(Canvas.Handle, Details, TempRect);
exit;
{$endif}
end
else if (GetImageList<>nil) and (GetImageList.Count>0) then
begin
FrameStateFlags:= DFCS_BUTTONPUSH;
if (StateFlags and DFCS_PUSHED <> 0) then
FrameStateFlags:= FrameStateFlags or DFCS_PUSHED;
if ShowBoxAroundGlyph then
begin
TempRect:= DrawRect;
InflateRect(TempRect, 1, 1);
Canvas.Brush.Color:= clWhite;
Canvas.FillRect(TempRect);
Canvas.Brush.Color:= clBlack;
Canvas.FrameRect(TempRect);
end;
if (FShowAsButton) then begin
TempRect:= DrawRect;
InflateRect(TempRect, 2, 2);
if not Enabled then
FrameSTateFlags:= FrameStateFlags + DFCS_INACTIVE;
with DrawRect do
DrawFrameControl(Canvas.Handle, TempRect,
DFC_BUTTON, FrameStateFlags);
end;
if TempState=cbChecked then
begin
if (GetImageList<>nil) and (GetImageList.count>1) then begin
GetImageList.Draw(Canvas, drawrect.left, drawrect.top, 1, True);
exit;
end
end
else if TempState=cbUnchecked then
begin
if (GetImageList<>nil) and (GetImageList.count>0) then begin
GetImageList.Draw(Canvas, drawrect.left, drawrect.top, 0, True);
exit;
end
end
else begin
if (GetImageList<>nil) and (GetImageList.count>2) then begin
GetImageList.Draw(Canvas, drawrect.left, drawrect.top, 2, True);
exit;
end
end;
end;
Canvas.Brush.Color := clBtnFace;
Canvas.FillRect(DrawRect);
Canvas.Brush.Color := clBtnShadow;
if GetImageList=nil then
begin
if not Enabled then
StateFlags:= StateFlags + DFCS_INACTIVE;
if wwUseThemes(self) then
begin
// PerformEraseBackground(Self, Canvas.Handle);
{$ifdef wwUseThemeManager}
CheckboxStyle:= GetCheckboxThemeStyle((StateFlags and DFCS_PUSHED)<>0);
Details := ThemeServices.GetElementDetails(CheckboxStyle);
PaintRect := DrawRect;
ThemeServices.DrawElement(Canvas.Handle, Details, PaintRect);
PaintRect := ThemeServices.ContentRect(Canvas.Handle, Details, PaintRect);
{$endif}
end
else begin
with DrawRect do
DrawFrameControl(Canvas.Handle, DrawRect,
DFC_BUTTON, StateFlags);
end
end
end;
Function Max(x,y: integer): integer;
begin
if x>y then result:=x else result:=y
end;
procedure EndPainting;
begin
if (FCanvas = Canvas) then exit;
r:= ClientRect;
// InflateRect(r, -2, -2); // Seems to cause glyph to not appear
FCanvas.CopyRect(r, FPaintCanvas, r);
end;
begin
if False and Focused and (not AlwaysTransparent) then
begin
FPaintBitmap:= TBitmap.create;
FPaintCanvas:= FPaintBitmap.canvas;
FPaintBitmap.Width:= ClientWidth;
FPaintBitmap.Height:= ClientHeight;
end;
try
if (not (Frame.Enabled and Frame.Transparent)) or
(not AlwaysTransparent) and (Focused) then
begin
if not (IsInGridPaint(self)) then
begin
r:= ClientRect;
// InflateRect(r, -2, -2); // Seems to cause glyph to not appear
Canvas.Brush.Color:= Color;
// 4/15/01 - Back-color support
if (not IsTransparentEffective) then
begin
if Frame.Enabled and (not Focused) and (Frame.NonFocusColor<>clNone) then
begin
Canvas.Brush.Color:= Frame.NonFocusColor;
end
end;
{
// If rowselect is True for grid then
// if dgAlwaysshowSelection is true, then paint highlight
// else if expandbutton has focus then override painting to paint as highlight
if (wwIsClass(parent.classtype, 'TwwCustomDBGrid')) then
begin
if (dgRowSelect in TwwCheatGridCast(Parent).Options) then
begin
if (dgAlwaysShowSelection in TwwCheatGridCast(Parent).Options) or
Focused then
begin
Canvas.Brush.Color:= clHighlight;
Canvas.Font.Color := clHighlightText;
end
end;
end;
}
if DrawHighlight then begin
Canvas.Brush.Color := clHighlight;
Canvas.Font.Color := clHighlightText;
end;
{ Honor grid's colors when painting cell }
if DrawHighlight and (wwIsClass(parent.classtype, 'TwwCustomDBGrid')) then
begin
if TwwCustomDBGrid(parent).PaintOptions.ActiveRecordColor<>clNone then
Canvas.Brush.Color:=
TwwCustomDBGrid(parent).PaintOptions.ActiveRecordColor;
if (GetField<>nil) then
TwwCheatGridCast(Parent).DoCalcCellColors(GetField, [], True, Canvas.Font, Canvas.Brush);
Canvas.FillRect(r);
end
else begin
if FillBackground and not(wwUseThemes(self)) then
Canvas.FillRect(r);
end;
end
end;
if not HideExpand then PaintCheckbox;
if ShowText then PaintText;
// 8/25/01 - Check grid's rowselect
// 3/30/2002 - Only check for rowselect so focusrect will still show.
if DrawHighlight and not DrawHighlightForRowSelect(False) and
(parent.Focused and not (csPaintCopy in ControlState)) then
begin
r:= ClientRect;
Canvas.Brush.Color := clHighlight;
Canvas.Font.Color := clHighlightText;
Canvas.Pen.Color:= clHighlight;
Canvas.FrameRect(r);
SetTextColor(Canvas.Handle, ColorToRGB(clHighlightText));
SetBkColor(Canvas.Handle, ColorToRGB(clHighlight));
Canvas.DrawFocusRect(r);
end
finally
EndPainting;
FPaintBitmap.Free;
FPaintBitmap:=nil;
end
end;
procedure TwwCustomCheckBox.WMLButtonUp(var Message: TWMLButtonUp);
var r: TRect;
begin
inherited;
if not IsInGrid(self) then begin
if PtInRect(ClientRect, Point(Message.xpos,Message.ypos)) then
Toggle;
end
else begin
ComputeGlyphRect(r);
InflateRect(r, 3, 3);
if PtInRect(r, Point(Message.xpos,Message.ypos)) then
if not wwIsClass(self.classtype, 'TwwExpandButton') or
Focused or (not Checked) then
Toggle;
end
end;
procedure TwwCustomCheckBox.BMSetCheck(var Message: TMessage);
var r: TRect;
begin
inherited;
if DynamicCaption then begin
if State=cbChecked then Caption:= DisplayValueChecked
else if State=cbUnchecked then Caption:= DisplayValueUnchecked
else Caption:= ''
end
else begin
if IsTransparentEffective and
((not Focused) or AlwaysTransparent) then
begin
ComputeGlyphRect(r);
r:= Rect(r.left + left, r.top + top, r.right+left, r.bottom+top);
InvalidateRect(parent.handle, @r, False);
// Frame.RefreshTransparentText(False, False);
end
end;
invalidate;
end;
procedure TwwCustomCheckBox.PaintBorder;
begin
if HandleAllocated then
begin
if not Frame.Enabled then exit;
Frame.Ncpaint(Focused, AlwaysTransparent);
end;
end;
procedure TwwCustomCheckBox.WMKillFocus(var Message: TWMKillFocus);
var
exStyle, origStyle: longint;
// r: TRect;
begin
inherited;
if IsTransparentEffective then
begin
OrigStyle:= Windows.GetWindowLong(handle, GWL_EXSTYLE);
exStyle:= OrigStyle or WS_EX_TRANSPARENT;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -