Редактор данных в DBGrid -> Un

unit Un_frmDBGridEditNum;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Buttons,db,Grids, DBGrids, ExtCtrls;

type
  TfrmDBGridEditNum = class(TForm)
    btn7: TSpeedButton;
    btn8: TSpeedButton;
    btn9: TSpeedButton;
    btnBack: TSpeedButton;
    btnClear: TSpeedButton;
    btnRevers: TSpeedButton;
    btnSetValue: TSpeedButton;
    btnSeparator: TSpeedButton;
    btnSign: TSpeedButton;
    btn0: TSpeedButton;
    btn1: TSpeedButton;
    btn4: TSpeedButton;
    btn5: TSpeedButton;
    btn6: TSpeedButton;
    btn3: TSpeedButton;
    btn2: TSpeedButton;
    shLeftLine: TShape;
    shTopLine: TShape;
    shRightLine: TShape;
    shBottomLine: TShape;
    sh7: TShape;
    sh8: TShape;
    sh9: TShape;
    sh4: TShape;
    sh5: TShape;
    sh6: TShape;
    sh1: TShape;
    sh2: TShape;
    sh3: TShape;
    sh0: TShape;
    shSign: TShape;
    shSeparator: TShape;
    shBack: TShape;
    shClear: TShape;
    shRevers: TShape;
    shSetValue: TShape;
    tmrActivateGrid: TTimer;
    procedure AddChar(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ChangeSign(Sender: TObject);
    procedure AddSeparator(Sender: TObject);
    procedure ClearValue(Sender: TObject);
    procedure DeleteChar(Sender: TObject);
    procedure ReversValue(Sender: TObject);
    procedure SetValue(Sender: TObject);
    procedure ActivateGrid(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
     FControlHandle: HWND;
     FControl: TDBGrid;
     FOnChangeField:TFieldNotifyEvent;
     FOnStateChange:TNotifyEvent;
     property ControlHandle:HWND read FControlHandle write FControlHandle;
     procedure SetControl(const Value: TDBGrid);
     procedure OnChangeField(Sender: TField);
     procedure OnStateChange(Sender:TObject);
     procedure RestoreEvents;
     procedure RebuildWindowRgn;
  protected
     procedure Resize; override;
  public
     constructor Create(AOwner: TComponent);override;
     property Control:TDBGrid read FControl write SetControl;
     procedure Show;
  end;

procedure ShowCalc(AGrid:TDBGrid);

implementation

uses Mask;

var
   Hook:HHOOK;
   AForm:TfrmDBGridEditNum;

function KeyboardProc(Code:Integer;_WParam:WParam;_LParam:LParam):LResult;stdcall;
begin
   if _WParam=VK_ESCAPE then
      AForm.Close;
   Result:=CallNextHookEx(Hook,Code,_wParam,_LParam);
end;
   
procedure ShowCalc(AGrid:TDBGrid);
begin
   if Assigned(AForm) then begin
      Beep;
      Exit;
      //Raise Exception.Create('ShowCalc:Модуль уже используется');
   end;
   AForm:=TfrmDBGridEditNum.Create(AGrid);
   with AForm do begin
      Control:=AGrid;
      Show;
   end;
end;

{$R *.DFM}

{ TForm3 }

procedure TfrmDBGridEditNum.Show;
var
   R:TRect;
begin
   GetWindowRect(FControlHandle,R);
   if (R.Bottom+Height+2<=Screen.Height) then
     Top:=R.Bottom+1
   else Top:=R.Top-Height-1;
   if (R.Left+Width+2<=Screen.Width) then
    begin
       Left:=R.Left+1;
       if (Left<0) then
          Left:=1;
    end
   else Left:=Screen.Width-Width;
   inherited Show;
end;

procedure TfrmDBGridEditNum.AddChar(Sender: TObject);
begin
   SendMessage(FControlHandle,WM_CHAR,Ord((Sender as TSpeedButton).Caption[1]),0);
   Windows.SetFocus(FControlHandle);
end;

procedure TfrmDBGridEditNum.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   Action:=caFree;
   RestoreEvents;
   UnhookWindowsHookEx(Hook);
   AForm:=nil;
end;

procedure TfrmDBGridEditNum.SetControl(const Value: TDBGrid);
begin
  FControl := Value;
  if FControl<>nil then
   begin
      FControlHandle:=GetTopWindow(FControl.Handle);
      if FControlHandle=0 then
         Raise Exception.Create('Grid не в режиме редактирования');
      if Assigned(FControl.DataSource)and Assigned(FControl.DataSource.DataSet) then begin
         if (FControl.SelectedField.DataType in [ftSmallint,ftInteger,ftLargeInt]) then begin
            btnSeparator.Enabled:=False;
            btnRevers.Enabled:=False;
         end;
         //Заменяем события для того,чтобы калькулятор убирался при вводе с клавиатуры
         FOnChangeField:=FControl.SelectedField.OnChange;
         FControl.SelectedField.OnChange:=OnChangeField;
         //Надо установить режим редактирования,чтобы калькулятор закрылся по Esc
         if not(FControl.DataSource.DataSet.State in [dsEdit,dsInsert]) then
            FControl.DataSource.DataSet.Edit;
         FOnStateChange:=FControl.DataSource.OnStateChange;
         FControl.DataSource.OnStateChange:=OnStateChange;
         //Надо изменить содержимое,чтобы при переходе в другое место закрылась форма
         SendMessage(FControlHandle,WM_CHAR,Ord('0'),0);
         SendMessage(FControlHandle,WM_CHAR,8,0);
      end;
   end
  else Raise Exception.Create('Должна быть ссылка на объект');
end;

procedure TfrmDBGridEditNum.OnChangeField(Sender: TField);
begin
   if Assigned(FOnChangeField) then
      FOnChangeField(FControl.SelectedField);
   Close;
end;

procedure TfrmDBGridEditNum.ChangeSign(Sender: TObject);
var
   AText:string;
   ALength:Integer;
begin
   ALength:=GetWindowTextLength(FControlHandle);
   SetLength(AText,ALength+1);
   try
      GetWindowText(FControlHandle,PChar(AText),ALength+1);
      if (AText='')or(AText[1]<>'-') then
       begin //Добавляем минус
          SendMessage(FControlHandle, EM_SETSEL, 0, 0);
          SendMessage(FControlHandle, WM_CHAR, Ord('-'), 0);
          SendMessage(FControlHandle, EM_SETSEL, ALength+1, ALength+1);
       end
      else if (AText<>'') then
       begin //Удаляем минус
          SendMessage(FControlHandle, EM_SETSEL, 1, 1);
          SendMessage(FControlHandle, WM_CHAR, 8, 0);
          SendMessage(FControlHandle, EM_SETSEL, ALength, ALength);
       end;
   finally
      Windows.SetFocus(FControlHandle);
   end;
end;

procedure TfrmDBGridEditNum.AddSeparator(Sender: TObject);
var
   AText:string;
   ALength:Integer;
begin
   ALength:=GetWindowTextLength(FControlHandle);
   SetLength(AText,ALength+1);
   try
      GetWindowText(FControlHandle,PChar(AText),ALength+1);
      if Pos(Decimalseparator,AText)=0 then
       begin //Добавляем разделитель
          SendMessage(FControlHandle, WM_CHAR, Ord(DecimalSeparator), 0);
       end;
   finally
      Windows.SetFocus(FControlHandle);
   end;
end;

procedure TfrmDBGridEditNum.ClearValue(Sender: TObject);
var
   ALength:Integer;
begin
   ALength:=GetWindowTextLength(FControlHandle);
   SendMessage(FControlHandle, EM_SETSEL, 0, ALength);
   SendMessage(FControlHandle, WM_CHAR, 8, 0);
   Windows.SetFocus(FControlHandle);
end;

procedure TfrmDBGridEditNum.DeleteChar(Sender: TObject);
begin
   SendMessage(FControlHandle, WM_CHAR, 8, 0);
   Windows.SetFocus(FControlHandle);
end;

procedure TfrmDBGridEditNum.ReversValue(Sender: TObject);
var
   AText:string;
   ALength,I:Integer;
begin
   ALength:=GetWindowTextLength(FControlHandle);
   SetLength(AText,ALength+1);
   try
      GetWindowText(FControlHandle,PChar(AText),ALength+1);
      if (AText<>'')and(StrToFloat(AText)<>0) then begin
          SendMessage(FControlHandle, EM_SETSEL, 0, ALength+1);
          SendMessage(FControlHandle, WM_CHAR, 8, 0);
          AText:=FloatToStr(1/StrToFloat(AText));
          for I:=1 to Length(AText) do
             SendMessage(FControlHandle, WM_CHAR, Ord(AText[I]), 0);
      end;
   finally
      Windows.SetFocus(FControlHandle);
   end;
end;

procedure TfrmDBGridEditNum.SetValue(Sender: TObject);
begin
   RestoreEvents;
   Hide;
   SendMessage(FControlHandle, WM_CHAR, 13, 0);
   Close;
end;

procedure TfrmDBGridEditNum.RebuildWindowRgn;
var
  FullRgn, Rgn: THandle;
  ClientX, ClientY, I: Integer;
begin
  // определяем относительные координаты клиентской части
  ClientX:= (Width - ClientWidth) div 2;
  ClientY:= Height - ClientHeight - ClientX;
  FullRgn:= CreateRectRgn(0, 0, Width, Height); // создаем регион для всей формы
  // создаем регион для клиентской части формы и вычитаем его из FullRgn
  Rgn:= CreateRectRgn(ClientX, ClientY, ClientX + ClientWidth, ClientY +ClientHeight);
  CombineRgn(FullRgn, FullRgn, Rgn, rgn_Diff);
  // теперь добавляем к FullRgn регионы каждого контрольного элемента
  for I:= 0 to ControlCount -1 do
   with Controls[I] do begin
     Rgn:= CreateRectRgn(ClientX + Left, ClientY + Top, ClientX + Left +Width, ClientY + Top + Height);
     CombineRgn(FullRgn, FullRgn, Rgn, rgn_Or);
   end;
  SetWindowRgn(Handle, FullRgn, True); // устанавливаем новый регион окна
end;

procedure TfrmDBGridEditNum.Resize;
begin
  inherited;
  RebuildWindowRgn; // строим новый регион
end;

constructor TfrmDBGridEditNum.Create(AOwner: TComponent);
begin
  inherited;
  HorzScrollBar.Visible:= False; // убираем сколлбары, чтобы не мешались
  VertScrollBar.Visible:= False; // при изменении размеров формы
  RebuildWindowRgn; // строим новый регион
end;

procedure TfrmDBGridEditNum.OnStateChange(Sender: TObject);
begin
   if Assigned(FOnStateChange) then
      FOnStateChange(FControl.DataSource);
   Close;
end;

procedure TfrmDBGridEditNum.RestoreEvents;
begin
   FControl.SelectedField.OnChange:=FOnChangeField;
   FControl.DataSource.OnStateChange:=FOnStateChange;
end;

procedure TfrmDBGridEditNum.ActivateGrid(Sender: TObject);
var
   ALength:Integer;
begin
   //Это событие должно сработать один раз при создании формы
   tmrActivateGrid.Enabled:=False;
   Windows.SetFocus(FControlHandle);
   ALength:=GetWindowTextLength(FControlHandle);
   SendMessage(FControlHandle, EM_SETSEL, 0, ALength);
end;

procedure TfrmDBGridEditNum.FormShow(Sender: TObject);
begin
   //Устанавливаем ловушку
   Hook:=SetWindowsHookEx(WH_KEYBOARD,KeyboardProc,0,GetCurrentThreadID);
   if Hook=0 then
      ShowMessage('Ловушка не установлена');
end;

end.
Сайт управляется системой uCoz