unit grideditlinks;

// The editor links, instanciated by VirtualTree.CreateEditor

interface

uses

Winapi.Windows, Vcl.Forms, Vcl.Graphics, Winapi.Messages, VirtualTrees, VirtualTrees.BaseTree, VirtualTrees.Types, Vcl.ComCtrls, System.SysUtils, System.Classes,

Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.CheckLst, Vcl.Controls, System.Types, Vcl.Dialogs, Vcl.Menus, Vcl.Mask, System.DateUtils, System.Math,

dbconnection, dbstructures, apphelpers, texteditor, bineditor, gnugettext,

System.StrUtils, System.UITypes, SynRegExpr, Vcl.Themes, extra_controls;

type

// Radio buttons and checkboxes which do not pass <Enter> key to their parent control

// so a OnKeyDown event using <Enter> has the chance to end editing.

TAllKeysRadioButton = class(TRadioButton)

procedure WMGetDlgCode(var Msg: TMessage); message WM_GETDLGCODE;

end;

TAllKeysCheckBox = class(TCheckBox)

procedure WMGetDlgCode(var Msg: TMessage); message WM_GETDLGCODE;

end;

TBaseGridEditorLink = class(TInterfacedObject, IVTEditLink)

private

FInstanceId: Integer;

FParentForm: TWinControl; // A back reference to the main form

FTree: TVirtualStringTree; // A back reference to the tree calling.

FNode: PVirtualNode; // The node to be edited.

FColumn: TColumnIndex; // The column of the node.

FCellText: String; // Original cell text value

FCellFont: TFont; // Cosmetic

FCellBackground: TColor;

FMainControl: TWinControl; // The editor's most important component

FStopping: Boolean; // Set to True when the edit link requests stopping the edit action.

FLastKeyDown: Integer; // Set in OnKeyDown on the editor's main control

FLastShiftState: TShiftState;

FOldWindowProc: TWndMethod; // Temporary switched to TempWindowProc to be able to catch Tab key

FTableColumn: TTableColumn;

FModified: Boolean;

FAllowEdit: Boolean;

FBeginEditTime: Cardinal;

procedure Log(Msg: String);

procedure TempWindowProc(var Message: TMessage);

procedure DoKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

procedure DoEndEdit(Sender: TObject);

procedure DoCancelEdit(Sender: TObject);

function GetCellRect(InnerTextBounds: Boolean): TRect;

public

// The table column of the cell being edited. Mostly used in data grids.

property TableColumn: TTableColumn read FTableColumn;

// The original constructor, not used any more, throws an exception if you do

constructor Create; overload;

// The right constructor, we need the Tree reference

constructor Create(Tree: TVirtualStringTree; AllowEdit: Boolean; Col: TTableColumn); overload; virtual;

destructor Destroy; override;

property Tree: TVirtualStringTree read FTree;

function PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean; virtual; stdcall;

function BeginEdit: Boolean; virtual; stdcall;

function CancelEdit: Boolean; virtual; stdcall;

function EndEdit: Boolean; virtual; stdcall; abstract;

function EndEditHelper(NewText: String): Boolean;

function GetBounds: TRect; virtual; stdcall; // Normally useless and unused

procedure ProcessMessage(var Message: TMessage); stdcall;

procedure SetBounds(R: TRect); virtual; stdcall; abstract;

end;

THexEditorLink = class(TBaseGridEditorLink)

private

FForm: TfrmBinEditor;

public

MaxLength: Integer;

TitleText: String;

constructor Create(Tree: TVirtualStringTree; AllowEdit: Boolean; Col: TTableColumn); override;

destructor Destroy; override;

function BeginEdit: Boolean; override;

function CancelEdit: Boolean; override;

function EndEdit: Boolean; override;

function PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean; override;

procedure SetBounds(R: TRect); override;

end;

TDateTimeEditorLink = class(TBaseGridEditorLink)

private

FPanel: TPanel;

FMaskEdit: TMaskEdit;

FTimer: TTimer;

FModifyOffset: Integer;

FTimerCalls: Integer;

FUpDown: TUpDown;

procedure DoKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

procedure DoKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);

procedure UpDownChangingEx(Sender: TObject; var AllowChange: Boolean;

NewValue: Integer; Direction: TUpDownDirection);

procedure UpDownMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

