编写自定义属性检查器 - 如何在验证值时处理内部编辑器焦点?

时间:2015-08-02 17:55:12

标签: delphi delphi-xe7

概述

我正在尝试编写自己的简单属性检查器,但我面临着一个困难且相当混乱的问题。首先,虽然让我说我的组件不适合处理或处理组件属性,但它允许添加自定义值。我的组件的完整源代码是问题所在,一旦你将它安装在一个包中并从一个新的空项目运行它,它应该看起来像这样:

enter image description here

问题(简​​要)

问题在于使用就地编辑器和验证属性值。我们的想法是,如果属性值无效,则向用户显示一条消息,通知他们该值无法接受,然后重点关注最初关注的行和内部编辑器。

我们实际上可以使用Delphi自己的Object Inspector来说明我正在寻找的行为,例如尝试在Name属性中编写一个无法接受的字符串,然后单击远离Object Inspector。显示一条消息,在关闭它时,它将重点回到Name行。

源代码

这个问题在没有任何代码的情况下变得过于模糊,但由于我试图编写的组件的性质,它也非常大。为了问题和例子的目的,我尽可能地将其剥离了。我相信会有一些评论问我为什么不这样做或者那样做但是重要的是要知道我不是Delphi的专家,而且经常做出错误的决定和选择,但我总是愿意学习所有评论欢迎,特别是如果它有助于找到我的解决方案。

unit MyInspector;

interface

uses
  Winapi.Windows,
  Winapi.Messages,
  System.Classes,
  System.SysUtils,
  Vcl.Controls,
  Vcl.Dialogs,
  Vcl.StdCtrls,
  Vcl.Graphics,
  Vcl.Forms;

type
  TMyInspectorItems = class(TObject)
  private
    FPropertyNames: TStringList;
    FPropertyValues: TStringList;

    procedure AddItem(APropName, APropValue: string);
    procedure Clear;
  public
    constructor Create;
    destructor Destroy; override;
  end;

  TOnMouseMoveEvent = procedure(Sender: TObject; X, Y: Integer) of object;
  TOnSelectRowEvent = procedure(Sender: TObject; PropName, PropValue: string; RowIndex: Integer) of object;

  TMyCustomInspector = class(TGraphicControl)
  private
    FInspectorItems: TMyInspectorItems;
    FOnMouseMove: TOnMouseMoveEvent;
    FOnSelectRow: TOnSelectRowEvent;

    FRowCount: Integer;
    FNamesFont: TFont;
    FValuesFont: TFont;

    FSelectedRow: Integer;

    procedure SetNamesFont(const AValue: TFont);
    procedure SetValuesFont(const AValue: TFont);

    procedure CalculateInspectorHeight;
    function GetMousePosition: TPoint;
    function MousePositionToRowIndex: Integer;
    function RowIndexToMousePosition(ARowIndex: Integer): Integer;
    function GetRowHeight: Integer;
    function GetValueRowWidth: Integer;
    function RowExists(ARowIndex: Integer): Boolean;
    function IsRowSelected: Boolean;

  protected
    procedure Loaded; override;
    procedure Paint; override;
    procedure WMKeyDown(var Message: TMessage); message WM_KEYDOWN;
    procedure WMMouseDown(var Message: TMessage); message WM_LBUTTONDOWN;
    procedure WMMouseMove(var Message: TMessage); message WM_MOUSEMOVE;
    procedure WMMouseUp(var Message: TMessage); message WM_LBUTTONUP;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    function RowCount: Integer;

    property Items: TMyInspectorItems read FInspectorItems write FInspectorItems;
    property OnMouseMove: TOnMouseMoveEvent read FOnMouseMove write FOnMouseMove;
    property OnSelectRow: TOnSelectRowEvent read FOnSelectRow write FOnSelectRow;
  published
    property Align;
  end;

  TMyPropertyInspector = class(TScrollBox)
  private
    FInspector: TMyCustomInspector;
    FInplaceStringEditor: TEdit;

    FSelectedRowName: string;
    FLastSelectedRowName: string;
    FLastSelectedRow: Integer;

    function SetPropertyValue(RevertToPreviousValueOnFail: Boolean): Boolean;

    procedure InplaceStringEditorEnter(Sender: TObject);
    procedure InplaceStringEditorExit(Sender: TObject);
    procedure InplaceStringEditorKeyPress(Sender: TObject; var Key: Char);
    procedure SelectRow(Sender: TObject; PropName, PropValue: string; RowIndex: Integer);
    function ValidateStringValue(Value: string): Boolean;
  protected
    procedure Loaded; override;
    procedure WMSize(var Message: TMessage); message WM_SIZE;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure AddItem(APropName, APropValue: string);
    function GetSelectedPropertyName: string;
    function GetSelectedPropertyValue: string;
    function RowCount: Integer;
  end;

