dbgridehimpexp.pas

Delphi控件源码

 DBGridEh: TCustomDBGridEh; const FileName: String; IsLoadToAll: Boolean);
var DBGridEhImport:TDBGridEhImport;
begin
  DBGridEhImport := ImportClass.Create;
  try
    DBGridEhImport.DBGridEh := DBGridEh;
    DBGridEhImport.ImportFromFile(FileName,IsLoadToAll);
  finally
    DBGridEhImport.Free;
  end;
end;

procedure ReadDBGridEhFromImportStream(ImportClass: TDBGridEhImportClass;
  DBGridEh: TCustomDBGridEh; Stream: TStream; IsLoadToAll: Boolean);
var DBGridEhImport:TDBGridEhImport;
begin
  DBGridEhImport := ImportClass.Create;
  try
    DBGridEhImport.DBGridEh := DBGridEh;
    DBGridEhImport.ImportFromStream(Stream,IsLoadToAll);
  finally
    DBGridEhImport.Free;
  end;
end;

{ Routines to support clipboard with DBGridEh }

var
  CF_CSV: Word;
  CF_RICH_TEXT_FORMAT: Word;
//  CF_BIFF: Word;
//  CF_HTML_FORMAT: Word;

procedure Clipboard_PutFromStream(Format: Word; ms:TMemoryStream);
var
  Data: THandle;
  DataPtr: Pointer;
  Buffer:Pointer;
begin
  Buffer := ms.Memory;
  ClipBoard.Open;
  try
    Data := GlobalAlloc(GMEM_MOVEABLE+GMEM_DDESHARE, ms.Size);
    try
      DataPtr := GlobalLock(Data);
      try
        Move(Buffer^, DataPtr^, ms.Size);
        ClipBoard.SetAsHandle(Format, Data);
      finally
        GlobalUnlock(Data);
      end;
    except
      GlobalFree(Data);
      raise;
    end;
  finally
    ClipBoard.Close;
  end;
end;

procedure Clipboard_GetToStream(Format: Word; ms:TMemoryStream);
var
  Data: THandle;
  DataPtr: Pointer;
begin
  ClipBoard.Open;
  try
    Data := ClipBoard.GetAsHandle(Format);
    if Data = 0 then Exit;
    DataPtr := GlobalLock(Data);
    if DataPtr = nil then Exit;
    try
      ms.WriteBuffer(DataPtr^, GlobalSize(Data));
    finally
      GlobalUnlock(Data);
    end;
  finally
    ClipBoard.Close;
  end;
end;

procedure DBGridEh_DoCutAction(DBGridEh: TCustomDBGridEh; ForWholeGrid:Boolean);
begin
  DBGridEh_DoCopyAction(DBGridEh,ForWholeGrid); 
  DBGridEh_DoDeleteAction(DBGridEh,ForWholeGrid);
end;

procedure DBGridEh_DoDeleteAction(DBGridEh: TCustomDBGridEh; ForWholeGrid:Boolean);
var i:Integer;
    ColList:TColumnsEhList;
    ASelectionType:TDBGridEhSelectionType;

  procedure ClearColumns;
  var i:Integer;
      Field:TField;
  begin
    for i := 0 to ColList.Count-1 do
    begin
      if ColList[i].CanModify(False) then
      begin
        if (ColList[i].Field <> nil) and ColList[i].Field.Lookup then
          Field := ColList[i].Field.Dataset.FieldByName(ColList[i].Field.KeyFields)
        else
          Field := ColList[i].Field;
        if Field.DataSet.CanModify then
        begin
          Field.DataSet.Edit;
          if Field.DataSet.State in [dsEdit,dsInsert] then
            Field.Clear;
        end;
      end;
    end;
  end;

  function DeletePrompt: Boolean;
  var
    Msg: string;
  begin
    Result := True;
    if ASelectionType = gstRecordBookmarks then
      if (DBGridEh.Selection.Rows.Count > 1) then
        Msg := SDeleteMultipleRecordsQuestion
      else
        Msg := SDeleteRecordQuestion
    else if ASelectionType = gstRectangle then
      Msg := 'Clear selected cells?'
    else
      Exit;
    Result := not (dgConfirmDelete in DBGridEh.Options) or
      (MessageDlg(Msg, mtConfirmation, mbOKCancel, 0) <> idCancel);
  end;

