dbgrideh.pas

Dbgrid 增强(附源码):支持多表头,多固定列,按表头排序,支持合计列,并支持直接打印

    procedure WMPaint(var Message: TWMPaint); message wm_Paint;
    procedure WMSetCursor(var Message: TWMSetCursor); message WM_SetCursor;
    procedure SetWordWrap(const Value: Boolean);
  protected
    procedure BoundsChanged; override;
    procedure CloseUp(Accept: Boolean);
    //ddd
    procedure CreateParams(var Params: TCreateParams); override;
    //\\\
    procedure DoDropDownKeys(var Key: Word; Shift: TShiftState);
    procedure DropDown;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure PaintWindow(DC: HDC); override;
    procedure UpdateContents; override;
    procedure WndProc(var Message: TMessage); override;
    //ddd
    procedure KeyPress(var Key: Char); override;
    property WordWrap: Boolean read FWordWrap write SetWordWrap;
    //\\\
    property  EditStyle: TEditStyle read FEditStyle write SetEditStyle;
    property  ActiveList: TWinControl read FActiveList write FActiveList;
    property  DataList: TDBLookupListBox read FDataList;
    property  PickList: TPopupListbox read FPickList;
  public
    constructor Create(Owner: TComponent); override;
  end;

{ TPopupListbox }

  TPopupListbox = class(TCustomListbox)
  private
    FSearchText: String;
    FSearchTickCount: Longint;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure KeyPress(var Key: Char); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  end;

//ddd
{ TPopupMonthCalendar }
  TPopupMonthCalendar = class(TMonthCalendar)
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  end;
//\\\

procedure TPopupListBox.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := Style or WS_BORDER;
    ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST;
    WindowClass.Style := CS_SAVEBITS;
  end;
end;

procedure TPopupListbox.CreateWnd;
begin
  inherited CreateWnd;
  Windows.SetParent(Handle, 0);
  CallWindowProc(DefWndProc, Handle, wm_SetFocus, 0, 0);
end;

procedure TPopupListbox.Keypress(var Key: Char);
var
  TickCount: Integer;
begin
  case Key of
    #8, #27: FSearchText := '';
    #32..#255:
      begin
        TickCount := GetTickCount;
        if TickCount - FSearchTickCount > 2000 then FSearchText := '';
        FSearchTickCount := TickCount;
        if Length(FSearchText) < 32 then FSearchText := FSearchText + Key;
        SendMessage(Handle, LB_SelectString, WORD(-1), Longint(PChar(FSearchText)));
        Key := #0;
      end;
  end;
  inherited Keypress(Key);
end;

procedure TPopupListbox.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  TDBGridInPlaceEdit(Owner).CloseUp((X >= 0) and (Y >= 0) and
      (X < Width) and (Y < Height));
end;

//ddd

procedure TPopupMonthCalendar.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := Style or WS_BORDER;
    ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST;
    WindowClass.Style := CS_SAVEBITS;
  end;
end;

procedure TPopupMonthCalendar.CreateWnd;
begin
  inherited CreateWnd;
  Windows.SetParent(Handle, 0);
  CallWindowProc(DefWndProc, Handle, wm_SetFocus, 0, 0);
end;

procedure TPopupMonthCalendar.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var MCHInfo:TMCHitTestInfo;
begin
  inherited MouseUp(Button, Shift, X, Y);
  MCHInfo.cbSize := SizeOf(TMCHitTestInfo);
  MCHInfo.pt.x := X;
  MCHInfo.pt.y := Y;
  MonthCal_HitTest(Handle,MCHInfo);
  if ((MCHInfo.uHit and MCHT_CALENDARDATE) > 0) and  (MCHInfo.uHit <> MCHT_CALENDARDAY) and
   (MCHInfo.uHit <> MCHT_TITLEBTNNEXT) and (MCHInfo.uHit <> MCHT_TITLEBTNPREV) then
    TDBGridInPlaceEdit(Owner).CloseUp(True)
  else if (MCHInfo.uHit and MCHT_NOWHERE > 0) then
    TDBGridInPlaceEdit(Owner).CloseUp(False)
  else if not ((X >= 0) and (Y >= 0) and
      (X < Width) and (Y < Height)) then
    TDBGridInPlaceEdit(Owner).CloseUp(False);
end;

//\\\

constructor TDBGridInplaceEdit.Create(Owner: TComponent);
begin
  inherited Create(Owner);
  FLookupSource := TDataSource.Create(Self);
  FButtonWidth := GetSystemMetrics(SM_CXVSCROLL);
  FEditStyle := esSimple;
end;

procedure TDBGridInplaceEdit.BoundsChanged;
var
  R: TRect;
begin
  SetRect(R, 2, 2, Width - 2, Height);
  if FEditStyle <> esSimple then Dec(R.Right, FButtonWidth);
  SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@R));
  SendMessage(Handle, EM_SCROLLCARET, 0, 0);
  if SysLocale.FarEast then
    SetImeCompositionWindow(Font, R.Left, R.Top);
  //ddd
  if FEditStyle = esUpDown then
  begin
    FUpDown.Visible := True;
    FUpDown.SetBounds(Width - FButtonWidth, 0, FButtonWidth, Height);
  end;
  //\\\
end;

procedure TDBGridInplaceEdit.CloseUp(Accept: Boolean);
var
  MasterField: TField;
  ListValue: Variant;
  //ddd
  CurColumn:TColumnEh;
  idx:Integer;
  //\\\
