?»??»?//-----------------------------------------------------------------------------
// TDosMove ver 1.02
//
// Last updated at: 09/10/1998
//
// Component that allows you to move thourgh the controls in your app with
//  UP/DOWN arrows or ENTER key insted of using the old boring TAB.
//
// Code by: Liran Shahar
//          Israel
//          simpletech@ibm.net
//-----------------------------------------------------------------------------
// Modify Version 1.02h
// Designer : Danny Tzu
// E-Mail: deven_tzu.tw@yahoo.com.tw
// ¤¤¤å»¡©ú¤Î¿ù»~­×¥¿¦Cªí ½Ð¬Ý README.TXT
unit DosMove;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Grids, DBCtrls, ComCtrls,wwdblook, DB,dxDBGrid,
  DbiTypes,DbiProcs,DbiErrs,typinfo,
  wwDBNavigator,cxDropDownEdit,cxDBEdit,cxTextEdit;

type
  TMoveOptions = set of (moEnter,moUpDn);

  TDosMove = class(TComponent)
  private
    FActive,
    FActiveColor: Boolean;
    FOptions: TMoveOptions;
    FEditNoBeep: Boolean;
    FLastWasEdit: Boolean;
    FIsTabGrid: Boolean;
    FTabGrid: Boolean;
    FPageControl: TPageControl;
    FSelectPageOptions: TShiftState;
    FEnterColor,
    FOldColor: TColor;
    FOldControl: TControl;
    FNPClassNames: TStringList;  // Not Process ClassNames
    gDataset: Tdataset;
    gWwDBNavigator:TWwDBNavigator;

    FOverWrite: Boolean; //¤ý­§Þ³
    FIsLoad: Boolean;    //¤ý­§Þ³
    Msg: TWMKey;         //¤ý­§Þ³

    FOwnerKeyDown: TKeyEvent;
    FOwnerKeyPress: TKeyPressEvent;
    FActiveControlChange: TNotifyEvent;

    FwwDBLookupComboDropDown: TNotifyEvent;

    procedure SetTabGrid(const Value: Boolean);
    procedure SetActive(const Value: boolean);
    procedure SetKeyEvent;
    procedure SetSelectPageOptions(const Value: TShiftState);
    procedure SetActiveColor(const Value: boolean);
    procedure SetControlColor(AControl: TControl);
    procedure SetNPClassNames(const Value: TStringList);
    procedure SetDataset(ds:Tdataset);
    procedure SetWwDBNavigator(nav:TwwDBNavigator);


  protected
    procedure NewKeyDown(Sender : TObject;var Key : word;Shift : TShiftState);
    procedure NewKeyPress(Sender : Tobject;var Key : char);
    procedure ActiveControlChange(Sender: TObject);
    procedure wwDBLookupComboDropDown(Sender: TObject);
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    
    procedure TabCycle(cmActive: TWinControl;var Key : word);
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
  published
    property Active: boolean read FActive write SetActive default False;
    property ActiveColor: boolean read FActiveColor write SetActiveColor default False;
    property Options: TMoveOptions read FOptions write FOptions default [moEnter,moUpDn];
    property EditNoBeep: boolean read FEditNoBeep write FEditNoBeep default True;
    property TabGrid: Boolean read FTabGrid write SetTabGrid default True;
    property PageControl: TPageControl read FPageControl write FPageControl;
    property SelectPageOptions: TShiftState read FSelectPageOptions write SetSelectPageOptions default [ssCtrl];
    property EnterColor: TColor read FEnterColor write FEnterColor default clWindow;
    property NPClassNames: TStringList read FNPClassNames write SetNPClassNames;
    property Dateset: TDataset read gdataset write SetDataset;
    property wwDBNavigator: TwwDBNavigator read gWwDBNavigator write SetWwDBNavigator;

  end;

procedure Register;

implementation

uses VDBConsts;

type
  TDosMoveControl = Class(TControl)
  published
    property Color;
  end;

procedure Register;
begin
  RegisterComponents('HomeMade', [TDosMove]);
end;

constructor TDosMove.Create(AOwner : TComponent);
var
  Loop : integer;