procedure DoOnTimer(Sender: TObject);

procedure ModifyDate(Offset: Integer);

procedure TextChange(Sender: TObject);

function MicroSecondsPrecision: Integer;

public

constructor Create(Tree: TVirtualStringTree; AllowEdit: Boolean; Col: TTableColumn); override;

destructor Destroy; override;

function BeginEdit: Boolean; override;

function EndEdit: Boolean; override;

function PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean; override;

procedure SetBounds(R: TRect); override;

end;

TEnumEditorLink = class(TBaseGridEditorLink)

private

FCombo: TExtComboBox;

procedure DoKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

procedure DoSelect(Sender: TObject);

public

ValueList, DisplayList: TStringList;

AllowCustomText: Boolean;

ItemMustExist: Boolean;

constructor Create(Tree: TVirtualStringTree; AllowEdit: Boolean; Col: TTableColumn); override;

destructor Destroy; override;

function BeginEdit: Boolean; override;

function EndEdit: Boolean; override;

function PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean; override;

procedure SetBounds(R: TRect); override;

end;

TSetEditorLink = class(TBaseGridEditorLink)

private

FPanel: TPanel;

FCheckList: TCheckListBox;

FBtnOK, FBtnCancel: TButton;

FEndTimer: TTimer;

procedure BtnOkClick(Sender: TObject);

procedure BtnCancelClick(Sender: TObject);

public

ValueList: TStringList;

constructor Create(Tree: TVirtualStringTree; AllowEdit: Boolean; Col: TTableColumn); override;

destructor Destroy; override;

function BeginEdit: Boolean; override;

function EndEdit: Boolean; override;

function PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean; override;

procedure SetBounds(R: TRect); override;

end;

// Inplace editor with button

TInplaceEditorLink = class(TBaseGridEditorLink)

private

FPanel: TPanel;

FEdit: TEdit;

FButton: TButton;

FMaxLength: Integer;

procedure DoKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

procedure ButtonClick(Sender: TObject);

public

ButtonVisible: Boolean;

TitleText: String;

constructor Create(Tree: TVirtualStringTree; AllowEdit: Boolean; Col: TTableColumn); override;

destructor Destroy; override;

function BeginEdit: Boolean; override;

function EndEdit: Boolean; override;

function PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean; override;

procedure SetBounds(R: TRect); override;

property MaxLength: Integer read FMaxLength write FMaxLength;

end;

TColumnDefaultEditorLink = class(TBaseGridEditorLink)

private

FPanel: TPanel;

FRadioNothing, FRadioText, FRadioNULL, FRadioExpression, FRadioAutoInc: TAllKeysRadioButton;

FlblOnUpdate: TLabel;

FTextEdit: TButtonedEdit;

FTextDropDown: TPopupMenu;

FExpressionEdit: TComboBox;

FOnUpdateEdit: TComboBox;

FBtnOK, FBtnCancel: TButton;

FEndTimer: TTimer;

procedure RadioClick(Sender: TObject);

procedure EditChange(Sender: TObject);

procedure EditDropDownClick(Sender: TObject);

procedure BtnOkClick(Sender: TObject);

procedure BtnCancelClick(Sender: TObject);

public

DefaultType, OnUpdateType: TColumnDefaultType;

DefaultText, OnUpdateText: String;

constructor Create(Tree: TVirtualStringTree; AllowEdit: Boolean; Col: TTableColumn); override;

destructor Destroy; override;

function BeginEdit: Boolean; override;

function EndEdit: Boolean; override;

function PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean; override;

procedure SetBounds(R: TRect); override;

end;

TDataTypeEditorLink = class(TBaseGridEditorLink)

private

FTreeSelect: TVirtualStringTree;

FMemoHelp: TMemo;

procedure DoTreeSelectGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;

Column: TColumnIndex; TextType: TVSTTextType; var CellText: String);

procedure DoTreeSelectInitNode(Sender: TBaseVirtualTree;

ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);

procedure DoTreeSelectInitChildren(Sender: TBaseVirtualTree;

Node: PVirtualNode; var ChildCount: Cardinal);

procedure DoTreeSelectHotChange(Sender: TBaseVirtualTree; OldNode, NewNode: PVirtualNode);

procedure DoTreeSelectPaintText(Sender: TBaseVirtualTree;

const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;

TextType: TVSTTextType);