var
  FCanSelect: Boolean;

implementation

{ TMyInspectorItems }

constructor TMyInspectorItems.Create;
begin
  inherited Create;
  FPropertyNames  := TStringList.Create;
  FPropertyValues := TStringList.Create;
end;

destructor TMyInspectorItems.Destroy;
begin
  FPropertyNames.Free;
  FPropertyValues.Free;
  inherited Destroy;
end;

procedure TMyInspectorItems.AddItem(APropName, APropValue: string);
begin
  FPropertyNames.Add(APropName);
  FPropertyValues.Add(APropValue);
end;

procedure TMyInspectorItems.Clear;
begin
  FPropertyNames.Clear;
  FPropertyValues.Clear;
end;

{ TMyCustomInspector }

constructor TMyCustomInspector.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FInspectorItems     := TMyInspectorItems.Create;

  FNamesFont          := TFont.Create;
  FNamesFont.Color    := clWindowText;
  FNamesFont.Name     := 'Segoe UI';
  FNamesFont.Size     := 9;
  FNamesFont.Style    := [];

  FValuesFont         := TFont.Create;
  FValuesFont.Color   := clNavy;
  FValuesFont.Name    := 'Segoe UI';
  FValuesFont.Size    := 9;
  FValuesFont.Style   := [];
end;

destructor TMyCustomInspector.Destroy;
begin
  FInspectorItems.Free;
  FNamesFont.Free;
  FValuesFont.Free;
  inherited Destroy;
end;

procedure TMyCustomInspector.Loaded;
begin
  inherited Loaded;
end;

procedure TMyCustomInspector.Paint;

  procedure DrawBackground;
  begin
    Canvas.Brush.Color := clWindow;
    Canvas.Brush.Style := bsSolid;
    Canvas.FillRect(Rect(0, 0, Self.Width, Self.Height));
  end;

  procedure DrawNamesBackground;
  begin
    Canvas.Brush.Color := clWindow;
    Canvas.Brush.Style := bsSolid;
    Canvas.FillRect(Rect(0, 0, Self.Width div 2, Self.Height));
  end;

  procedure DrawNamesSelection;
  begin
    if (FRowCount > -1) and (RowExists(MousePositionToRowIndex)) then
    begin
      Canvas.Brush.Color := $00E0E0E0;
      Canvas.Brush.Style := bsSolid;
      Canvas.FillRect(Rect(0, RowIndexToMousePosition(FSelectedRow),
        Self.Width div 2, RowIndexToMousePosition(FSelectedRow) + GetRowHeight));
    end;
  end;

  procedure DrawNamesText;
  var
    I: Integer;
    Y: Integer;
  begin
    FRowCount := FInspectorItems.FPropertyNames.Count;

    Canvas.Brush.Style  := bsClear;
    Canvas.Font.Color   := FNamesFont.Color;
    Canvas.Font.Name    := FNamesFont.Name;
    Canvas.Font.Size    := FNamesFont.Size;

    Y := 0;
    for I := 0 to FInspectorItems.FPropertyNames.Count -1 do
    begin
      Canvas.TextOut(2, Y, FInspectorItems.FPropertyNames.Strings[I]);
      Inc(Y, GetRowHeight);
    end;
  end;

  procedure DrawValuesBackground;
  begin
    Canvas.Brush.Color := clWindow;
    Canvas.Brush.Style := bsSolid;
    Canvas.FillRect(Rect(Self.Width div 2, 0, Self.Width, Self.Height));
  end;

  procedure DrawValuesSelection;
  begin
    if (FRowCount > -1) and (RowExists(MousePositionToRowIndex)) then
    begin
      Canvas.DrawFocusRect(Rect(Self.Width div 2, RowIndexToMousePosition(FSelectedRow),
        Self.Width, RowIndexToMousePosition(FSelectedRow) + GetRowHeight));
    end;
  end;

  procedure DrawValues;
  var
    I, Y: Integer;
  begin
    FRowCount := FInspectorItems.FPropertyValues.Count;

    Y := 0;
    for I := 0 to FInspectorItems.FPropertyValues.Count -1 do
    begin
      Canvas.Brush.Style  := bsClear;
      Canvas.Font.Color   := FValuesFont.Color;
      Canvas.Font.Name    := FValuesFont.Name;
      Canvas.Font.Size    := FValuesFont.Size;

      Canvas.TextOut(Self.Width div 2 + 2, Y + 1, FInspectorItems.FPropertyValues.Strings[I]);
      Inc(Y, GetRowHeight);
    end;
  end;

begin
  DrawNamesBackground;
  DrawNamesSelection;
  DrawNamesText;
  DrawValuesBackground;
  DrawValuesSelection;
  DrawValues;
end;

procedure TMyCustomInspector.WMKeyDown(var Message: TMessage);
begin
  inherited;

  case Message.WParam of
    VK_DOWN:
    begin

    end;
  end;
end;

procedure TMyCustomInspector.WMMouseDown(var Message: TMessage);
begin
  inherited;

  Parent.SetFocus;

  FSelectedRow := MousePositionToRowIndex;

  if FSelectedRow <> -1 then
  begin
    if Assigned(FOnSelectRow) then
    begin
      FOnSelectRow(Self, FInspectorItems.FPropertyNames.Strings[FSelectedRow],
        FInspectorItems.FPropertyValues.Strings[FSelectedRow], FSelectedRow);
    end;
  end;

  Invalidate;
end;

procedure TMyCustomInspector.WMMouseMove(var Message: TMessage);
begin
  inherited;

  if Assigned(FOnMouseMove) then
  begin
    FOnMouseMove(Self, GetMousePosition.X, GetMousePosition.Y);
  end;
end;

procedure TMyCustomInspector.WMMouseUp(var Message: TMessage);
begin
  inherited;
end;

procedure TMyCustomInspector.SetNamesFont(const AValue: TFont);
begin
  FNamesFont.Assign(AValue);
  Invalidate;
end;

procedure TMyCustomInspector.SetValuesFont(const AValue: TFont);
begin
  FValuesFont.Assign(AValue);
  Invalidate;
end;

procedure TMyCustomInspector.CalculateInspectorHeight;
var
  I, Y: Integer;
begin
  FRowCount := FInspectorItems.FPropertyNames.Count;

  Y := GetRowHeight;
  for I := 0 to FRowCount -1 do
  begin
    Inc(Y, GetRowHeight);
  end;

  if Self.Height <> Y then
    Self.Height := Y;
end;

function TMyCustomInspector.GetMousePosition: TPoint;
var
  Pt: TPoint;
begin
  Pt := Mouse.CursorPos;
  Pt := ScreenToClient(Pt);
  Result := Pt;
end;

function TMyCustomInspector.MousePositionToRowIndex: Integer;
begin
  Result := GetMousePosition.Y div GetRowHeight;
end;

function TMyCustomInspector.RowIndexToMousePosition(
  ARowIndex: Integer): Integer;
begin
  Result := ARowIndex * GetRowHeight;
end;

function TMyCustomInspector.GetRowHeight: Integer;
begin
  Result := FNamesFont.Size * 2 + 1;
end;

function TMyCustomInspector.GetValueRowWidth: Integer;
begin
  Result := Self.Width div 2;
end;

function TMyCustomInspector.RowCount: Integer;
begin
  Result := FRowCount;
end;

function TMyCustomInspector.RowExists(ARowIndex: Integer): Boolean;
begin
  Result := MousePositionToRowIndex < RowCount;
end;

function TMyCustomInspector.IsRowSelected: Boolean;
begin
  Result := FSelectedRow <> -1;
end;

{ TMyPropertyInspector }