begin
  //ddd
  CurColumn := TCustomDBGridEh(Grid).Columns[TCustomDBGridEh(Grid).SelectedIndex];
  //\\\
  if FListVisible then
  begin
    if GetCapture <> 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
    if FActiveList = FDataList then
      ListValue := FDataList.KeyValue
    else
    //ddd
    if FActiveList = FPopupMonthCalendar then begin
    end
    else
    //\\\
      if FPickList.ItemIndex <> -1 then begin
        //ddd
        if Assigned(CurColumn.KeyList)  and (CurColumn.KeyList.Count > 0) then
           ListValue := CurColumn.KeyList.Strings[FPicklist.ItemIndex]
        else
        //\\
         ListValue := FPickList.Items[FPicklist.ItemIndex];
      end;
    SetWindowPos(FActiveList.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
      SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
    FListVisible := False;
    if Assigned(FDataList) then
      FDataList.ListSource := nil;
    FLookupSource.Dataset := nil;
    Invalidate;
    if Accept then begin
      if FActiveList = FDataList then
        with TCustomDBGridEh(Grid), Columns[SelectedIndex].Field do
        begin
          MasterField := DataSet.FieldByName(KeyFields);
          if MasterField.CanModify and Columns[SelectedIndex].CanModify(True) then
          begin
            DataSet.Edit;
            try
              MasterField.Value := ListValue;
            //ddd
            except
               on Exception do begin
                 Text := TCustomDBGridEh(Grid).Columns[TCustomDBGridEh(Grid).SelectedIndex].Field.Text + ' '; //May be delphi bag. But without ' ' don't assign
                 raise;
               end;
            end;
            Text := FDataList.SelectedItem;
            //\\\
          end;
        end
      else
      //ddd
      if (FActiveList = FPopupMonthCalendar) then begin
        with TCustomDBGridEh(Grid), Columns[SelectedIndex].Field do
          if Columns[SelectedIndex].CanModify(True) then begin
            DataSet.Edit;
            AsDateTime := FPopupMonthCalendar.Date;
          end;
      end
      else
      //\\\
        if (not VarIsNull(ListValue)) and {dddEditCanModify}TCustomDBGridEh(Grid).CanEditModifyText  then
          with TCustomDBGridEh(Grid), Columns[SelectedIndex].Field do
            //ddd
            if Assigned(CurColumn) and Assigned(CurColumn.KeyList)  and (CurColumn.KeyList.Count > 0) then begin
              Self.Text := FPickList.Items[FPicklist.ItemIndex];
              Text := ListValue;
            end
            else
            //\\\
              Text := ListValue
    end
    //ddd
    else if FActiveList = FDataList then
      Text := TCustomDBGridEh(Grid).Columns[TCustomDBGridEh(Grid).SelectedIndex].Field.Text
    else if FActiveList = FPickList then
      if CurColumn.GetColumnType = ctKeyPickList then begin
        idx := CurColumn.KeyList.IndexOf(CurColumn.Field.Text);
        if (idx <> -1) then
          Text := CurColumn.PickList.Strings[idx]
        else
          Text := '';
      end else
        Text := TCustomDBGridEh(Grid).Columns[TCustomDBGridEh(Grid).SelectedIndex].Field.Text;
    //\\\
  end;
end;

//ddd
procedure TDBGridInplaceEdit.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  if WordWrap then
    Params.Style:=Params.Style and (not ES_AUTOHSCROLL)  or ES_MULTILINE  or ES_LEFT;
end;
//\\\

procedure TDBGridInplaceEdit.DoDropDownKeys(var Key: Word; Shift: TShiftState);
begin
  case Key of
    VK_UP, VK_DOWN:
      if ssAlt in Shift then
      begin
        if FListVisible then CloseUp(True) else DropDown;
        Key := 0;
      end;
    VK_RETURN, VK_ESCAPE:
      if FListVisible and not (ssAlt in Shift) then
      begin
        CloseUp(Key = VK_RETURN);
        Key := 0;
      end;
  end;
end;

procedure TDBGridInplaceEdit.DropDown;
var
  P: TPoint;
  I,J,Y: Integer;
  Column: TColumnEh;
  //ddd
  TM: TTextMetric;
  RestoreCanvas: Boolean;
  fList:TList;
  dlcw:Integer;
  WorkArea,R: TRect;
  //\\\
begin
  if not FListVisible and Assigned(FActiveList) then
  begin
    FActiveList.Width := Width;
    with TCustomDBGridEh(Grid) do
      Column := Columns[SelectedIndex];
    if FActiveList = FDataList then
    with Column.Field do
    begin
      FDataList.Color := Color;
      FDataList.Font := Font;
      FDataList.RowCount := Column.DropDownRows;
      FLookupSource.DataSet := LookupDataSet;
      FDataList.KeyField := LookupKeyFields;
//ddd      FDataList.ListField := {ddd LookupResultField}Column.LookupDisplayFields;
      //ddd
      FDataList.ListFieldIndex := 0;
      if (Column.DropDownWidth = -1) then begin
        RestoreCanvas := not HandleAllocated;
        if RestoreCanvas then
          TCustomDBGridEh(Grid).Canvas.Handle := GetDC(0);
        try
          fList := TList.Create;
          LookupDataSet.GetFieldList(fList,Column.LookupDisplayFields);
          TCustomDBGridEh(Grid).Canvas.Font := Self.Font;
          GetTextMetrics(TCustomDBGridEh(Grid).Canvas.Handle, TM);
          dlcw := 0;
          for i := 0 to fList.Count - 1 do begin
            Inc(dlcw,TField(fList[i]).DisplayWidth * (TCustomDBGridEh(Grid).Canvas.TextWidth('0') - TM.tmOverhang)
                                        + TM.tmOverhang + 4);
            if (TField(fList[i]).FieldName = LookupResultField) then FDataList.ListFieldIndex := i;
          end;
          FDataList.ClientWidth := dlcw;
          if (FDataList.Width < Self.Width) then FD