jvclipbrd.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvClipbrd.PAS, released on 2003-05-18.

The Initial Developer of the Original Code is Olivier Sannier
  [obones att altern dott org]
Portions created by Olivier Sannier are Copyright (C) 2003 Olivier Sannier.
All Rights Reserved.

Contributor(s): none to date.

You may retrieve the latest version of this file at the Connection Manager
home page, located at http://cnxmanager.sourceforge.net

Known Issues: none to date.
-----------------------------------------------------------------------------}
// $Id: JvClipbrd.pas,v 1.22 2005/02/17 10:20:02 marquardt Exp $

unit JvClipbrd;

{$I jvcl.inc}
{$I windowsonly.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Windows, Messages, Classes, Clipbrd;

type
  // the type of the event fired when a format has been added with delayed
  // rendering and needs rendering because an application asked for it.
  // Parameters are :
  //   Sender     The object triggering the event. Cleary, will always
  //              be the value returned by JvClipboard, unless you
  //              call the event yourself
  //   Format     The format needing rendering
  //   buffer     The buffer where the rendered data has to be or
  //              has been put
  //              You may change the value of the buffer parameter to
  //              point on a memory that will survive the exit of your
  //              handler. Clearly, you can't give a pointer to a local
  //              variable or use a PChar() conversion.
  //              Alternatively, you can allocate some memory with
  //              GetMem(), copy your data in the buffer and set the
  //              mustFree parameter to True to ask the clipboard to
  //              free the memory for you (done using FreeMem)
  //              Setting buffer to nil will make the system remove this
  //              format from the clipboard, even if it is not a
  //              documented behaviour
  //   size       the size in bytes of the data available in the buffer
  //              Setting size to 0 will make the system remove this
  //              format from the clipboard, even if it is not a
  //              documented behaviour
  //   mustFree   set to False by default. If you set this to True, the
  //              clipboard will call FreeMem(buffer) after having copied
  //              the data in the system clipboard. This is useful only
  //              if you allocated the buffer using GetMem()
  TJvRenderFormatEvent = procedure(Sender: TObject; Format: Word;
    var Buffer: Pointer; var Size: Cardinal; var MustFree: Boolean) of object;

  // the new clipboard object, with added power !
  // clearly, it now allows to use delayed rendering through the
  // OnRenderFormat event.
  // All methods have been overriden to allow specifying delayed
  // rendering. See their documentation for details.
  // However, SetAsHandle has not been overriden as it is enough
  // to set its second parameter to 0 to get delayed rendering
  TJvClipboard = class(TClipboard)
  private
    function GetAsWideText: WideString;
    procedure SetAsWideText(const Value: WideString);
  protected
    // the pointer to the user procedure to call for the event
    // see the declaration of TOnRenderFormat
    FOnRenderFormat: TJvRenderFormatEvent;

    // the list of formats that have been added using delayed rendering
    // we need to keep track of them because we must be able to render
    // them when the WM_RENDERALLFORMATS event is fired.
    // And we can't simply loop through the Formats property as this
    // is not a good thing to call RenderFormat for formats not put
    // by the user in the clipboard (for instance, adding CF_TEXT will
    // make the system add a CF_OEMTEXT and a CF_UNICODETEXT automatically)
    // Moreover, to ensure that the delayed rendering formats will
    // survive the death of the application, we must ask for their value
    // from the DestroyHandle method
    // If the formats are quite big, which may cause memory problems,
    // you should ask the user if he wants to keep them and if not,
    // call the clear method before destroying the handle
    // This list will actually only contain Words (Format Ids)
    FDelayedFormats: TList;

    // the handle to the window processing the messages
    FClipboardWindow: THandle;

    // This flag is used to determine wether or not the RenderFormat
    // method should be called as a result of the WM_RENDERALLFORMATS
    // message. It will be set to True from within DestroyHandle,
    // thus ensuring a delayed rendering format is only rendered once
    FFromDestroyHandle: Boolean;

    // overridden wndproc to handle WM_RENDERFORMAT and
    // WM_RENDERALLFORMATS messages
    {$IFDEF COMPILER6_UP}
    procedure WndProc(var Message: TMessage); override;
    {$ELSE}
    procedure WndProc(var Message: TMessage); virtual;
    procedure MainWndProc(var Message: TMessage);

    // SetBuffer is not protected in the VCL shipped with D5 and BCB5.
    // We need to access it anyway and this is done using direct memory
    // access to the correct procedure. However this method cannot be
    // called SetBuffer because under BCB the Buffer parameter will be
    // output as a void* for both Pointer and Untyped types.
    procedure SetBufferVCL5(Format: Word; var Buffer; Size: Integer);
    {$ENDIF COMPILER6_UP}

    // This function calls the user event handler and does the
    // rendering the way windows expects it
    // it will trigger an exception if no OnRenderFormat event
    // handler is given
    procedure RenderFormat(Format: Word); virtual;

    // returns the window handle (the value of FClipboardWindow)
    function GetHandle: THandle;
  public
    // creates the list
    constructor Create; virtual;

    // destroys the list and the window (only if needed, see below)
    destructor Destroy; override;

    // To ensure that the formats using delayed rendering are
    // saved when the application terminates, it is necessary
    // that we get their values before actually destroying the
    // underlying window (which handle is given by the Handle property)
    // As a result, the OnRenderFormat event will be fired for every
    // format with delayed rendering still in the clipboard.
    // This could lead to memory problems if the format is quite big.
    // You should then asks the user if he wants to keep the big objects
    // available for other programs
    // If you don't call this method and some formats are in the
    // clipboard with delayed rendering, it will be called upon
    // destruction of the clipboard, which is likely to happen after the
    // destruction of the object where the event is set.
    // I let you imagine the consequences...
    // So you should call this function from the destructor (or the
    // OnDestroy event) of the component where the OnRenderFormat event
    // handler is set (eg, the main form) as this component is likely
    // to be destroyed before the clipboard itself.
    procedure DestroyHandle;

    {$IFDEF COMPILER6_UP}
    // forced to override Open to be able to use our own
    // window handle
    procedure Open; override;

    // Close is overriden but simply calls the inherited Close
    // method. It is still there if you want to tweak around
    procedure Close; override;

    // forced to override Clear to keep track of the delayed
    // formats in the delayedFormats list
    procedure Clear; override;
    {$ELSE}
    procedure Open; virtual;
    procedure Close; virtual;
    procedure Clear; virtual;
    {$ENDIF COMPILER6_UP}

    // registers a format of that name with the system and returns
    // its identifier. You may as well call RegisterClipboardFormat
    // directly
    function RegisterFormat(const Name: string): Word;

    // add a format that uses delayed rendering
    // if you do so, you MUST provide an OnRenderFormat event handler
    procedure AddDelayed(Format: Word);

    // overriden method to allow setting buffer to nil and thus
    // asking to use delayed rendering. If you do so, you MUST provide
    // an OnRenderFormat event handler
    // if buffer <> nil then the inherited method is called
    procedure SetBuffer(Format: Word; Buffer: Pointer; Size: Integer); overload;

    // get a buffer of the given format
    // the format must be present in the clipboard. If not the function
    // returns False.
    // The buffer and the size parameters must be set to the correct size
    // for the specified format. If they are too small, the data will be
    // truncated, resulting in corrupted values on your side (but you're
    // the one who knows what to do with that).
    // If they are too large, the application will crash as it will be
    // asking the system for more data than available
    // Returns True if data was successfuly retrieved, else use
    // Windows.GetLastError to get the error code
    function GetBuffer(Format: Word; Buffer: Pointer; Size: Cardinal): Boolean;

    // overloaded version of the same procedure in TClipboard that
    // now allows you to specify delayed rendering.
    // If delayed is set to False, the inherited method is called
    // else, the format is simply added in the clipboard and you MUST
    // provid an OnRenderFormat event;
    procedure SetComponent(Component: TComponent; Delayed: Boolean); overload;

    // overloaded version of the same procedure in TClipboard that
    // now allows you to specify delayed rendering.
    // If delayed is set to False, the inherited method is called
    // else, the format is simply added in the clipboard and you MUST
    // provid an OnRenderFormat event;
    procedure SetTextBuf(Buffer: PChar; Delayed: Boolean); overload;

    // the handle to the underlying window handling the delayed
    // rendering messages
    property Handle: THandle read GetHandle;
  {$IFNDEF COMPILER6_UP}
  private
    function GetOpenRefCount: Integer;
  protected
    property OpenRefCount: Integer read GetOpenRefCount;
  {$ENDIF !COMPILER6_UP}
  published
    // the event fired when a format has been added with delayed
    // rendering and needs rendering because an application (or the
    // DestroyHandle method) asked for it
    property OnRenderFormat: TJvRenderFormatEvent read FOnRenderFormat
      write FOnRenderFormat;
    property AsWideText: WideString read GetAsWideText write SetAsWideText;
  end;

// global function to get access to a TJvClipboard object
function JvClipboard: TJvClipboard;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvClipbrd.pas,v $';
    Revision: '$Revision: 1.22 $';
    Date: '$Date: 2005/02/17 10:20:02 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  SysUtils, Consts,
  JvTypes, JvJVCLUtils, JvResources;

{$IFNDEF COMPILER6_UP}

// Delphi 5 implementation
type
  TPrivateClipboard = class(TPersistent)
  private
    FOpenRefCount: Integer;
  end;

var
  Clipboard_SetBuffer: procedure(Instance: TClipboard; Format: Word; var Buffer;
    Size: Integer);

{$ENDIF !COMPILER6_UP}

constructor TJvClipboard.Create;
begin
  inherited Create;
  // create the list used to keep track of delayed formats
  // in the clipboard
  FDelayedFormats := TList.Create;

  // if a WM_RENDERALLFORMATS message is fired, then
  // it is not yet as a result of a call to DestroyHandle
  FFromDestroyHandle := False;
end;

destructor TJvClipboard.Destroy;
begin
  // ensure handle is destroyed, but see remark where
  // DestroyHandle is declared
  DestroyHandle;

  // free the list
  FDelayedFormats.Free;

  // and let the rest be done
  inherited Destroy;
end;

{$IFNDEF COMPILER6_UP}

procedure TJvClipboard.SetBufferVCL5(Format: Word; var Buffer; Size: Integer);
var
  P: PByte;
begin
  if not Assigned(Clipboard_SetBuffer) then
  begin
    P := @TClipboard.SetTextBuf;
    while P^ <> $E8 do
      Inc(P); // StrLen
    Inc(P);
    while P^ <> $E8 do
      Inc(P); // SetBuffer
    Inc(P);
    Clipboard_SetBuffer := Pointer(Integer(P) + 4 + PInteger(P)^);
  end;
  if Assigned(Clipboard_SetBuffer) then
    Clipboard_SetBuffer(Self, Format, Buffer, Size);
end;

function TJvClipboard.GetOpenRefCount: Integer;
begin
  Result := TPrivateClipboard(Self).FOpenRefCount;
end;

{$ENDIF !COMPILER6_UP}

procedure TJvClipboard.Clear;
begin
  // call the inherited method, will do its job
  inherited Clear;
  // no more delayed formats available
  FDelayedFormats.Clear;
end;

function TJvClipboard.GetBuffer(Format: Word; Buffer: Pointer;
  Size: Cardinal): Boolean;
var
  Data: THandle;
  DataPtr: Pointer;
begin
  // retrieve data of the given format

  // first, open clipoard
  Open;

  // ask for data
  Data := GetClipboardData(Format);

  // was data retrieved ?
  if Data <> 0 then
  begin