constructor TMyPropertyInspector.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  Self.DoubleBuffered               := True;
  Self.Height                       := 150;
  Self.HorzScrollBar.Visible        := False;
  Self.TabStop                      := True; // needed to receive focus
  Self.Width                        := 250;

  FInspector                        := TMyCustomInspector.Create(Self);
  FInspector.Parent                 := Self;
  FInspector.Align                  := alTop;
  FInspector.Height                 := 0;
  FInspector.OnSelectRow            := SelectRow;

  FInplaceStringEditor              := TEdit.Create(Self);
  FInplaceStringEditor.Parent       := Self;
  FInplaceStringEditor.BorderStyle  := bsNone;
  FInplaceStringEditor.Color        := clWindow;
  FInplaceStringEditor.Height       := 0;
  FInplaceStringEditor.Left         := 0;
  FInplaceStringEditor.Name         := 'MyPropInspectorInplaceStringEditor';
  FInplaceStringEditor.Top          := 0;
  FInplaceStringEditor.Visible      := False;
  FInplaceStringEditor.Width        := 0;
  FInplaceStringEditor.Font.Assign(FInspector.FValuesFont);

  FInplaceStringEditor.OnEnter      := InplaceStringEditorEnter;
  FInplaceStringEditor.OnExit       := InplaceStringEditorExit;
  FInplaceStringEditor.OnKeyPress   := InplaceStringEditorKeyPress;

  FCanSelect                        := True;
end;

destructor TMyPropertyInspector.Destroy;
begin
  FInspector.Free;
  FInplaceStringEditor.Free;
  inherited Destroy;
end;

procedure TMyPropertyInspector.Loaded;
begin
  inherited Loaded;
end;

procedure TMyPropertyInspector.WMSize(var Message: TMessage);
begin
  FInspector.Width := Self.Width;
  Invalidate;
end;


procedure TMyPropertyInspector.AddItem(APropName, APropValue: string);
begin
  FInspector.CalculateInspectorHeight;
  FInspector.Items.AddItem(APropName, APropValue);
  FInspector.Invalidate;
  Self.Invalidate;
end;

function TMyPropertyInspector.GetSelectedPropertyName: string;
begin
  Result := '';

  if FInspector.FSelectedRow <> -1 then
  begin
    Result := FInspector.FInspectorItems.FPropertyNames.Strings[FInspector.FSelectedRow];
  end;
end;

function TMyPropertyInspector.GetSelectedPropertyValue: string;
begin
  Result := '';

  if FInspector.FSelectedRow <> -1 then
  begin
    Result := FInspector.FInspectorItems.FPropertyValues.Strings[FInspector.FSelectedRow];
  end;
end;

function TMyPropertyInspector.RowCount: Integer;
begin
  Result := FInspector.RowCount;
end;

procedure TMyPropertyInspector.InplaceStringEditorEnter(Sender: TObject);
begin
  FCanSelect := False;
  FLastSelectedRow := FInplaceStringEditor.Tag;
end;

procedure TMyPropertyInspector.InplaceStringEditorExit(Sender: TObject);
begin
  if SetPropertyValue(True) then
  begin
    FCanSelect := True;
  end;
end;

procedure TMyPropertyInspector.InplaceStringEditorKeyPress(Sender: TObject;
  var Key: Char);
begin
  if Key = Chr(VK_RETURN) then
  begin
    Key := #0;
    FInplaceStringEditor.SelectAll;
  end;
end;

procedure TMyPropertyInspector.SelectRow(Sender: TObject; PropName, PropValue: string; RowIndex: Integer);
begin
  FSelectedRowName     := PropName;
  FLastSelectedRowName := PropName;

  FInplaceStringEditor.Height   := FInspector.GetRowHeight - 2;
  FInplaceStringEditor.Left     := Self.Width div 2;
  FInplaceStringEditor.Tag      := RowIndex;
  FInplaceStringEditor.Text     := GetSelectedPropertyValue;
  FInplaceStringEditor.Top      := FInspector.RowIndexToMousePosition(FInspector.FSelectedRow) + 1 - Self.VertScrollBar.Position;
  FInplaceStringEditor.Visible  := True;
  FInplaceStringEditor.Width    := FInspector.GetValueRowWidth - 3;
  FInplaceStringEditor.SetFocus;
  FInplaceStringEditor.SelectAll;
end;

function TMyPropertyInspector.SetPropertyValue(
  RevertToPreviousValueOnFail: Boolean): Boolean;
var
  S: string;
begin
  Result := False;

  S := FInplaceStringEditor.Text;

  if ValidateStringValue(S) then
  begin
    Result := True;
  end
  else
  begin
    ShowMessage('"' + S + '"' + 'is not a valid value.');
    Result := False;
  end;
