implemented copying graphics from/to clipboard

git-svn-id: trunk@4598 -

lcl/clipbrd.pp

@@ -165,10 +165,10 @@ type
     FOnRequest: TClipboardRequestEvent;
     FOpenRefCount: Integer; // reference count for Open and Close (not used yet)
     procedure AssignGraphic(Source: TGraphic);
+    procedure AssignGraphic(Source: TGraphic; FormatID: TClipboardFormat);
     procedure AssignPicture(Source: TPicture);
-    procedure AssignToBitmap(Dest: TBitmap);
+    function AssignToGraphic(Dest: TGraphic): boolean;
-    procedure AssignToPixmap(Dest: TPixmap);
+    function AssignToGraphic(Dest: TGraphic; FormatID: TClipboardFormat): boolean;
-    procedure AssignToIcon(Dest: TIcon);
     //procedure AssignToMetafile(Dest: TMetafile);
     procedure AssignToPicture(Dest: TPicture);
     function GetAsText: string;
@@ -182,18 +182,18 @@ type
     procedure SetAsText(const Value: string);
     procedure SetBuffer(FormatID: TClipboardFormat; var Buffer; Size: Integer);
     procedure SetOnRequest(AnOnRequest: TClipboardRequestEvent);
-  protected
-    procedure AssignTo(Dest: TPersistent); override;
   public
     function AddFormat(FormatID: TClipboardFormat; Stream: TStream): Boolean;
     function AddFormat(FormatID: TClipboardFormat; var Buffer; Size: Integer): Boolean;
     procedure Assign(Source: TPersistent); override;
+    procedure AssignTo(Dest: TPersistent); override;
     procedure Clear;
     procedure Close; // dummy for delphi compatibility only
     constructor Create;
     constructor Create(AClipboardType: TClipboardType);
     destructor Destroy; override;
     function FindPictureFormatID: TClipboardFormat;
+    function FindFormatID(const FormatName: string): TClipboardFormat;
     //function GetAsHandle(Format: integer): THandle;
     function GetComponent(Owner, Parent: TComponent): TComponent;
     function GetFormat(FormatID: TClipboardFormat; Stream: TStream): Boolean;
@@ -202,6 +202,7 @@ type
                                var FormatList: PClipboardFormat);
     function GetTextBuf(Buffer: PChar; BufSize: Integer): Integer;
     function HasFormat(FormatID: TClipboardFormat): Boolean;
+    function HasFormatName(const FormatName: string): Boolean;
     function HasPictureFormat: boolean;
     procedure Open; // dummy for delphi compatibility only
     //procedure SetAsHandle(Format: integer; Value: THandle);
@@ -319,12 +320,27 @@ begin
     FreeAndNil(FClipboards[AClipboardType]);
 end;
 
+procedure LoadGraphicFromClipboardFormat(Dest: TGraphic;
+  ClipboardType: TClipboardType; FormatID: TClipboardFormat);
+begin
+  Clipboard(ClipboardType).AssignToGraphic(Dest,FormatID);
+end;
+
+procedure SaveGraphicToClipboardFormat(Src: TGraphic;
+  ClipboardType: TClipboardType; FormatID: TClipboardFormat);
+begin
+  Clipboard(ClipboardType).AssignGraphic(Src,FormatID);
+end;
+
 //-----------------------------------------------------------------------------
 
 procedure InternalInit;
 var
   AClipboardType: TClipboardType;
 begin
+  OnLoadGraphicFromClipboardFormat:=@LoadGraphicFromClipboardFormat;
+  OnSaveGraphicToClipboardFormat:=@SaveGraphicToClipboardFormat;
+
   for AClipboardType:=Low(TClipboardType) to High(TClipboardType) do
     FClipboards[AClipboardType]:=nil;
 end;