begin
  with DBGridEh do
  begin
    if ForWholeGrid then ASelectionType := gstAll else ASelectionType := Selection.SelectionType;
    if (ASelectionType = gstNon) or
       (DataSource = nil) or (DataSource.Dataset = nil) or
       not DeletePrompt then
      Exit;
    with DataSource.Dataset do
    begin
      SaveBookmark;
      DisableControls;
      try
        case ASelectionType of
          gstRecordBookmarks:
          begin
            ColList := VisibleColumns;
            for i := 0 to Selection.Rows.Count-1 do
            begin
              Bookmark := Selection.Rows[I];
              Delete;
            end;
          end;
          gstRectangle:
          begin
            ColList := TColumnsEhList.Create;
            try
              for i := Selection.Rect.LeftCol to Selection.Rect.RightCol do
                if Columns[i].Visible then
                  ColList.Add(Columns[i]);
              Bookmark := Selection.Rect.TopRow;
              while True do
              begin
                ClearColumns;
                if CompareBookmarks(Pointer(Selection.Rect.BottomRow),Pointer(Bookmark)) = 0 then Break;
                Next;
                if Eof then Break;
              end;
            finally
              ColList.Free;
            end;
            RestoreBookmark;
          end;
          gstColumns:
          begin
            ColList := Selection.Columns;
            First;
            while  Eof = False do
            begin
              ClearColumns;
              Next;
            end;
            RestoreBookmark;
          end;
          gstAll:
          begin
            ColList := VisibleColumns;
            First;
            while  Eof = False do
              Delete;
          end;
        end;
      finally
        EnableControls;
      end;
    end;
  end;
end;

procedure DBGridEh_DoCopyAction(DBGridEh: TCustomDBGridEh; ForWholeGrid:Boolean);
var ms:TMemoryStream;
begin
  ms := nil;
  Clipboard.Open;
  try
    ms := TMemoryStream.Create;

    WriteDBGridEhToExportStream(TDBGridEhExportAsText,DBGridEh,ms,ForWholeGrid);
    ms.WriteBuffer(PChar('')^,1);
    Clipboard_PutFromStream(CF_TEXT,ms);
    ms.Clear;

    WriteDBGridEhToExportStream(TDBGridEhExportAsCSV,DBGridEh,ms,ForWholeGrid);
    ms.WriteBuffer(PChar('')^,1);
    Clipboard_PutFromStream(CF_CSV,ms);
    ms.Clear;

    WriteDBGridEhToExportStream(TDBGridEhExportAsRTF,DBGridEh,ms,ForWholeGrid);
    ms.WriteBuffer(PChar('')^,1);
    Clipboard_PutFromStream(CF_RICH_TEXT_FORMAT,ms);
    ms.Clear;

    WriteDBGridEhToExportStream(TDBGridEhExportAsVCLDBIF,DBGridEh,ms,ForWholeGrid);
    Clipboard_PutFromStream(CF_VCLDBIF,ms);
    ms.Clear;

    { This version of HTML and Biff export routines don't work under MS Office

    WriteDBGridEhToExportStream(TDBGridEhExportAsHTML,DBGridEh,ms,ForWholeGrid);
    Clipboard_PutFromStream(CF_HTML_FORMAT,ms);
    ms.Clear;

    WriteDBGridEhToExportStream(TDBGridEhExportAsXLS,DBGridEh,ms,ForWholeGrid);
    Clipboard_PutFromStream(CF_BIFF,ms);
    ms.Clear;
    }

  finally
    ms.Free;
    Clipboard.Close;
  end;
end;

procedure DBGridEh_DoPasteAction(DBGridEh: TCustomDBGridEh; ForWholeGrid:Boolean);
var ms:TMemoryStream;
begin
  ms := nil;
  Clipboard.Open;
  try
    ms := TMemoryStream.Create;

    if Clipboard.HasFormat(CF_VCLDBIF) then
    begin
      Clipboard_GetToStream(CF_VCLDBIF,ms);
      ms.Position := 0;
      ReadDBGridEhFromImportStream(TDBGridEhImportAsVCLDBIF,DBGridEh,ms,ForWholeGrid);
    end
    else if Clipboard.HasFormat(CF_TEXT) then
    begin
      Clipboard_GetToStream(CF_TEXT,ms);
      ms.Position := 0;
      ReadDBGridEhFromImportStream(TDBGridEhImportAsText,DBGridEh,ms,ForWholeGrid);
    end;

  finally
    ms.Free;
    Clipboard.Close;
  end;
end;

{ TDBGridEhExport }

procedure TDBGridEhExport.ExportToFile(FileName: String; IsExportAll: Boolean);
var FileStream: TFileStream;
begin
  FileStream := TFileStream.Create(FileName, fmCreate);
  try
    ExportToStream(FileStream, IsExportAll);
  finally
    FileStream.Free;
  end;
end;

procedure TDBGridEhExport.ExportToStream(AStream: TStream; IsExportAll: Boolean);
var i:Integer;
    ColList:TColumnsEhList;
    ASelectionType:TDBGridEhSelectionType;
