lazarus-ccr/components/orpheus/ovctcbox.pas

{*********************************************************}
{*                  OVCTCBOX.PAS 4.06                    *}
{*********************************************************}

{* ***** BEGIN LICENSE BLOCK *****                                            *}
{* Version: MPL 1.1                                                           *}
{*                                                                            *}
{* The contents of this file are subject to the Mozilla Public License        *}
{* Version 1.1 (the "License"); you may not use this file except in           *}
{* compliance with the License. You may obtain a copy of the License at       *}
{* http://www.mozilla.org/MPL/                                                *}
{*                                                                            *}
{* Software distributed under the License is distributed on an "AS IS" basis, *}
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License   *}
{* for the specific language governing rights and limitations under the       *}
{* License.                                                                   *}
{*                                                                            *}
{* The Original Code is TurboPower Orpheus                                    *}
{*                                                                            *}
{* The Initial Developer of the Original Code is TurboPower Software          *}
{*                                                                            *}
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002    *}
{* TurboPower Software Inc. All Rights Reserved.                              *}
{*                                                                            *}
{* Contributor(s):                                                            *}
{*                                                                            *}
{* ***** END LICENSE BLOCK *****                                              *}

{$I OVC.INC}

{$B-} {Complete Boolean Evaluation}
{$I+} {Input/Output-Checking}
{$P+} {Open Parameters}
{$T-} {Typed @ Operator}
{.W-} {Windows Stack Frame}
{$X+} {Extended Syntax}

unit ovctcbox;
  {-Orpheus Table Cell - Check box type}

interface

uses
  {$IFNDEF LCL} Windows, {$ELSE} LclIntf, {$ENDIF}
  SysUtils, Graphics, Classes, Controls, StdCtrls,
  OvcTCmmn, OvcTCell, OvcTGRes, OvcTCGly;

type
  TOvcTCCustomCheckBox = class(TOvcTCCustomGlyph)
    protected {private}
      {.Z+}
      FAllowGrayed : boolean;

      FatherValue : Integer;
      {.Z-}

    protected
      {.Z+}
      procedure SetAllowGrayed(AG : boolean);

      procedure GlyphsHaveChanged(Sender : TObject);
      procedure tcPaint(TableCanvas : TCanvas;
                  const CellRect    : TRect;
                        RowNum      : TRowNum;
                        ColNum      : TColNum;
                  const CellAttr    : TOvcCellAttributes;
                        Data        : pointer); override;
      {.Z-}

    public
      constructor Create(AOwner : TComponent); override;

      function  CanAssignGlyphs(CBG : TOvcCellGlyphs) : boolean; override;

      procedure SaveEditedData(Data : pointer); override;
      procedure StartEditing(RowNum : TRowNum; ColNum : TColNum;
                             CellRect : TRect;
                       const CellAttr : TOvcCellAttributes;
                             CellStyle: TOvcTblEditorStyle;
                             Data : pointer); override;
      procedure StopEditing(SaveValue : boolean;
                            Data : pointer); override;

      property AllowGrayed : boolean
         read FAllowGrayed write SetAllowGrayed;

  end;

  TOvcTCCheckBox = class(TOvcTCCustomCheckBox)
    published
      {properties inherited from custom ancestor}
      property AcceptActivationClick default True;
      property Access default otxDefault;
      property Adjust default otaDefault;
      property AllowGrayed default False;
      property CellGlyphs;
      property Color;
      property Hint;
      property Margin default 4;
      property ShowHint default False;
      property Table;
      property TableColor default True;

      {events inherited from custom ancestor}
      property OnClick;
      property OnDragDrop;
      property OnDragOver;
      property OnEndDrag;
      property OnEnter;
      property OnExit;
      property OnKeyDown;
      property OnKeyPress;
      property OnKeyUp;
      property OnMouseDown;
      property OnMouseMove;
      property OnMouseUp;
      property OnOwnerDraw;
  end;

implementation


{===TOvcTCCustomCheckBox creation/destruction========================}
constructor TOvcTCCustomCheckBox.Create(AOwner : TComponent);
  begin
    inherited Create(AOwner);
    CellGlyphs.OnCfgChanged := nil;
    if (CellGlyphs.ActiveGlyphCount = 3) then
      CellGlyphs.ActiveGlyphCount := 2;
    CellGlyphs.OnCfgChanged := GlyphsHaveChanged;
    FAcceptActivationClick := true;
  end;
{--------}
procedure TOvcTCCustomCheckBox.SetAllowGrayed(AG : boolean);
  begin
    if AG <> FAllowGrayed then
      begin
        FAllowGrayed := AG;
        if AG then
          CellGlyphs.ActiveGlyphCount := 3
        else
          CellGlyphs.ActiveGlyphCount := 2;
        tcDoCfgChanged;
      end;
  end;
{--------}
function TOvcTCCustomCheckBox.CanAssignGlyphs(CBG : TOvcCellGlyphs) : boolean;
  begin
    Result := CBG.GlyphCount = 3;
  end;
{--------}
procedure TOvcTCCustomCheckBox.GlyphsHaveChanged(Sender : TObject);
  begin
    CellGlyphs.OnCfgChanged := nil;
    if FAllowGrayed then
      CellGlyphs.ActiveGlyphCount := 3
    else
      CellGlyphs.ActiveGlyphCount := 2;
    CellGlyphs.OnCfgChanged := GlyphsHaveChanged;
    tcDoCfgChanged;
  end;
{====================================================================}


{===TOvcTCCustomCheckBox painting====================================}
procedure TOvcTCCustomCheckBox.tcPaint(TableCanvas : TCanvas;
                                 const CellRect    : TRect;
                                       RowNum      : TRowNum;
                                       ColNum      : TColNum;
                                 const CellAttr    : TOvcCellAttributes;
                                       Data        : pointer);
  var
    B : ^TCheckBoxState absolute Data;
    Value : integer;
  begin
    if (Data = nil) then
      inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CellAttr, nil)
    else
      begin
        Value := ord(B^);
        inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CellAttr, @Value);
      end;
  end;
{====================================================================}


{===TOvcTCCheckBox editing===========================================}
procedure TOvcTCCustomCheckBox.SaveEditedData(Data : pointer);
  begin
    if Assigned(Data) then
      begin
        inherited SaveEditedData(@FatherValue);
        TCheckBoxState(Data^) := TCheckBoxState(FatherValue);
      end;
  end;
{--------}
procedure TOvcTCCustomCheckBox.StartEditing(RowNum : TRowNum; ColNum : TColNum;
                                            CellRect : TRect;
                                      const CellAttr : TOvcCellAttributes;
                                            CellStyle: TOvcTblEditorStyle;
                                            Data : pointer);
  begin
    if (Data = nil) then
      inherited StartEditing(RowNum, ColNum,
                             CellRect, CellAttr, CellStyle, nil)
    else
      begin
        FatherValue := Integer(TCheckBoxState(Data^));
        inherited StartEditing(RowNum, ColNum,
                               CellRect, CellAttr, CellStyle, @FatherValue);
      end;
  end;
{--------}
procedure TOvcTCCustomCheckBox.StopEditing(SaveValue : boolean;
                                           Data : pointer);
  begin
    inherited StopEditing(SaveValue, @FatherValue);
    if SaveValue and Assigned(Data) then
      TCheckBoxState(Data^) := TCheckBoxState(FatherValue);
  end;
{====================================================================}


end.