Date: Fri, 08 Jun 2001 20:00:29 +0100
Newsgroups: borland.public.delphi.graphics
Mime-Version: 1.0
Content-Type: text/plain; charset=iso-8859-1
Content-Transfer-Encoding: 8bit
X-Newsreader: Virtual Access by Atlantic Coast PLC, http://www.atlantic-coast.com/va
Message-ID: <VA.00000208.02699607@lineone.net>
Subject: Re: Icons and Clipboard
From: Bob Villiers <bob_villiers@lineone.net>
Reply-To: bob_villiers@lineone.net
References: <9fq2h6$4al$07$1@news.t-online.com>
NNTP-Posting-Host: 213.123.59.21
X-Trace: dnews 992026729 213.123.59.21 (8 Jun 2001 11:58:49 -0700)
Lines: 130
Path: dnews
Xref: dnews borland.public.delphi.graphics:39548

Marcus,

There is no built in method for storing icon files in the clipboard so 
you have to do a bit more work. Here is a little demo.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, 
Dialogs,
  StdCtrls, ExtDlgs, ExtCtrls;

var
  CF_ICON: Word;

type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenPictureDialog1: TOpenPictureDialog;
    Button2: TButton;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses Clipbrd;

procedure TForm1.Button1Click(Sender: TObject);
var
  memStream: TMemoryStream;
  Data: THandle;
  DataPtr: Pointer;
begin
  if OpenPictureDialog1.Execute then begin
    memStream:= TMemoryStream.Create;
    try
      memStream.LoadFromFile(OpenPictureDialog1.FileName);
      Data := GlobalAlloc(GMEM_MOVEABLE, memStream.Size);
      try
        DataPtr := GlobalLock(Data);
        Move(memStream.Memory^, DataPtr^, memStream.Size);
        ClipBoard.Open;
        Clipboard.SetAsHandle(CF_ICON,Data);
        Clipboard.Close;
        GlobalUnlock(Data);
      except
        GlobalFree(Data);
        raise;
      end;
    finally
      memStream.Free;
    end;
  end;
end;


procedure TForm1.FormCreate(Sender: TObject);
var s: TFilename;
begin
  s:= ExtractFilePath(Application.Exename);
  OpenPictureDialog1.InitialDir:= s;
  OpenPictureDialog1.Filter:= 'Icon files (*.ico)|*.ICO';
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  Data: THandle;
  DataPtr: Pointer;
  MemStream: TMemoryStream;
  Icon: TIcon;
begin
   Clipboard.Open;
    try
      Data:= Clipboard.GetAsHandle(CF_ICON);
      try
        if Data = 0 then Exit;
        DataPtr := GlobalLock(Data);
        try
          if DataPtr = nil then Exit;
          MemStream := TMemoryStream.Create;
          try
            MemStream.WriteBuffer(DataPtr^, GlobalSize(Data));
            Memstream.Seek(0,0);
            Icon:= TIcon.Create;
            try
              Icon.LoadFromStream(Memstream);
              Image1.Picture.Graphic:= Icon;
            finally
              Icon.Free;
            end;
          finally
            memStream.Free;
          end;
        finally
          GlobalUnlock(Data);
        end;
      except
        GlobalFree(Data);
        raise;
      end;
    finally
      clipboard.Close;
    end;
end;


initialization
  CF_ICON := RegisterClipboardFormat('Icon Data');
end.

Bob
----
Sent using Virtual Access 5.01 - download your freeware copy now
http://www.atlantic-coast.com/downloads/vasetup.exe