{ *************************************************************************** }
{                                                                             }
{ EControl Syntax Editor SDK                                                  }
{                                                                             }
{ Copyright (c) 2004 - 2008 EControl Ltd., Zaharov Michael                    }
{     www.econtrol.ru                                                         }
{     support@econtrol.ru                                                     }
{                                                                             }
{ *************************************************************************** }
{$I ecSyntEdit.INC}

unit ecDBSyntMemo;

interface

uses Windows, Messages, Classes, Controls, DB, DBCtrls, ecSyntMemo, ecSyntAnal,
     ecStrUtils;

type

  TDBSyntaxMemo = class(TCustomSyntaxMemo)
  private
    FDataLink: TFieldDataLink;
    FAutoDisplay: Boolean;
    FFocused: Boolean;
    FMemoLoaded: Boolean;
    FSelfChange: Boolean;
    FSaveAsUnicode: Boolean;
    procedure DataChange(Sender: TObject);
    procedure EditingChange(Sender: TObject);
    function GetDataField: string;
    function GetDataSource: TDataSource;
    function GetField: TField;
    function GetReadOnly: Boolean;
    procedure SetDataField(const Value: string);
    procedure SetDataSource(Value: TDataSource);
    procedure SetReadOnly(Value: Boolean);
    procedure SetAutoDisplay(Value: Boolean);
    procedure SetFocused(Value: Boolean);
    procedure UpdateData(Sender: TObject);
    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    procedure SetSaveAsUnicode(const Value: Boolean);
{$IFNDEF EC_DOTNET}
    procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
{$ENDIF}
  protected
    procedure Change; override;
    procedure KeyPress(var Key: Char); override;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure LoadMemo; virtual;
    function ExecuteAction(Action: TBasicAction): Boolean; override;
    function UpdateAction(Action: TBasicAction): Boolean; override;
    function UseRightToLeftAlignment: Boolean; override;
    function IsCommandEnabled(Command: integer; Data: ecPointer = nil): Boolean; override;
    function CanInsertText(Pos: integer): Boolean; override;
    function CanDeleteText(Pos, Count: integer): Boolean; override;
    property Field: TField read GetField;
  published
    property Align;
    property Anchors;
    property AutoDisplay: Boolean read FAutoDisplay write SetAutoDisplay default True;
    property BevelEdges;
    property BevelInner;
    property BevelOuter;
    property BevelKind;
    property BevelWidth;
    property BiDiMode;
    property Color;
    property Constraints;
    property Ctl3D;
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property ImeMode;
    property ImeName;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property About;
    
    property DoubleBuffered;
    property MultiLine; // 2.27
    property Charset; // 2.27
    property KeyQueue; // 2.30
    property Zoom;  // 2.32
    property SaveAsUnicode: Boolean read FSaveAsUnicode write SetSaveAsUnicode;

//    property Lines;
    property SyntaxAnalyzer;
    property TextSource;
    property TabList;
    property NonPrinted;
    property LineNumbers;
    property Gutter;
    property HintProps;
    property KeyMapping;
    property UserRanges;
    property UserStyles;
    property Animation;

    property ReplaceMode;
    property UndoLimit;
    property TabMode;
    property ShowRightMargin;
    property Cursor;
    property RightMarginColor;
    property RightMargin;
    property ScrollBars;
    property TextMargin;
    property BlockIndent;
    property CollapseLevel;
    property StaplePen;
    property StapleOffset;
    property WordWrap;
    property IncSearchBack;
    property IncSearchIgnoreCase;
    property LineSpacing;
    property FlatScrollBars;
    property CollapseBreakColor;
    property CollapseStyle;
    property DefaultStyles;
//    property InTextImages;
//    property InTextImageList;
    property LineStateDisplay;
    property DefaultPopup;
    property SyncEditing;

    property Options;
    property BorderStyle;
    property CharCase;

    property OnCaretPosChanged;
    property OnGetGutterImage;
    property OnLineHighLight;
    property OnGutterClick;
    property OnGetTokenHint;
    property OnInsertChar;
    property OnCanResize;
    property OnGetLineNumberStr;
    property OnDrawToken;
    property OnBeforeLineDraw;
    property OnAfterLineDraw;
    property OnSetBookmark;
    property OnAnimate;
    property OnIncSearchChange;
    property OnTextChanged;
    property OnGetStyleEntry;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnFinishAnalysis;
    property OnGetMouseSelMode;
    property OnCanSyncEdit;

    property OnChange;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
    property OnConstrainedResize;
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnResize;
  end;

procedure Register;

implementation

uses SysUtils, ecCmdConst, ClipBrd;

{$IFNDEF EC_DOTNET}
{$R ecDBSyntMemo.dcr}
{$ENDIF}

procedure Register;
begin
  RegisterComponents('EC SyntEdit', [TDBSyntaxMemo]);
end;

{ TDBSyntaxMemo }

constructor TDBSyntaxMemo.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := Self;
  FDataLink.OnDataChange := DataChange;
  FDataLink.OnEditingChange := EditingChange;
  FDataLink.OnUpdateData := UpdateData;
  FAutoDisplay := True;
  inherited ReadOnly := True;
  Options := Options + [soAlwaysShowCaret, soSmartCaret];
  WordWrap := True;
end;

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

procedure TDBSyntaxMemo.Loaded;
begin
  inherited Loaded;
  if (csDesigning in ComponentState) then DataChange(Self);
end;

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

