⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 dbgridehimpexp.pas

📁 最新的 DBGRIDEH4.0
💻 PAS
📖 第 1 页 / 共 5 页
字号:
  { Routines to import/export DBGridEh to/from file/stream }

procedure WriteDBGridEhToExportStream(ExportClass: TDBGridEhExportClass;
  DBGridEh: TCustomDBGridEh; Stream: TStream; IsSaveAll: Boolean);
var DBGridEhExport: TDBGridEhExport;
begin
  DBGridEhExport := ExportClass.Create;
  try
    DBGridEhExport.DBGridEh := DBGridEh;
    DBGridEhExport.ExportToStream(Stream, IsSaveAll);
  finally
    DBGridEhExport.Free;
  end;
end;

procedure SaveDBGridEhToExportFile(ExportClass: TDBGridEhExportClass;
  DBGridEh: TCustomDBGridEh; const FileName: String; IsSaveAll: Boolean);
var DBGridEhExport: TDBGridEhExport;
begin
  DBGridEhExport := ExportClass.Create;
  try
    DBGridEhExport.DBGridEh := DBGridEh;
    DBGridEhExport.ExportToFile(FileName, IsSaveAll);
  finally
    DBGridEhExport.Free;
  end;
end;

procedure LoadDBGridEhFromImportFile(ImportClass: TDBGridEhImportClass;
  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: IntPtr;
{$IFNDEF CIL}
  Buffer: IntPtr;
{$ENDIF}
begin
{$IFNDEF CIL}
  Buffer := ms.Memory;
{$ENDIF}
  ClipBoard.Open;
  try
    Data := GlobalAlloc(GMEM_MOVEABLE + GMEM_DDESHARE, ms.Size);
    try
      DataPtr := GlobalLock(Data);
      try
{$IFDEF CIL}
        Marshal.Copy(ms.Memory, 0, DataPtr, ms.Size);
{$ELSE}
        Move(Buffer^, DataPtr^, ms.Size);
{$ENDIF}
        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: IntPtr;
{$IFDEF CIL}
  DataBytes: TBytes;
{$ENDIF}
begin
  ClipBoard.Open;
  try
    Data := ClipBoard.GetAsHandle(Format);
    if Data = 0 then Exit;
    DataPtr := GlobalLock(Data);
    if DataPtr = nil then Exit;
    try
{$IFDEF CIL}
      SetLength(DataBytes, GlobalSize(Data));
      Marshal.Copy(DataPtr, DataBytes, 0, GlobalSize(Data));
      ms.WriteBuffer(DataBytes, Length(DataBytes));
{$ELSE}
      ms.WriteBuffer(DataPtr^, GlobalSize(Data));
{$ENDIF}
    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 := SClearSelectedCellsEh
    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;
              Selection.Clear;
            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 DataSetCompareBookmarks(DBGridEh.DataSource.Dataset,
                    Selection.Rect.BottomRow, 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;

function IsPlatformNT():boolean;
var VI : TOSVersionInfo;
begin
  VI.dwOSVersionInfoSize := sizeof (VI);
  GetVersionEx (VI);
  result := (VI.dwPlatformId = VER_PLATFORM_WIN32_NT);
end;

{$IFNDEF CIL}
procedure Clipboard_PutUnicodeFromStream(ms: TMemoryStream);
var
  Data: THandle;
  DataPtr: IntPtr;
  BufSize: Integer;
  Buffer: IntPtr;
begin
  Buffer := ms.Memory;
  ClipBoard.Open;
  try
    BufSize := MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, Buffer, ms.Size,
      nil, 0) * 2;
    Data := GlobalAlloc(GMEM_MOVEABLE + GMEM_DDESHARE, BufSize);
    try
      DataPtr := GlobalLock(Data);
      MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, Buffer, ms.Size, DataPtr,
        BufSize div 2);
      try
        ClipBoard.SetAsHandle(CF_UNICODETEXT, Data);
      finally
        GlobalUnlock(Data);
      end;
    except
      GlobalFree(Data);
      raise;
    end;
  finally
    ClipBoard.Close;
  end;
end;
{$ENDIF}

procedure SreamWriteNullStr(st: TStream);
begin
{$IFDEF CIL}
    st.WriteBuffer([0,0], 2);
{$ELSE}
    st.WriteBuffer(PChar('')^, 1);
{$ENDIF}
end;

procedure SreamWriteNullAnsiStr(st: TStream);
begin
{$IFDEF CIL}
    st.WriteBuffer([0], 1);
{$ELSE}
    st.WriteBuffer(PChar('')^, 1);
{$ENDIF}
end;

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

  DBGridEh.DataSource.Dataset.DisableControls;
  try
    ms := TMemoryStreamEh.Create;
    ms.HalfMemoryDelta := $10000;

    WriteDBGridEhToExportStream(TDBGridEhExportAsText, DBGridEh, ms, ForWholeGrid);
    SreamWriteNullStr(ms);

{$IFNDEF CIL}
    if IsPlatformNT() then
      Clipboard_PutUnicodeFromStream(ms);
{$ENDIF}

    ms.Clear;

    WriteDBGridEhToExportStream(TDBGridEhExportAsCSV, DBGridEh, ms, ForWholeGrid);
    SreamWriteNullStr(ms);
    Clipboard_PutFromStream(CF_CSV, ms);
    ms.Clear;

    WriteDBGridEhToExportStream(TDBGridEhExportAsRTF, DBGridEh, ms, ForWholeGrid);
    SreamWriteNullStr(ms);
    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;
    DBGridEh.DataSource.Dataset.EnableControls;
  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
        DisableControls;
        SaveBookmark;
        try
          case ASelectionType of
            gstRecordBookmarks:
              begin
                ExpCols := VisibleColumns;
//                FooterValues := AllocMem(SizeOf(Currency) * ExpCols.Count * DBGridEh.FooterRowCount);
                SetLength(FooterValues, ExpCols.Count * DBGridEh.FooterRowCount);

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -