Работа с буфером обмена через свой формат

{
Copyright © 1999 by Delphi 5 Developer's Guide - Xavier Pacheco and Steve Teixeira
}
unit
 cbdata;
interface

uses

  SysUtils, Windows, clipbrd;

const


  DDGData = 'CF_DDG'; // constant for registering the clipboard format.
type


  // Record data to be stored to the clipboard

  TDataRec = packed
 record

    LName: string
[10];
    FName: string
[10];
    MI: string
[2];
    Age: Integer;
    BirthDate: TDateTime;
  end
;

  { Define an object around the TDataRec that contains the methods
    for copying and pasting the data to and from the clipboard }
  TData = class

  public

    Rec: TDataRec;
    procedure
 CopyToClipBoard;
    procedure
 GetFromClipBoard;
  end
;

var

  CF_DDGDATA: word; // Receives the return value of RegisterClipboardFormat().

implementation


procedure
 TData.CopyToClipBoard;
{ This function copies the contents of the TDataRec field, Rec, to the
  clipboard as both binary data, as text. Both formats will be
  available from the clipboard }
const

  CRLF = #13#10;
var

Data: THandle;
  DataPtr: Pointer;
  TempStr: string
[50];
begin

  // Allocate SizeOf(TDataRec) bytes from the heap
  Data := GlobalAlloc(GMEM_MOVEABLE, SizeOf(TDataRec));
  try

    // Obtain a pointer to the first byte of the allocated memory
    DataPtr := GlobalLock(Data);
    try

      // Move the data in Rec to the memory block
      Move(Rec, DataPtr^, SizeOf(TDataRec));
      { Clipboard.Open must be called if multiple clipboard formats are
        being copied to the clipboard at once. Otherwise, if only one
        format is being copied the call isn't necessary }
      ClipBoard.Open;
      try

        // First copy the data as its custom format
        ClipBoard.SetAsHandle(CF_DDGDATA, Data);
        // Now copy the data as text format
        with
 Rec do

          TempStr := FName + CRLF + LName + CRLF + MI + CRLF + IntToStr(Age) +
            CRLF +
            DateTimeToStr(BirthDate);
        ClipBoard.AsText := TempStr;
        { If a call to Clipboard.Open is made you must match it
          with a call to Clipboard.Close }
      finally

        Clipboard.Close
      end
;
    finally

      // Unlock the globally allocated memory
      GlobalUnlock(Data);
    end
;
  except

    { A call to GlobalFree is required only if an exception occurs.
      Otherwise, the clipboard takes over managing any allocated
      memory to it.}
    GlobalFree(Data);
    raise
;
  end
;
end
;

procedure
 TData.GetFromClipBoard;
{ This method pastes memory saved in the clipboard if it is of the
  format CF_DDGDATA. This data is stored in the TDataRec field of
  this object. }
var

  Data: THandle;
  DataPtr: Pointer;
  Size: Integer;
begin

  // Obtain a handle to the clipboard
  Data := ClipBoard.GetAsHandle(CF_DDGDATA);
  if
 Data = 0 then

    Exit;
  // Obtain a pointer to the memory block referred to by Data
  DataPtr := GlobalLock(Data);
  try

    // Obtain the size of the data to retrieve
    if
 SizeOf(TDataRec) > GlobalSize(Data) then

      Size := GlobalSize(Data)
    else

      Size := SizeOf(TDataRec);
    // Copy the data to the TDataRec field
    Move(DataPtr^, Rec, Size)
  finally

    // Free the pointer to the memory block.
    GlobalUnlock(Data);
  end
;
end
;

initialization

  // Register the custom clipboard format
  CF_DDGDATA := RegisterClipBoardFormat(DDGData);
end
.

{
Copyright © 1999 by Delphi 5 Developer's Guide - Xavier Pacheco and Steve Teixeira
}

unit
 MainFrm;

interface


uses

  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, clipbrd, Mask, ComCtrls;
type


  TMainForm = class
(TForm)
    edtFirstName: TEdit;
    edtLastName: TEdit;
    edtMI: TEdit;
    btnCopy: TButton;
    btnPaste: TButton;
    meAge: TMaskEdit;
    btnClear: TButton;
    lblFirstName: TLabel;
    lblLastName: TLabel;
    lblMI: TLabel;
    lblAge: TLabel;
    lblBirthDate: TLabel;
    memAsText: TMemo;
    lblCustom: TLabel;
    lblText: TLabel;
    dtpBirthDate: TDateTimePicker;
    procedure
 btnCopyClick(Sender: TObject);
    procedure
 btnPasteClick(Sender: TObject);
    procedure
 btnClearClick(Sender: TObject);
  end
;

var

  MainForm: TMainForm;

implementation

uses
 cbdata;

{$R *.DFM}

procedure
 TMainForm.btnCopyClick(Sender: TObject);
// This method copies the data in the form's controls onto the clipboard
var

  DataObj: TData;
begin

  DataObj := TData.Create;
  try

    with
 DataObj.Rec do

    begin

      FName := edtFirstName.Text;
      LName := edtLastName.Text;
      MI := edtMI.Text;
      Age := StrToInt(meAge.Text);
      BirthDate := dtpBirthDate.Date;
      DataObj.CopyToClipBoard;
    end
;
  finally

    DataObj.Free;
  end
;
end
;

procedure
 TMainForm.btnPasteClick(Sender: TObject);
{ This method pastes CF_DDGDATA formatted data from the clipboard to
  the form's controls. The text version of this data is copied to the
  form's TMemo component. }
var

  DataObj: TData;
begin

  btnClearClick(nil
);
  DataObj := TData.Create;
  try

    // Check if the CF_DDGDATA format is available
    if
 ClipBoard.HasFormat(CF_DDGDATA) then

      // Copy the CF_DDGDATA formatted data to the form's controls
      with
 DataObj.Rec do

      begin

        DataObj.GetFromClipBoard;
        edtFirstName.Text := FName;
        edtLastName.Text := LName;
        edtMI.Text := MI;
        meAge.Text := IntToStr(Age);
        dtpBirthDate.Date := BirthDate;
      end
;
  finally

    DataObj.Free;
  end
;
  // Now copy the text version of the data to form's TMemo component.
  if
 ClipBoard.HasFormat(CF_TEXT) then

    memAsText.PasteFromClipBoard;
end
;

procedure
 TMainForm.btnClearClick(Sender: TObject);
var

  i: integer;
begin

  // Clear the contents of all controls on the form
  for
 i := 0 to
 ComponentCount - 1 do

    if
 Components[i] is
 TCustomEdit then

      TCustomEdit(Components[i]).Text := '';
end
;

end
.

Другое по теме:

• Форма как графический объект
• Сохранить содержимое буфера обмена или потока как картинку
• Сохранение данных в Clipboard