begin
  // First check to see no other TDosMove exists on the form
  for Loop := 0 to AOwner.ComponentCount-1 do
    if AOwner.Components[Loop] is TDosMove then
      raise
        EInvalidOperation.Create('TDosMove can have only one instance per form');

  // Create component and set default properties
  inherited Create(AOwner);
  FActive := False;
  FOptions := [moEnter,moUpDn];
  FEditNoBeep := True;
  FIsTabGrid := False;
  FTabGrid := True;
  (AOwner as TForm).KeyPreview := True;
  FEnterColor := clWindow;

  FSelectPageOptions := [ssCtrl];
  FPageControl := nil;
  FOldControl := nil;
  FActiveControlChange := nil;
  FwwDBLookupComboDropDown:=nil;

  FOverWrite := False; //¤ý­§Þ³
  FIsLoad := False;    //¤ý­§Þ³

  FNPClassNames := TStringList.Create;

  FNPClassNames.Add('TPageControl');
  FNPClassNames.Add('TTabControl');
  FNPClassNames.Add('TButton');
  FNPClassNames.Add('TDBGrid');
  FNPClassNames.Add('TBitBtn');
  FNPClassNames.Add('TTabSheet');
  FNPClassNames.Add('TPanel');
  FNPClassNames.Add('TdxLayoutItem');
  FNPClassNames.Add('TdxLayoutControl');
  FNPClassNames.Add('TdxLayoutGroup');
  FNPClassNames.Add('TdxDBGrid');

  FNPClassNames.Sorted := True;
end; // Create


destructor TDosMove.Destroy;
begin
  ActiveColor := False;
  FOldControl := nil;
  FNPClassNames.Free;

  inherited Destroy;
end;
procedure TDosMove.SetWwDBNavigator(nav:TwwDBNavigator);
begin
    gWwDBNavigator:=nav;
end;
procedure TDosMove.SetDataset(ds:Tdataset);
begin
  gDataset:=ds;
end;


procedure TDosMove.wwDBLookupComboDropDown(Sender: TObject);
begin
  try
    TwwDBLookupCombo(Sender).grid.Color:= FEnterColor;
  finally
    if Assigned(FwwDBLookupComboDropDown) then
       //FwwDBLookupComboDropDown(Sender);
  end;
end;
procedure TDosMove.ActiveControlChange(Sender: TObject);
var AControl: TControl;
begin
  try
    if Assigned(Screen) then
    begin
      AControl := Screen.ActiveControl;
      if not (csDesigning in ComponentState) then
        if (AControl <> nil) and
           (AControl is TControl) then
          SetControlColor(AControl);
    end;
    if (AControl <> nil) and (AControl is TwwDBLookupCombo) then begin
        try
            FwwDBLookupComboDropDown := TwwDBLookupCombo(AControl).OnDropDown;
            TwwDBLookupCombo(AControl).OnDropDown := wwDBLookupComboDropDown;
        finally
          if Assigned(FwwDBLookupComboDropDown) then
             FwwDBLookupComboDropDown(AControl);
        end;
    end;

    
  finally
    if Assigned(FActiveControlChange) then
       FActiveControlChange(Sender);
  end;
end;


procedure TDosMove.TabCycle(cmActive: TWinControl;var Key : word);
var i:Integer;
//var max:Integer;
var PropInfo: PPropInfo;
var parent:TWinControl;
var temp:Integer;
var hasBigger:boolean;
var intab:boolean;
var sheet:TTabSheet;
var stop:Integer;
begin
          if (key=VK_RETURN) or (key=VK_DOWN) then begin
              parent:=cmActive;
              intab:=false;
              while assigned(parent) do
              begin
                parent:=parent.Parent;
                if (parent is TTabSheet) then begin
                    sheet:=TTabSheet(parent);
                    intab:=true;
                    break;
                end;
              end;    // while

              parent:=cmActive.Parent;

              if intab then begin
                  hasBigger:=false;

                  for i:=0 to Parent.ControlCount-1 do begin
                      PropInfo := GetPropInfo(Parent.Controls[i].ClassInfo, 'TabOrder');
                      if Assigned(PropInfo) then begin
                        temp:=GetOrdProp(Parent.Controls[i],PropInfo);

                        PropInfo := GetPropInfo(Parent.Controls[i].ClassInfo, 'TabStop');

                        if Assigned(PropInfo) then begin
                            stop:=GetOrdProp(Parent.Controls[i],PropInfo);
                            if (temp>cmActive.TabOrder) and(stop=1)then begin
                                hasBigger:=true;
                                break;
                            end;
                        end;

                      end;
                  end;
                  if not(hasBigger) then begin

                    sheet.PageControl.SelectNextPage(true);
                    while not(sheet.PageControl.ActivePage.Enabled) do begin
                      sheet.PageControl.SelectNextPage(true);
                    end;    // while
                    sheet.PageControl.SetFocus;
                    (owner as TForm).Perform(WM_NEXTDLGCTL, 0, 0);
                    key:=0;
                  end;
              end;
          end;

        //TcxCustomerComboBoxInnerEdit
//
end;


procedure TDosMove.NewKeyDown(Sender : TObject;var Key : word;
  Shift : TShiftState);
var
  cmActive: TWinControl;
  booDropDown: Boolean;
begin

  cmActive := (Owner as TForm).ActiveControl;

  application.Title:=cmActive.ClassName;
  if (cmActive is TDBMemo) then begin
      exit;
  end;
  if not(cmActive is TdxDBGrid) then begin
      //exit;
  end;
  {  if (cmActive.Parent is   TcxDBImage) then begin
      (owner as TForm).Perform(WM_NEXTDLGCTL, 0, 0);
      exit;
  end;
}
  booDropDown := False;
  // Call owner OnKeyDown if it's assigned
  if Assigned(FOwnerKeyDown) then
    FOwnerKeyDown(Sender,Key,Shift);

  if FActive then
  begin
    if Key = vk_Insert then
      FOverWrite := not FOverWrite; //¤ý­§Þ³
    // true if last active control is TCustomEdit and above
    if(cmActive is TcxCustomInnerTextEdit) or
      (cmActive is TcxCustomComboBoxInnerEdit) then begin
       cmActive:=cmActive.Parent;
    end;


    FLastWasEdit := cmActive is TCustomEdit;
    if (FOptions <> []) and (ssCtrl	in	Shift) then begin
        if Assigned(gDataset) then begin
          if gDataset.Active then begin
            if (key=VK_INSERT ) then begin
               gDataset.Insert;
                exit;
            end else if (key=VK_DELETE ) then begin
                if Application.MessageBox(LPSTR(SDeleteRecordQuestion),'§R°£½T»{',MB_YESNO	)=IDYES then begin
                    gdataset.Delete;

                end;
                exit;
            end else if (key=VK_CANCEL) then begin
                gDataset.Cancel;
                exit;
            end;
          end;
        end;
    end;



    if (FOptions <> []) and (Shift = []) then
    begin

        if Assigned(gDataset) then begin
          if gDataset.Active then begin
            if  (key=VK_PRIOR	)	 then begin
               if gDataset.Bof then begin
                gDataset.Last;
               end else begin
                   gDataset.Prior;
                   if gDataset.Bof then begin
                    gDataset.Last;
                   end;
               end;
            end else if (key=VK_NEXT ) then begin
               if gDataset.Eof then begin
                  gDataset.First;
               end else begin
                   gDataset.Next;
                   if gDataset.Eof then begin
                      gDataset.First;
                   end;
               end;
            end;

          end;
        end;

      if (cmActive is TCustomGrid) or (cmActive is TdxDBGrid) then begin
        if (Key = VK_RETURN) and FTabGrid then
        begin
          Key := VK_TAB;
          FIsTabGrid := True;
        end;
      end else begin

        //webber
        TabCycle(cmActive, key);


        if (cmActive is TCustomComboBox) or
           (cmActive is TDBLookupComboBox) or
           (cmActive is TwwDBLookupCombo) or
           (cmActive is TcxDBComboBox) then
        begin
          // §PÂ_¬O§_¤w¸gÅã¥Ü¿ï¶µ




          if (cmActive is TCustomComboBox) then
            booDropDown := TCustomComboBox(cmActive).DroppedDown;
          if (cmActive is TDBLookupComboBox) then
            booDropDown := TDBLookupComboBox(cmActive).ListVisible;
          if (cmActive is TwwDBLookupCombo) then
            booDropDown := TwwDBLookupCombo(cmActive).Grid.Visible;
          if (cmActive is TcxDBComboBox) then
            booDropDown := TcxDBComboBox(cmActive).DroppedDown;;

          if not booDropDown then
          begin
            if (Key = VK_DOWN) or (Key = VK_RETURN) then
            begin
              (Owner as TForm).Perform(WM_NEXTDLGCTL, 0, 0);
              Key := 0;
            end;
            if (Key = VK_UP) then
            begin
              (Owner as TForm).Perform(WM_NEXTDLGCTL, 1, 0);
              Key := 0;
            end;
            if (Key = VK_SPACE) then begin
