lazarus-ccr/components/jvcllaz/run/JvDB/jvdbcontrols.pas

{-----------------------------------------------------------------------------
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/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvDBCtrl.PAS, released on 2002-07-04.

The Initial Developers of the Original Code are: Fedor Koshevnikov, Igor Pavluk and Serge Korolev
Copyright (c) 1997, 1998 Fedor Koshevnikov, Igor Pavluk and Serge Korolev
Copyright (c) 2001,2002 SGB Software
All Rights Reserved.

Contributor(s):
  Polaris Software

  Lazarus port: Michal Gawrycki

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.delphi-jedi.org

Known Issues:

    === NEW IN JVCL 3.0 ==
        TJvDBMaskEdit is a new control, added by Warren Postma.

    Major Issues:
        EditMask property enables operation as masked edit, which doesn't
        work properly in a Control Grid, yet, if you set the EditMask.
        You can use it as a generic editor control inside a control grid.
          -- Warren Postma (warrenpstma att hotmail dott com)
-----------------------------------------------------------------------------}
// $Id$

unit JvDBControls;

interface

uses
  JvBaseEdits, DB, DBCtrls, Classes, LMessages, LCLVersion, GroupedEdit;

type

  { TJvDBEbEdit }

  TJvDBEbEdit = class(TJvEbEdit)
    procedure WMCut(var Msg: TLMessage); message LM_CUT;
    procedure WMPaste(var Msg: TLMessage); message LM_PASTE;
  end;

  { TJvDBCalcEdit }

  TJvDBCalcEdit = class(TJvCalcEdit)
  private
    FDataLink: TFieldDataLink;
    FDefaultParams: Boolean;
    //Polaris
    FLEmptyIsNull: Boolean;
    FEmptyIsNull: Boolean;
    procedure SetEmptyIsNull(AValue: Boolean);
    function GetZeroEmpty: Boolean;
    procedure SetZeroEmpty(AValue: Boolean);
    function StoreEmptyIsNull: Boolean;
    //Polaris
    procedure DataChange(Sender: TObject);
    procedure EditingChange(Sender: TObject);
    function GetDataField: string;
    function GetDataSource: TDataSource;
    function GetField: TField;
    procedure SetDataField(const AValue: string);
    procedure SetDataSource(AValue: TDataSource);
    procedure SetDefaultParams(AValue: Boolean);
    procedure UpdateFieldData(Sender: TObject);
    procedure CMGetDataLink(var Msg: TLMessage); message CM_GETDATALINK;
    function GetReadOnly: Boolean; reintroduce;
    procedure SetReadOnly(AValue: Boolean); reintroduce;
  protected
    function GetEditorClassType: TGEEditClass; override;
    procedure AcceptValue(AValue: Double); override;
    procedure DoExit; override;
    function GetDisplayText: string; override;
    procedure EditChange; override;
    procedure SetText(const AValue: string); override;

    procedure DataChanged; override; //Polaris

    function EditCanModify: Boolean; override;
    function IsValidChar(Key: Char): Boolean; override;
    procedure EditKeyDown(var Key: Word; Shift: TShiftState); override;
    procedure EditKeyPress(var Key: Char); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Reset; override;
    //Polaris
    procedure Loaded; override;
    //Polaris
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure UpdateFieldParams;
    function ExecuteAction(AAction: TBasicAction): Boolean; override;
    function UpdateAction(AAction: TBasicAction): Boolean; override;
    property Field: TField read GetField;
    property Value;
  published
    property Align;
    property DecimalPlaceRound;

    property Action;
    property AutoSize;
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property DefaultParams: Boolean read FDefaultParams write SetDefaultParams default False;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
    property Alignment;
    property AutoSelect;
    property BorderStyle;
    property ButtonHint;
    property CheckOnExit;
    property Color;
    property DecimalPlaces;
    property DirectInput;
    property DisplayFormat;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property FormatOnEditing;
    {$IF LCL_FullVersion >= 2000000}
    property ImageIndex;
    property Images;
    {$IFEND}
    property ButtonWidth;
    property HideSelection;
    property Anchors;
    property BiDiMode;
    property Constraints;
    property DragKind;
    property ParentBiDiMode;
    property MaxLength;
    property MaxValue;
    property MinValue;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    //Polaris
    property EmptyIsNull: Boolean read FEmptyIsNull write SetEmptyIsNull stored StoreEmptyIsNull;
    property ZeroEmpty: Boolean read GetZeroEmpty write SetZeroEmpty default True;
    //Polaris
    property OnButtonClick;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
    property OnContextPopup;
    property OnEndDock;
    property OnStartDock;
  end;

