wwcheckbox.pas

InfoPower_Studio 2007 v5.0.1.3 banben

    procedure DoBeforeCollapse; virtual;
    procedure DoAfterExpand; virtual;
    procedure DoAfterCollapse; virtual;
    function HideExpand: boolean; override;
    function GetDrawFlags: integer; override;
   public
    PaintAsExpanded: boolean;
    DesiredRow: integer;
    ExpandedGridRow: integer;
    InRefreshCalcField: boolean;
    InToggle: boolean;
//    ftest: integer;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ResetHeight;
    procedure Click; override;
    property Expanded: boolean read GetExpanded write SetExpanded;
    procedure RefreshCalcField;
    procedure ExpandAfterDelay;
//    property Checked: boolean read FExpanded write SetExpanded;
   published
    property DisableThemes;
    property Grid: TWinControl read FGrid write SetGrid;
    property AutoShrink: boolean read FAutoShrink write FAutoShrink default True;
    property TextAlignment;

    property AutoHideExpand: boolean read FAutoHideExpand write FAutoHideExpand default False;
    property ShowFocusRect;
    property OnBeforeExpand: TNotifyEvent read FOnBeforeExpand write FOnBeforeExpand;
    property OnBeforeCollapse: TNotifyEvent read FOnBeforeCollapse write FOnBeforeCollapse;
    property OnAfterExpand: TNotifyEvent read FOnAfterExpand write FOnAfterExpand;
    property OnAfterCollapse: TNotifyEvent read FOnAfterCollapse write FOnAfterCollapse;
    property OnCheckVisibleButton: TwwCheckVisibleButton read FOnCheckVisibleButton write FOnCheckVisibleButton;
    property GridIndents: TwwExpandGridIndents read FGridIndents write FGridIndents;
//    property Alignment;
    property BiDiMode;
    property Caption;
    property Color;
    property Constraints;
//    property test: integer read FTest write FTest;
    property DataField;
    property DataSource;
    property Enabled;
    property Font;
    property Images;
    property ParentBiDiMode;
    property ParentColor;
    property Indents;
    property ShowAsButton;
    property ShowText default False;
//    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property ButtonAlignment: TAlignment read FButtonAlignment write FButtonAlignment default taLeftJustify;
//    property OnClick;
    property OnContextPopup;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseEnter;
    property OnMouseLeave;

    property ReadOnly;
  end;


implementation
uses
     {$ifdef wwDelphi7Up}
     themes,
     {$endif}
     {$ifdef ThemeManager}
     thememgr, themesrv, uxtheme,
     {$endif}
     wwdbigrd;
type
  EwwExpandError = class(Exception);
  
Function TwwCustomCheckbox.GetColor: TColor;
begin
   result:= inherited Color;
end;

procedure TwwCustomCheckbox.SetColor(Value: TColor);
begin
   inherited Color:= Value;
end;

Function TwwCustomCheckbox.IsColorStored;
begin
   result:= not ParentColor;
end;

procedure TwwCustomCheckBox.CNDrawItem(var Message: TWMDrawItem);
begin
  DrawItem(Message.DrawItemStruct^);
end;

procedure TwwCustomCheckBox.DrawItem(const DrawItemStruct: TDrawItemStruct);
  procedure CanvasNeeded;
  begin
    if FCanvas = nil then
    begin
      FCanvas := TControlCanvas.Create;
      FCanvas.Control := Self;
    end;
  end;
begin
  CanvasNeeded;
  FCanvas.Handle := DrawItemStruct.hDC;
  FCanvas.Font:= Font;
  Paint;
  PaintBorder;
  FCanvas.Handle := 0;
end;

