unit1.pas

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

        begin
          Bits := FormImage.Handle;
          GetDIBSizes(Bits, InfoSize, ImageSize);
          Info := AllocMem(InfoSize);
          try
            Image := AllocMem(ImageSize);
            try
              GetDIB(Bits, 0, Info^, Image^);
              with Info^.bmiHeader do
              begin
                DIBWidth := biWidth;
                DIBHeight := biHeight;
              end;
              case PrintScale of
                poProportional:
                  begin
                    PrintWidth := MulDiv(DIBWidth, GetDeviceCaps(Printer.Handle,
                      LOGPIXELSX), PixelsPerInch);
                    PrintHeight := MulDiv(DIBHeight, GetDeviceCaps(Printer.Handle,
                      LOGPIXELSY), PixelsPerInch);
                  end;
                poPrintToFit:
                  begin
                    PrintWidth := MulDiv(DIBWidth, PagEheight, DIBHeight);
                    if PrintWidth < PageWidth then
                      PrintHeight := PagEheight
                    else
                    begin
                      PrintWidth := PageWidth;
                      PrintHeight := MulDiv(DIBHeight, PageWidth, DIBWidth);
                    end;
                  end;
              else
                PrintWidth := DIBWidth;
                PrintHeight := DIBHeight;
              end;
              StretchDIBits(Canvas.Handle, 0, 0, PrintWidth, PrintHeight, 0, 0,
                DIBWidth, DIBHeight, Image, Info^, DIB_RGB_COLORS, SRCCOPY);
            finally
              FreeMem(Image, ImageSize);
            end;
          finally
            FreeMem(Info, InfoSize);
          end;
        end;
      finally
        Canvas.Unlock;
        FormImage.Free;
      end;
      Inc(i);
      if PageControl1.PageCount = i then Exit;
      PrinterPreview.NewPage;
    end;
  finally
    PrinterPreview.EndDoc;
  end;
  finally
    SetPrinterPreview(StdPrinterPreview);
    PageControl1.ActivePage := PageControl1.Pages[0];
  end;
end;

procedure TForm1.ToolButton2Click(Sender: TObject);
var mi:TMenuItem;
    S:String;
    p:Integer;
  function GetBackCharPos(S:String; C:Char; N:Integer):Integer;
  var i:Integer;
  begin
    Result := 1;
    for i := Length(S) downto 1 do
      if S[i] = C then begin
        Dec(N);
        if N = 0 then begin
          Result := i+1;
          Exit;
        end;
      end;
  end;
  type
    TReplaceFlags = set of (rfReplaceAll, rfIgnoreCase);

  function StringReplace(const S, OldPattern, NewPattern: string;
    Flags: TReplaceFlags): string;
  var
    SearchStr, Patt, NewStr: string;
    Offset: Integer;
  begin
    if rfIgnoreCase in Flags then
    begin
      SearchStr := AnsiUpperCase(S);
      Patt := AnsiUpperCase(OldPattern);
    end else
    begin
      SearchStr := S;
      Patt := OldPattern;
    end;
    NewStr := S;
    Result := '';
    while SearchStr <> '' do
    begin
     Offset := AnsiPos(Patt, SearchStr);
      if Offset = 0 then
      begin
        Result := Result + NewStr;
        Break;
      end;
      Result := Result + Copy(NewStr, 1, Offset - 1) + NewPattern;
      NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
      if not (rfReplaceAll in Flags) then
      begin
        Result := Result + NewStr;
        Break;
      end;
     SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt);
    end;
  end;