implementation

uses
  SysUtils, LCLType, JvConsts, JvJCLUtils, Math, FmtBCD, Variants;

function IsNullOrEmptyStringField(Field: TField): Boolean;
begin
  Result := Field.IsNull or ((Field is TStringField) and (Trim(Field.AsString) = ''));
end;

{ TJvDBEbEdit }

procedure TJvDBEbEdit.WMCut(var Msg: TLMessage);
begin
  if Owner is TJvDBCalcEdit then
    with Owner as TJvDBCalcEdit do
      FDataLink.Edit;
  inherited;
end;

procedure TJvDBEbEdit.WMPaste(var Msg: TLMessage);
begin
  if Owner is TJvDBCalcEdit then
    with Owner as TJvDBCalcEdit do
      FDataLink.Edit;
  inherited;
end;

//=== { TJvDBCalcEdit } ======================================================

constructor TJvDBCalcEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  //Polaris
  FEmptyIsNull := ZeroEmpty;
  FLEmptyIsNull := True;
  //Polaris
  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := Self;
  FDataLink.OnDataChange := @DataChange;
  FDataLink.OnEditingChange := @EditingChange;
  FDataLink.OnUpdateData := @UpdateFieldData;
  inherited ReadOnly := True;
end;

destructor TJvDBCalcEdit.Destroy;
begin
  FDataLink.Free;
  FDataLink := nil;
  inherited Destroy;
end;

procedure TJvDBCalcEdit.Loaded;
begin
  inherited Loaded;
  FLEmptyIsNull := True;
end;

procedure TJvDBCalcEdit.SetEmptyIsNull(AValue: Boolean);
begin
  if AValue <> FEmptyIsNull then
  begin
    FEmptyIsNull := AValue;
    if csLoading in ComponentState then
      FLEmptyIsNull := False;
  end;
end;

function TJvDBCalcEdit.GetZeroEmpty: Boolean;
begin
  Result := inherited ZeroEmpty;
end;

procedure TJvDBCalcEdit.SetZeroEmpty(AValue: Boolean);
begin
  inherited ZeroEmpty := AValue;
  if FLEmptyIsNull then
    SetEmptyIsNull(ZeroEmpty)
end;

function TJvDBCalcEdit.StoreEmptyIsNull: Boolean;
begin
  Result := FEmptyIsNull <> ZeroEmpty;
end;

//Polaris

procedure TJvDBCalcEdit.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FDataLink <> nil) and
    (AComponent = DataSource) then
    DataSource := nil;
end;

procedure TJvDBCalcEdit.EditKeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  if not ReadOnly and
    ((Key = VK_DELETE) and (Shift * KeyboardShiftStates = [])) or
    ((Key = VK_INSERT) and (Shift * KeyboardShiftStates = [ssShift])) then
    FDataLink.Edit;
end;

procedure TJvDBCalcEdit.EditKeyPress(var Key: Char);
begin
  inherited EditKeyPress(Key);
  case Key of
    CtrlH, CtrlV, CtrlX, #32..High(Char):
        FDataLink.Edit;
    Cr: if FDataLink.CanModify then
      FDataLink.UpdateRecord;
    Esc:
      begin
        FDataLink.Reset;
        SelectAll;
        Key := #0;
      end;
  end;
end;

function TJvDBCalcEdit.IsValidChar(Key: Char): Boolean;
begin
  Result := inherited IsValidChar(Key);
  if Result and (FDataLink.Field <> nil) then
    Result := FDataLink.Field.IsValidChar(Key);
end;