procedure DoTreeSelectFocusChanging(Sender: TBaseVirtualTree; OldNode, NewNode:

PVirtualNode; OldColumn, NewColumn: TColumnIndex; var Allowed: Boolean);

procedure DoTreeSelectFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex);

public

constructor Create(Tree: TVirtualStringTree; AllowEdit: Boolean; Col: TTableColumn); override;

destructor Destroy; override;

function BeginEdit: Boolean; override;

function EndEdit: Boolean; override;

function PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean; override;

procedure SetBounds(R: TRect); override;

end;

var

ActiveGridEditor: TBaseGridEditorLink=nil;

implementation

uses

main;

procedure TAllKeysRadioButton.WMGetDlgCode(var Msg: TMessage);

begin

inherited;

Msg.Result := Msg.Result or DLGC_WANTALLKEYS;

end;

procedure TAllKeysCheckBox.WMGetDlgCode(var Msg: TMessage);

begin

inherited;

Msg.Result := Msg.Result or DLGC_WANTALLKEYS;

end;

procedure TBaseGridEditorLink.Log(Msg: String);

begin

MainForm.LogSQL('#'+FInstanceId.ToString+': '+Msg, lcDebug);

end;

constructor TBaseGridEditorLink.Create;

begin

raise Exception.CreateFmt(_('Wrong constructor called: %s.%s. Instead, please call the overloaded version %s.%s.'),

[Self.ClassName, 'Create', Self.ClassName, 'Create(VirtualStringTree)']);

end;

constructor TBaseGridEditorLink.Create(Tree: TVirtualStringTree; AllowEdit: Boolean; Col: TTableColumn);

begin

inherited Create;

FInstanceId := Random(100);

FTree := Tree;

// Enable mouse scrolling, plus ensure the editor component

// is not partly hidden when it pops up in a bottom cell

FParentForm := GetParentForm(FTree);

// Avoid flicker

FParentForm.Repaint;

FMainControl := nil;

FModified := False;

FAllowEdit := AllowEdit;

ActiveGridEditor := Self;

FTableColumn := Col;

end;

destructor TBaseGridEditorLink.Destroy;

var

NewColumn, FirstCol, LastCol: TColumnIndex;

NewNode: PVirtualNode;

DoPrev: Boolean;

begin

ActiveGridEditor := nil;

if Assigned(FMainControl) then begin

FMainControl.WindowProc := FOldWindowProc;

FMainControl := nil;

end;

if FLastKeyDown = VK_TAB then begin

DoPrev := ssShift in FLastShiftState;

// Advance to next/previous visible column/node.

NewNode := FNode;

NewColumn := FColumn;

FirstCol := FTree.Header.Columns.GetFirstVisibleColumn;

LastCol := FTree.Header.Columns.GetLastVisibleColumn;

while true do begin

// Find a column for the current node which can be focused.

if DoPrev then begin

if NewColumn = FirstCol then begin

NewColumn := LastCol;

NewNode := FTree.GetPreviousVisible(NewNode);

end else

NewColumn := FTree.Header.Columns.GetPreviousVisibleColumn(NewColumn);

end else begin

if NewColumn = LastCol then begin

NewColumn := FirstCol;

NewNode := FTree.GetNextVisible(NewNode);

end else

NewColumn := FTree.Header.Columns.GetNextVisibleColumn(NewColumn);

end;

if not Assigned(NewNode) then

Break;

if not FTree.CanEdit(NewNode, NewColumn) then

Continue;

FTree.ClearSelection;

FTree.Selected[NewNode] := True;

FTree.EditNode(NewNode, NewColumn);

Break;

end;

end;

inherited;

end;

function TBaseGridEditorLink.PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean;

var

FCellTextBounds: TRect;

HasNulls: Boolean;

begin

Result := not FStopping;

if not Result then

Exit;

FNode := Node;

FColumn := Column;

FCellFont := TFont.Create;

FTree.GetTextInfo(FNode, FColumn, FCellFont, FCellTextBounds, FCellText);

apphelpers.RemoveNullChars(FCellText, HasNulls);

if HasNulls and FAllowEdit then begin

FAllowEdit := False;

end;

// Not all editors have a connection assigned, e.g. session manager tree

if Assigned(FTableColumn) then begin

FCellFont.Color := DatatypeCategories[FTableColumn.DataType.Category].Color;