end;

function TMyPropertyInspector.ValidateStringValue(Value: string): Boolean;
begin
  // a quick and dirty way of testing for a valid string value, here we just
  // look for strings that are not zero length.
  Result := Length(Value) > 0;
end;

end.

问题(详细)

我所拥有的困惑归结为谁首先获得焦点以及如何正确处理和回应它。因为我是自定义绘制我的行,所以我在单击检查器控件时确定鼠标的位置,然后我绘制选定的行来显示它。然而,在处理就座编辑器时,特别是OnEnterOnExit事件我遇到了各种各样的时髦问题,在某些情况下,我一直陷入验证错误消息的循环中,例如反复显示(因为焦点从我的检查器切换到就地编辑器来回)。

要在运行时填充检查器,您可以执行以下操作:

procedure TForm1.Button1Click(Sender: TObject);
begin
  MyPropertyInspector1.AddItem('A', 'Some Text');
  MyPropertyInspector1.AddItem('B', 'Hello World');
  MyPropertyInspector1.AddItem('C', 'Blah Blah');
  MyPropertyInspector1.AddItem('D', 'The Sky is Blue');
  MyPropertyInspector1.AddItem('E', 'Another String');
end;

你可以试试一下:

  • 点击一行
  • 从内部编辑器中删除内容
  • 选择另一行
  • 出现验证错误消息框(暂不关闭)
  • 消息框仍然可见,将鼠标移到另一行
  • 现在按Enter键关闭消息框
  • 您会注意到所选行现已移至鼠标所在的位置

我需要的是在验证消息框显示和关闭后,我需要将焦点设置回首先验证的行。它变得令人困惑,因为看起来(或者我认为)在我的检查员的OnExit代码之后调用了就地编辑器WMMouseDown(var Message: TMessage);

如果问题仍然不清楚的话,尽可能简单,Delphi Object Inspector的行为是我试图在我的组件中实现的。您在inplace编辑器中输入一个值,如果验证失败,则显示一个消息框,然后将焦点移回到上次选择的行。一旦焦点从就地编辑器切换出来,就应该进行就地编辑器验证。

2 个答案:

答案 0 :(得分:2)

  

我似乎无法弄清楚首先被调用的是什么以及什么是阻止事件被触发,它变得令人困惑,因为我绘制所选行的方式取决于鼠标在单击检查器时的位置控制。

这是你的事件流程:

  • TMyCustomInspector.WMMouseDown被调用
    1. 其中,Parent.SetFocus被调用
      • 焦点将从编辑控件中删除,TMyPropertyInspector.InplaceStringEditorExit称为
      • 消息对话框由SetPropertyValue
      • 显示
    2. FSelectedRow正在重置
    3. TMyPropertyInspector.SelectRow被调用(通过TMyCustomInspector.FOnSelectRow),将焦点重置为替换的Edit控件。

如果验证失败,则需要阻止FSelectedRow重置。所有需要的成分已经存在,只需添加以下条件:

  if FCanSelect then
    FSelectedRow := MousePositionToRowIndex;

一些评论:

  • FCanSelect设为TMyCustomInspector的受保护或私有字段,
  • 您需要在TMyCustomInspector.MousePositionToRowIndex中检查限制才能返回-1

答案 1 :(得分:0)

你的问题非常有趣。根据我收集的内容,当评估为false时,您需要一种方法将焦点重置为无效行。在我看到你的地方,这是在你的<body>功能中。我相信如果您执行以下操作,您将能够在用户点击&#34; OK&#34;之后重置焦点。在消息中:

SetPropertyValue

function TMyPropertyInspector.SetPropertyValue( RevertToPreviousValueOnFail: Boolean): Boolean; var S: string; begin Result := False; S := FInplaceStringEditor.Text; if ValidateStringValue(S) then begin Result := True; end else begin if (MessageDlg('"' + S + '"' + 'is not a valid value.', mtError, [mbOK], 0)) = mrOK then begin SelectRow(nil, FSelectedRowName, FInplaceStringEditor.Text, FInplaceStringEditor.Tag); end; Result := False; end; end; 更改为ShowMessage将允许在按下按钮时执行操作。然后用(我相信的)全局变量调用你的MessageDlg函数来表示最后一行的信息,将焦点设置为坏单元格。