begin
  Stream := AStream;
  try
  with DBGridEh do
  begin
    if IsExportAll then ASelectionType := gstAll else ASelectionType := Selection.SelectionType;
    if ASelectionType = gstNon then Exit;
    with DataSource.Dataset do
    begin
      SaveBookmark;
      DisableControls;
      try
        case ASelectionType of
          gstRecordBookmarks:
          begin
            ExpCols := VisibleColumns;
            FooterValues := AllocMem(SizeOf(Currency)*ExpCols.Count*DBGridEh.FooterRowCount);
            WritePrefix;
            if dgTitles in Options then WriteTitle(VisibleColumns);
            for i := 0 to Selection.Rows.Count-1 do
            begin
              Bookmark := Selection.Rows[I];
              CalcFooterValues;
              WriteRecord(VisibleColumns);
            end;
            for i := 0 to FooterRowCount-1 do WriteFooter(VisibleColumns,i);
          end;
          gstRectangle:
          begin
            ColList := TColumnsEhList.Create;
            try
              for i := Selection.Rect.LeftCol to Selection.Rect.RightCol do
                if Columns[i].Visible then
                  ColList.Add(Columns[i]);
              ExpCols := ColList;
              FooterValues := AllocMem(SizeOf(Currency)*ExpCols.Count*DBGridEh.FooterRowCount);
              WritePrefix;
              if dgTitles in Options then WriteTitle(ColList);
              Bookmark := Selection.Rect.TopRow;
              while True do
              begin
                WriteRecord(ColList);
                CalcFooterValues;
                if CompareBookmarks(Pointer(Selection.Rect.BottomRow),Pointer(Bookmark)) = 0 then Break;
                Next;
                if Eof then Break;
              end;
              for i := 0 to FooterRowCount-1 do WriteFooter(ColList,i);
            finally
              ColList.Free;
            end;
          end;
          gstColumns:
          begin
            ExpCols := Selection.Columns;
            FooterValues := AllocMem(SizeOf(Currency)*ExpCols.Count*DBGridEh.FooterRowCount);
            WritePrefix;
            if dgTitles in Options then WriteTitle(Selection.Columns);
            First;
            while  Eof = False do
            begin
              WriteRecord(Selection.Columns);
              CalcFooterValues;
              Next;
            end;
            for i := 0 to FooterRowCount-1 do WriteFooter(Selection.Columns,i);
          end;
          gstAll:
          begin
            ExpCols := VisibleColumns;
            FooterValues := AllocMem(SizeOf(Currency)*ExpCols.Count*DBGridEh.FooterRowCount);
            WritePrefix;
            if dgTitles in Options then WriteTitle(VisibleColumns);
            First;
            while  Eof = False do
            begin
              WriteRecord(VisibleColumns);
              CalcFooterValues;
              Next;
            end;
            for i := 0 to FooterRowCount-1 do WriteFooter(VisibleColumns,i);
          end;
        end;
      finally
        RestoreBookmark;
        EnableControls;
      end;
    end;
  end;
  WriteSuffix;
  finally
    FreeMem(FooterValues);
  end;
end;

procedure TDBGridEhExport.WriteTitle(ColumnsList:TColumnsEhList);
begin
end;

procedure TDBGridEhExport.WriteRecord(ColumnsList:TColumnsEhList);
var i:Integer;
    Font:TFont;
    Background: TColor;
    State:TGridDrawState;
begin
  Font := TFont.Create;
  try
    for i := 0 to ColumnsList.Count-1 do
    begin
      Font.Assign(ColumnsList[i].Font);
      Background := ColumnsList[i].Color;
      State := [];
      if Assigned(DBGridEh.OnGetCellParams) then
        DBGridEh.OnGetCellParams(DBGridEh,ColumnsList[i],Font,Background,State);
      WriteDataCell(ColumnsList[i],Font,Background);
    end;
  finally
    Font.Free;
  end;
end;

procedure TDBGridEhExport.WriteFooter(ColumnsList:TColumnsEhList; FooterNo:Integer);
var i:Integer;
    Font:TFont;
    Background: TColor;
    State:TGridDrawState;
    Alignment:TAlignment;
    Value:String;
begin
  Font := TFont.Create;
  try
    for i := 0 to ColumnsList.Count-1 do
    begin
      Font.Assign(ColumnsList[i].UsedFooter(FooterNo).Font);
      Background := ColumnsList[i].UsedFooter(FooterNo).Color;
      Alignment := ColumnsList[i].UsedFooter(FooterNo).Alignment;
      if ColumnsList[i].UsedFooter(FooterNo).ValueType in [fvtSum,fvtCount] then
        Value := GetFooterValue(FooterNo,i)
      else
        Value := DBGridEh.GetFooterValue(FooterNo,ColumnsList[i]);
      State := [];