end;

FCellBackground := FTree.Header.Columns[FColumn].Color;

if Assigned(FMainControl) then begin

FOldWindowProc := FMainControl.WindowProc;

FMainControl.WindowProc := TempWindowProc;

TExtForm.FixControls(FMainControl);

end;

// Adjust editor position and allow repainting mainform

SetBounds(FCellTextBounds);

if not IsWine then

SendMessage(FParentForm.Handle, WM_SETREDRAW, 1, 0);

end;

function TBaseGridEditorLink.BeginEdit: Boolean;

begin

Result := not FStopping;

FBeginEditTime := GetTickCount;

end;

function TBaseGridEditorLink.CancelEdit: Boolean;

begin

Result := not FStopping;

if Result then begin

FStopping := True;

FTree.CancelEditNode;

if FTree.CanFocus then

FTree.SetFocus;

end;

end;

function TBaseGridEditorLink.EndEditHelper(NewText: String): Boolean;

begin

Result := not FStopping;

if FStopping then Exit;

FStopping := True;

if FModified and FAllowEdit then

FTree.Text[FNode, FColumn] := NewText;

if FTree.CanFocus and (FLastKeyDown <> VK_TAB) then

FTree.SetFocus;

end;

procedure TBaseGridEditorLink.TempWindowProc(var Message: TMessage);

begin

case Message.Msg of

WM_CHAR: // Catch hotkeys

if not (TWMChar(Message).CharCode = VK_TAB) then

FOldWindowProc(Message);

WM_GETDLGCODE: // "WantTabs" mode for main control

Message.Result := Message.Result or DLGC_WANTARROWS or DLGC_WANTALLKEYS or DLGC_WANTTAB;

else begin

try

FOldWindowProc(Message);

except

// EAccessViolation occurring in some cases

on E:Exception do begin

Log(E.Message+' Message CharCode:'+TWMChar(Message).CharCode.ToString+' Msg:'+Message.Msg.ToString);

end;

end;

end;

end;

end;

procedure TBaseGridEditorLink.ProcessMessage(var Message: TMessage);

begin

if (FMainControl <> nil) and FMainControl.HandleAllocated then

FMainControl.WindowProc(Message);

end;

function TBaseGridEditorLink.GetBounds: TRect; stdcall;

begin

// Only important if the editor resizes itself.

Result := Rect(0, 0, 0, 0);

end;

function TBaseGridEditorLink.GetCellRect(InnerTextBounds: Boolean): TRect;

var

Text: String;

CellBounds, TextBounds: TRect;

Ghosted: Boolean;

ImageIndex: TImageIndex;

f: TFont;

begin

// Return the cell's rectangle, relative to the parent form.

f := TFont.Create;

FTree.GetTextInfo(FNode, FColumn, f, TextBounds, Text);

CellBounds := FTree.GetDisplayRect(FNode, FColumn, False);

Inc(CellBounds.Left, Integer(FTree.GetNodeLevel(FNode)) * (Integer(FTree.Indent)+FTree.TextMargin));

if (toShowRoot in FTree.TreeOptions.PaintOptions)

and (FColumn = FTree.Header.MainColumn) then begin

// Reserve space for plus or minus button

Inc(CellBounds.Left, FTree.Indent);

end;

if Assigned(FTree.Images) and Assigned(FTree.OnGetImageIndex) then begin

// Reserve space for image

ImageIndex := -1;

FTree.OnGetImageIndex(FTree, FNode, ikNormal, FColumn, Ghosted, ImageIndex);

if ImageIndex > -1 then

Inc(CellBounds.Left, FTree.Images.Width+2);

end;

TextBounds.Left := CellBounds.Left + 2*FTree.TextMargin;

if InnerTextBounds then begin

// Inner bounds are considered to be relative to the outer cell bounds

Result := Rect(TextBounds.Left-CellBounds.Left,

TextBounds.Top-CellBounds.Top,

CellBounds.Right-CellBounds.Left, // Far right edge of cell, not of text

CellBounds.Bottom-CellBounds.Top

);

end else begin

// Recalculate top left corner of rectangle, so it is relative to the parent form (which is FParentForm)

Result := CellBounds;

OffsetRect(Result,

FTree.ClientOrigin.X - FParentForm.ClientOrigin.X,

FTree.ClientOrigin.Y - FParentForm.ClientOrigin.Y

);

