VPF::TEdit как редактор VirtualStringTree - Форум программистов

Dom

Дата 21.1.2009, 22:35 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 121
Регистрация: 7.8.2005

Репутация: 3
Всего: 4

Первый опыт по использованию собственного редактора данных в VST. Реализовал на основе всем известного примера от Quadr0 редактор TEdit в VirtualStringView. Все работает, за небольшим исключением - если фокус на Edit'e и нажимаем Esc или Enter, то выдается AV. Не могу глазами найти или понять в чем загвоздка. Обработчик события OnKeyDown отрабатывает нормально, но при выходе из него (на строке 107 жмем Ф7 например) возникает ошибка доступа.
Отличия от оригинального примера. Дополнительно в OnKeyPress проверяется введенный символ, чтобы можно было вводить только числа или удалять их Backspace'ом. Также при окончании редактирования идет проверка, что введенное значение в поле является числом. Но эти процедуры никак не влияют на возникновение AV. Если их отключить все остается на своих местах.
Подскажите, пожалуйста, в чем тут дело и как исправить.

Прилагаю файл проекта и дублирую его код ниже (возможно и проект запускать не потребуется).

ЗЫ. Нашел в инете на делфикиндом совершенно аналогичную тему, но там так и не ответили на вопрос в чем может быть проблема.

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, VirtualTrees,StdCtrls;

type
  TForm1 = class(TForm)
    VT: TVirtualStringTree;
    procedure VTCreateEditor(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; out EditLink: IVTEditLink);
    procedure VTNewText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; NewText: WideString);
    procedure FormCreate(Sender: TObject);
    procedure VTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; TextType: TVSTTextType;
      var CellText: WideString);
    procedure VTEditing(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; var Allowed: Boolean);
    procedure VTClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  PVTEditNode = ^TVTEditNode;
  TVTEditNode = record
    Value1: String;
    Value2: String;
    Value3: String;
  end;

type
  TVTCustomEditor = class(TInterfacedObject, IVTEditLink)
  private
    FEdit: TEdit;     
    FTree: TVirtualStringTree; 
    FNode: PVirtualNode;       
    FColumn: Integer;          
  protected
    procedure EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure EditKeyPress(Sender: TObject; var Key: Char);
    function StrIsInt(S: string): boolean;
  public
    destructor Destroy; override;
    function BeginEdit: Boolean; stdcall;
    function CancelEdit: Boolean; stdcall;
    function EndEdit: Boolean; stdcall;
    function GetBounds: TRect; stdcall;
    function PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex): Boolean; stdcall;
    procedure ProcessMessage(var Message: TMessage); stdcall;
    procedure SetBounds(R: TRect); stdcall;
end;


var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TVTCustomEditor }

function TVTCustomEditor.BeginEdit: Boolean;
begin
  Result := true;
  with FEdit do
  begin
    Show;
    SetFocus;
  end;
end;

function TVTCustomEditor.CancelEdit: Boolean;
begin
  Result := true;
  FEdit.Hide;
end;

destructor TVTCustomEditor.Destroy;
begin
  FreeAndNil(FEdit);
  inherited;
end;

procedure TVTCustomEditor.EditKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case Key of
    VK_ESCAPE:
      begin
        FTree.CancelEditNode;
        Key := 0;
      end;
    VK_RETURN:
      begin
        FTree.EndEditNode;
        Key := 0;
      end;
  end;
end;