@@ -344,6 +360,9 @@ end.
 
 {
   $Log$
+  Revision 1.13  2003/09/10 19:15:15  mattias
+  implemented copying graphics from/to clipboard
+
   Revision 1.12  2003/09/10 16:29:13  mattias
   added Kylix 3 specials
 

lcl/graphics.pp

@@ -504,9 +504,16 @@ type
     procedure SaveToFile(const Filename: string); virtual;
     procedure LoadFromStream(Stream: TStream); virtual; abstract;
     procedure SaveToStream(Stream: TStream); virtual; abstract;
+    procedure LoadFromMimeStream(Stream: TStream; const MimeType: string); virtual;
     procedure LoadFromLazarusResource(const ResName: String); virtual; abstract;
-    procedure LoadFromClipboardFormat(FormatID: TClipboardFormat); virtual; abstract;
+    procedure LoadFromClipboardFormat(FormatID: TClipboardFormat); virtual;
-    procedure SaveToClipboardFormat(FormatID: TClipboardFormat); virtual; abstract;
+    procedure LoadFromClipboardFormatID(ClipboardType: TClipboardType;
+      FormatID: TClipboardFormat); virtual;
+    procedure SaveToClipboardFormat(FormatID: TClipboardFormat); virtual;
+    procedure SaveToClipboardFormatID(ClipboardType: TClipboardType;
+      FormatID: TClipboardFormat); virtual;
+    procedure GetSupportedSourceMimeTypes(List: TStrings); virtual;
+    function GetDefaultMimeType: string; virtual;
   public
     property Empty: Boolean read GetEmpty;
     property Height: Integer read GetHeight write SetHeight;
@@ -559,10 +566,11 @@ type
       Graphic - The TGraphic object contained by the TPicture
       Bitmap - Returns a bitmap.  If the contents is not already a bitmap, the
         contents are thrown away and a blank bitmap is returned.
-      Icon - Returns an icon.  If the contents is not already an icon, the
-        contents are thrown away and a blank icon is returned.
       Pixmap - Returns a pixmap.  If the contents is not already a pixmap, the
         contents are thrown away and a blank pixmap is returned.
+      PNG - Returns a png.  If the contents is not already a png, the
+        contents are thrown away and a blank png (TPortableNetworkGraphic) is
+        returned.
       }
 
   TPicture = class(TPersistent)
@@ -598,6 +606,8 @@ type
     procedure LoadFromFile(const Filename: string);
     procedure SaveToFile(const Filename: string);
     procedure LoadFromClipboardFormat(FormatID: TClipboardFormat);
+    procedure LoadFromClipboardFormatID(ClipboardType: TClipboardType;
+      FormatID: TClipboardFormat);
     procedure SaveToClipboardFormat(FormatID: TClipboardFormat);
     class function SupportsClipboardFormat(FormatID: TClipboardFormat): Boolean;
     procedure Assign(Source: TPersistent); override;
@@ -903,13 +913,15 @@ type
     procedure LoadFromLazarusResource(const ResName: String); override;
     procedure LoadFromResourceName(Instance: THandle; const ResName: String); virtual;
     procedure LoadFromResourceID(Instance: THandle; ResID: Integer); virtual;
-    procedure LoadFromClipboardFormat(FormatID: TClipboardFormat); override;
+    procedure LoadFromMimeStream(Stream: TStream; const MimeType: string); override;
-    procedure SaveToClipboardFormat(FormatID: TClipboardFormat); override;
+    procedure GetSupportedSourceMimeTypes(List: TStrings); override;
+    function GetDefaultMimeType: string; override;
     Procedure LoadFromXPMFile(const Filename : String);
     procedure Mask(ATransparentColor: TColor);
     procedure SaveToStream(Stream: TStream); override;
     Function ReleaseHandle: HBITMAP;
     function ReleasePalette: HPALETTE;
+  public
     property Canvas: TCanvas read GetCanvas write FCanvas;
     property Handle: HBITMAP read GetHandle write SetHandle;
     property HandleType: TBitmapHandleType read GetHandleType write SetHandleType;
@@ -939,6 +951,7 @@ type
     function LazarusResourceTypeValid(const ResourceType: string): boolean; override;
     procedure ReadStream(Stream: TStream; Size: Longint); override;
     procedure WriteStream(Stream: TStream; WriteSize: Boolean); override;