Dec(Result.Bottom, 1);

end;

end;

procedure TBaseGridEditorLink.DoKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

begin

FLastKeyDown := Key;

FLastShiftState := Shift;

case Key of

// Cancel by Escape

VK_ESCAPE: FTree.CancelEditNode;

// Apply changes and end editing by [Ctrl +] Enter or Tab

VK_RETURN, VK_TAB: FTree.EndEditNode;

end;

end;

procedure TBaseGridEditorLink.DoEndEdit(Sender: TObject);

begin

FTree.EndEditNode;

end;

procedure TBaseGridEditorLink.DoCancelEdit(Sender: TObject);

begin

FTree.CancelEditNode;

end;

constructor THexEditorLink.Create(Tree: TVirtualStringTree; AllowEdit: Boolean; Col: TTableColumn);

begin

inherited;

end;

destructor THexEditorLink.Destroy;

begin

inherited;

FForm.Close;

FreeAndNil(FForm);

end;

function THexEditorLink.PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean; stdcall;

begin

Result := inherited PrepareEdit(Tree, Node, Column);

if not Result then

Exit;

// Create the text editor form

FForm := TfrmBinEditor.Create(Ftree);

FForm.SetFont(FCellFont);

FForm.SetText(FCellText);

FForm.SetTitleText(TitleText);

FForm.SetMaxLength(MaxLength);

FForm.memoText.ReadOnly := not FAllowEdit;

end;

function THexEditorLink.BeginEdit: Boolean; stdcall;

begin

Result := inherited BeginEdit;

if Result then

FForm.ShowModal;

end;

function THexEditorLink.CancelEdit: Boolean;

begin

Result := inherited CancelEdit;

if Result then

FForm.Close;

end;

function THexEditorLink.EndEdit: Boolean; stdcall;

begin

FForm.Close;

FModified := FForm.Modified;

Result := EndEditHelper(FForm.GetText);

end;

procedure THexEditorLink.SetBounds(R: TRect); stdcall;

begin

// Not in use, form's position is centered on mainform

end;

{ DateTime editor }

constructor TDateTimeEditorLink.Create(Tree: TVirtualStringTree; AllowEdit: Boolean; Col: TTableColumn);

begin

inherited;

FPanel := TPanel.Create(FParentForm);

FPanel.Parent := FParentForm;

FPanel.Hide;

FPanel.ParentBackground := False;

FPanel.BevelOuter := bvNone;

FPanel.OnExit := DoEndEdit;

FMaskEdit := TMaskEdit.Create(FPanel);

FMaskEdit.Parent := FPanel;

FMaskEdit.ParentColor := True;

FMaskEdit.BorderStyle := bsNone;

FMaskEdit.OnKeyDown := DoKeyDown;

FMaskEdit.OnKeyUp := DoKeyUp;

FMaskEdit.OnChange := TextChange;

FMainControl := FMaskEdit;

FUpDown := TUpDown.Create(FPanel);

FUpDown.Parent := FPanel;

FUpDown.OnChangingEx := UpDownChangingEx;

FUpDown.OnMouseUp := UpDownMouseUp;

FTimer := TTimer.Create(FMaskEdit);

FTimer.Interval := 50;

FTimer.OnTimer := DoOnTimer;

FTimer.Enabled := False;

end;

destructor TDateTimeEditorLink.Destroy;

begin

AppSettings.WriteInt(asDateTimeEditorCursorPos, FMaskEdit.SelStart, IntToStr(Integer(FTableColumn.DataType.Category)));

FreeAndNil(FTimer);

FreeAndNil(FUpDown);

FreeAndNil(FMaskEdit);

FreeAndNil(FPanel);

inherited;

end;

function TDateTimeEditorLink.BeginEdit: Boolean; stdcall;

begin

Result := inherited BeginEdit;

if Result then begin

FPanel.Show;

FMaskEdit.SetFocus;

// Focus very last segment of date

FMaskEdit.SelStart := AppSettings.ReadInt(asDateTimeEditorCursorPos, IntToStr(Integer(FTableColumn.DataType.Category)));

FMaskEdit.SelLength := 1;

end;

end;

function TDateTimeEditorLink.EndEdit: Boolean;

begin

