Project JEDI - Issue Tracker
Mantis Bugtracker

Viewing Issue Simple Details Jump to Notes ] View Advanced ] Issue History ] Print ]
ID Category Severity Reproducibility Date Submitted Last Update
0002554 [JEDI VCL] 04 Feature Request feature always 2005-01-25 04:05 2005-08-10 08:36
Reporter uli-korn View Status public  
Assigned To obones
Priority normal Resolution fixed  
Status resolved   Product Version
Summary 0002554: TJvEnterAsTab-Enhancement JVCL-RC1
Description Hi there,

i have a little problem with the behavior of the TJvEnterAsTab-component,
because it routes the 'return' on every 'TButtonClass'-Descendant, i.e. TCheckBox.

Prior to ask you to enhance this component i have done this by myself and send you
the code. I hope it is JVCL-compliant an you will integrate it.

With this componant you are able to say explicit which component recieve the 'return'(AllowComponent-List) or never reciev(DisAllowComponent-List).

The hole code is in the Additional Information and in the attachment.


MfG Uli Korn from germany
Additional Information {-----------------------------------------------------------------------------
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: JvEnterTab.PAS, released on 2002-05-26.

The Initial Developer of the Original Code is Peter Thörnqvist [peter3 at sourceforge dot net]
Portions created by Peter Thörnqvist are Copyright (C) 2002 Peter Thörnqvist.
All Rights Reserved.

Contributor(s):
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net [^]

Description:
  A unit that converts all Enter keypresses to Tab keypresses.

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvEnterTab.pas,v 1.22 2004/10/28 07:31:06 marquardt Exp $

unit JvEnterTab;

{$I jvcl.inc}

interface

uses
  Windows, Messages, Classes, Graphics, Controls, StdCtrls, SysUtils,
  {$IFDEF VisualCLX}
  Qt, JvQConsts,
  {$ENDIF VisualCLX}
  JvComponent;

type
  TJvEnterAsTab = class;

  TComponentCollectionItem = class(TCollectionItem)
  private
    FComponent: TComponent;
    procedure SetComponent(const Value: TComponent);
  public
    function GetDisplayName: String; override;
  published
    property Component: TComponent read FComponent write SetComponent;
  end;

  TComponentCollection = class(TCollection)
  private
    FMyComponent: TComponent;
    function GetItem(Index: Integer): TComponentCollectionItem;
    procedure SetItem(Index: Integer; Value: TComponentCollectionItem);
  protected
    function GetOwner: TPersistent; override;
  public
    property Items[Index: Integer]: TComponentCollectionItem read GetItem write SetItem; default;
    constructor Create(MyComponent: TComponent);
    function Add: TComponentCollectionItem;
    function ComponentByName(const Name: String): TComponent;
  end;

  TJvEnterAsTab = class(TJvGraphicControl)
  private
    FEnterAsTab: Boolean;
    FAllowDefault: Boolean;
    FAllowComponents: TComponentCollection;
    FDisAllowComponents: TComponentCollection;
    FBmp: TBitmap;

    procedure SetAllowComponents(Value: TComponentCollection);
    procedure SetDisAllowComponents(Value: TComponentCollection);
  protected
    {$IFDEF VCL}
    procedure CMDialogKey(var Msg: TCMDialogKey); message CM_DIALOGKEY;
    {$ENDIF VCL}
    {$IFDEF VisualCLX}
    function TabKeyHook(Sender: QObjectH; Event: QEventH): Boolean; virtual;
    {$ENDIF VisualCLX}
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetBounds(ALeft: Integer; ATop: Integer; AWidth: Integer;
      AHeight: Integer); override;
  published
    property EnterAsTab: Boolean read FEnterAsTab write FEnterAsTab default True;
    property AllowDefault: Boolean read FAllowDefault write FAllowDefault default True;
    property AllowComponents: TComponentCollection read FAllowComponents write SetAllowComponents;
    property DisAllowComponents: TComponentCollection read FDisAllowComponents write SetDisAllowComponents;
  end;

implementation

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Forms;

{$IFDEF MSWINDOWS}
{$R ..\Resources\JvEnterTab.res}
{$ENDIF MSWINDOWS}
{$IFDEF UNIX}
{$R ../Resources/JvEnterTab.res}
{$ENDIF UNIX}

constructor TJvEnterAsTab.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Self.FAllowComponents := TComponentCollection.Create(Self);
  Self.FDisAllowComponents := TComponentCollection.Create(Self);
  ControlStyle := ControlStyle + [csNoStdEvents, csFixedHeight, csFixedWidth];
  FEnterAsTab := True;
  FAllowDefault := True;
  if csDesigning in ComponentState then
  begin
    FBmp := TBitmap.Create;
    FBmp.LoadFromResourceName(hInstance, 'DESIGNENTERASTAB');
  end
  else
    Visible := False;
  {$IFDEF VisualCLX}
  InstallApplicationHook(TabKeyHook);
  {$ENDIF VisualCLX}
end;

destructor TJvEnterAsTab.Destroy;
begin
  {$IFDEF VisualCLX}
  UninstallApplicationHook(TabKeyHook);
  {$ENDIF VisualCLX}
  Self.FAllowComponents.Free;
  Self.FDisAllowComponents.Free;
  FBmp.Free;
  inherited Destroy;
end;

{$IFDEF VCL}
procedure TJvEnterAsTab.CMDialogKey(var Msg: TCMDialogKey);
var
    SendTab: Boolean;
begin
  SendTab := False;

  if Self.FDisAllowComponents.Count > 0 then
  begin
      if Self.FDisAllowComponents.ComponentByName(GetParentForm(Self).ActiveControl.Name) <> nil then
      begin
        SendTab := True;
      end;
  end;

  if Self.FAllowComponents.Count > 0 then
  begin
      if Self.FAllowComponents.ComponentByName(GetParentForm(Self).ActiveControl.Name) = nil then
      begin
          SendTab := True;
      end;
  end;

  if (GetParentForm(Self).ActiveControl.FieldAddress('Default') <> nil) and AllowDefault then
  begin
      if not TButton(GetParentForm(Self).ActiveControl).Default then
      begin
        SendTab := True;
      end;
  end;

  if (Msg.CharCode = VK_RETURN) and EnterAsTab and SendTab then
  begin
      GetParentForm(Self).Perform(CM_DIALOGKEY, VK_TAB, 0);
      Msg.Result := 1;
  end else begin
      inherited;
  end;
end;
{$ENDIF VCL}
{$IFDEF VisualCLX}
function TJvEnterAsTab.TabKeyHook(Sender: QObjectH; Event: QEventH): Boolean;
var
  ws: WideString;
begin
  Result := False;
  if QEvent_type(Event) = QEventType_KeyPress then
  begin
    if QObject_inherits(Sender, 'QButton') and AllowDefault then
      Exit;

    if ((QKeyEvent_key(QKeyEventH(Event)) = Key_Enter) or
      (QKeyEvent_key(QKeyEventH(Event)) = Key_Return) ) and EnterAsTab then
    begin
      ws := Tab;

      QApplication_postEvent(GetParentForm(Self).Handle,
        QKeyEvent_create(QEventType_KeyPress, Key_Tab, Ord(Tab), 0, @ws, False, 1));
      QApplication_postEvent(GetParentForm(Self).Handle,
        QKeyEvent_create(QEventType_KeyRelease, Key_Tab, Ord(Tab), 0, @ws, False, 1));

      Result := True;
    end;
  end;
end;
{$ENDIF VisualCLX}

procedure TJvEnterAsTab.Paint;
begin
  if not (csDesigning in ComponentState) then
    Exit;
  with Canvas do
  begin
    Brush.Color := clBtnFace;
    BrushCopy({$IFDEF VisualCLX} Canvas, {$ENDIF} ClientRect, FBmp, ClientRect, clFuchsia);
  end;
end;

procedure TJvEnterAsTab.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited SetBounds(ALeft, ATop, 28, 28);
end;

{ TComponentCollectionItem }

function TComponentCollectionItem.GetDisplayName: String;
begin
    Result := '';
    if Assigned(Self.FComponent) then Result := Self.FComponent.Name;
end;

procedure TComponentCollectionItem.SetComponent(
  const Value: TComponent);
begin
    if Self.FComponent <> Value then Self.FComponent := Value;
end;

{ TComponentCollection }

function TComponentCollection.Add: TComponentCollectionItem;
begin
    Result := TComponentCollectionItem(inherited Add);
end;

function TComponentCollection.ComponentByName(
  const Name: String): TComponent;
var
    i: Integer;
begin
    Result := nil;
    for i := 0 to Self.Count - 1 do
    begin
        if LowerCase(Self.Items[i].Component.Name) = LowerCase(Name) then Result := Self.Items[i].Component;
    end;
end;

constructor TComponentCollection.Create(MyComponent: TComponent);
begin
    inherited Create(TComponentCollectionItem);
    Self.FMyComponent := MyComponent;
end;

function TComponentCollection.GetItem(
  Index: Integer): TComponentCollectionItem;
begin
    Result := TComponentCollectionItem(inherited GetItem(Index));
end;

function TComponentCollection.GetOwner: TPersistent;
begin
    Result := Self.FMyComponent;
end;

procedure TComponentCollection.SetItem(Index: Integer;
  Value: TComponentCollectionItem);
begin
    inherited SetItem(Index, Value);
end;

procedure TJvEnterAsTab.SetAllowComponents(Value: TComponentCollection);
begin
    Self.FAllowComponents.Assign(Value);
end;

procedure TJvEnterAsTab.SetDisAllowComponents(Value: TComponentCollection);
begin
    Self.FDisAllowComponents.Assign(Value);
end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvEnterTab.pas,v $';
    Revision: '$Revision: 1.22 $';
    Date: '$Date: 2004/10/28 07:31:06 $';
    LogPath: 'JVCL\run'
  );

initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.
Tags No tags attached.
Attached Files ? file icon JvEnterTab.pas [^] (8,997 bytes) 2005-01-25 04:05

- Relationships

-  Notes
(0006281)
user72
2005-01-25 11:15

The idea is great, but I think it would be more elegant (and a lot simpler) to handle it in an event, i.e something like:

type
  TJvEnterAsTabEvent = procedure (Sender:TObject; AControl:TWinCOntrol; var IsHandled:Boolean) of object;

protected
  function EnterHandled(AControl: TWinControl): Boolean;virtual;
published
  property OnEnterHandled:TJvEnterAsTabEvent;
end;

implementaiton

function TJvEnterAsTab.EnterHandled(AControl:TWinControl):Boolean;
begin
  Result := AControl is TButtonControl;
  if Assigned(FOnEnterHandled) then
    FOnEnterHandled(Self, AControl, Result);
end;

procedure TJvEnterAsTab.CMDialogKey(var Msg: TCMDialogKey);
begin
  if AllowDefault and EnterHandled(GetParentForm(Self).ActiveControl) then
    inherited
  else
  if (Msg.CharCode = VK_RETURN) and EnterAsTab then
  begin
    GetParentForm(Self).Perform(CM_DIALOGKEY, VK_TAB, 0);
    Msg.Result := 1;
  end
  else
    inherited;
