{*********************************************************}
{*                  OVCTCBEF.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 ovctcbef;
  {-Orpheus Table Cell - base entry field type}

interface

uses
  {$IFNDEF LCL} Windows, {$ELSE} LclIntf, LclType, MyMisc, {$ENDIF}
  SysUtils, Classes, Graphics, Controls, Forms,
  OvcBase, OvcCmd, OvcEF, OvcCaret, OvcTCmmn, OvcTCell, OvcTable, OvcTCStr;

type
  TOvcTCBaseEntryField = class(TOvcTCBaseString)
    protected {private}
      FEdit        : TOvcBaseEntryField;
      FEditDisplay : TOvcBaseEntryField;

      FOnError          : TValidationErrorEvent;
      FOnUserCommand    : TUserCommandEvent;
      FOnUserValidation : TUserValidationEvent;

      CopyOfData     : pointer;
      CopyOfDataSize : Integer;

    protected
      function GetCaretIns : TOvcCaret;
      function GetCaretOvr : TOvcCaret;
      function GetControlCharColor : TColor;
      function GetDataSize : integer;
      function GetDecimalPlaces : byte;
      function GetOptions : TOvcEntryFieldOptions;
      function GetEFColors : TOvcEFColors;
      function GetMaxLength : word;
      function GetModified : boolean;
      function GetPadChar : AnsiChar;
      function GetPasswordChar : AnsiChar;
      function GetRangeHi : string;
      function GetRangeLo : string;
      function GetTextMargin : integer;

      procedure SetCaretIns(CI : TOvcCaret);
      procedure SetCaretOvr(CO : TOvcCaret);
      procedure SetControlCharColor(CCC : TColor);
      procedure SetDecimalPlaces(DP : byte);
      procedure SetEFColors(Value : TOvcEFColors);
      procedure SetMaxLength(ML : word);
      procedure SetOptions(Value : TOvcEntryFieldOptions);
      procedure SetPadChar(PC : AnsiChar);
      procedure SetPasswordChar(PC : AnsiChar);
      procedure SetRangeHi(const RI : string);
      procedure SetRangeLo(const RL : string);
      procedure SetTextMargin(TM : integer);

      procedure DefineProperties(Filer: TFiler); override;

      procedure tcPaint(TableCanvas : TCanvas;
                  const CellRect    : TRect;
                        RowNum      : TRowNum;
                        ColNum      : TColNum;
                  const CellAttr    : TOvcCellAttributes;
                        Data        : pointer); override;

      {properties for entry fields, to be exposed by descendants}
      property CaretIns : TOvcCaret
         read GetCaretIns write SetCaretIns;

      property CaretOvr : TOvcCaret
         read GetCaretOvr write SetCaretOvr;

      property ControlCharColor : TColor
         read GetControlCharColor write SetControlCharColor;

      property DecimalPlaces : byte
         read GetDecimalPlaces write SetDecimalPlaces;

      property EFColors : TOvcEFColors
         read GetEFColors write SetEFColors;

      property MaxLength : word
         read GetMaxLength write SetMaxLength;

      property Options : TOvcEntryFieldOptions
         read GetOptions write SetOptions;

      property PadChar : AnsiChar
         read GetPadChar write SetPadChar;

      property PasswordChar : AnsiChar
         read GetPasswordChar write SetPasswordChar;

      property RangeHi : string
         read GetRangeHi write SetRangeHi
         stored false;

      property RangeLo : string
         read GetRangeLo write SetRangeLo
         stored false;

      property TextMargin : integer
         read GetTextMargin write SetTextMargin;

      {events}
      property OnError : TValidationErrorEvent
         read FOnError write FOnError;

      property OnUserCommand : TUserCommandEvent
         read FOnUserCommand write FOnUserCommand;

      property OnUserValidation : TUserValidationEvent
         read FOnUserValidation write FOnUserValidation;

    public
      constructor Create(AOwner : TComponent); override;
      destructor Destroy;
        override;
      function CreateEntryField(AOwner : TComponent) : TOvcBaseEntryField; virtual; abstract;

      function  EditHandle : THandle; override;
      procedure EditHide; override;
      procedure EditMove(CellRect : TRect); override;

      function CanSaveEditedData(SaveValue : boolean) : 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 DataSize : integer
         read GetDataSize;

      property Modified : boolean
         read GetModified;

    published
      property About;
  end;

implementation

uses
  Dialogs;

type {for typecast to get around protected clause}
  TOvcBEF = class(TOvcBaseEntryField)
    public
      property CaretIns;
      property CaretOvr;
      property ControlCharColor;
      property DecimalPlaces;
      property EFColors;
      property MaxLength;
      property Options;
      property PadChar;
      property PasswordChar;
      property RangeHi;
      property RangeLo;
      property ShowHint;
      property TextMargin;
  end;

{===TOvcTCBaseEntryField=============================================}
constructor TOvcTCBaseEntryField.Create(AOwner : TComponent);
  begin
    inherited Create(AOwner);

    FEdit := CreateEntryField(Self);
    FEdit.Visible := false;

    FEditDisplay := CreateEntryField(Self);
    FEditDisplay.Visible := false;
  end;

destructor TOvcTCBaseEntryField.Destroy;
begin
  if (CopyOfData <> nil) and (CopyOfDataSize > 0) then
    FreeMem(CopyOfData, CopyOfDataSize);

  inherited Destroy;
end;

{--------}
function TOvcTCBaseEntryField.CanSaveEditedData(SaveValue : boolean) : boolean;
  begin
    Result := true;
    if Assigned(FEdit) then
      if SaveValue then
        with TOvcBEF(FEdit) do
          if Controller.ErrorPending then
            Result := false
          else
            Result := ValidateSelf
      else
        FEdit.Restore;
  end;
{--------}
function TOvcTCBaseEntryField.EditHandle : THandle;
  begin
    if Assigned(FEdit) then
      Result := FEdit.Handle
    else
      Result := 0;
  end;
{--------}
procedure TOvcTCBaseEntryField.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 TOvcTCBaseEntryField.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 TOvcTCBaseEntryField.tcPaint(TableCanvas : TCanvas;
                                 const CellRect    : TRect;
                                       RowNum      : TRowNum;
                                       ColNum      : TColNum;
                                 const CellAttr    : TOvcCellAttributes;
                                       Data        : pointer);
  var
    S : ShortString;
    I : integer;
  begin
    if (Data = nil) then
      inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CellAttr, Data)
    else
      begin
        FEditDisplay.Controller := TOvcTable(FTable).Controller;
        if (FEditDisplay.Controller = nil) then
          ShowMessage('NIL in tcPaint');
        FEditDisplay.Parent := FTable;
        SetWindowPos(FEditDisplay.Handle, HWND_TOP, 0, 0, 0, 0,
                     SWP_HIDEWINDOW or SWP_NOREDRAW or SWP_NOZORDER);
        FEditDisplay.SetValue(Data^);
        S := Trim(FEditDisplay.DisplayString);  // Inserted Trim
