⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 wwcheckbox.pas

📁 InfoPower_Studio 2007 v5.0.1.3 banben
💻 PAS
📖 第 1 页 / 共 5 页
字号:
      {$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 + -