//                if (cmActive is TCustomComboBox) then
//                  TCustomComboBox(cmActive).DroppedDown;
                if (cmActive is TDBLookupComboBox) then
                  TDBLookupComboBox(cmActive).DropDown;
                if (cmActive is TwwDBLookupCombo) then
                  TwwDBLookupCombo(cmActive).DropDown;
            end;
            
          end else begin
              if (Key = VK_RETURN) then begin
                  if (cmActive is TwwDBLookupCombo) then begin
                      TwwDBLookupCombo(cmActive).Grid.Visible:=false;
                       Key := 0;
                  end;
              end;
          end;
        end else
        begin
          if (cmActive is TCustomListBox) then
          begin
            // ¤è¦VÁä [ <- ] ¤W¤@­Ó¤¸¥ó
            if (Key = VK_LEFT) then
              (Owner as TForm).Perform(WM_NEXTDLGCTL, 1, 0);
            // ¤è¦VÁä [ -> ] ¤U¤@­Ó¤¸¥ó
            if (Key = VK_RIGHT) then
              (Owner as TForm).Perform(WM_NEXTDLGCTL, 0, 0);
          end else
          begin
            // Handle the specials keys
            if ((Key = VK_DOWN) and (moUpDn in FOptions)) or
               ((Key = VK_RETURN) and (moEnter in FOptions)) then
              (Owner as TForm).Perform(WM_NEXTDLGCTL, 0, 0)
            else
              if (Key = VK_UP) and (moUpDn in FOptions) then
                (Owner as TForm).Perform(WM_NEXTDLGCTL, 1, 0);

            //¤ý­§Þ³
            if (FOverWrite) and
               (TCustomEdit((Owner as TForm).ActiveControl).SelLength = 0) and
               (TCustomEdit((Owner as TForm).ActiveControl).SelStart <
                TCustomEdit((Owner as TForm).ActiveControl).GetTextLen) and
               (Key <> vk_Return) and (Key <> vk_Up) and (Key <> vk_Down) and
               (Key <> vk_Left) and (Key <> vk_Right) and (Key <> vk_Insert) and
               (Key <> vk_Back) then
            begin
              //TCustomEdit((Owner as TForm).ActiveControl).SelLength := 1;
              if Msg.CharCode > 127 then
                 TCustomEdit((Owner as TForm).ActiveControl).SelLength := 2
              else
              begin
                TCustomEdit((Owner as TForm).ActiveControl).SelLength := 2;
                { if char on current Caret positon is a Chinese word }
                if Ord(TCustomEdit((Owner as TForm).ActiveControl).SelText[1]) > 127 then
                   TCustomEdit((Owner as TForm).ActiveControl).SelLength := 2
                else
                   TCustomEdit((Owner as TForm).ActiveControl).SelLength := 1;
                end;
            end;
          end;
        end;
      end;
    end else
    begin
      if Assigned(PageControl) and (FSelectPageOptions = Shift) then
      begin
        if (Key >= 49) and (Key <= 57) then
          PageControl.ActivePageIndex := (Key - 49);

        if (Key = 192) then
        begin
          // ´`Àô¤Á´«­¶­±
          if (PageControl.ActivePageIndex + 1)
             < PageControl.ControlCount then
            PageControl.ActivePageIndex := PageControl.ActivePageIndex + 1
          else
            PageControl.ActivePageIndex := 0;
        end;
      end;
    end; // if Options<>[] ...

  end; // if FActive ...

end; // NewKeyDown

//-----------------------------------------------------------------------------
procedure TDosMove.NewKeyPress(Sender : TObject;var Key : char);
begin
  // Call owner OnKeyPress if it's assigned
  if Assigned(FOwnerKeyPress) then
    FOwnerKeyPress(Sender, Key);

  // Handle 'Enter' key that makes Edits beep
  if FActive then
  begin
    if FEditNoBeep and
       FLastWasEdit and
       (Key = #13) then
      Key := #0;

    if FIsTabGrid then
    begin
      FIsTabGrid := False;
      Key := #0;
    end;
  end; // if FActive ...
  
end; // NewKeyPress

procedure TDosMove.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) then
    if (AComponent = PageControl) then
      PageControl := nil;
