tntjvdbgrids.pas

TntExUpdate 是 流行的 TntUnicodeControls控件的扩展包.包括很难找到的 TntJVCL 也在里面. TntSysUtils2.pas/TntSysUtilsEx.pa

end;

function TTntDBGridInplaceEdit.GetText: WideString;
begin
  Result := TntControl_GetText(Self);
end;

procedure TTntDBGridInplaceEdit.SetText(const Value: WideString);
begin
  TntControl_SetText(Self, Value);
end;

procedure TTntDBGridInplaceEdit.WMSetText(var Message: TWMSetText);
begin
  if (not FBlockSetText) then
    inherited;
end;

procedure TTntDBGridInplaceEdit.UpdateContents;
var
  Grid: TTntJvCustomDBGridS;
begin
  Grid := Self.Grid as TTntJvCustomDBGridS;
  EditMask  := Grid.GetEditMask(Grid.Col, Grid.Row);
  Text      := Grid.GetEditText(Grid.Col, Grid.Row);
  MaxLength := Grid.GetEditLimit;

  FBlockSetText := True;
  try
    inherited;
  finally
    FBlockSetText := False;
  end;
end;

procedure TTntDBGridInplaceEdit.DblClick;
begin
  FInDblClick := True;
  try
    inherited;
  finally
    FInDblClick := False;
  end;
end;

{ TTntGridDataLink }

procedure TTntGridDataLink.GridUpdateFieldText(Sender: TField; const Text: AnsiString);
begin
  Sender.OnSetText := OriginalSetText;
  if Assigned(Sender) then
    SetWideText(Sender, (Grid as TTntJvCustomDBGridS).FEditText);
end;

procedure TTntGridDataLink.RecordChanged(Field: TField);
var
  CField: TField;
begin
  inherited;
  if Grid.HandleAllocated then begin
    CField := Grid.SelectedField;
    if ((Field = nil) or (CField = Field)) and
      (Assigned(CField) and (GetWideText(CField) <> (Grid as TTntJvCustomDBGridS).FEditText)) then
    begin
      with (Grid as TTntJvCustomDBGridS) do begin
        InvalidateEditor;
        if InplaceEditor <> nil then InplaceEditor.Deselect;
      end;
    end;
  end;
end;

procedure TTntGridDataLink.UpdateData;
var
  Field: TField;
begin
  Field := (Grid as TTntJvCustomDBGridS).SelectedField;
  // remember "set text"
  if Field <> nil then
    OriginalSetText := Field.OnSetText;
  try
    // redirect "set text" to self
    if Field <> nil then
      Field.OnSetText := GridUpdateFieldText;
    inherited; // clear modified !
  finally
    // redirect "set text" to field
    if Field <> nil then
      Field.OnSetText := OriginalSetText;
    // forget original "set text"
    OriginalSetText := nil;
  end;
end;

{ TTntDBGridColumns }

function TTntDBGridColumns.Add: TTntColumn;
begin
  Result := inherited Add as TTntColumn;
end;

function TTntDBGridColumns.GetColumn(Index: Integer): TTntColumn;
begin
  Result := inherited Items[Index] as TTntColumn;
end;

procedure TTntDBGridColumns.SetColumn(Index: Integer; const Value: TTntColumn);
begin
  inherited Items[Index] := Value;
end;

//============================================================================

constructor TJvCustomDBGrid0.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FHintColor := clDefault;
end;

function TJvCustomDBGrid0.BaseWndProc(Msg: Integer; WParam: Integer = 0; LParam: Integer = 0): Integer;
var
  Mesg: TMessage;
begin
  Mesg.Msg := Msg;
  Mesg.WParam := WParam;
  Mesg.LParam := LParam;
  Mesg.Result := 0;
  inherited WndProc(Mesg);
  Result := Mesg.Result;
end;

procedure TJvCustomDBGrid0.VisibleChanged;
begin
  BaseWndProc(CM_VISIBLECHANGED);
end;

procedure TJvCustomDBGrid0.EnabledChanged;
begin
  BaseWndProc(CM_ENABLEDCHANGED);
end;

procedure TJvCustomDBGrid0.TextChanged;
begin
  BaseWndProc(CM_TEXTCHANGED);
end;

procedure TJvCustomDBGrid0.FontChanged;
begin
  BaseWndProc(CM_FONTCHANGED);
end;

procedure TJvCustomDBGrid0.ColorChanged;
begin
  BaseWndProc(CM_COLORCHANGED);
end;

procedure TJvCustomDBGrid0.ParentFontChanged;
begin
  BaseWndProc(CM_PARENTFONTCHANGED);
end;