Result := EndEditHelper(Trim(FMaskEdit.Text));

end;

function TDateTimeEditorLink.PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean; stdcall;

var

MinColWidth,

ForceTextLen: Integer;

begin

Result := inherited PrepareEdit(Tree, Node, Column);

if not Result then

Exit;

FMaskEdit.ReadOnly := not FAllowEdit;

case FTableColumn.DataType.Index of

dbdtDate:

FMaskEdit.EditMask := '0000-00-00;1; ';

dbdtDatetime, dbdtDatetime2, dbdtTimestamp, dbdtInt, dbdtBigint: begin

if MicroSecondsPrecision > 0 then

FMaskEdit.EditMask := '0000-00-00 00\:00\:00.'+StringOfChar('0', MicroSecondsPrecision)+';1; '

else

FMaskEdit.EditMask := '0000-00-00 00\:00\:00;1; ';

end;

dbdtTime: begin

ForceTextLen := 10;

if MicroSecondsPrecision > 0 then begin

FMaskEdit.EditMask := '#900\:00\:00.'+StringOfChar('0', MicroSecondsPrecision)+';1; ';

Inc(ForceTextLen, MicroSecondsPrecision + 1);

end else

FMaskEdit.EditMask := '#900\:00\:00;1; ';

while Length(FCellText) < ForceTextLen do

FCellText := ' ' + FCellText;

end;

dbdtYear:

FMaskEdit.EditMask := '0000;1; ';

end;

FMaskEdit.Text := FCellText;

FModified := False;

FMaskEdit.Font.Assign(FCellFont);

FPanel.Color := FCellBackground;

// Auto-enlarge current tree column so the text in the edit is not cut

MinColWidth := FTree.Canvas.TextWidth(FCellText) + FTree.TextMargin + FUpDown.Width + 5;

if FTree.Header.Columns[FColumn].Width < MinColWidth then

FTree.Header.Columns[FColumn].Width := MinColWidth;

end;

procedure TDateTimeEditorLink.SetBounds(R: TRect); stdcall;

var

EditRect: TRect;

OldSelStart, OldSelLen: Integer;

begin

FPanel.BoundsRect := GetCellRect(False);

FUpDown.Left := FPanel.Width - FUpDown.Width;

FUpDown.Height := FPanel.Height;

EditRect := GetCellRect(True);

EditRect.Right := FUpDown.Left;

FMaskEdit.BoundsRect := EditRect;

OldSelStart := FMaskEdit.SelStart;

OldSelLen := FMaskEdit.SelLength;

FMaskEdit.SelStart := 0;

FMaskEdit.SelStart := OldSelStart;

FMaskEdit.SelLength := OldSelLen;

end;

procedure TDateTimeEditorLink.DoKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

begin

inherited DoKeyDown(Sender, Key, Shift);

if (Key in [VK_UP, VK_DOWN]) and (not FTimer.Enabled) then begin

if Key = VK_UP then FModifyOffset := 1

else FModifyOffset := -1;

FTimerCalls := 0;

DoOnTimer(Sender);

FTimer.Enabled := True;

end;

end;

procedure TDateTimeEditorLink.DoKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);

begin

FTimer.Enabled := False;

end;

procedure TDateTimeEditorLink.UpDownChangingEx(Sender: TObject; var AllowChange: Boolean;

NewValue: Integer; Direction: TUpDownDirection);

begin

if FTimer.Enabled then

Exit;

if Direction = updUp then FModifyOffset := 1

else FModifyOffset := -1;

FTimerCalls := 0;

DoOnTimer(Sender);

FTimer.Enabled := True;

end;

procedure TDateTimeEditorLink.UpDownMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

FTimer.Enabled := False;

end;

procedure TDateTimeEditorLink.DoOnTimer(Sender: TObject);

var

DelayCalls: Integer;

begin

Inc(FTimerCalls);

// short delay before counting up/down

DelayCalls := 350 Div FTimer.Interval;

if (FTimerCalls > DelayCalls) or (not (Sender is TTimer)) then

ModifyDate(FModifyOffset);

// Speed up counting in steps

if FTimerCalls in [DelayCalls*5, DelayCalls*10] then begin

if FModifyOffset > 0 then

Inc(FModifyOffset, 3)

else

Dec(FModifyOffset, 3);

end;

end;