+    function GetDefaultMimeType: string; override;
   end;
   
   { TIcon }
@@ -956,13 +969,14 @@ type
   end;
 
 
-  // Color / Identifier mapping
-  TGetColorStringProc = procedure(const s:ansistring) of object;
-  
 function GraphicFilter(GraphicClass: TGraphicClass): string;
 function GraphicExtension(GraphicClass: TGraphicClass): string;
 function GraphicFileMask(GraphicClass: TGraphicClass): string;
 
+type
+  // Color / Identifier mapping
+  TGetColorStringProc = procedure(const s:ansistring) of object;
+  
 function ColorToIdent(Color: Longint; var Ident: String): Boolean;
 function IdentToColor(const Ident: string; var Color: Longint): Boolean;
 function ColorToRGB(Color: TColor): Longint;
@@ -975,6 +989,7 @@ Function Green(rgb: TColor) : BYTE;
 Function Red(rgb: TColor) : BYTE;
 procedure RedGreenBlue(rgb: TColor; Red, Green, Blue: Byte);
 
+// fonts
 procedure GetCharsetValues(Proc: TGetStrProc);
 function CharsetToIdent(Charset: Longint; var Ident: string): Boolean;
 function IdentToCharset(const Ident: string; var Charset: Longint): Boolean;
@@ -989,6 +1004,19 @@ function ClearXLFDHeight(const LongFontName: string): string;
 function ClearXLFDPitch(const LongFontName: string): string;
 function ClearXLFDStyle(const LongFontName: string): string;
 
+// graphics
+type
+  TOnLoadGraphicFromClipboardFormat =
+    procedure(Dest: TGraphic; ClipboardType: TClipboardType;
+              FormatID: TClipboardFormat);
+  TOnSaveGraphicToClipboardFormat =
+    procedure(Src: TGraphic; ClipboardType: TClipboardType;
+              FormatID: TClipboardFormat);
+
+var
+  OnLoadGraphicFromClipboardFormat: TOnLoadGraphicFromClipboardFormat;
+  OnSaveGraphicToClipboardFormat: TOnSaveGraphicToClipboardFormat;
+
 function TestStreamBitmapNativeType(Stream: TMemoryStream): TBitmapNativeType;
 function TestStreamIsBMP(Stream: TMemoryStream): boolean;
 function TestStreamIsXPM(Stream: TMemoryStream): boolean;
@@ -1185,11 +1213,15 @@ end;
 initialization
   PicClipboardFormats:=nil;
   PicFileFormats:=nil;
+  OnLoadGraphicFromClipboardFormat:=nil;
+  OnSaveGraphicToClipboardFormat:=nil;
   RegisterIntegerConsts(TypeInfo(TColor), @IdentToColor, @ColorToIdent);
   RegisterIntegerConsts(TypeInfo(TFontCharset), @IdentToCharset, @CharsetToIdent);
 
 finalization
   GraphicsFinalized:=true;
+  OnLoadGraphicFromClipboardFormat:=nil;
+  OnSaveGraphicToClipboardFormat:=nil;
   FreeAndNil(PicClipboardFormats);
   FreeAndNil(PicFileFormats);
 
@@ -1199,6 +1231,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.90  2003/09/10 19:15:15  mattias
+  implemented copying graphics from/to clipboard
+
   Revision 1.89  2003/09/08 13:07:17  mattias
   TBitmap now uses fpImage for writing bitmaps
 

lcl/include/bitmap.inc

@@ -295,14 +295,30 @@ begin
   writeln('ToDo: TBitMap.LoadFromResourceID');
 end;
 
-procedure TBitmap.LoadFromClipboardFormat(FormatID: TClipboardFormat);
+procedure TBitmap.GetSupportedSourceMimeTypes(List: TStrings);
 begin