procedure TJvCustomDBGrid0.ParentColorChanged;
begin
  BaseWndProc(CM_PARENTCOLORCHANGED);
  if Assigned(OnParentColorChange) then
    OnParentColorChange(Self);
end;

procedure TJvCustomDBGrid0.ParentShowHintChanged;
begin
  BaseWndProc(CM_PARENTSHOWHINTCHANGED);
end;

function TJvCustomDBGrid0.WantKey(Key: Integer; Shift: TShiftState; const KeyText: WideString): Boolean;
begin
  Result := BaseWndProc(CM_DIALOGCHAR, Word(Key), ShiftStateToKeyData(Shift)) <> 0;
end;

function TJvCustomDBGrid0.HitTest(X, Y: Integer): Boolean;
begin
  Result := BaseWndProc(CM_HITTEST, 0, Integer(PointToSmallPoint(Point(X, Y)))) <> 0;
end;

function TJvCustomDBGrid0.HintShow(var HintInfo: THintInfo): Boolean;
begin
  GetHintColor(HintInfo, Self, FHintColor);
  Result := BaseWndProc(CM_HINTSHOW, 0, Integer(@HintInfo)) <> 0;
end;

procedure TJvCustomDBGrid0.MouseEnter(AControl: TControl);
begin
  FMouseOver := True;
  {$IFDEF VCL}
  if Assigned(FOnMouseEnter) then
    FOnMouseEnter(Self);
  {$ENDIF VCL}
  BaseWndProc(CM_MOUSEENTER, 0, Integer(AControl));
end;

procedure TJvCustomDBGrid0.MouseLeave(AControl: TControl);
begin
  FMouseOver := False;
  BaseWndProc(CM_MOUSELEAVE, 0, Integer(AControl));
  {$IFDEF VCL}
  if Assigned(FOnMouseLeave) then
    FOnMouseLeave(Self);
  {$ENDIF VCL}
end;

procedure TJvCustomDBGrid0.FocusChanged(AControl: TWinControl);
begin
  BaseWndProc(CM_FOCUSCHANGED, 0, Integer(AControl));
end;

{$IFDEF COMPILER5}
{$IFNDEF HASAUTOSIZE}

procedure TJvCustomDBGrid0.CMSetAutoSize(var Msg: TMessage);
begin
  SetAutoSize(Msg.WParam <> 0);
end;

procedure TJvCustomDBGrid0.SetAutoSize(Value: Boolean);
begin
  TOpenControl_SetAutoSize(Self, Value);
end;

{$ENDIF !HASAUTOSIZE}
{$ENDIF COMPILER5}

procedure TJvCustomDBGrid0.BoundsChanged;
begin
end;

procedure TJvCustomDBGrid0.CursorChanged;
begin
  BaseWndProc(CM_CURSORCHANGED);
end;

procedure TJvCustomDBGrid0.ShowingChanged;
begin
  BaseWndProc(CM_SHOWINGCHANGED);
end;

procedure TJvCustomDBGrid0.ShowHintChanged;
begin
  BaseWndProc(CM_SHOWHINTCHANGED);
end;

{ VCL sends CM_CONTROLLISTCHANGE and CM_CONTROLCHANGE in a different order than
  the CLX methods are used. So we must correct it by evaluating "Inserting". }
procedure TJvCustomDBGrid0.ControlsListChanging(Control: TControl; Inserting: Boolean);
begin
  if Inserting then
    BaseWndProc(CM_CONTROLLISTCHANGE, Integer(Control), Integer(Inserting))
  else
    BaseWndProc(CM_CONTROLCHANGE, Integer(Control), Integer(Inserting));
end;

procedure TJvCustomDBGrid0.ControlsListChanged(Control: TControl; Inserting: Boolean);
begin
  if not Inserting then
    BaseWndProc(CM_CONTROLLISTCHANGE, Integer(Control), Integer(Inserting))
  else
    BaseWndProc(CM_CONTROLCHANGE, Integer(Control), Integer(Inserting));
end;

procedure TJvCustomDBGrid0.GetDlgCode(var Code: TDlgCodes);
begin
end;

procedure TJvCustomDBGrid0.FocusSet(PrevWnd: HWND);
begin
  BaseWndProc(WM_SETFOCUS, Integer(PrevWnd), 0);
end;

procedure TJvCustomDBGrid0.FocusKilled(NextWnd: HWND);
begin
  BaseWndProc(WM_KILLFOCUS, Integer(NextWnd), 0);
end;

function TJvCustomDBGrid0.DoEraseBackground(Canvas: TCanvas; Param: Integer): Boolean;
begin
  Result := BaseWndProc(WM_ERASEBKGND, Canvas.Handle, Param) <> 0;
end;