function TJvDBCalcEdit.EditCanModify: Boolean;
begin
  Result := FDataLink.Edit;
end;

function TJvDBCalcEdit.GetDisplayText: string;
begin
  if FDataLink.Field = nil then
  begin
    if csDesigning in ComponentState then
      Result := Format('(%s)', [Name])
    else
      Result := '';
  end
  else
  //Polaris Result := inherited GetDisplayText;
  if FDataLink.Field.IsNull then
    Result := ''
  else
    Result := inherited GetDisplayText;
  //Polaris
end;

procedure TJvDBCalcEdit.Reset;
begin
  FDataLink.Reset;
  inherited Reset;
end;

procedure TJvDBCalcEdit.EditChange;
begin
  if not Formatting then
    FDataLink.Modified;
  inherited EditChange;
end;

procedure TJvDBCalcEdit.SetText(const AValue: string);
begin
  if not ReadOnly then
    inherited SetText(AValue);
end;

//Polaris
procedure TJvDBCalcEdit.DataChanged;
begin
  inherited;
  if Assigned(FDataLink) and Assigned(FDataLink.Field) {and DecimalPlaceRound} then
  begin
    EditText := DisplayText;
    try
      if EditText <> '' then
        if (StrToFloat(TextToValText(EditText)) = 0) and ZeroEmpty then
          EditText := '';
    except
    end;
  end;
end;
//Polaris

function TJvDBCalcEdit.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

procedure TJvDBCalcEdit.SetDataSource(AValue: TDataSource);
begin
  if FDataLink.DataSource <> AValue then
  begin
    if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
    begin
      if FDataLink.DataSource <> nil then
        FDataLink.DataSource.RemoveFreeNotification(Self);
      FDataLink.DataSource := AValue;
    end;
    if AValue <> nil then
      AValue.FreeNotification(Self);
    UpdateFieldParams;
  end;
end;

function TJvDBCalcEdit.GetDataField: string;
begin
  Result := FDataLink.FieldName;
end;

procedure TJvDBCalcEdit.SetDataField(const AValue: string);
begin
  if FDataLink.FieldName <> AValue then
  begin
    FDataLink.FieldName := AValue;
    UpdateFieldParams;
  end;
end;

procedure TJvDBCalcEdit.SetDefaultParams(AValue: Boolean);
begin
  if DefaultParams <> AValue then
  begin
    FDefaultParams := AValue;
    if FDefaultParams then
      UpdateFieldParams;
  end;
end;

procedure TJvDBCalcEdit.UpdateFieldParams;
begin
  if FDataLink.Field <> nil then
  begin
    if FDataLink.Field is TNumericField then
    begin
      if TNumericField(FDataLink.Field).DisplayFormat <> '' then
        DisplayFormat := TNumericField(FDataLink.Field).DisplayFormat;
      Alignment := TNumericField(FDataLink.Field).Alignment;
    end;
    if FDataLink.Field is TLargeintField then
    begin
      MaxValue := TLargeintField(FDataLink.Field).MaxValue;
      MinValue := TLargeintField(FDataLink.Field).MinValue;
      DecimalPlaces := 0;
      if DisplayFormat = '' then
        DisplayFormat := ',#';
    end
    else
    if FDataLink.Field is TIntegerField then
    begin
      MaxValue := TIntegerField(FDataLink.Field).MaxValue;
      MinValue := TIntegerField(FDataLink.Field).MinValue;
      DecimalPlaces := 0;
      if DisplayFormat = '' then
        DisplayFormat := ',#';
    end
    else
    if FDataLink.Field is TBCDField then
    begin
      MaxValue := TBCDField(FDataLink.Field).MaxValue;
      MinValue := TBCDField(FDataLink.Field).MinValue;
    end
    else
    if FDataLink.Field is TFloatField then
    begin
      MaxValue := TFloatField(FDataLink.Field).MaxValue;
      MinValue := TFloatField(FDataLink.Field).MinValue;
        //Polaris      DecimalPlaces := TFloatField(FDataLink.Field).Precision;
      DecimalPlaces := Min(DecimalPlaces, TFloatField(FDataLink.Field).Precision);
    end
    else
    if FDataLink.Field is TBooleanField then
    begin
      MinValue := 0;
      MaxValue := 1;
      DecimalPlaces := 0;
      if DisplayFormat = '' then
        DisplayFormat := ',#';
    end;
  end;