procedure TwwCustomCheckBox.WMEraseBkgnd(var Message: TWMEraseBkgnd);
{$ifdef wwUseThemeManager}
var r: TRect;
{$endif}
begin
  if IsInwwObjectViewPaint(self) or
    ((IsTransparentEffective and not Focused) or AlwaysTransparent) then
  begin
     if not (csDesigning in ComponentState) then Message.result:= 1
     else inherited;
  end
  else if wwUseThemes(self) then
  begin
    {$ifdef wwUseThemeManager}
    if (parent is TCustomGrid) then
    begin
       r:= ClientRect;
       if (FCanvas<>nil) then
       begin
          FCanvas.Brush.Color:= Color;
          Windows.FillRect(message.dc, r, FCanvas.brush.handle );
       end;
       message.result:=1
    end
    else begin
      { Get the parent to draw its background into the control's background. }
      {$ifdef wwDelphi7Up}
      ThemeServices.DrawParentBackground(Handle, Message.DC, nil, False);
      {$endif}
      message.result:=1;
    end
    {$endif}
  end
  else
     inherited;
{   if Frame.enabled and not (csDesigning in ComponentState) then
      message.result:=1
   else inherited;}
end;

procedure TwwCustomCheckBox.CreateParams(var Params: TCreateParams);
const
  Alignments: array[Boolean, TLeftRight] of DWORD =
    ((BS_LEFTTEXT, 0), (0, BS_LEFTTEXT));
begin
   inherited;
   CreateSubClass(Params, 'BUTTON');
   if IsTransparentEffective then
     Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;  // For transparency

// Following 2 lines may not be necessary
//   if ThemeServices.ThemesEnabled then
//     Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;  // For transparency

   with Params do begin
     Style:= Style and not BS_3STATE;
     Style := Style or BS_ownerdraw;
//     Style:= Style or ws_border;
     WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
   end;
end;

procedure TwwCustomCheckBox.CreateWnd;
  procedure DisableParentClipping;
  begin
     SetWindowLong(GetParent(Handle), GWL_STYLE,
      GetWindowLong(GetParent(Handle), GWL_STYLE) and not WS_CLIPCHILDREN);
  end;
begin
   inherited;
   if IsTransparentEffective then
   begin
     DisableParentClipping;
   end;
   Modified := FModified;
end;

destructor TwwCustomCheckBox.Destroy;
begin
   FIndents.Free;
   FCanvas.Free;
   FFrame.Free;
   inherited;
end;
{
procedure TwwCustomCheckBox.PaintGlyph(drawrect: TRect; b: TBitmap);
var TempRect: TRect;
    FGlyphs: TImageList;
    i: integer;
begin
 for i:= 1 to 1 do
  begin
   FGlyphs:= TImageList.createsize(b.Width, b.Height);
   FGlyphs.AddMasked(b, b.Canvas.Pixels[0, b.Height-1]);
   Canvas.Lock;
   TempRect:= Rect(0, 0, b.Width, b.Height);
   try
      FGlyphs.Draw(Canvas, drawrect.left, drawrect.top,
        0, True);
//      FCanvas.Brush.Style:= bsClear;
//      FCanvas.BrushCopy(DrawRect, b, TempRect,
//          b.Canvas.Pixels[0, b.Height-1]);
   finally
      Canvas.Unlock;
      FGlyphs.Free;
   end;
end
end;
}

procedure TwwCustomCheckBox.ComputeGlyphRect(var DrawRect: TRect);
var offsetx, offsety: integer;
    checkboxSizeX, checkboxSizeY: integer;
    pt: TPoint;
    TempIndentCheckboxX: integer;
begin
   if (GetImageList<>nil) and (GetImageList.count>0) then
   begin
      checkboxSizeX:= GetImageList.Width;
      checkboxSizeY:= GetImageList.Height;
   end
   else begin
      checkboxSizex:= 13;
      checkboxSizey:= 13;
   end;

     offsetx:= checkboxsizex div 2;
     offsety:= checkboxsizey div 2;

     TempIndentCheckboxX:= Indents.ButtonX+1+GetExtraIndentX;
     if parent is TCustomGrid then inc(TempIndentCheckboxX);

     if Frame.Enabled and
        (efLeftBorder in Frame.FocusBorders) then
     begin
        TempIndentCheckboxX:= wwmax(TempIndentCheckboxX, 3);
     end;

     if GetAlignment = taRightJustify then
        pt.x:= offsetx + TempIndentCheckboxX
     else if GetAlignment = taLeftJustify then
        pt.x:= ClientWidth - TempIndentCheckboxX - offsetx -2
     else
        pt.x:= (ClientWidth - offsetx) div 2;
     pt.y:= Height div 2;

     DrawRect.Left:= pt.x - offsetx;
     DrawRect.Right:= pt.x + offsetx+1;
     DrawRect.Top:= pt.y-offsety+Indents.ButtonY;
     DrawRect.Bottom:= pt.y+offsety+1+Indents.ButtonY;

end;

procedure TwwCustomCheckBox.ComputeTextRect(var DrawRect: TRect);
var TempIndentTextX: integer;
    pt: TPoint;
    NewDrawRect: TRect;
    DrawFlags: integer;
    TempCaption : string;
begin
   ComputeGlyphRect(DrawRect);

   TempIndentTextX:= Indents.TextX;
   if Frame.Enabled and
      (efLeftBorder in Frame.FocusBorders) then
      TempIndentTextX:= wwmax(TempIndentTextX, 3);
//   if FShowAsButton then TempIndentTextX:= wwmax(TempIndentTextX, 3);

   pt.y:= Height div 2;
   if GetAlignment = taRightJustify then
       NewDrawRect:= Rect(DrawRect.Right + 4 + TempIndentTextX, 0,
                     Width, Height)
   else
       NewDrawRect:= Rect(TempIndentTextX + 2, 0, DrawRect.Left, Height);
   DrawFlags:= GetDrawFlags;
   if WordWrap then
      DrawFlags:= DrawFlags or DT_EDITCONTROL or DT_WORDBREAK;
   if DynamicCaption then
   begin
      TempCaption:=  DisplayValueChecked;
      if length(TempCaption)<length(DisplayValueUnchecked) then
         TempCaption:= DisplayValueUnchecked;
      //if length(TempCaption) < length(Caption) then TempCaption := Caption; !! Uncomment?
   end
   else TempCaption:= GetDisplayText; //Caption;


   DrawTextEx(Canvas.Handle, PChar(TempCaption),
              Length(TempCaption), newdrawrect, DrawFlags or DT_CALCRECT, nil);
   DrawRect:= NewDrawRect;

   if CenterTextVertically then
      DrawRect.Top:= Indents.TextY + (ClientHeight -
                   (NewDrawRect.Bottom-NewDrawRect.Top)) div 2
   else
      DrawRect.Top:= Indents.TextY + 1;

   DrawRect.Bottom:= DrawRect.Top + NewDrawRect.Bottom; //DrawRect.Bottom - (NewDrawRect.Bottom-NewDrawRect.Top) div 2;
   if wwIsClass(parent.classtype, 'TwwDBGrid') and
      (dgRowLines in TwwDBGrid(parent).Options) then
       DrawRect.Top:= DrawRect.Top +1;

end;

type
  TwwCheatGridCast = class(TwwDBGrid);

procedure TwwCustomCheckBox.Paint;
var r: TRect;

// 8/25/01 -   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
// 3/30/2002 - In some cases we only wish to check for rowselect so focusrect will still show.
   function DrawHighlightForRowSelect(CheckBoth:boolean=True): boolean;
   begin
      Result:= False;
      if (wwIsClass(classtype, 'TwwExpandbutton')) then
      begin
          if (wwIsClass(parent.classtype, 'TwwCustomDBGrid')) then
          begin
             if (dgRowSelect in TwwCheatGridCast(Parent).Options) or
                (CheckBoth and (TwwCheatGridCast(Parent).PaintOptions.ActiveRecordColor<>clNone)) then
             begin
                if (dgAlwaysShowSelection in TwwCheatGridCast(Parent).Options) or
                   Focused then
                begin
                    result:= True;
                end
             end;
          end;
      end
  end;
  function DrawHighlight: boolean;
  begin
     result:= False;
     if wwIsClass(parent.classtype, 'TwwDBGrid') then begin

       result:= parent.focused {or
               (TwwDBGrid(parent).HasFocus and
               (not Focused) and
                not wwInPaintCopyState(ControlState))};
       //    8/25/01
       if (not result) and DrawHighlightForRowSelect then result:= True;
    end
  end;

    {$ifdef wwUseThemeManager}
    function GetCheckboxThemeStyle(Pressed: boolean): TThemedButton;
    var TempState: TCheckboxState;
    begin
       if csPaintCopy in ControlState then
          TempState:= GetFieldState
       else
          TempState:= State;

       if (TempState=cbGrayed) or (not Enabled) then
       begin
          if TempState = cbChecked then
             Result:= tbCheckboxCheckedDisabled
          else Result:= tbCheckboxUnCheckedDisabled
       end
       else begin
          if TempState = cbChecked then
          begin
             if Pressed then
                Result:= tbCheckboxCheckedPressed
             else begin
                if IsMouseInControl and not (csPaintCopy in ControlState) then
                   Result:= tbCheckboxCheckedHot
                else
                   Result:= tbCheckboxCheckedNormal
             end
          end
          else begin
             if Pressed then
                Result:= tbCheckboxUncheckedPressed
             else begin
                if IsMouseInControl and not (csPaintCopy in ControlState) then
                   Result:= tbCheckboxUncheckedHot
                else
                   Result:= tbCheckboxUncheckedNormal
             end
          end;
       end;
    end;
    {$endif}

  procedure PaintText;
  var ARect, FocusRect: TRect;
      Flags: integer;
      HaveText: boolean;
      TempCaption: string;
      SaveColorbg,savecolorfont:TColor;
      temp: integer;
      tempRect: TRect;