{$IFDEF JVCLThemesEnabledD56}
function TJvCustomDBGrid0.GetParentBackground: Boolean;
begin
  Result := JvThemes.GetParentBackground(Self);
end;

procedure TJvCustomDBGrid0.SetParentBackground(Value: Boolean);
begin
  JvThemes.SetParentBackground(Self, Value);
end;
{$ENDIF JVCLThemesEnabledD56}

procedure TJvCustomDBGrid0.WndProc(var Msg: TMessage);
var
  IdSaveDC: Integer;
  DlgCodes: TDlgCodes;
  Canvas: TCanvas;
begin
  case Msg.Msg of
    CM_DENYSUBCLASSING:
      Msg.Result := Ord(GetInterfaceEntry(IJvDenySubClassing) <> nil);
    CM_DIALOGCHAR:
      with TCMDialogChar(Msg) do
        Result := Ord(WantKey(CharCode, KeyDataToShiftState(KeyData), WideChar(CharCode)));
    CM_HINTSHOW:
      with TCMHintShow(Msg) do
        Result := Integer(HintShow(HintInfo^));
    CM_HITTEST:
      with TCMHitTest(Msg) do
        Result := Integer(HitTest(XPos, YPos));
    CM_MOUSEENTER:
      MouseEnter(TControl(Msg.LParam));
    CM_MOUSELEAVE:
      MouseLeave(TControl(Msg.LParam));
    CM_VISIBLECHANGED:
      VisibleChanged;
    CM_ENABLEDCHANGED:
      EnabledChanged;
    CM_TEXTCHANGED:
      TextChanged;
    CM_FONTCHANGED:
      FontChanged;
    CM_COLORCHANGED:
      ColorChanged;
    CM_FOCUSCHANGED:
      FocusChanged(TWinControl(Msg.LParam));
    CM_PARENTFONTCHANGED:
      ParentFontChanged;
    CM_PARENTCOLORCHANGED:
      ParentColorChanged;
    CM_PARENTSHOWHINTCHANGED:
      ParentShowHintChanged;
    CM_CURSORCHANGED:
      CursorChanged;
    CM_SHOWINGCHANGED:
      ShowingChanged;
    CM_SHOWHINTCHANGED:
      ShowHintChanged;
    CM_CONTROLLISTCHANGE:
      if Msg.LParam <> 0 then
        ControlsListChanging(TControl(Msg.WParam), True)
      else
        ControlsListChanged(TControl(Msg.WParam), False);
    CM_CONTROLCHANGE:
      if Msg.LParam = 0 then
        ControlsListChanging(TControl(Msg.WParam), False)
      else
        ControlsListChanged(TControl(Msg.WParam), True);
    WM_SETFOCUS:
      FocusSet(HWND(Msg.WParam));
    WM_KILLFOCUS:
      FocusKilled(HWND(Msg.WParam));
    WM_SIZE:
      begin
        inherited WndProc(Msg);
        BoundsChanged;
      end;
    WM_ERASEBKGND:
      begin
        IdSaveDC := SaveDC(HDC(Msg.WParam)); // protect DC against Stock-Objects from Canvas
        Canvas := TCanvas.Create;
        try
          Canvas.Handle := HDC(Msg.WParam);
          Msg.Result := Ord(DoEraseBackground(Canvas, Msg.LParam));
        finally
          Canvas.Handle := 0;
          Canvas.Free;
          RestoreDC(HDC(Msg.WParam), IdSaveDC);
        end;
      end;
    WM_PRINTCLIENT, WM_PRINT: // VCL bug fix
      begin
        IdSaveDC := SaveDC(HDC(Msg.WParam)); // protect DC against changes
        try
          inherited WndProc(Msg);
        finally
          RestoreDC(HDC(Msg.WParam), IdSaveDC);
        end;
      end;
    WM_GETDLGCODE:
      begin
        inherited WndProc(Msg);
        DlgCodes := [dcNative] + DlgcToDlgCodes(Msg.Result);
        GetDlgCode(DlgCodes);
        if not (dcNative in DlgCodes) then
          Msg.Result := DlgCodesToDlgc(DlgCodes);
      end;
  else
    inherited WndProc(Msg);
  end;
end;

//============================================================================
{ TTntJvCustomDBGridS }

procedure TTntJvCustomDBGridS.CreateWindowHandle(const Params: TCreateParams);
begin
  CreateUnicodeHandle(Self, Params, '');
end;

type TAccessCustomGrid = class(TCustomGrid);

procedure TTntJvCustomDBGridS.WMChar(var Msg: TWMChar);
begin
  if (goEditing in TAccessCustomGrid(Self).Options)
  and (AnsiChar(Msg.CharCode) in [^H, #32..#255]) then begin