jvclipbrd.pas

East make Tray Icon in delphi

    // if some data retrieved, get a Pointer to it
    DataPtr := GlobalLock(Data);

    // did we get a valid Pointer ?
    if DataPtr <> nil then
    begin
      // if yes, copy from global pointer to user supplied pointer
      CopyMemory(Buffer, DataPtr, Size);
      // and retrieval was a success
      Result := True;
    end
    else
    begin
      // else, retrieval has failed
      Result := False;
    end;

    // unlock global memory
    GlobalUnlock(Data);
  end
  else
  begin
    // if no data retrieved, then retrieval failed
    Result := False;
  end;

  // finally, close clipoard
  Close;
end;

procedure TJvClipboard.Open;
begin
  // call the inherited open method to force the inherited
  // private FOpenRefCount to be greater than 0. This is the
  // result of a bad design, because FOpenRefCount should be
  // protected in the TClipboard class, allowing us to access
  // it directly, rather than tweaking around
  // Having the inherited FOpenRefCount greater than 0 is
  // required for the inherited method that put data in the
  // clipboard to work. Indeed, they call the private method
  // Adding which calls Clear only if FOpenRefCount is not 0.
  // And calling Clear is required for the window to get the
  // clipboard ownership.
  // Another good decision would have been to make the Adding
  // method protected rather than private. This would have
  // allowed to easily add other methods to put other types
  // in the clipboard.
  // But it seems the people in charge of that part didn't
  // have reusability in mind when they designed the
  // TClipboard class
  inherited Open;

  // if we were just opened (the inherited FOpenRefCount
  // just turned to 1)
  if OpenRefCount = 1 then
  begin
    // then, if we need a window to handle delayed rendering
    if FClipboardWindow = 0 then
    begin
      // then we create one, passing MainWndProc rather than
      // WndProc as MainWndProc will call WndProc but in a
      // try except statement ensuring good exception handling
      FClipboardWindow := AllocateHWndEx(MainWndProc);
    end;

    // we must now close the clipboard as it was opened
    // with an incorrect window handle (most likely the
    // application window handle)
    CloseClipboard;

    // and we finally open the clipboard with our window handle
    // to ensure that we can process delayed rendering messages
    if not OpenClipboard(FClipboardWindow) then
      raise EJVCLException.CreateRes(@SCannotOpenClipboard);
  end;
end;

procedure TJvClipboard.Close;
begin
  // call the inherited close method to force update of the
  // inherited FOpenRefCount and to close the clipboard if
  // needed
  inherited Close;
end;

function TJvClipboard.RegisterFormat(const Name: string): Word;
var
  Tmp: PChar;
begin
  GetMem(Tmp, Length(Name) + 1); // don't forget +1 for trailing #0
  try
    StrPCopy(Tmp, Name);
    Result := RegisterClipboardFormat(Tmp);
  finally
    FreeMem(Tmp);
  end;
  // Note : Yes, we could have used PChar(name) as an argument to
  // RegisterClipboardFormat, but this only works under Delphi 6
  // and this code have to work under older versions
end;

procedure TJvClipboard.RenderFormat(Format: Word);
var
  Buffer: Pointer;
  Size: Cardinal;
  hglb: HGLOBAL;
  GlobalPtr: Pointer;
  MustFree: Boolean;
begin
  // by default, we must not free the given buffer
  MustFree := False;

  // if user gave us an event
  if Assigned(FOnRenderFormat) then
    // then ask user to render the format
    FOnRenderFormat(Self, Format, Buffer, Size, MustFree)
  else
    // else, trigger an exception, how could we guess the
    // size and data to put in the buffer ?
    raise EJVCLException.CreateRes(@RsENoRenderFormatEventGiven);

  // now render the way windows wants it

  // first allocate a global memory
  hglb := GlobalAlloc(GMEM_DDESHARE or GMEM_MOVEABLE, Size);
  if hglb <> 0 then
  begin
    // if allocation was successful
    // then lock global memory to get access to it
    GlobalPtr := GlobalLock(hglb);

    // copy user supplied data
    CopyMemory(GlobalPtr, Buffer, Size);

    // unlock global memory
    GlobalUnlock(hglb);

    // finally, place the content in the clipboard
    SetClipboardData(Format, hglb);
  end;

  // if user asked us to free his buffer
  if MustFree then
    // then we free it
    FreeMem(Buffer);
end;

procedure TJvClipboard.WndProc(var Message: TMessage);
var
  I: Integer;
begin
  case Message.Msg of
    // if asked to render a particular format
    WM_RENDERFORMAT:
      begin
        // then render it
        RenderFormat(Message.WParam);
        // and tell windows so
        Message.Result := 0;
      end;
    // if asked to render all available formats
    WM_RENDERALLFORMATS:
      begin
        // then if it is not the result of a call
        // to DestroyHandle
        if not FFromDestroyHandle then
        begin
          // then we render all the delayed formats
          // we are aware of
          for I := 0 to FDelayedFormats.Count - 1 do
            RenderFormat(Word(FDelayedFormats[I]));
        end;
        // tell windows we handled the message
        Message.Result := 0;
      end;
  end;

  {$IFDEF COMPILER6_UP}
  // in any case let the ancestor do its stuff
  inherited WndProc(Message);
  {$ELSE}
  with Message do
    Result := DefWindowProc(Handle, Msg, WParam, LParam);
  {$ENDIF COMPILER6_UP}