-  writeln('ToDo: TBitMap.LoadFromClipboardFormat');
+  if (ClassType=TBitmap) or (ClassType=TPixmap) then begin
+    List.Clear;
+    List.Add(PredefinedClipboardMimeTypes[pcfBitmap]);
+    List.Add(PredefinedClipboardMimeTypes[pcfDelphiBitmap]);
+    List.Add(PredefinedClipboardMimeTypes[pcfPixmap]);
+  end else
+    inherited GetSupportedSourceMimeTypes(List);
 end;
 
-procedure TBitmap.SaveToClipboardFormat(FormatID: TClipboardFormat);
+function TBitmap.GetDefaultMimeType: string;
 begin
-  writeln('ToDo: TBitmap.SaveToClipboardFormat');
+  if (ClassType=TBitmap) or (ClassType=TPixmap) then begin
+    if FImage.SaveStream<>nil then begin
+      case FImage.SaveStreamType of
+      bnXPixmap: Result:=PredefinedClipboardMimeTypes[pcfPixmap];
+      else
+        Result:=PredefinedClipboardMimeTypes[pcfBitmap];
+      end;
+    end else
+      Result:=PredefinedClipboardMimeTypes[pcfBitmap];
+  end else
+    Result:=inherited GetDefaultMimeType;
 end;
 
 Procedure TBitmap.LoadFromXPMFile(const Filename : String);
@@ -480,6 +496,20 @@ begin
   end;
 end;
 
+procedure TBitmap.LoadFromMimeStream(Stream: TStream; const MimeType: string);
+begin
+  if (ClassType=TBitmap) or (ClassType=TPixmap) then begin
+    if (AnsiCompareText(MimeType,PredefinedClipboardMimeTypes[pcfBitmap])=0)
+    or (AnsiCompareText(MimeType,PredefinedClipboardMimeTypes[pcfDelphiBitmap])=0)
+    or (AnsiCompareText(MimeType,PredefinedClipboardMimeTypes[pcfPixmap])=0) then
+    begin
+      LoadFromStream(Stream);
+      exit;
+    end;
+  end;
+  inherited LoadFromMimeStream(Stream, MimeType);
+end;
+
 procedure TBitmap.SetWidthHeight(NewWidth, NewHeight: integer);
 begin
   with FImage do
@@ -888,6 +918,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.46  2003/09/10 19:15:15  mattias
+  implemented copying graphics from/to clipboard
+
   Revision 1.45  2003/09/08 13:07:17  mattias
   TBitmap now uses fpImage for writing bitmaps
 

lcl/include/clipbrd.inc

@@ -403,45 +403,63 @@ begin
 end;
 
 function TClipboard.FindPictureFormatID: TClipboardFormat;
-const
-  PicFormats: set of TPredefinedClipboardFormat = [
-      pcfBitmap,
-      pcfPixmap,
-      pcfIcon,
-      pcfPicture,
-      pcfDelphiBitmap,
-      pcfDelphiPicture,
-      //pcfDelphiMetaFilePict,  (unsupported yet)
-      pcfKylixPicture,
-      pcfKylixBitmap
-      //pcfKylixDrawing  (unsupported yet)
-    ];
 var
-  f: TPredefinedClipboardFormat;
   List: PClipboardFormat;
   cnt, i: integer;
 begin
   //writeln('[TClipboard.FindPictureFormatID]');
   List:=nil;
+  Result:=0;
+  cnt:=0;
   if not FAllocated then begin
-    if not ClipboardGetFormats(ClipboardType,cnt,List) then begin
+    if not ClipboardGetFormats(ClipboardType,cnt,List) then
-      Result:=0;
       exit;
-    end;
-  end else begin
-    cnt:=0;
   end;
   try