(*  TurboPower bug: this code trims string of white space, but in using I as
     index into string S doesn't check if I is in range of 1..Length(S),
     which can result in range-check error.
        I := 1;
        while (S[I] <= #32) do
          Inc(I);
        Delete(S, 1, I-1);
        I := Length(S);
        while (S[I] <= #32) do
          Dec(I);
        Delete(S, I+1, Length(S) - I);
*)
        inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CellAttr, @S);
      end;
  end;
{--------}
procedure TOvcTCBaseEntryField.SaveEditedData(Data : pointer);
  begin
    if Assigned(Data) then
      begin
        FEdit.GetValue(CopyOfData^);
        Move(CopyOfData^, Data^, CopyOfDataSize);
      end;
  end;
{--------}
procedure TOvcTCBaseEntryField.StartEditing(RowNum : TRowNum; ColNum : TColNum;
                                           CellRect : TRect;
                                     const CellAttr : TOvcCellAttributes;
                                           CellStyle: TOvcTblEditorStyle;
                                           Data : pointer);
  begin
    CopyOfDataSize := FEdit.DataSize;
    GetMem(CopyOfData, CopyOfDataSize);
    if (Data = nil) then
      FillChar(CopyOfData^, CopyOfDataSize, 0)
    else
      Move(Data^, CopyOfData^, CopyOfDataSize);

    with TOvcBEF(FEdit) do
      begin
        Parent := FTable;
        Font := CellAttr.caFont;
        Font.Color := CellAttr.caFontColor;
        Color := CellAttr.caColor;
        BorderStyle := bsNone;
        Ctl3D := false;
        case CellStyle of
          tesBorder : BorderStyle := bsSingle;
          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;
        TabStop := false;
        Controller := TOvcTable(FTable).Controller;
        if (Controller = nil) then
          ShowMessage('NIL in StartEditing');
        SetValue(CopyOfData^);
        Visible := true;

        OnChange := Self.OnChange;
        OnClick := Self.OnClick;
        OnDblClick := Self.OnDblClick;
        OnDragDrop := Self.OnDragDrop;
        OnDragOver := Self.OnDragOver;
        OnEndDrag := Self.OnEndDrag;
        OnEnter := Self.OnEnter;
        OnError := Self.OnError;
        OnExit := Self.OnExit;
        OnKeyDown := Self.OnKeyDown;
        OnKeyPress := Self.OnKeyPress;
        OnKeyUp := Self.OnKeyUp;
        OnMouseDown := Self.OnMouseDown;
        OnMouseMove := Self.OnMouseMove;
        OnMouseUp := Self.OnMouseUp;
        OnUserCommand := Self.OnUserCommand;
        OnUserValidation := Self.OnUserValidation;
      end;
  end;
{--------}
procedure TOvcTCBaseEntryField.StopEditing(SaveValue : boolean;
                                           Data : pointer);
  begin
    if SaveValue and Assigned(Data) then
      begin
        FEdit.GetValue(CopyOfData^);
        Move(CopyOfData^, Data^, CopyOfDataSize);
      end;
    FreeMem(CopyOfData, CopyOfDataSize);
    CopyOfData := nil;
    CopyOfDataSize := 0;
    EditHide;
  end;
{====================================================================}


{===TOvcTCBaseEntryField property access=============================}
procedure TOvcTCBaseEntryField.DefineProperties(Filer: TFiler);
  begin
    inherited DefineProperties(Filer);
    with Filer do
      begin
        DefineBinaryProperty('RangeHigh',
           TOvcBEF(FEdit).efReadRangeHi, TOvcBEF(FEdit).efWriteRangeHi, true);
        DefineBinaryProperty('RangeLow',
           TOvcBEF(FEdit).efReadRangeLo, TOvcBEF(FEdit).efWriteRangeLo, true);
      end;
  end;
{--------}
function TOvcTCBaseEntryField.GetOptions : TOvcEntryFieldOptions;
  begin
    if Assigned(FEdit) then
      Result := FEdit.Options
    else
      Result := [];
  end;
function TOvcTCBaseEntryField.GetCaretIns : TOvcCaret;
  begin
    if Assigned(FEdit) then
         Result := TOvcBEF(FEdit).CaretIns
    else Result := nil;
  end;
{--------}
function TOvcTCBaseEntryField.GetCaretOvr : TOvcCaret;
  begin
    if Assigned(FEdit) then
         Result := TOvcBEF(FEdit).CaretOvr
    else Result := nil;
  end;
{--------}
function TOvcTCBaseEntryField.GetControlCharColor : TColor;
  begin
    if Assigned(FEdit) then
         Result := TOvcBEF(FEdit).ControlCharColor
    else Result := clRed;
  end;
{--------}
function TOvcTCBaseEntryField.GetDataSize : integer;
  begin
    if Assigned(FEdit) then
         Result := TOvcBEF(FEdit).DataSize
    else Result := 0;
  end ;
{--------}
function TOvcTCBaseEntryField.GetDecimalPlaces : byte;
  begin
    if Assigned(FEdit) then
         Result := TOvcBEF(FEdit).DecimalPlaces
    else Result := 0;
  end ;
{--------}
function TOvcTCBaseEntryField.GetEFColors : TOvcEFColors;
  begin
    Result := nil;
    if Assigned(FEdit) then
      Result := TOvcBEF(FEdit).EFColors;
  end;
{--------}
function TOvcTCBaseEntryField.GetModified : boolean;
  begin
    if Assigned(FEdit) then
         Result := TOvcBEF(FEdit).Modified
    else Result := false;
  end ;
{--------}
function TOvcTCBaseEntryField.GetMaxLength : word;
  begin
    if Assigned(FEdit) then
        Result := TOvcBEF(FEdit).MaxLength
   else Result := 0;
  end;
{--------}
function TOvcTCBaseEntryField.GetPadChar : AnsiChar;
  begin
    if Assigned(FEdit) then
         Result := TOvcBEF(FEdit).PadChar
    else Result := ' ';
  end;
{--------}
function TOvcTCBaseEntryField.GetPasswordChar : AnsiChar;
  begin
    if Assigned(FEdit) then
         Result := TOvcBEF(FEdit).PasswordChar
    else Result := '*';
  end;
{--------}
function TOvcTCBaseEntryField.GetRangeHi : string;
  begin
    if Assigned(FEdit) then
         Result := TOvcBEF(FEdit).RangeHi
    else Result := '';
  end;
{--------}
function TOvcTCBaseEntryField.GetRangeLo : string;
  begin
    if Assigned(FEdit) then
         Result := TOvcBEF(FEdit).RangeLo
    else Result := '';
  end;
{--------}
function TOvcTCBaseEntryField.GetTextMargin : integer;
  begin
    if Assigned(FEdit) then
         Result := TOvcBEF(FEdit).TextMargin
    else Result := 0;
  end;
{--------}
procedure TOvcTCBaseEntryField.SetCaretIns(CI : TOvcCaret);
  begin
    if Assigned(FEdit) then TOvcBEF(FEdit).CaretIns := CI;
  end;
{--------}
procedure TOvcTCBaseEntryField.SetCaretOvr(CO : TOvcCaret);
  begin
    if Assigned(FEdit) then TOvcBEF(FEdit).CaretOvr := CO;
  end;
{--------}
procedure TOvcTCBaseEntryField.SetControlCharColor(CCC : TColor);
  begin
    if Assigned(FEdit) then TOvcBEF(FEdit).ControlCharColor := CCC;
  end;
{--------}
procedure TOvcTCBaseEntryField.SetDecimalPlaces(DP : byte);
  begin
    if Assigned(FEdit) then
      begin
        TOvcBEF(FEdit).DecimalPlaces := DP;
        TOvcBEF(FEditDisplay).DecimalPlaces := DP;
      end;
  end;
{--------}
procedure TOvcTCBaseEntryField.SetEFColors(Value : TOvcEFColors);
  begin
    if Assigned(FEdit) then
      TOvcBEF(FEdit).EFColors := Value;
  end;
{--------}
procedure TOvcTCBaseEntryField.SetMaxLength(ML : word);
  begin
    if Assigned(FEdit) then begin
      TOvcBEF(FEdit).MaxLength := ML;
      TOvcBEF(FEditDisplay).MaxLength := ML;
    end;
  end;
{--------}
procedure TOvcTCBaseEntryField.SetOptions(Value : TOvcEntryFieldOptions);
  begin
    if Assigned(FEdit) then begin
      TOvcBEF(FEdit).Options := Value;
      TOvcBEF(FEditDisplay).Options := Value;
    end;
  end;
{--------}
procedure TOvcTCBaseEntryField.SetPadChar(PC : AnsiChar);
  begin
    if Assigned(FEdit) then
      begin
        TOvcBEF(FEdit).PadChar := PC;
        TOvcBEF(FEditDisplay).PadChar := PC;
      end;
  end;
{--------}
procedure TOvcTCBaseEntryField.SetPasswordChar(PC : AnsiChar);
  begin
    if Assigned(FEdit) then
      begin
        TOvcBEF(FEdit).PasswordChar := PC;
        TOvcBEF(FEditDisplay).PasswordChar := PC;
      end;
  end;
{--------}
procedure TOvcTCBaseEntryField.SetRangeHi(const RI : string);
  begin
    if Assigned(FEdit) then TOvcBEF(FEdit).RangeHi := RI;
  end;
{--------}
procedure TOvcTCBaseEntryField.SetRangeLo(const RL : string);
  begin
    if Assigned(FEdit) then TOvcBEF(FEdit).RangeLo := RL;
  end;
{--------}
procedure TOvcTCBaseEntryField.SetTextMargin(TM : integer);
  begin
    if Assigned(FEdit) then TOvcBEF(FEdit).TextMargin := TM;
  end;

end.