end;

{$IFNDEF COMPILER6_UP}
procedure TJvClipboard.MainWndProc(var Message: TMessage);
begin
  try
    WndProc(Message);
  except
    ShowException(ExceptObject, ExceptAddr);
  end;
end;
{$ENDIF !COMPILER6_UP}

procedure TJvClipboard.DestroyHandle;
var
  I: Integer;
  Format: Word;
  Buffer: Char;
begin
  // if we have a window handle, hence, meaning that it is
  // the first time DestroyHandle is called
  if FClipboardWindow <> 0 then
  begin
    // to ensure persistance of the private formats, we
    // must get them before destroying the window
    // this is rather strange as destroying the window fires
    // the WM_RENDERALLFORMATS message but it seems the system
    // forgets the results.
    // so we do the job ourselves and ask for the data
    // Of course, this will not work for formats that the user
    // put in the clipboard using delayed rendering through direct
    // API calls
    for I := 0 to FDelayedFormats.Count - 1 do
    begin
      // get the format id
      Format := Word(FDelayedFormats[I]);

      // ask to get this format from the clipboard, will
      // in turn trigger a WM_RENDERFORMAT message
      // we only ask for one byte as we don't know what to
      // do with the format and clearly won't use it
      // Asking for one byte ensures that windows will
      // effectively give us something
      GetBuffer(Format, @Buffer, 1);
    end;

    // Having done that will not prevent the WM_RENDERALLFORMATS
    // message from being fired so me must ensure the RenderFormat
    // method is not called twice for all delayed rendering formats
    FFromDestroyHandle := True;

    // we can now safely destroy the window
    DeallocateHWndEx(FClipboardWindow);

    // and we no longer have a window
    FClipboardWindow := 0;
  end;
end;

function TJvClipboard.GetHandle: THandle;
begin
  Result := FClipboardWindow;
end;

procedure TJvClipboard.SetComponent(Component: TComponent; Delayed: Boolean);
begin
  if Delayed then
    // add as delayed
    AddDelayed(CF_COMPONENT)
  else
    inherited SetComponent(Component);
end;

procedure TJvClipboard.SetTextBuf(Buffer: PChar; Delayed: Boolean);
begin
  if Delayed then
    // add as delayed
    AddDelayed(CF_TEXT)
  else
    inherited SetTextBuf(Buffer);
end;

procedure TJvClipboard.SetBuffer(Format: Word; Buffer: Pointer; Size: Integer);
begin
  // if buffer is nil
  if Buffer = nil then
    // then add the format using delayed rendering
    AddDelayed(Format)
  else
  begin
    // else call inherited method
    {$IFDEF COMPILER6_UP}
    inherited SetBuffer(Format, Buffer^, Size);
    {$ELSE}
    SetBufferVCL5(Format, Buffer^, Size);
    {$ENDIF COMPILER6_UP}
  end;
end;

procedure TJvClipboard.AddDelayed(Format: Word);
begin
  // add as delayed
  inherited SetAsHandle(Format, 0);
  // and we keep track of that format
  FDelayedFormats.Add(Pointer(Format));
end;

function TJvClipboard.GetAsWideText: WideString;
var
  Data: THandle;
begin
  Open;
  Data := GetClipboardData(CF_UNICODETEXT);
  try
    if Data <> 0 then
      Result := PWideChar(GlobalLock(Data))
    else
      Result := '';
  finally
    if Data <> 0 then
      GlobalUnlock(Data);
    Close;
  end;
  if (Data = 0) or (Result = '') then
    Result := AsText
end;

procedure TJvClipboard.SetAsWideText(const Value: WideString);
begin
  Open;
  try
    AsText := Value; {Ensures ANSI compatiblity across platforms.}
    {$IFDEF COMPILER6_UP}
    SetBuffer(CF_UNICODETEXT, PWideChar(Value)^, (Length(Value) + 1) * SizeOf(WideChar));
    {$ELSE}
    SetBufferVCL5(CF_UNICODETEXT, PWideChar(Value)^, (Length(Value) + 1) * SizeOf(WideChar));
    {$ENDIF COMPILER6_UP}
  finally
    Close;
  end;
end;

var
  GlobalClipboard: TJvClipboard;

// global function to call to get access to the clipboard

function JvClipboard: TJvClipboard;
begin
  if GlobalClipboard = nil then
    GlobalClipboard := TJvClipboard.Create;
  Result := GlobalClipboard;
end;

initialization
  {$IFDEF UNITVERSIONING}
  RegisterUnitVersion(HInstance, UnitVersioning);
  {$ENDIF UNITVERSIONING}

finalization
  FreeAndNil(GlobalClipboard);
  {$IFDEF UNITVERSIONING}
  UnregisterUnitVersion(HInstance);
  {$ENDIF UNITVERSIONING}

end.