function TDBSyntaxMemo.UseRightToLeftAlignment: Boolean;
begin
  Result := DBUseRightToLeftAlignment(Self, Field);
end;

procedure TDBSyntaxMemo.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  if FMemoLoaded then
  begin
    if (Ord(Key) >= 32) and (FDataLink.Field <> nil) and
      not FDataLink.Field.IsValidChar(Key) then
    begin
      MessageBeep(0);
      Key := #0;
    end;
    if Key = #27 then
     begin
      FDataLink.Reset;
      Refresh;
     end;
  end else
  begin
    if Key = #13 then LoadMemo;
    Key := #0;
  end;
end;

procedure TDBSyntaxMemo.Change;
begin
  if FMemoLoaded then FDataLink.Modified;
  FMemoLoaded := True;
  inherited Change;
end;

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

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

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

procedure TDBSyntaxMemo.SetDataField(const Value: string);
begin
  FDataLink.FieldName := Value;
end;

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

procedure TDBSyntaxMemo.SetReadOnly(Value: Boolean);
begin
  FDataLink.ReadOnly := Value;
end;

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

procedure TDBSyntaxMemo.LoadMemo;
var St: TStringStream;
begin
  if not FMemoLoaded and Assigned(FDataLink.Field) and FDataLink.Field.IsBlob then
  begin
    try
      if SaveAsUnicode then
        begin
          St := TStringStream.Create(FDataLink.Field.AsString);
          try
            Lines.LoadFromStream(St);
          finally
            St.Free;
          end;
        end
      else
        Lines.Text := FDataLink.Field.AsString;
      FMemoLoaded := True;
    except
      { Memo too large }
      on E:EInvalidOperation do
        Lines.Text := Format('(%s)', [E.Message]);
    end;
    EditingChange(Self);
  end;
end;

procedure TDBSyntaxMemo.UpdateData(Sender: TObject);
var St: TStringStream;
begin
  if SaveAsUnicode then
    begin
      St := TStringStream.Create('');
      try
        Lines.SaveToStream(St);
        FDataLink.Field.AsString := St.DataString;
      finally
        St.Free;
      end;
    end
  else
    FDataLink.Field.AsString := Text;
end;

procedure TDBSyntaxMemo.DataChange(Sender: TObject);
begin
  if FSelfChange then Exit;
  if FDataLink.Field <> nil then
    if FDataLink.Field.IsBlob then
    begin
      if FAutoDisplay or (FDataLink.Editing and FMemoLoaded) then
      begin
        FMemoLoaded := False;
        LoadMemo;
      end else
      begin
        Text := Format('(%s)', [FDataLink.Field.DisplayLabel]);
        FMemoLoaded := False;
      end;
    end else
    begin
      if FFocused and FDataLink.CanModify then
        Text := FDataLink.Field.Text
      else
        Text := FDataLink.Field.DisplayText;
      FMemoLoaded := True;
    end
  else
  begin
    if csDesigning in ComponentState then Text := Name else Text := '';
    FMemoLoaded := False;
  end;
  if HandleAllocated then
    RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_ERASE or RDW_FRAME);
end;

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

procedure TDBSyntaxMemo.SetFocused(Value: Boolean);
begin
  if FFocused <> Value then
  begin
    FFocused := Value;
    if not Assigned(FDataLink.Field) or not FDataLink.Field.IsBlob then
      FDataLink.Reset;
  end;
end;

procedure TDBSyntaxMemo.CMEnter(var Message: TCMEnter);
begin
  SetFocused(True);
  inherited;
  if SysLocale.FarEast and FDataLink.CanModify then
    inherited ReadOnly := False;
end;

procedure TDBSyntaxMemo.CMExit(var Message: TCMExit);
begin
  try
    FDataLink.UpdateRecord;
  except
    SetFocus;
    raise;
  end;
  SetFocused(False);
  inherited;
end;

procedure TDBSyntaxMemo.SetAutoDisplay(Value: Boolean);
begin
  if FAutoDisplay <> Value then
  begin
    FAutoDisplay := Value;
    if Value then LoadMemo;
  end;
end;

procedure TDBSyntaxMemo.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
  if not FMemoLoaded then LoadMemo else inherited;
end;

{$IFNDEF EC_DOTNET}
procedure TDBSyntaxMemo.CMGetDataLink(var Message: TMessage);
begin
  Message.Result := Integer(FDataLink);
end;
{$ENDIF}

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

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

function TDBSyntaxMemo.CanDeleteText(Pos, Count: integer): Boolean;
begin
  FSelfChange := True;
  FDataLink.Edit;
  FSelfChange := False;
  Result := inherited CanDeleteText(Pos, Count);
end;

function TDBSyntaxMemo.CanInsertText(Pos: integer): Boolean;
begin
  FSelfChange := True;
  FDataLink.Edit;
  FSelfChange := False;
  Result := inherited CanInsertText(Pos);
end;

function TDBSyntaxMemo.IsCommandEnabled(Command: integer;
  Data: ecPointer): Boolean;
begin
  case Command of
    smCut:         Result := HaveSelection;
//    smPaste:       Result := Clipboard.HasFormat(CF_TEXT);
    else           Result := inherited IsCommandEnabled(Command, Data);
  end;
end;

procedure TDBSyntaxMemo.SetSaveAsUnicode(const Value: Boolean);
begin
  if FSaveAsUnicode <> Value then
    begin
      FSaveAsUnicode := Value;
      DataChange(nil);
    end;
end;

end.