begin
  mi := TMenuItem.Create(nil);
  with DBGridEh1.VisibleColumns do begin
    S := Items[Count-1].Title.Caption;
    p := GetBackCharPos(S,'|',2);
    S := Copy(S,p,Length(S));
    mi.Caption := StringReplace(S,'|',#9,[rfReplaceAll]);
    mi.Tag := Integer(Items[Count-1]);
    mi.OnClick := ColumnMenuItem;
  end;
  pmNoVisibleCols.Items.Insert(0,mi);
  DBGridEh1.VisibleColumns.Items[DBGridEh1.VisibleColumns.Count-1].Visible := False;
  if (DBGridEh1.VisibleColumns.Count = 0) then ToolButton2.Enabled := False;
  ToolButton1.Enabled := True;
end;

procedure TForm1.ToolButton1Click(Sender: TObject);
begin
  pmNoVisibleCols.Items[0].Free;
  DBGridEh1.Columns[DBGridEh1.VisibleColumns.Count].Visible := True;
  if (DBGridEh1.Columns.Count = DBGridEh1.VisibleColumns.Count) then
    ToolButton1.Enabled := False;
  ToolButton2.Enabled := True;
end;

procedure TForm1.ColumnMenuItem(Sender: TObject);
begin
  TColumnEh(TMenuItem(Sender).Tag).Index := DBGridEh1.VisibleColumns.Count;
  TColumnEh(TMenuItem(Sender).Tag).Visible := True;
  Sender.Free;
  if (DBGridEh1.Columns.Count = DBGridEh1.VisibleColumns.Count) then
    ToolButton1.Enabled := False;
end;

function TForm1.GridSelectionAsText(AGrid: TDBGridEh): String;
var //bm:TBookmarkStr;
    i,j :Integer;
    ss: TStringStream;
    function StringTab(s:String; Index, Count:Integer):String;
    begin
      if Index <> Count then
        Result := s + #09
      else
        Result := s;
    end;
begin
  Result := '';
  with AGrid do begin
    if Selection.SelectionType = gstNon then Exit;
    ss := TStringStream.Create('');
    with Datasource.Dataset do
    try
      // BM := Bookmark;
      SaveBookmark;
      DisableControls;
      try
        case Selection.SelectionType of
          gstRecordBookmarks:
          begin
            for I := 0 to Selection.Rows.Count-1 do
            begin
              Bookmark := Selection.Rows[I];
              for j := 0 to VisibleColumns.Count - 1 do
                ss.WriteString(StringTab(VisibleColumns[j].DisplayText,j,VisibleColumns.Count - 1));
              ss.WriteString(#13#10);
            end;
          end;
          gstRectangle: begin
             Bookmark := Selection.Rect.TopRow;
             while True do begin
               for j := Selection.Rect.LeftCol to Selection.Rect.RightCol do
                 if Columns[j].Visible then
                   ss.WriteString(StringTab(Columns[j].DisplayText,j,Selection.Rect.RightCol));
               if CompareBookmarks(Pointer(Selection.Rect.BottomRow),Pointer(Bookmark)) = 0 then Break;
               Next;
               if Eof then Break;
               ss.WriteString(#13#10);
             end;
          end;
          gstColumns: begin
             for j := 0 to Selection.Columns.Count-1 do
                 ss.WriteString(StringTab(Selection.Columns[j].Title.Caption,j,Selection.Columns.Count-1));
             ss.WriteString(#13#10);
             First;
             while  EOF = False do begin
               for j := 0 to Selection.Columns.Count-1 do
                 ss.WriteString(StringTab(Selection.Columns[j].DisplayText,j,Selection.Columns.Count-1));
               ss.WriteString(#13#10);
               Next;
             end;
             for i := 0 to FooterRowCount-1 do begin
               for j := 0 to Selection.Columns.Count-1 do
                   ss.WriteString(StringTab(GetFooterValue(i,Selection.Columns[j]),j,Selection.Columns.Count-1));
               ss.WriteString(#13#10);
             end;
          end;
          gstAll: begin
             for j := 0 to VisibleColumns.Count-1 do
                 ss.WriteString(StringTab(VisibleColumns[j].Title.Caption,j,VisibleColumns.Count-1));
             ss.WriteString(#13#10);
             First;
             while  EOF = False do begin
               for j := 0 to VisibleColumns.Count-1 do
                 ss.WriteString(StringTab(VisibleColumns[j].DisplayText,j,VisibleColumns.Count-1));
               ss.WriteString(#13#10);
               Next;
             end;
             for i := 0 to FooterRowCount-1 do begin
               for j := 0 to VisibleColumns.Count-1 do
                   ss.WriteString(StringTab(GetFooterValue(i,VisibleColumns[j]),j,VisibleColumns.Count-1));
               ss.WriteString(#13#10);
             end;
          end;
        end;
        Result := ss.DataString;
      finally
        //Bookmark := BM;
        RestoreBookmark;
        EnableControls;
      end;
    finally
      ss.Free;
    end;
  end;
end;

procedure TForm1.dbgListDragDrop(Sender, Source: TObject; X, Y: Integer);
var i,j:Integer;
begin
  if Source = dbgList1 then begin
    dbgList.DataSource.DataSet.DisableControls;
    dbgList1.DataSource.DataSet.DisableControls;
    dbgList.SaveBookmark;
    if dbgList1.Selection.SelectionType = gstRecordBookmarks then
      for i := 0 to dbgList1.SelectedRows.Count-1 do
      begin
        dbgList1.DataSource.DataSet.Bookmark := dbgList1.SelectedRows[I];
        dbgList.DataSource.DataSet.Append;
        dbgList.DataSource.DataSet.Edit;
        for j := 0 to dbgList.DataSource.DataSet.FieldCount-1 do
          dbgList.DataSource.DataSet.Fields[j].Value := dbgList1.DataSource.DataSet.Fields[j].Value;
        dbgList.DataSource.DataSet.Post;
      end
    else if dbgList1.Selection.SelectionType = gstAll then begin
      dbgList1.DataSource.DataSet.First;
      while  dbgList1.DataSource.DataSet.EOF = False do begin
        dbgList.DataSource.DataSet.Append;
        dbgList.DataSource.DataSet.Edit;
        for j := 0 to dbgList.DataSource.DataSet.FieldCount-1 do
          dbgList.DataSource.DataSet.Fields[j].Value := dbgList1.DataSource.DataSet.Fields[j].Value;
        dbgList.DataSource.DataSet.Post;
        dbgList1.DataSource.DataSet.Delete;
      end;
      dbgList1.Selection.Clear;
    end;
    dbgList.RestoreBookmark;
    dbgList1.SelectedRows.Delete;
    dbgList1.DataSource.DataSet.Refresh;
    dbgList1.DataSource.DataSet.EnableControls;
    dbgList.DataSource.DataSet.EnableControls;
  end;
end;

procedure TForm1.dbgListDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  if Source = dbgList1 then Accept := True else Accept := False;
end;

procedure TForm1.dbgListStartDrag(Sender: TObject;
  var DragObject: TDragObject);
begin
{
              ABOUT DRAG & DROP DATA BETWEEN APPLICATIONS.
  Standard drag and drop capacity don't support interapplication interaction.
  To ensure drag and drop from one application to over need use over tools.
  One of such tools is DRAG & DROP COMPONENT SUITE VERSION by Angus Johnson &
  Anders Melander.
  This is a set of components that implements Dragging & Dropping of data
  between applications.
  These components implement the COM interfaces - IDataObject, IDropSource and
  IDropTarget which are the backbone of Windows drag-and-drop.
  The homesite for the Drag and Drop Component Suite is http://www.melander.dk.
  To make use this component download it, install DRAG & DROP COMPONENT SUITE
  VERSION to Delphi , drop TDropTextSource on this Form, do visible
  cbInterAppDragNDrop checkbox and uncomment below text.
  It give you capacity to drag grid info in such applications as Excel or Word
}

//  if not cbInterAppDragNDrop.Checked then Exit;
//  CancelDrag;
//  DropTextSource1.Text := GridSelectionAsText(dbgList);
//  DropTextSource1.Execute;

end;

procedure TForm1.dbgList1DragDrop(Sender, Source: TObject; X, Y: Integer);
var i,j:Integer;
begin
  if Source = dbgList then begin
    dbgList1.DataSource.DataSet.DisableControls;
    dbgList.DataSource.DataSet.DisableControls;
    dbgList1.SaveBookmark;
    if dbgList.Selection.SelectionType = gstRecordBookmarks then
      for i := 0 to dbgList.SelectedRows.Count-1 do
      begin
        dbgList.DataSource.DataSet.Bookmark := dbgList.SelectedRows[I];
        dbgList1.DataSource.DataSet.Append;
        dbgList1.DataSource.DataSet.Edit;
        for j := 0 to dbgList1.DataSource.DataSet.FieldCount-1 do
          dbgList1.DataSource.DataSet.Fields[j].Value := dbgList.DataSource.DataSet.Fields[j].Value;
        dbgList1.DataSource.DataSet.Post;
      end
    else if dbgList.Selection.SelectionType = gstAll then begin
      dbgList.DataSource.DataSet.First;
      while  dbgList.DataSource.DataSet.EOF = False do begin
        dbgList1.DataSource.DataSet.Append;
        dbgList1.DataSource.DataSet.Edit;
        for j := 0 to dbgList1.DataSource.DataSet.FieldCount-1 do
          dbgList1.DataSource.DataSet.Fields[j].Value := dbgList.DataSource.DataSet.Fields[j].Value;
        dbgList1.DataSource.DataSet.Post;
        dbgList.DataSource.DataSet.Delete;
      end;
      dbgList.Selection.Clear;
    end;
    dbgList1.RestoreBookmark;
    dbgList.SelectedRows.Delete;
    dbgList.DataSource.DataSet.Refresh;
    dbgList.DataSource.DataSet.EnableControls;
    dbgList1.DataSource.DataSet.EnableControls;
  end;
end;

procedure TForm1.dbgList1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  if Source = dbgList then Accept := True else Accept := False;
end;

procedure TForm1.qCustomerUpdateRecord(DataSet: TDataSet;
  UpdateKind: TUpdateKind; var UpdateAction: TUpdateAction);
begin
//
end;

procedure TForm1.qCustomer2UpdateRecord(DataSet: TDataSet;
  UpdateKind: TUpdateKind; var UpdateAction: TUpdateAction);
begin
//
end;

procedure TForm1.cbDragNDropClick(Sender: TObject);
begin
  if cbDragNDrop.Checked then begin
    dbgList.DragMode := dmAutomatic;
    dbgList1.Visible := True and not cbInterAppDragNDrop.Checked;
  end
  else begin
    dbgList.DragMode := dmManual;
    dbgList1.Visible := False;
  end;
end;

procedure TForm1.cbDichromaticClick(Sender: TObject);
begin
  dbgList.Invalidate;
end;

procedure TForm1.dbgListGetCellParams(Sender: TObject; Column: TColumnEh;
  AFont: TFont; var Background: TColor; State: TGridDrawState);
begin
  if cbDichromatic.Checked then
    if dbgList.SumList.RecNo mod 2 = 1 then
      Background := $00FFC4C4
    else
      Background := $00FFDDDD;
end;

procedure TForm1.ApplicationIdle(Sender: TObject; var Done: Boolean);
begin
  // Under Delphi 4 and upper better to user Actions to determine
  // enablitity buttons and menus
  bbCopy.Enabled := DBGridEh1.Selection.SelectionType <> gstNon;
end;

procedure TForm1.bbCopyClick(Sender: TObject);
begin
  Clipboard.AsText := GridSelectionAsText(DBGridEh1);
end;

procedure TForm1.DBGridEh1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_INSERT) and ([ssCtrl] = Shift) then
    Clipboard.AsText := GridSelectionAsText(DBGridEh1);
end;

procedure TForm1.cbInterAppDragNDropClick(Sender: TObject);
begin
  dbgList1.Visible := True and not cbInterAppDragNDrop.Checked;
end;

end.