procedure TDateTimeEditorLink.ModifyDate(Offset: Integer);

var

dt: TDateTime;

d: TDate;

i, MaxSeconds, MinSeconds: Int64;

text: String;

OldSelStart, OldSelLength,

ms, DotPos: Integer;

function TimeToSeconds(Str: String): Int64;

var

Hours: String;

Seconds: Int64;

begin

Hours := Trim(Copy(Str, 1, 4));

Result := MakeInt(Hours) * 60 * 60;

Seconds := MakeInt(Copy(Str, 6, 2)) * 60 + MakeInt(Copy(Str, 9, 2));

if (Result < 0) or ((Result = 0) and (Hours[1]='-')) then

Dec(Result, Seconds)

else

Inc(Result, Seconds);

end;

function SecondsToTime(Seconds: Int64): String;

var

HoursNum, Minutes: Int64;

Hours: String;

begin

HoursNum := Abs(Seconds div (60*60));

Hours := IntToStr(HoursNum);

if Length(Hours) = 1 then

Hours := '0' + Hours;

if Seconds < 0 then

Hours := '-' + Hours;

Seconds := Abs(Seconds) mod (60*60);

Minutes := Seconds div 60;

Seconds := Seconds mod 60;

Result := Format('%4s:%.2u:%.2u', [Hours, Minutes, Seconds]);

end;

begin

try

// Detect microseconds part of value if any

if MicroSecondsPrecision > 0 then begin

DotPos := Length(FMaskEdit.Text) - Pos('.', ReverseString(FMaskEdit.Text)) + 2;

ms := MakeInt(Copy(FMaskEdit.Text, DotPos, Length(FMaskEdit.Text)));

end else

ms := 0;

case FTableColumn.DataType.Index of

dbdtYear: begin

i := MakeInt(FMaskEdit.Text);

i := i + Offset;

text := IntToStr(i);

end;

dbdtDate: begin

d := StrToDate(FMaskEdit.Text);

// De- or increase focused date segment

case FMaskEdit.SelStart of

0..3: d := IncYear(d, Offset);

5,6: d := IncMonth(d, Offset);

8..10: d := IncDay(d, Offset);

end;

text := DateToStr(d);

end;

dbdtDateTime, dbdtDateTime2, dbdtTimestamp, dbdtInt, dbdtBigint: begin

dt := StrToDateTime(FMaskEdit.Text);

case FMaskEdit.SelStart of

0..3: dt := IncYear(dt, Offset);

5,6: dt := IncMonth(dt, Offset);

8,9: dt := IncDay(dt, Offset);

11,12: dt := IncHour(dt, Offset);

14,15: dt := IncMinute(dt, Offset);

17..19: dt := IncSecond(dt, Offset);

20..26: Inc(ms, Offset);

end;

text := DateTimeToStr(dt);

if Length(text) = 10 then

text := text + ' 00:00:00';

if MicroSecondsPrecision > 0 then

text := text + '.' + Format('%.'+IntToStr(MicroSecondsPrecision)+'d', [ms]);

end;

dbdtTime: begin

i := TimeToSeconds(FMaskEdit.Text);

case FMaskEdit.SelStart of

0..3: Inc(i, Offset*60*60);

5,6: Inc(i, Offset*60);

8,9: Inc(i, Offset);

10..16: Inc(ms, Offset);

end;

// Stop at max and min values. See http://dev.mysql.com/doc/refman/5.0/en/time.html

MaxSeconds := 839*60*60-1;

MinSeconds := -(MaxSeconds);

if i > MaxSeconds then

i := MaxSeconds;

if i < MinSeconds then

i := MinSeconds;

text := SecondsToTime(i);

if MicroSecondsPrecision > 0 then

text := text + '.' + Format('%.'+IntToStr(MicroSecondsPrecision)+'d', [ms]);

end;

else text := '';

end;

if text <> '' then begin

OldSelStart := FMaskEdit.SelStart;

OldSelLength := FMaskEdit.SelLength;

FMaskEdit.Text := text;

FMaskEdit.SelStart := OldSelStart;

FMaskEdit.SelLength := OldSelLength;

end;

except

on E:EConvertError do begin

// Ignore any DateToStr exception. Should only appear in cases where the users

// enters invalid dates

end else

raise;

end;

end;

procedure TDateTimeEditorLink.TextChange;

begin

FModified := True;

