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

unit Un_frmDBGridEditDate;

interface

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

type
  TfrmDBGridEditDate = class(TForm)
    sgDays: TStringGrid;
    lMonth: TLabel;
    btnNextMonth: TSpeedButton;
    btnSelectMonth: TSpeedButton;
    btnNextYear: TSpeedButton;
    btnSelectYear: TSpeedButton;
    btnPriorMonth: TSpeedButton;
    btnPriorYear: TSpeedButton;
    pmSelectMonth: TPopupMenu;
    N01: TMenuItem;
    N02: TMenuItem;
    N03: TMenuItem;
    N04: TMenuItem;
    N05: TMenuItem;
    N06: TMenuItem;
    N07: TMenuItem;
    N08: TMenuItem;
    N09: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    pmSelectYear: TPopupMenu;
    N1998: TMenuItem;
    N1999: TMenuItem;
    N2000: TMenuItem;
    N2001: TMenuItem;
    N2002: TMenuItem;
    N2003: TMenuItem;
    shLeftLine: TShape;
    shRightLine: TShape;
    shTopLine: TShape;
    shBottomLine: TShape;
    tmrChangeTime: TTimer;
    pOk: TPanel;
    btnToday: TSpeedButton;
    btnOk: TSpeedButton;
    pClock: TPanel;
    lHoure: TLabel;
    Label2: TLabel;
    lMinets: TLabel;
    Image1: TImage;
    Image2: TImage;
    Image3: TImage;
    Image4: TImage;
    btnMinetsDown: TSpeedButton;
    btnHoureDown: TSpeedButton;
    btnHoureUp: TSpeedButton;
    btnMinetsUp: TSpeedButton;
    procedure SetToday(Sender: TObject);
    procedure sgDaysDrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure FillDays(Sender: TObject);
    procedure sgDaysSelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure FormShow(Sender: TObject);
    procedure btnNextMonthClick(Sender: TObject);
    procedure btnPriorMonthClick(Sender: TObject);
    procedure btnNextYearClick(Sender: TObject);
    procedure btnPriorYearClick(Sender: TObject);
    procedure SelectMonth(Sender: TObject);
    procedure SetMonth(Sender: TObject);
    procedure SelectYear(Sender: TObject);
    procedure SetYear(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnOkClick(Sender: TObject);
    procedure ChangeTime(Sender: TObject);
    procedure StartTimer(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure StopTimer(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ChangeTimeByTimer(Sender: TObject);
  private
     FDate:TDate;
     FMonth:Word;
     FYear:Word;
     FDay:Word;
     FControl: TDBGrid;
     FControlHandle: HWND;
     FOnChangeField:TFieldNotifyEvent;
     FOnStateChange:TNotifyEvent;
     FTime: TTime;
     FWithClock: Boolean;
     procedure SetControl(const Value: TDBGrid);
     procedure OnChangeField(Sender: TField);
     procedure OnStateChange(Sender:TObject);
     procedure RestoreEvents;
     procedure SetDate(const Value: TDate);
     procedure SendToControl;
     procedure SendDateToControl(ADate: TDate);
     procedure SendTimeToControl(ATime: TTime);
     procedure SetTime(const Value: TTime);
     procedure SetWithClock(const Value: Boolean);
//     procedure RebuildWindowRgn;
  public
     property WithClock:Boolean read FWithClock write SetWithClock;
     constructor Create(AOwner: TComponent);override;
     property SelectedDate:TDate read FDate write SetDate;
     property SelectedTime:TTime read FTime write SetTime;
     property Control:TDBGrid read FControl write SetControl;
     procedure Show;
  end;

procedure ShowDateEditor(AGrid:TDBGrid;AWithClock:Boolean=False);

implementation

uses
   DateUtil;

var
   Hook:HHOOK;
   AForm:TfrmDBGridEditDate;

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;


{$R *.DFM}

procedure ShowDateEditor(AGrid:TDBGrid;AWithClock:Boolean=False);
var
   Y,M,D,H,N,S,mS:Word;
begin
   if Assigned(AForm) then begin
      Beep;
      Exit;
      //Raise Exception.Create('ShowDateEditor:Модуль уже используется');
   end;
   AForm:=TfrmDBGridEditDate.Create(AGrid);
   with AForm do begin
      Control:=AGrid;
      WithClock:=AWithClock;
      Show;
      if (AGrid.SelectedField.AsDateTime > 0) then
      begin
        DecodeDate(AGrid.SelectedField.AsDateTime,Y,M,D);
        DecodeTime(AGrid.SelectedField.AsDateTime,H,N,S,mS);
      end else
      begin
        DecodeDate(Date,Y,M,D);
        DecodeTime(Date,H,N,S,mS);
      end;
      SelectedDate:=EncodeDate(Y,M,D);
      SelectedTime:=EncodeTime(H,N,0,0);
//      Show;
   end;
end;

procedure TfrmDBGridEditDate.SendDateToControl(ADate:TDate);
var
   sBuf:string;
   I:Integer;
   ALength:Integer;
begin
   ALength:=GetWindowTextLength(FControlHandle);
   SendMessage(FControlHandle, EM_SETSEL, 0, ALength);
   SendMessage(FControlHandle, WM_CHAR, 8, 0);
   sBuf:=DateToStr(ADate);
   for I:=1 to Length(sBuf) do
      SendMessage(FControlHandle,WM_CHAR,Ord(sBuf[I]),0);
   Windows.SetFocus(FControlHandle);
end;

procedure TfrmDBGridEditDate.SetDate(const Value: TDate);
var
   ARow,ACol,LastDay,ADay,AMonth,AYear:Word;
   CurDate:TDate;
begin
   FDate:=Value;
   lMonth.Caption:=FormatDateTime('mmmm ( mm ) ,yyyy',FDate);
   SendToControl;
   with sgDays do begin
     //Очистка грида
     for ARow:=1 to RowCount-1 do
        Rows[ARow].Clear;
     DecodeDate(FDate,AYear,AMonth,ADay);
     FDay:=ADay;
     FMonth:=AMonth;
     FYear:=AYear;
     ADay:=1;
     CurDate:=EncodeDate(AYear,AMonth,1);
     ACol:=(DayOfWeek(CurDate)+5) mod 7;
     ARow:=1;
     LastDay:=0;
     while (ARow<=6) do begin
       while (ACol<=6) do begin
          Cells[ACol,ARow]:=IntToStr(ADay);
          if CurDate=FDate then begin
             OnSelectCell:=nil;
             Row:=ARow;
             Col:=ACol;
             OnSelectCell:=sgDaysSelectCell;
          end;
          CurDate:=IncDay(CurDate,1);
          Inc(ACol);
          LastDay:=ADay;
          DecodeDate(CurDate,AYear,AMonth,ADay);
          if (LastDay>ADay) then Break;
       end;
       if (LastDay>ADay) then Break;
       ACol:=0;
       Inc(ARow);
     end;
   end;
end;

procedure TfrmDBGridEditDate.SetToday(Sender: TObject);
begin
   if SelectedDate=Date then
      Close
   else SelectedDate:=Date;
end;

procedure TfrmDBGridEditDate.sgDaysDrawCell(Sender: TObject; ACol,
  ARow: Integer; Rect: TRect; State: TGridDrawState);
begin
   with sgDays,sgDays.Canvas do begin
      if (ACol in [5,6]) then
         Font.Color :=clRed;
      if gdSelected in State then begin
         Brush.Color:=clMenu;
         Font.Color:=clWhite;
      end;
      FillRect(Rect);
      if (ARow>0)and(Cells[ACol,ARow]<>'')and(Date=EncodeDate(FYear,FMonth,StrToInt(Cells[ACol,ARow]))) then
         Font.Style:=Font.Style+[fsBold];
      TextOut(Rect.Right-TextWidth(Cells[ACol,ARow])-2,Rect.Top+2,Cells[ACol,ARow]);
      if (ARow in [0,6]) then begin
         Pen.Color:=clBlack;
         MoveTo(Rect.Left,Rect.Bottom);
         LineTo(Rect.Right+1,Rect.Bottom);
      end;
   end;
end;

procedure TfrmDBGridEditDate.FillDays(Sender: TObject);
begin
   with sgDays do begin
     Cells[0,0]:='Пн';
     Cells[1,0]:='Вт';
     Cells[2,0]:='Ср';
     Cells[3,0]:='Чт';
     Cells[4,0]:='Пт';
     Cells[5,0]:='Сб';
     Cells[6,0]:='Вс';
   end;
end;

procedure TfrmDBGridEditDate.sgDaysSelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
begin
   with sgDays do begin
     CanSelect:=(ARow>0)and(Cells[ACol,ARow]<>'');
     if CanSelect then begin
        FDay:=StrToInt(Cells[ACol,ARow]);
        FDate:=EncodeDate(FYear,FMonth,FDay);
        SendToControl;
     end;
   end;
end;

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

procedure TfrmDBGridEditDate.btnNextMonthClick(Sender: TObject);
begin
   SelectedDate:=IncMonth(SelectedDate,1);
   Windows.SetFocus(FControlHandle);
end;

procedure TfrmDBGridEditDate.btnPriorMonthClick(Sender: TObject);
begin
   SelectedDate:=IncMonth(SelectedDate,-1);
   Windows.SetFocus(FControlHandle);
end;

procedure TfrmDBGridEditDate.btnNextYearClick(Sender: TObject);
begin
   SelectedDate:=IncYear(SelectedDate,1);
   Windows.SetFocus(FControlHandle);
end;

procedure TfrmDBGridEditDate.btnPriorYearClick(Sender: TObject);
begin
   SelectedDate:=IncYear(SelectedDate,-1);
   Windows.SetFocus(FControlHandle);
end;

procedure TfrmDBGridEditDate.SelectMonth(Sender: TObject);
begin
   pmSelectMonth.Popup(Mouse.CursorPos.X,Mouse.CursorPos.Y);
   Windows.SetFocus(FControlHandle);
end;

procedure TfrmDBGridEditDate.SetMonth(Sender: TObject);
var
   ADay,AMonth,AYear:Word;
begin
   DecodeDate(FDate,AYear,AMonth,ADay);
   AMonth:=StrToInt(Copy((Sender as TMenuItem).Name,2,2));
   SelectedDate:=EncodeDate(AYear,AMonth,ADay);
end;

procedure TfrmDBGridEditDate.SelectYear(Sender: TObject);
begin
   pmSelectYear.Popup(Mouse.CursorPos.X,Mouse.CursorPos.Y);
   Windows.SetFocus(FControlHandle);
end;

procedure TfrmDBGridEditDate.SetYear(Sender: TObject);
var
   ADay,AMonth,AYear:Word;
begin
   DecodeDate(FDate,AYear,AMonth,ADay);
   AYear:=StrToInt(Copy((Sender as TMenuItem).Name,2,4));
   SelectedDate:=EncodeDate(AYear,AMonth,ADay);
end;

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

{procedure TfrmGridEditDate.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 TfrmDBGridEditDate.FormClose(Sender: TObject;var Action: TCloseAction);
begin
   Action:=caFree;
   RestoreEvents;
   UnhookWindowsHookEx(Hook);
   AForm:=nil;
end;

procedure TfrmDBGridEditDate.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
         //Заменяем события для того,чтобы калькулятор убирался при вводе с клавиатуры
         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;
      end;
   end
  else Raise Exception.Create('Должна быть ссылка на объект');
end;

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

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

procedure TfrmDBGridEditDate.RestoreEvents;
begin
   with FControl do begin
      SelectedField.OnChange:=FOnChangeField;
      DataSource.OnStateChange:=FOnStateChange;
   end;
end;

procedure TfrmDBGridEditDate.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 TfrmDBGridEditDate.btnOkClick(Sender: TObject);
begin
   Close;
end;

procedure TfrmDBGridEditDate.ChangeTime(Sender: TObject);
  function GetMinCount:Integer;
  begin
    if Sender=btnHoureUp then
       Result:=60
    else if Sender=btnHoureDown then
       Result:=-60
    else if Sender=btnMinetsUp then
       Result:=1
    else if Sender=btnMinetsDown then
       Result:=-1
    else Raise Exception.Create('TfrmGridEditDate.ChangeTime:Неправильный параметр');
  end;
begin
   SelectedTime:=IncMinute(SelectedTime,GetMincount);
end;

procedure TfrmDBGridEditDate.SetTime(const Value: TTime);
var
  AHoure,AMinets,ASeconds,AMili:Word;
begin
  FTime := Value;
  DecodeTime(FTime,AHoure,AMinets,ASeconds,AMili);
  lHoure.Caption:=Format('%.2d',[AHoure]);
  lMinets.Caption:=Format('%.2d',[AMinets]);
  SendToControl;
end;

procedure TfrmDBGridEditDate.SendTimeToControl(ATime: TTime);
var
   sBuf:string;
   I:Integer;
begin
  if FWithClock then begin
    sBuf:='  '+FormatDateTime('hh:nn',ATime);
    for I:=1 to Length(sBuf) do
       SendMessage(FControlHandle,WM_CHAR,Ord(sBuf[I]),0);
    Windows.SetFocus(FControlHandle);
  end;
end;

procedure TfrmDBGridEditDate.SendToControl;
begin
   SendDateToControl(FDate);
   SendTimeToControl(FTime);
end;

procedure TfrmDBGridEditDate.SetWithClock(const Value: Boolean);
begin
  FWithClock := Value;
  if FWithClock then
   begin
      Height:=211;
      pClock.Top:=145;
      pOk.Top:=185;
   end
  else begin
     Height:=170;
     pClock.Top:=172;
     pOk.Top:=145;
  end;
end;

procedure TfrmDBGridEditDate.StartTimer(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
   with tmrChangeTime do begin
      Interval:=500;
      Enabled:=True;
      Tag:=Integer(Sender);
   end;
end;

procedure TfrmDBGridEditDate.StopTimer(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   tmrChangeTime.Enabled:=False;
end;

procedure TfrmDBGridEditDate.ChangeTimeByTimer(Sender: TObject);
begin
   tmrChangeTime.Interval:=100;
   ChangeTime(TObject(tmrChangeTime.Tag));
end;

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