mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-10 05:56:02 +02:00
implemented copying graphics from/to clipboard
git-svn-id: trunk@4598 -
This commit is contained in:
parent
670b0a5f64
commit
e5570985e8
@ -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);
|
||||
procedure AssignToPixmap(Dest: TPixmap);
|
||||
procedure AssignToIcon(Dest: TIcon);
|
||||
function AssignToGraphic(Dest: TGraphic): boolean;
|
||||
function AssignToGraphic(Dest: TGraphic; FormatID: TClipboardFormat): boolean;
|
||||
//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
|
||||
|
||||
|
@ -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 SaveToClipboardFormat(FormatID: TClipboardFormat); virtual; abstract;
|
||||
procedure LoadFromClipboardFormat(FormatID: TClipboardFormat); virtual;
|
||||
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 SaveToClipboardFormat(FormatID: TClipboardFormat); override;
|
||||
procedure LoadFromMimeStream(Stream: TStream; const MimeType: string); 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
|
||||
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
Result:=0;
|
||||
if not ClipboardGetFormats(ClipboardType,cnt,List) then
|
||||
exit;
|
||||
end;
|
||||
end else begin
|
||||
cnt:=0;
|
||||
end;
|
||||
try
|
||||
for f:=Low(TPredefinedClipboardFormat) to High(TPredefinedClipboardFormat) do
|
||||
begin
|
||||
Result:=PredefinedClipboardFormat(f);
|
||||
if (Result<>0) and (f in PicFormats) then begin
|
||||
if not FAllocated then begin
|
||||
for i:=0 to cnt-1 do
|
||||
if (List[i]=Result) then exit;
|
||||
end else begin
|
||||
if IndexOfCachedFormatID(Result,false)>=0 then exit;
|
||||
end;
|
||||
if not FAllocated then begin
|
||||
for i:=0 to cnt-1 do begin
|
||||
Result:=List[i];
|
||||
if TPicture.SupportsClipboardFormat(Result) then
|
||||
exit;
|
||||
end;
|
||||
end else begin
|
||||
for i:=FCount-1 downto 0 do begin
|
||||
Result:=FData[i].FormatID;
|
||||
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
|
||||
raise Exception.Create('TClipboard.AssignToPicture not implemented yet');
|
||||
end;
|
||||
|
||||
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');
|
||||
FormatID:=FindPictureFormatID;
|
||||
if FormatID=0 then exit;
|
||||
Dest.LoadFromClipboardFormatID(ClipboardType,FormatID);
|
||||
end;
|
||||
|
||||
procedure TClipboard.AssignPicture(Source: TPicture);
|
||||
begin
|
||||
// ToDo
|
||||
raise Exception.Create('TClipboard.AssignPicture not implemented yet');
|
||||
AssignGraphic(Source.Graphic);
|
||||
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
|
||||
raise Exception.Create('TClipboard.AssignGraphic not implemented yet');
|
||||
MimeType:=Source.GetDefaultMimeType;
|
||||
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
|
||||
AssignToBitmap(TBitmap(Dest))
|
||||
else if Dest is TPixmap then
|
||||
AssignToPixmap(TPixmap(Dest))
|
||||
else if Dest is TGraphic then
|
||||
AssignToGraphic(TGraphic(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
|
||||
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
@ -45,6 +45,11 @@ begin
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function TPortableNetworkGraphic.GetDefaultMimeType: string;
|
||||
begin
|
||||
Result:='image/png';
|
||||
end;
|
||||
|
||||
|
||||
// included by graphics.pp
|
||||
|
||||
|
@ -1717,8 +1717,8 @@ type
|
||||
const
|
||||
PredefinedClipboardMimeTypes : array[TPredefinedClipboardFormat] of string = (
|
||||
'text/plain',
|
||||
'image/lcl.bitmap',
|
||||
'image/lcl.pixmap',
|
||||
'image/bmp',
|
||||
'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
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user