end;

function TDateTimeEditorLink.MicroSecondsPrecision: Integer;

var

rx: TRegExpr;

begin

if not FTableColumn.LengthSet.IsEmpty then

Result := MakeInt(FTableColumn.LengthSet)

else begin

// Find default length of supported microseconds in datatype definition

// See dbstructures

rx := TRegExpr.Create;

rx.Expression := '\.([^\.]+)$';

if rx.Exec(FTableColumn.DataType.Format) then

Result := rx.MatchLen[1]

else

Result := 0;

rx.Free;

end;

// No microseconds for UNIX timestamp columns

if FTableColumn.DataType.Index in [dbdtInt, dbdtBigint] then

Result := 0;

end;

{ Enum editor }

constructor TEnumEditorLink.Create(Tree: TVirtualStringTree; AllowEdit: Boolean; Col: TTableColumn);

begin

inherited;

AllowCustomText := False;

ItemMustExist := False;

FCombo := TExtComboBox.Create(FParentForm);

FCombo.Hide;

FCombo.Parent := FParentForm;

FCombo.OnKeyDown := DoKeyDown;

FCombo.OnExit := DoEndEdit;

FCombo.OnSelect := DoSelect;

// Show some more than the default 8 items

FCombo.DropDownCount := 16;

ValueList := TStringList.Create;

DisplayList := TStringList.Create;

FMainControl := FCombo;

end;

destructor TEnumEditorLink.Destroy;

begin

FCombo.Free;

inherited;

end;

function TEnumEditorLink.BeginEdit: Boolean; stdcall;

begin

Result := inherited BeginEdit;

if Result then begin

FCombo.Show;

FCombo.SetFocus;

end;

end;

function TEnumEditorLink.EndEdit: Boolean; stdcall;

var

NewText: String;

begin

if AllowCustomText and FAllowEdit and (not ItemMustExist) then

NewText := FCombo.Text

else if (ValueList.Count > 0) and (FCombo.ItemIndex > -1) then

NewText := ValueList[FCombo.ItemIndex]

else

NewText := '';

FModified := NewText <> FCellText;

Result := EndEditHelper(NewText);

end;

function TEnumEditorLink.PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean; stdcall;

begin

Result := inherited PrepareEdit(Tree, Node, Column);

if Result then begin

if DisplayList.Count = ValueList.Count then

FCombo.Items.AddStrings(DisplayList)

else

FCombo.Items.AddStrings(ValueList);

FCombo.ItemIndex := ValueList.IndexOf(FCellText);

if AllowCustomText and FAllowEdit then begin

FCombo.Style := csDropDown;

FCombo.Text := FCellText;

end else begin

// Set style to OwnerDraw, otherwise we wouldn't be able to adjust the combo's height

FCombo.Style := csOwnerDrawFixed;

end;

end;

end;

procedure TEnumEditorLink.SetBounds(R: TRect); stdcall;

begin

FCombo.BoundsRect := GetCellRect(False);

end;

procedure TEnumEditorLink.DoKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

begin

// Work around a magic automatic TAB key arriving the editor if the user got

// into this cell via TAB. Only seen for a TComboBox with style=csDropDown.

// See issue #2809

if (not AllowCustomText) and (GetTickCount-FBeginEditTime > 200) then

inherited;

end;

procedure TEnumEditorLink.DoSelect(Sender: TObject);

begin

// Read only mode?

if not FAllowEdit then begin

FCombo.ItemIndex := ValueList.IndexOf(FCellText);

end;

end;

{ SET editor }

constructor TSetEditorLink.Create(Tree: TVirtualStringTree; AllowEdit: Boolean; Col: TTableColumn);

begin

inherited;

ValueList := TStringList.Create;

FPanel := TPanel.Create(FParentForm);

FPanel.Hide;

FPanel.Parent := FParentForm;

FPanel.ParentBackground := False;

FPanel.Height := TExtForm.ScaleSize(150, FParentForm);

FPanel.OnExit := DoEndEdit;

FCheckList := TCheckListBox.Create(FPanel);

FCheckList.Parent := FPanel;

FCheckList.OnKeyDown := DoKeyDown;

FMainControl := FCheckList;

FBtnOk := TButton.Create(FPanel);

FBtnOk.Parent := FPanel;

FBtnOk.Caption := _('OK');