end;

THe implementation for CLX would have to be slightly different, but not by much. What do you think?
(0006285)
anonymous (viewer)
2005-01-25 13:49

This is great, too.

I think both possibilitys should be implemented.
Sometimes you have very easy task to do and you can
customize all within the object-inspector(quick and dirty).
Otherwise sometimes you have to check serveral params and you can
implement then hole logic in the OnEnterHandled-Event
(which is more elegant and powerful).

What do you think?
(0007783)
obones (administrator)
2005-08-10 08:36

event option is in CVS, we won't go further.

- Issue History
Date Modified Username Field Change
2005-01-25 04:05 uli-korn New Issue
2005-01-25 04:05 uli-korn File Added: JvEnterTab.pas
2005-01-25 04:09 uli-korn Issue Monitored: uli-korn
2005-01-25 11:15 user72 Note Added: 0006281
2005-01-25 11:15 user72 Status new => feedback
2005-01-25 13:17 user72 Note Added: 0006282
2005-01-25 13:20 user72 Note Deleted: 0006282
2005-01-25 13:49 anonymous Note Added: 0006285
2005-08-10 08:36 obones Status feedback => resolved
2005-08-10 08:36 obones Resolution open => fixed
2005-08-10 08:36 obones Assigned To => obones
2005-08-10 08:36 obones Note Added: 0007783


Mantis 1.1.6[^]
Copyright © 2000 - 2008 Mantis Group
Powered by Mantis Bugtracker