-    for f:=Low(TPredefinedClipboardFormat) to High(TPredefinedClipboardFormat) do
+    if not FAllocated then begin
-    begin
+      for i:=0 to cnt-1 do begin
-      Result:=PredefinedClipboardFormat(f);
+        Result:=List[i];
-      if (Result<>0) and (f in PicFormats) then begin
+        if TPicture.SupportsClipboardFormat(Result) then
-        if not FAllocated then begin
+          exit;
-          for i:=0 to cnt-1 do
+      end;
-            if (List[i]=Result) then exit;
+    end else begin
-        end else begin
+      for i:=FCount-1 downto 0 do begin
-          if IndexOfCachedFormatID(Result,false)>=0 then exit;
+        Result:=FData[i].FormatID;
-        end;
+        if TPicture.SupportsClipboardFormat(Result) then
+          exit;
+      end;
+    end;
+  finally
+    if List<>nil then FreeMem(List);
+  end;
+  Result:=0;
+end;
+
+function TClipboard.FindFormatID(const FormatName: string): TClipboardFormat;
+var
+  List: PClipboardFormat;
+  cnt, i: integer;
+begin
+  //writeln('[TClipboard.FindPictureFormatID]');
+  List:=nil;
+  Result:=0;
+  cnt:=0;
+  if not FAllocated then begin
+    if not ClipboardGetFormats(ClipboardType,cnt,List) then
+      exit;
+  end;
+  try
+    if not FAllocated then begin
+      for i:=0 to cnt-1 do begin
+        Result:=List[i];
+        if AnsiCompareText(ClipboardFormatToMimeType(Result),FormatName)=0 then
+          exit;
+      end;
+    end else begin
+      for i:=FCount-1 downto 0 do begin
+        Result:=FData[i].FormatID;
+        if AnsiCompareText(ClipboardFormatToMimeType(Result),FormatName)=0 then
+          exit;
       end;
     end;
   finally
@@ -487,40 +505,90 @@ begin
   //writeln('[TClipboard.HasFormat] END ',ClipboardTypeName[ClipboardType],' FormatID=',FormatID,' Result=',Result);
 end;
 
+function TClipboard.HasFormatName(const FormatName: string): Boolean;
+begin
+  Result:=FindFormatID(FormatName)<>0;
+end;
+
 procedure TClipboard.AssignToPicture(Dest: TPicture);
+var
+  FormatID: TClipboardFormat;
 begin
-  // ToDo
+  FormatID:=FindPictureFormatID;
-  raise Exception.Create('TClipboard.AssignToPicture not implemented yet');
+  if FormatID=0 then exit;
-end;
+  Dest.LoadFromClipboardFormatID(ClipboardType,FormatID);
-
-procedure TClipboard.AssignToBitmap(Dest: TBitmap);
-begin
-  // ToDo
-  raise Exception.Create('TClipboard.AssignToBitmap not implemented yet');
-end;
-
-procedure TClipboard.AssignToPixmap(Dest: TPixmap);
-begin
-  // ToDo
-  raise Exception.Create('TClipboard.AssignToPixmap not implemented yet');
-end;
-
-procedure TClipboard.AssignToIcon(Dest: TIcon);
-begin
-  // ToDo
-  raise Exception.Create('TClipboard.AssignToIcon not implemented yet');
 end;
 
 procedure TClipboard.AssignPicture(Source: TPicture);
 begin
-  // ToDo
+  AssignGraphic(Source.Graphic);
-  raise Exception.Create('TClipboard.AssignPicture not implemented yet');
+end;
+
+function TClipboard.AssignToGraphic(Dest: TGraphic): boolean;
+var
+  MimeTypes: TStringList;
+  i: Integer;
+  GraphicFormatID: TClipboardFormat;
+begin
+  Result:=false;
+  MimeTypes:=TStringList.Create;
+  try
+    Dest.GetSupportedSourceMimeTypes(MimeTypes);
+    for i:=0 to MimeTypes.Count-1 do begin
+      GraphicFormatID:=FindFormatID(MimeTypes[i]);
+      if GraphicFormatID<>0 then begin
+        AssignToGraphic(Dest,GraphicFormatID);
+        Result:=true;
+        exit;
+      end;
+    end;
+  finally
+    MimeTypes.Free;
+  end;
+end;
+
+function TClipboard.AssignToGraphic(Dest: TGraphic; FormatID: TClipboardFormat
+  ): boolean;
+var
+  MemStream: TMemoryStream;
+begin
+  Result:=false;
+  if FormatID=0 then exit;
+  MemStream:=TMemoryStream.Create;
+  try
+    if not GetFormat(FormatID,MemStream) then exit;
+    MemStream.Position:=0;
+    Dest.LoadFromMimeStream(MemStream,ClipboardFormatToMimeType(FormatID));
+  finally
+    MemStream.Free;
+  end;
+  Result:=true;
 end;
 
 procedure TClipboard.AssignGraphic(Source: TGraphic);
