lazarus-ccr/components/orpheus/ovctcgly.pas

{*********************************************************}
{*                  OVCTCGLY.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 ovctcgly;
  {-Orpheus Table Cell - Glyph type}

interface

uses
  {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
  SysUtils, Graphics, Classes, Controls,
  OvcTCmmn, OvcTCell, OvcTGRes, OvcTCBmp;

type
  TOvcTCGlyphEdit = class(TCustomControl)
    protected {private}
      {.Z+}
      FValue  : Integer;
      FCell   : TOvcBaseTableCell;
      FRow    : TRowNum;
      FCol    : TColNum;
      FCellAttr : TOvcCellAttributes;
      {.Z-}
{$IFDEF LCL}
      FCtl3D : Boolean;
{$ENDIF}

    protected
      {.Z+}
      procedure SetValue(V : integer);

      procedure WMGetDlgCode(var Msg : TMessage); message WM_GETDLGCODE;
      procedure WMKeyDown(var Msg : TWMKey); message WM_KEYDOWN;
      procedure WMKillFocus(var Msg : TWMKillFocus); message WM_KILLFOCUS;
      procedure WMLButtonDown(var Msg : TWMMouse); message WM_LBUTTONDOWN;
      procedure WMSetFocus(var Msg : TWMSetFocus); message WM_SETFOCUS;
      {.Z-}

    public
      constructor Create(AOwner : TComponent); override;
      procedure Paint; override;

      property CellOwner : TOvcBaseTableCell
         read FCell write FCell;
      property Value : integer
         read FValue write SetValue;
{$IFDEF LCL}
      property Ctl3D : Boolean read FCtl3D write FCtl3D;
{$ENDIF}
  end;

  TOvcTCCustomGlyph = class(TOvcTCBaseBitMap)
    protected {private}
      {.Z+}
      FCellGlyphs : TOvcCellGlyphs;
      FEdit       : TOvcTCGlyphEdit;
      {.Z-}

    protected
      {.Z+}
      function GetCellEditor : TControl; override;
      procedure SetCellGlyphs(CBG : TOvcCellGlyphs);

      procedure GlyphsHaveChanged(Sender : TObject);

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

      {properties}
      property CellGlyphs : TOvcCellGlyphs
        read FCellGlyphs write SetCellGlyphs;

    public
      {create/destroy}
      constructor Create(AOwner : TComponent); override;
      destructor Destroy; override;
      function CreateEditControl : TOvcTCGlyphEdit; virtual;

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

      function  EditHandle : THandle; override;
      procedure EditHide; override;
      procedure EditMove(CellRect : TRect); 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;

  end;

  TOvcTCGlyph = class(TOvcTCCustomGlyph)
    published
      {properties inherited from custom ancestor}
      property AcceptActivationClick default True;
      property Access default otxDefault;
      property Adjust default otaDefault;
      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


{===TOvcTCCustomGlyph creation/destruction===========================}
constructor TOvcTCCustomGlyph.Create(AOwner : TComponent);
  begin
    inherited Create(AOwner);
    FCellGlyphs := TOvcCellGlyphs.Create;
    FCellGlyphs.OnCfgChanged := GlyphsHaveChanged;
    FAcceptActivationClick := true;
  end;
{--------}
destructor TOvcTCCustomGlyph.Destroy;
  begin
    FCellGlyphs.Free;
    inherited Destroy;
  end;
{--------}
function  TOvcTCCustomGlyph.CanAssignGlyphs(CBG : TOvcCellGlyphs) : boolean;
  begin
    Result := true;
  end;
{--------}
function TOvcTCCustomGlyph.CreateEditControl : TOvcTCGlyphEdit;
  begin
    Result := TOvcTCGlyphEdit.Create(FTable);
  end;
{--------}
function TOvcTCCustomGlyph.GetCellEditor : TControl;
  begin
    Result := FEdit;
  end;
{--------}
procedure TOvcTCCustomGlyph.GlyphsHaveChanged(Sender : TObject);
  begin
    tcDoCfgChanged;
  end;
{--------}
procedure TOvcTCCustomGlyph.SetCellGlyphs(CBG : TOvcCellGlyphs);
  begin
    if CanAssignGlyphs(CBG) then
      FCellGlyphs.Assign(CBG);
  end;
{====================================================================}


{===TOvcTCCustomGlyph painting================================}
procedure TOvcTCCustomGlyph.tcPaint(TableCanvas : TCanvas;
                              const CellRect    : TRect;
                                    RowNum      : TRowNum;
                                    ColNum      : TColNum;
                              const CellAttr    : TOvcCellAttributes;
                                    Data        : pointer);
  var
    B : ^integer absolute Data;
    BitMapInfo : TCellBitMapInfo;
  begin
    {set up a bitmap info record}
    with BitMapInfo do
      begin
        BM := FCellGlyphs.BitMap;
        ActiveCount := FCellGlyphs.ActiveGlyphCount;
        Count := FCellGlyphs.GlyphCount;
        if (Data = nil) then
          begin
            if (csDesigning in ComponentState) then
              Index := (RowNum mod ActiveCount)      {for testing purposes}
            else
              Index := -1
          end
        else
          Index := B^;
        if (Index >= ActiveCount) then
          Index := pred(ActiveCount);
      end;
    inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CellAttr, @BitMapInfo);
  end;
{====================================================================}


{===TOvcTCCustomGlyph editing========================================}
function TOvcTCCustomGlyph.EditHandle : THandle;
  begin
    if Assigned(FEdit) then
      Result := FEdit.Handle
    else
      Result := 0;
  end;
{--------}
procedure TOvcTCCustomGlyph.EditHide;
  begin
    if Assigned(FEdit) then
      with FEdit do
        begin
          SetWindowPos(FEdit.Handle, HWND_TOP,
                       0, 0, 0, 0,
                       SWP_HIDEWINDOW or SWP_NOREDRAW or SWP_NOZORDER);
        end;
  end;
{--------}
procedure TOvcTCCustomGlyph.EditMove(CellRect : TRect);
  var
    EditHandle : HWND;
  begin
    if Assigned(FEdit) then
      begin
        EditHandle := FEdit.Handle;
        with CellRect do
          SetWindowPos(EditHandle, HWND_TOP,
                       Left, Top, Right-Left, Bottom-Top,
                       SWP_SHOWWINDOW or SWP_NOREDRAW or SWP_NOZORDER);
        InvalidateRect(EditHandle, nil, false);
        UpdateWindow(EditHandle);
      end;
  end;
{--------}
procedure TOvcTCCustomGlyph.SaveEditedData(Data : pointer);
  begin
    if Assigned(Data) then
      Integer(Data^) := FEdit.Value;
  end;
{--------}
procedure TOvcTCCustomGlyph.StartEditing(RowNum : TRowNum; ColNum : TColNum;
                                           CellRect : TRect;
                                     const CellAttr : TOvcCellAttributes;
                                           CellStyle: TOvcTblEditorStyle;
                                           Data : pointer);
  begin
    FEdit := CreateEditControl;
    with FEdit do
      begin
        CellOwner := Self;
        if Data = nil then
          Value := 0
        else
          Value := Integer(Data^);
        FRow := RowNum;
        FCol := ColNum;
        FCellAttr := CellAttr;
        Color := CellAttr.caColor;
        Ctl3D := false;
        case CellStyle of
          tes3D     : Ctl3D := true;
        end;{case}
        Left := CellRect.Left;
        Top := CellRect.Top;
        Width := CellRect.Right - CellRect.Left;
        Height := CellRect.Bottom - CellRect.Top;
        Hint := Self.Hint;
        ShowHint := Self.ShowHint;
        Parent := FTable;
        Visible := true;
        TabStop := false;

        OnClick := Self.OnClick;
        OnDblClick := Self.OnDblClick;
        OnDragDrop := Self.OnDragDrop;
        OnDragOver := Self.OnDragOver;
        OnEndDrag := Self.OnEndDrag;
        OnEnter := Self.OnEnter;
        OnExit := Self.OnExit;
        OnKeyDown := Self.OnKeyDown;
        OnKeyPress := Self.OnKeyPress;
        OnKeyUp := Self.OnKeyUp;
        OnMouseDown := Self.OnMouseDown;
        OnMouseMove := Self.OnMouseMove;
        OnMouseUp := Self.OnMouseUp;
      end;
  end;
{--------}
procedure TOvcTCCustomGlyph.StopEditing(SaveValue : boolean;
                                        Data : pointer);
  begin
    if SaveValue and Assigned(Data) then
      Integer(Data^) := FEdit.Value;
    FEdit.Free;
    FEdit := nil;
  end;
{====================================================================}


{---TOvcTCGlyphEdit===========================================}
constructor TOvcTCGlyphEdit.Create(AOwner : TComponent);
  begin
    inherited Create(AOwner);
    ControlStyle := ControlStyle - [csDoubleClicks];
  end;
{--------}
procedure TOvcTCGlyphEdit.Paint;
  var
    R   : TRect;
  begin
{$IFNDEF LCL}
    Windows.GetClientRect(Handle, R);
{$ELSE}
    LclIntf.GetClientRect(Handle, R);
{$ENDIF}
    FCell.Paint(Canvas, R, FRow, FCol, FCellAttr, @FValue);
  end;
{--------}
procedure TOvcTCGlyphEdit.SetValue(V : integer);
  begin
    if (V <> FValue) then
      begin
        if (V < 0) then
          V := 0
        else if (V >= TOvcTCGlyph(CellOwner).CellGlyphs.ActiveGlyphCount) then
          V := TOvcTCGlyph(CellOwner).CellGlyphs.ActiveGlyphCount;
        FValue := V;
        if HandleAllocated then
          begin
            Invalidate;
            Update;
          end;
      end;
  end;
{--------}
procedure TOvcTCGlyphEdit.WMGetDlgCode(var Msg : TMessage);
  begin
    Msg.Result := DLGC_WANTARROWS;
    if CellOwner.TableWantsTab then
      Msg.Result := Msg.Result or DLGC_WANTTAB;
    if CellOwner.TableWantsEnter then
      Msg.Result := Msg.Result or DLGC_WANTALLKEYS;
  end;
{--------}
procedure TOvcTCGlyphEdit.WMKeyDown(var Msg : TWMKey);
  var
    GridReply : TOvcTblKeyNeeds;
    GridUsedIt : boolean;
  begin
    GridUsedIt := false;
    GridReply := otkDontCare;
    if (CellOwner <> nil) then
      GridReply := CellOwner.FilterTableKey(Msg);
    case GridReply of
      otkMustHave :
        begin
          CellOwner.SendKeyToTable(Msg);
          GridUsedIt := true;
        end;
      otkWouldLike :
        if Msg.CharCode <> VK_SPACE then
          begin
            CellOwner.SendKeyToTable(Msg);
            GridUsedIt := true;
          end;
    end;{case}

    if not GridUsedIt then
      begin
        inherited;
        if (Msg.CharCode = VK_SPACE) then
          begin
            inc(FValue);
            if (FValue >= TOvcTCGlyph(FCell).FCellGlyphs.ActiveGlyphCount) then
              FValue := 0;
            Invalidate;
            Update;

            if ((@TOvcTCGlyph(FCell).FOnClick) <> nil) then
              OnClick(Self);
          end
        else if (Msg.CharCode = VK_BACK) then
          begin
            dec(FValue);
            if (FValue < 0) then
              FValue := pred(TOvcTCGlyph(FCell).FCellGlyphs.ActiveGlyphCount);
            Invalidate;
            Update;

            if ((@TOvcTCGlyph(FCell).FOnClick) <> nil) then
              OnClick(Self);
          end;
      end;
  end;
{--------}
procedure TOvcTCGlyphEdit.WMLButtonDown(var Msg : TWMMouse);
  begin
    inc(FValue);
    if (FValue >= TOvcTCGlyph(FCell).FCellGlyphs.ActiveGlyphCount) then
      FValue := 0;
    Invalidate;
    Update;

    inherited;
  end;
{--------}
procedure TOvcTCGlyphEdit.WMKillFocus(var Msg : TWMKillFocus);
  begin
    inherited;
    CellOwner.PostMessageToTable(ctim_KillFocus, Msg.FocusedWnd, 0);
  end;
{--------}
procedure TOvcTCGlyphEdit.WMSetFocus(var Msg : TWMSetFocus);
  begin
    inherited;
    CellOwner.PostMessageToTable(ctim_SetFocus, Msg.FocusedWnd, 0);
  end;
{====================================================================}


end.