end;

function TJvDBCalcEdit.GetReadOnly: Boolean;
begin
  Result := FDataLink.ReadOnly;
end;

procedure TJvDBCalcEdit.SetReadOnly(AValue: Boolean);
begin
  FDataLink.ReadOnly := AValue;
end;

function TJvDBCalcEdit.GetEditorClassType: TGEEditClass;
begin
  Result := TJvDBEbEdit;
end;

procedure TJvDBCalcEdit.AcceptValue(AValue: Double);
begin
  FDataLink.Field.Value := CheckValue(AValue, False);
  DataChange(nil);
end;

function TJvDBCalcEdit.GetField: TField;
begin
  Result := FDataLink.Field;
end;

procedure TJvDBCalcEdit.DataChange(Sender: TObject);
begin
  if FDefaultParams then
    UpdateFieldParams;
  if FDataLink.Field <> nil then
  begin
    if FDataLink.Field.IsNull then
    begin
      Self.Value := 0.0;
      EditText := '';
    end
    else
    if FDataLink.Field.DataType in [ftSmallint, ftInteger, ftWord] then
      Self.AsInteger := FDataLink.Field.AsInteger
    else
    if FDataLink.Field.DataType = ftBoolean then
      Self.AsInteger := Ord(FDataLink.Field.AsBoolean)
    else
    if FDataLink.Field is TLargeintField then
      Self.Value := TLargeintField(FDataLink.Field).AsLargeInt
    else
      Self.Value := FDataLink.Field.AsFloat;
    DataChanged;
  end
  else
  begin
    if csDesigning in ComponentState then
    begin
      Self.Value := 0;
      EditText := Format('(%s)', [Name]);
    end
    else
      Self.Value := 0;
  end;
end;

procedure TJvDBCalcEdit.EditingChange(Sender: TObject);
begin
  inherited ReadOnly := not FDataLink.Editing;
end;

procedure TJvDBCalcEdit.UpdateFieldData(Sender: TObject);
begin
  inherited UpdateData;
  //Polaris  if (Value = 0) and ZeroEmpty then FDataLink.Field.Clear
  if (Trim(Text) = '') and FEmptyIsNull then
    FDataLink.Field.Clear
      //if (Value = 0) and ZeroEmpty then
//  FDataLink.Field.Clear
  else

  case FDataLink.Field.DataType of
    ftSmallint,
    ftInteger,
    ftWord:
      begin
        FDataLink.Field.AsInteger := Self.AsInteger;
      end;
    ftBoolean:
      begin
        FDataLink.Field.AsBoolean := Boolean(Self.AsInteger);
      end;
    ftFMTBcd,
    ftBCD:
      begin
        FDataLink.Field.AsBCD := DoubleToBCD(Self.Value)
      end;
    else
      begin
        FDataLink.Field.AsFloat := Self.Value;
      end;
  end;
end;

procedure TJvDBCalcEdit.CMGetDataLink(var Msg: TLMessage);
begin
  Msg.Result := LRESULT(FDataLink);
end;

// Polaris
procedure TJvDBCalcEdit.DoExit;
begin
  if Modified then
  try
    CheckRange;
    FDataLink.UpdateRecord;
  except
    SelectAll;
    if CanFocus then
      SetFocus;
    raise;
  end;
  inherited DoExit;
end;

function TJvDBCalcEdit.ExecuteAction(AAction: TBasicAction): Boolean;
begin
  Result := inherited ExecuteAction(AAction) or (FDataLink <> nil) and
    FDataLink.ExecuteAction(AAction);
end;

function TJvDBCalcEdit.UpdateAction(AAction: TBasicAction): Boolean;
begin
  Result := inherited UpdateAction(AAction) or (FDataLink <> nil) and
    FDataLink.UpdateAction(AAction);
end;

end.