+var
+  MimeType: String;
+  FormatID: TClipboardFormat;
 begin
-  // ToDo
+  MimeType:=Source.GetDefaultMimeType;
-  raise Exception.Create('TClipboard.AssignGraphic not implemented yet');
+  FormatID:=ClipboardRegisterFormat(MimeType);
+  if FormatID<>0 then
+    AssignGraphic(Source,FormatID);
+end;
+
+procedure TClipboard.AssignGraphic(Source: TGraphic; FormatID: TClipboardFormat
+  );
+var
+  MemStream: TMemoryStream;
+begin
+  MemStream:=TMemoryStream.Create;
+  try
+    Source.SaveToStream(MemStream);
+    MemStream.Position:=0;
+    SetFormat(FormatID,MemStream);
+  finally
+    MemStream.Free;
+  end;
 end;
 
 procedure TClipboard.Assign(Source: TPersistent);
@@ -537,10 +605,8 @@ procedure TClipboard.AssignTo(Dest: TPersistent);
 begin
   if Dest is TPicture then
     AssignToPicture(TPicture(Dest))
-  else if Dest is TBitmap then
+  else if Dest is TGraphic then
-    AssignToBitmap(TBitmap(Dest))
+    AssignToGraphic(TGraphic(Dest))
-  else if Dest is TPixmap then
-    AssignToPixmap(TPixmap(Dest))
   else
     inherited AssignTo(Dest);
 end;