end;

procedure TDosMove.SetActive(const Value: boolean);
begin
  FActive := Value;
  SetKeyEvent;
end;

procedure TDosMove.SetActiveColor(const Value: boolean);
begin
  if (FActiveColor <> Value) then
  begin
    FActiveColor := Value;
    if FActiveColor then
    begin
      if Assigned(Screen) then
      begin
        FActiveControlChange := Screen.OnActiveControlChange;
        Screen.OnActiveControlChange := ActiveControlChange;
      end;
    end else
      Screen.OnActiveControlChange := FActiveControlChange;
  end;
end;

procedure TDosMove.SetKeyEvent;
begin
  // Intercept with OnKeyDown event and OnKeyPress event of 'Owner'

  // Run Time
  if not (csDesigning in ComponentState) then
  begin
    if FActive then
    begin
      // ³]©w
      FOwnerKeyDown := (Self.Owner as TForm).OnKeyDown;
      (Self.Owner as TForm).OnKeyDown := NewKeyDown;
      FOwnerKeyPress := (Self.Owner as TForm).OnKeyPress;
      (Self.Owner as TForm).OnKeyPress := NewKeyPress;
    end else
    begin
      // ÁÙ­ì
      (Self.Owner as TForm).OnKeyDown := FOwnerKeyDown;
      (Self.Owner as TForm).OnKeyPress := FOwnerKeyPress;
    end;
  end;
end;

procedure TDosMove.SetSelectPageOptions(const Value: TShiftState);
begin
  // ¤@¦¸¥u¯à¿ï¤@­Ó
  FSelectPageOptions := Value - FSelectPageOptions;
end;

procedure TDosMove.SetTabGrid(const Value: Boolean);
begin
  FTabGrid := Value;
end;

procedure TDosMove.SetControlColor(AControl: TControl);
  function CanProcessClassNames(FromClassName: String): Boolean;
  var i: Integer;
  begin
    //FNPClassNames.Find(FromClassName, i);
    i:=FNPClassNames.IndexOf(FromClassName);
    //Result := (i > 0);
    Result := (i = -1);
  end;
begin
  if Assigned(AControl) then
  begin
    if Assigned(FOldControl) then begin
        //
        if (FOldControl.Parent is TcxDBComboBox) then begin
            TcxDBComboBox(FOldControl.Parent).Style.Color:=FOldColor;
        end else if (FOldControl.Parent is TcxDBButtonEdit) then begin
            TcxDBButtonEdit(FOldControl.Parent).Style.Color:=FOldColor;
        end else if (FOldControl is TwwDBLookupCombo) then begin
            TwwDBLookupCombo(FOldControl).Color:=FOldColor;
            TwwDBLookupCombo(FOldControl).Grid.Color:=FOldColor;
        end else begin
            TDosMoveControl(FOldControl).Color := FOldColor;
        end;
    end;

    if CanProcessClassNames(AControl.ClassName)
        and FActiveColor
        //and AControl.Enabled
        //and (AControl.ClassName<>'TPageControl')
        //and (AControl.ClassName<>'TTabSheet')
        then
    begin

        if (AControl.Parent is TcxDBComboBox) then begin
            FOldControl := AControl;
            FOldColor := TcxDBComboBox(AControl.Parent).Style.Color;
            TcxDBComboBox(AControl.Parent).Style.Color := FEnterColor;
        end else if (AControl.Parent is TcxDBButtonEdit) then begin
            FOldControl := AControl;
            FOldColor := TcxDBButtonEdit(AControl.Parent).Style.Color;
            TcxDBButtonEdit(AControl.Parent).Style.Color := FEnterColor;
        end else if (AControl is TwwDBLookupCombo) then begin
            FOldControl := AControl;
            FOldColor := TwwDBLookupCombo(AControl).Color;
            TwwDBLookupCombo(AControl).Color := FEnterColor;
            TwwDBLookupCombo(AControl).grid.Color:= FEnterColor;

        end else begin
            FOldControl := AControl;
            FOldColor := TDosMoveControl(AControl).Color;
            TDosMoveControl(AControl).Color := FEnterColor;
        end;
    end else
    begin
      FOldControl := nil;
    end;
  end;
end;

procedure TDosMove.SetNPClassNames(const Value: TStringList);
begin
  FNPClassNames.Assign(Value);
end;

end.