procedure TVTCustomEditor.EditKeyPress(Sender: TObject; var Key: Char);
begin
  if not(Key in ['0'..'9', #8]) then
    Key := #0;
end;

function TVTCustomEditor.EndEdit: Boolean;
begin
  Result := true;
  if StrIsInt(Trim(FEdit.Text)) then
    FTree.Text[FNode, FColumn] := Trim(FEdit.Text)
  else
    FTree.Text[FNode, FColumn] := '';
  FEdit.Hide;
  FTree.SetFocus;
end;

function TVTCustomEditor.GetBounds: TRect;
begin
  Result := FEdit.BoundsRect;
end;

function TVTCustomEditor.PrepareEdit(Tree: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex): Boolean;
var
VTEditNode: PVTEditNode;
begin
  Result := true;
  FTree := Tree as TVirtualStringTree;
  FNode := Node;
  FColumn := Column;
  FreeAndNil(FEdit);
  VTEditNode := FTree.GetNodeData(Node);
  FEdit := TEdit.Create(nil);
  FEdit.AutoSize := false;
  FEdit.Visible := false;
  FEdit.Parent := Tree;
  case Column of
    0: FEdit.Text := VTEditNode.Value1;
    1: FEdit.Text := VTEditNode.Value2;
    2: FEdit.Text := VTEditNode.Value3;
  end;
  FEdit.OnKeyDown := EditKeyDown;
  FEdit.OnKeyPress := EditKeyPress;
end;

procedure TVTCustomEditor.ProcessMessage(var Message: TMessage);
begin
  FEdit.WindowProc(Message);
end;

procedure TVTCustomEditor.SetBounds(R: TRect);
var
  Dummy: Integer;
begin
  FTree.Header.Columns.GetColumnBounds(FColumn, Dummy, R.Right);
  FEdit.BoundsRect := R;
end;

procedure TForm1.VTCreateEditor(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink);
begin
  EditLink := TVTCustomEditor.Create;
end;

procedure TForm1.VTNewText(Sender: TBaseVirtualTree; Node: PVirtualNode;
  Column: TColumnIndex; NewText: WideString);
var
  VTEditNode: PVTEditNode;
begin
  VTEditNode := Sender.GetNodeData(Node);
  case Column of
    0: VTEditNode^.Value1 := Trim(NewText);
    1: VTEditNode^.Value2 := Trim(NewText);
    2: VTEditNode^.Value3 := Trim(NewText);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
  NewNode: PVirtualNode;
  VTEditNode: PVTEditNode;
  Col: TVirtualTreeColumn;
begin
  VT.NodeDataSize := SizeOf(TVTEditNode);
  for i := 0 to 2 do
  begin
    Col := VT.Header.Columns.Add;
    Col.Text := 'Col ' + IntToStr(i);
  end;

  for i := 0 to 6 do
  begin
    NewNode := VT.AddChild(nil);
    VTEditNode := VT.GetNodeData(NewNode);
    with VTEditNode^ do
    begin
      Value1 := '1';
      Value2 := '2';
      Value3 := '3';
    end;
  end;
end;

procedure TForm1.VTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
  Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
var
 VTEditNode: PVTEditNode;
begin
  VTEditNode := Sender.GetNodeData(Node);
  case Column of
    0: CellText := VTEditNode^.Value1;
    1: CellText := VTEditNode^.Value2;
    2: CellText := VTEditNode^.Value3;
  end;
end;

procedure TForm1.VTEditing(Sender: TBaseVirtualTree; Node: PVirtualNode;
  Column: TColumnIndex; var Allowed: Boolean);
begin
  Allowed := true;
end;

procedure TForm1.VTClick(Sender: TObject);
var
  Node: PVirtualNode;
  p: TPoint;
  Column: Integer;
begin
  p := VT.ScreenToClient(Mouse.CursorPos);
  Node := VT.GetNodeAt(p.X, p.Y);
  if Assigned(Node) then
  begin
    Column := VT.Header.Columns.ColumnFromPosition(p);
    VT.EditNode(Node, Column);
  end;
end;

function TVTCustomEditor.StrIsInt(S: string): boolean;
var
  num: integer;
  err: integer;
begin
  val(S, num, err);
  if err = 0 then result := true
  else result := false;
end;

end.

Это сообщение отредактировал(а) Dom - 22.1.2009, 06:26

Присоединённый файл ( Кол-во скачиваний: 44 )

VST_editor.rar 12,41 Kb

Rrader

Дата 22.1.2009, 13:30 (ссылка)

(голосов:1)

Загрузка ...

Inspired =)

Профиль
Группа: Экс. модератор
Сообщений: 1535
Регистрация: 7.5.2005

Репутация: 18
Всего: 191

См. аттач

Это сообщение отредактировал(а) Rrader - 22.1.2009, 13:33

Присоединённый файл ( Кол-во скачиваний: 123 )

Editor.rar 9,46 Kb

--------------------

Let's do this quickly!
Rest in peace, Vit!

Dom

Дата 22.1.2009, 22:03 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 121
Регистрация: 7.8.2005

Репутация: 3
Всего: 4

Rrader, сильно и красиво! smile

Благодарю!

Вопрос решен, все работает отлично, но хотелось бы знать в чем была ошибка-то в моем варианте кода? А то ж в следующий раз снова где-то наткнусь на нее. Хотя бы в двух словах если можно.
Сам пока въехать не могу, но поколдую еще.

Bose

Дата 23.1.2009, 07:59 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1458
Регистрация: 5.3.2005
Где: Riga, Latvia

Репутация: 8
Всего: 51

Цитата(Dom @ 22.1.2009, 21:03

)

Вопрос решен, все работает отлично, но хотелось бы знать в чем была ошибка-то в моем варианте кода? А то ж в следующий раз снова где-то наткнусь на нее. Хотя бы в двух словах если можно.
Сам пока въехать не могу, но поколдую еще.

Забавно. Пробовал повторить в Delphi 2009 с последней версией VST - не получилось.

Но когда-то у меня была похожая ошибка. Решалась заменой

Код


  FEdit.OnKeyDown := EditKeyDown;

на

Код


  FEdit.OnKeyUp := EditKeyDown;

Причина же была в том, что во после отрабатывания события OnKeyDown, сейчас уже не помню кто именно, но кто что-то пытался сделать с Edit-ом. А Edit к тому моменту уже был то ли спрятан, то ли уничтожен. Деталей сейчас к сожалению не помню. =(

Скомпилируй программу с Use Debug Units, и после возникновения исключения посмотри стек вызовов(Ctrl+Alt+S).

--------------------

Лучшее о Delphi за 2013 год. Подборка ссылок.

Rrader

Дата 23.1.2009, 09:30 (ссылка)

(нет голосов)

Загрузка ...

Inspired =)

Профиль
Группа: Экс. модератор
Сообщений: 1535
Регистрация: 7.5.2005

Репутация: 18
Всего: 191

Цитата(Dom @ 23.1.2009, 04:03

)

но хотелось бы знать в чем была ошибка-то в моем варианте кода?

Код


destructor TVTCustomEditor.Destroy;
begin
  { Эту строчку надо убрать }
  FreeAndNil(FEdit);
  inherited;
end;

Добавлено через 3 минуты
Bose, у меня ошибка только в D7 вываливается. Понять причину пока не смог, но вываливается здесь:

Код


class function TObject.InheritsFrom(AClass: TClass): Boolean;
{$IFDEF PUREPASCAL}
var
  ClassPtr: TClass;
begin
  ClassPtr := Self;
  while (ClassPtr <> nil) and (ClassPtr <> AClass) do
    ClassPtr := PPointer(Integer(ClassPtr) + vmtParent)^;
  Result := ClassPtr = AClass;
end;
{$ELSE}
asm
        { ->    EAX     Pointer to our class    }
        {       EDX     Pointer to AClass               }
        { <-    AL      Boolean result          }
        JMP     @@haveVMT
@@loop:
        MOV     EAX,[EAX]
@@haveVMT:
        CMP     EAX,EDX
        JE      @@success
        { Тут происходит сбой, EAX = 0 }
        MOV     EAX,[EAX].vmtParent
        TEST    EAX,EAX
        JNE     @@loop
        JMP     @@exit
@@success:
        MOV     AL,1
@@exit:
end;
{$ENDIF}

--------------------

Let's do this quickly!
Rest in peace, Vit!

Dom

Дата 23.1.2009, 18:59 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 121
Регистрация: 7.8.2005

Репутация: 3
Всего: 4

Да, забыл сразу сказать что у меня D7.

Bose, скомпилил с использованием дцушек. Ошибка вываливается в процедуре в последней строке.

Код


procedure TControl.WndProc(var Message: TMessage);
var
  Form: TCustomForm;
  KeyState: TKeyboardState;  
  WheelMsg: TCMMouseWheel;
begin
  if (csDesigning in ComponentState) then
  begin
    Form := GetParentForm(Self);
    if (Form <> nil) and (Form.Designer <> nil) and
      Form.Designer.IsDesignMsg(Self, Message) then Exit
  end;
  if (Message.Msg >= WM_KEYFIRST) and (Message.Msg <= WM_KEYLAST) then
  begin
    Form := GetParentForm(Self);
    if (Form <> nil) and Form.WantChildKey(Self, Message) then Exit;
  end
  else if (Message.Msg >= WM_MOUSEFIRST) and (Message.Msg <= WM_MOUSELAST) then
  begin
    if not (csDoubleClicks in ControlStyle) then
      case Message.Msg of
        WM_LBUTTONDBLCLK, WM_RBUTTONDBLCLK, WM_MBUTTONDBLCLK:
          Dec(Message.Msg, WM_LBUTTONDBLCLK - WM_LBUTTONDOWN);
      end;
    case Message.Msg of
      WM_MOUSEMOVE: Application.HintMouseMessage(Self, Message);
      WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
        begin
          if FDragMode = dmAutomatic then
          begin
            BeginAutoDrag;
            Exit;
          end;
          Include(FControlState, csLButtonDown);
        end;
      WM_LBUTTONUP:
        Exclude(FControlState, csLButtonDown);
    else
      with Mouse do
        if WheelPresent and (RegWheelMessage <> 0) and
          (Message.Msg = RegWheelMessage) then
        begin
          GetKeyboardState(KeyState);
          with WheelMsg do
          begin
            Msg := Message.Msg;
            ShiftState := KeyboardStateToShiftState(KeyState);
            WheelDelta := Message.WParam;
            Pos := TSmallPoint(Message.LParam);
          end;
          MouseWheelHandler(TMessage(WheelMsg));
          Exit;
        end;
    end;
  end
  else if Message.Msg = CM_VISIBLECHANGED then
    with Message do
      SendDockNotification(Msg, WParam, LParam);
  Dispatch(Message);
end;

При вызове стека там такая информация содержится.

Код


TControl.WndProc((256,65537,0,27,0,1,1,0,0))
TWinControl.WndProc((256,65537,0,27,0,1,1,0,0))
TWinControl.MainWndProc((256,65537,0,27,0,1,1,0,0))
StdWndProc(1115588,256,27,65537)
TApplication.ProcessMessage((1115588,256,27,65537,347729015,(824,766)))
TApplication.HandleMessage
TApplication.Run
Project1

Для меня это, честно говоря, малоинформативно пока что. Может у вас будут какие-то соображения?

Rrader, точно. Закомментировать эту строку и все работает. Проблемы при разрушении редактора. Но все равно не понятно. smile

Чувствую не разобраться мне, знаний не хватает. Ладно, будем считать это "багом/фичей" Делфи7.

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Для новичков \| Следующая тема »