@@ -607,6 +673,9 @@ end;
 
 {
   $Log$
+  Revision 1.14  2003/09/10 19:15:16  mattias
+  implemented copying graphics from/to clipboard
+
   Revision 1.13  2003/09/10 16:33:51  mattias
   added clipboard checks
 

lcl/include/graphic.inc

@@ -106,6 +106,56 @@ begin
   end;
 end;
 
+procedure TGraphic.LoadFromMimeStream(Stream: TStream; const MimeType: string);
+var
+  DefMimeType: String;
+begin
+  DefMimeType:=GetDefaultMimeType;
+  if (DefMimeType<>'') and (MimeType=GetDefaultMimeType) then
+    LoadFromStream(Stream)
+  else
+    raise Exception.Create(ClassName+': Unsupported MimeType: '+MimeType);
+end;
+
+procedure TGraphic.LoadFromClipboardFormat(FormatID: TClipboardFormat);
+begin
+  LoadFromClipboardFormatID(ctClipboard,FormatID);
+end;
+
+procedure TGraphic.LoadFromClipboardFormatID(ClipboardType: TClipboardType;
+  FormatID: TClipboardFormat);
+begin
+  if Assigned(OnLoadGraphicFromClipboardFormat) then
+    OnLoadGraphicFromClipboardFormat(Self,ClipboardType,FormatID);
+end;
+
+procedure TGraphic.SaveToClipboardFormat(FormatID: TClipboardFormat);
+begin
+  SaveToClipboardFormatID(ctClipboard,FormatID);
+end;
+
+procedure TGraphic.SaveToClipboardFormatID(ClipboardType: TClipboardType;
+  FormatID: TClipboardFormat);
+begin
+  if Assigned(OnSaveGraphicToClipboardFormat) then
+    OnSaveGraphicToClipboardFormat(Self,ClipboardType,FormatID);
+end;
+
+procedure TGraphic.GetSupportedSourceMimeTypes(List: TStrings);
+var
+  DefMimeType: String;
+begin
+  List.Clear;
+  DefMimeType:=GetDefaultMimeType;
+  if DefMimeType<>'' then
+    List.Add(DefMimeType);
+end;
+
+function TGraphic.GetDefaultMimeType: string;
+begin
+  Result:='';
+end;
+
 procedure TGraphic.LoadFromFile(const Filename: string);
 var
   Stream: TStream;

lcl/include/picture.inc

@@ -194,8 +194,10 @@ constructor TPicClipboardFormats.Create;
 begin
   inherited Create;
   Add(PredefinedClipboardFormat(pcfBitmap), TBitmap);
+  Add(PredefinedClipboardFormat(pcfDelphiBitmap), TBitmap);
   Add(PredefinedClipboardFormat(pcfPixmap), TPixmap);
-  Add(PredefinedClipboardFormat(pcfIcon), TIcon);
+  //Add(PredefinedClipboardFormat(pcfIcon), TIcon);
+  Add('image/png', TPortableNetworkGraphic);
 end;
 
 procedure TPicClipboardFormats.Clear;
@@ -221,6 +223,7 @@ procedure TPicClipboardFormats.Add(AFormatID: TClipboardFormat;
   AClass: TGraphicClass);
 var NewFormat: PPicClipboardFormat;
 begin
+  if AFormatID=0 then exit;
   New(NewFormat);
   with NewFormat^ do begin
     GraphicClass:=AClass;
@@ -238,7 +241,7 @@ begin
   for I := Count-1 downto 0 do begin
     P:=GetFormats(i);
     if P^.FormatID=FormatID then begin
-      Result := P^.GraphicClass;
+      Result:=P^.GraphicClass;
       Exit;
     end;
   end;
@@ -427,7 +430,6 @@ begin
     raise EInvalidGraphic.CreateFmt(rsUnknownPictureExtension, [Ext]);
 
   NewGraphic := GraphicClass.Create;
-
   ok:=false;
   try
     NewGraphic.OnProgress := @Progress;
@@ -438,8 +440,7 @@ begin
     // not alter the error backtrace output
     if not ok then NewGraphic.Free;
   end;
-  If FGraphic <> nil then
+  FGraphic.Free;
-    FGraphic.Free;
   FGraphic := NewGraphic;
   FGraphic.OnChange := @Changed;
   Changed(Self);
@@ -451,6 +452,12 @@ begin
 end;
 
 procedure TPicture.LoadFromClipboardFormat(FormatID: TClipboardFormat);
+begin
+  LoadFromClipboardFormatID(ctClipboard,FormatID);
+end;
+
+procedure TPicture.LoadFromClipboardFormatID(ClipboardType: TClipboardType;
+  FormatID: TClipboardFormat);
 var
   NewGraphic: TGraphic;
   GraphicClass: TGraphicClass;
@@ -465,7 +472,7 @@ begin
   ok:=false;
   try
     NewGraphic.OnProgress := @Progress;
-    NewGraphic.LoadFromClipboardFormat(FormatID);
+    NewGraphic.LoadFromClipboardFormatID(ClipboardType,FormatID);
     ok:=true;
   finally
     if not ok then NewGraphic.Free;

lcl/include/png.inc

@@ -45,6 +45,11 @@ begin
 {$ENDIF}
 end;
 
+function TPortableNetworkGraphic.GetDefaultMimeType: string;
+begin
+  Result:='image/png';
+end;
+
 
 // included by graphics.pp
 

lcl/lcltype.pp

@@ -1717,8 +1717,8 @@ type
 const
   PredefinedClipboardMimeTypes : array[TPredefinedClipboardFormat] of string = (
      'text/plain',
-     'image/lcl.bitmap',
+     'image/bmp',
-     'image/lcl.pixmap',
+     'image/xpm',
      'image/lcl.icon',
      'image/lcl.picture',
      'application/lcl.object',
@@ -1813,6 +1813,9 @@ end.
 
 {
   $Log$
+  Revision 1.42  2003/09/10 19:15:15  mattias
+  implemented copying graphics from/to clipboard
+
   Revision 1.41  2003/09/10 16:29:13  mattias
   added Kylix 3 specials