I'm coding a unit where I can paste an image from the clipboard and save it in a DB. The code actually works if I took screenshots or copy images from WhatsApp/Telegram Web.
But the problems appears when I try to paste a PNG or JPG file from the clipboard - the error message is:
Unsupported clipboard format
Why does this code work with screenshots but not with PNG or JPG files? How can I fix it?
BMP := TBitmap.Create;
BMP.Assign(Clipboard); //Here is where I got the exception
BMP.PixelFormat := pf32bit;
JPG := TJPEGImage.Create;
JPG.Assign(BMP);
JPG.CompressionQuality := 75;
AdvOfficeImage1.Picture.Assign(JPG);
If you copy a file from the shell, the clipboard will not contain the contents of the file, but merely the file name.
Hence, you need to obtain this file name, and then use it to load your image.
Here's a small example, just containing a TImage control:
procedure TForm1.FormClick(Sender: TObject);
begin
if Clipboard.HasFormat(CF_HDROP) then
begin
Clipboard.Open;
try
var LDrop := Clipboard.GetAsHandle(CF_HDROP);
if LDrop <> 0 then
begin
var LFileCount := DragQueryFile(LDrop, $FFFFFFFF, nil, 0);
if LFileCount = 1 then
begin
var LSize := DragQueryFile(LDrop, 0, nil, 0);
if LSize <> 0 then
begin
var LFileName: string;
SetLength(LFileName, LSize);
if DragQueryFile(LDrop, 0, PChar(LFileName), LFileName.Length + 1) <> 0 then
Image1.Picture.LoadFromFile(LFileName);
end;
end;
end;
finally
Clipboard.Close;
end;
end;
end;
Note: Clipboard is declared in Clipbrd and DragQueryFile in ShellAPI.
Related
In Delphi 10.4, I try to save a valid TPicture compressed to an INI file, trying to replicate the ZLibCompressDecompress example from the documentation:
procedure TForm1.SavePictureToIniFile(const APicture: TPicture);
// https://stackoverflow.com/questions/63216011/tinifile-writebinarystream-creates-exception
var
LInput: TMemoryStream;
LOutput: TMemoryStream;
MyIni: System.IniFiles.TMemIniFile;
ThisFile: string;
LZip: TZCompressionStream;
begin
if FileSaveDialog1.Execute then
ThisFile := FileSaveDialog1.FileName
else EXIT;
LInput := TMemoryStream.Create;
LOutput := TMemoryStream.Create;
LZip := TZCompressionStream.Create(clDefault, LOutput);
try
APicture.SaveToStream(LInput);
LInput.Position := 0;
//LOutput.Position := 0;
LZip.CopyFrom(LInput, LInput.Size);
MyIni := TMemIniFile.Create(ThisFile);
try
MyIni.WriteBinaryStream('Custom', 'IMG', LOutput);
MyIni.UpdateFile;
finally
MyIni.Free;
end;
finally
LInput.Free;
LOutput.Free;
LZip.Free;
end;
end;
But the stream is not saved in the INI file. The resulting INI file contains only these lines:
[Custom]
IMG=
So how can I save the compressed stream in the INI file?
You need to set LOutput.Position := 0 after the LZip.CopyFrom line, that is, immediately before
MyIni.WriteBinaryStream('Custom', 'IMG', LOutput);
I have this function that takes 4.2 seconds to convert a jpg to bmp.
Why it takes so long? Can I make if faster?
IrfanView loads and converts the file in only a fraction of that time.
I thought that is spends most of the time in JPG.LoadFromFile. But when I measured the time I was surprised to see it spends most of the time in BMP.Assing(JPG).
function ConvertJPG2BMP(CONST FileName: string): TBitmap;
VAR JPG: TJpegImage;
begin
Result:= NIL;
JPG:= TJpegImage.Create;
TRY
JPG.LoadFromFile(FileName);
if (JPG.Width > 0) AND (JPG.Width < 32768)
AND (JPG.Height> 0) AND (JPG.Height < 32768) then
begin
Result:= TBitmap.Create;
TRY
Result.HandleType:= bmDIB;
// Fuji_FinePix_F550.JPG [3200x1800] [1.44MB]
Result.Assign(JPG); <--- 4 seconds!!
EXCEPT
FreeAndNil(Result);
END;
end;
FINALLY
FreeAndNil(JPG);
end;
end;
Since I wanted to test the slightly older functions once, it is a good opportunity to do this now.
The sources used are here
These have been changed a bit in the code below.
Somewhat adapted source code of OP's function ConvertJPG2BMP() (2512 : ms)
function ConvertJPG2BMP(CONST FileName: string): TBitmap;
VAR
JPG: TJpegImage;
begin
Result:= NIL;
JPG:= TJpegImage.Create;
TRY
JPG.LoadFromFile(FileName);
if (JPG.Width > 0) AND (JPG.Width < 32768)
AND (JPG.Height> 0) AND (JPG.Height < 32768) then
begin
Result:= TBitmap.Create;
TRY
Result.PixelFormat := pf24bit;
Result.Width := JPG.Width;
Result.Height := JPG.Height;
Result.HandleType:= bmDIB;
// 2018-10-17 14.04.23.jpg [2560x1920] [1.66MB]
Result.Assign(JPG);
Result.SaveToFile('F:\ProgramFiles\Embarcadero\dtx\Projects\Bmp-DIB\JPG2BMP.bmp');
EXCEPT
FreeAndNil(Result);
END;
end;
FINALLY
FreeAndNil(JPG);
end;
end;
The source for the TWICImage usage (296 : ms)
There is another class in Vcl.Graphics? called TWICImage that handles images supported by the Microsoft Imaging Component
Including BMP, GIF, ICO, JPEG, PNG, TIF and Windows Media Photo
procedure LoadImageFromStream(Stream: TStream; Image: TImage);
var
wic: TWICImage;
Bitmap: TBitmap;
begin
Stream.Position := 0;
wic := TWICImage.Create;
try
wic.LoadFromStream(Stream);
Image.Picture.Assign(wic);
Bitmap := TBitmap.Create;
try
Bitmap.PixelFormat := pf24bit;
Bitmap.Width := Image.Picture.Width;
Bitmap.Height := Image.Picture.Height;
Bitmap.Canvas.Draw(0, 0, Image.Picture.Graphic);
Bitmap.SaveToFile('F:\ProgramFiles\Embarcadero\dtx\Projects\Bmp-DIB\TWICImage.bmp');
finally
Bitmap.Free;
end;
finally
wic.Free;
end;
end;
procedure RenderImage(const Filename: string);
var
fs: TFileStream;
begin
fs := TFileStream.Create(Filename, fmOpenRead);
try
LoadImageFromStream(fs, Form1.Image1);
finally
fs.Free;
end;
end;
GetTickCount for all tested routines.
procedure TForm1.Button1Click(Sender: TObject);
var
MyDIB : TBitmap;
loadStr : string;
XStart,Xend : LongWord;
begin
loadStr := 'F:\ProgramFiles\Embarcadero\dtx\Projects\Bmp-DIB\2018-10-17 14.04.23.jpg';
XStart := GetTickCount;
if RadioGroup1.ItemIndex = 0 then MyDIB := ConvertJPG2BMP(loadStr);// ConvertJPG2BMP()
if RadioGroup1.ItemIndex = 1 then TestBmp(loadStr);
if RadioGroup1.ItemIndex = 2 then RenderImage(loadStr);// TWICImage
if RadioGroup1.ItemIndex = 3 then GetOleGraphic(loadStr);
Xend := GetTickCount;
Label1.Caption := IntToStr(xEnd-XStart) + ' : MS' ;
end;
The generated images are identical to the file size only from the function GetOleGraphic() is a smaller file produced with a worse resolution?
here the source used for the GetOleGraphic()
Here is a compact version of WIC image loader posted by moskito-x above.
Please VOTE HIS answer not mine. My answer here is only to provide the compact version and some details.
{-----------------------------------------------
Uses TWICImage
Advantages:
8+ times faster than Delphi's JPG function
Works with: animated GIF, PNG, JPG
Drawbacks:
Fails with JPEG2K
No EXIF support
Platform dependent
-----------------------------------------------}
function LoadImageWic(CONST FileName: string): TBitmap;
VAR
wic: TWICImage;
begin
wic := TWICImage.Create;
TRY
wic.LoadFromFile(FileName);
Result := TBitmap.Create;
TRY
Result.Assign(wic);
EXCEPT
FreeAndNil(Result);
END;
FINALLY
FreeAndNil(wic);
END;
end;
Just try to decompress the jpeg using our Open Source SynGDIPlus unit.
We found it much faster than the Delphi built-in jpeg.pas unit.
The latest revision can be retrieved from github.
As an alternative, you may try to use our fast Jpeg decoder using SSE2 but it doesn't handle all kind of Jpegs, and it is for Win32 only.
I am using delphi XE-5 and I am loading button information from a JSON file, in order to create buttons on a TMS ADVToolBar control. Each button is 50X35 and in png format with transparency.
I am getting each url, using the idHTTP component to retrieve it to a stream and then load it into a png. I then draw it onto a transparent BMP. However, I dont think this is the correct way. Anyway, the bmp is then added to a TImageList where it is assigned to a button using the index. The Image shows up on the button, but with no transparency.
see my code below:
imgUrl:= //code to get img url from JSON file;
MS := TMemoryStream.Create;
png := TPngImage.Create;
png.Transparent:= True;
try
idHTTP1.get(imgUrl,MS);
Ms.Seek(0,soFromBeginning);
png.LoadFromStream(MS);
bmp:= TBitmap.Create;
bmp.Transparent:= True;
bmp.Width:= 50;
bmp.Height:= 50;
png.Draw(bmp.Canvas, Rect(7, 7, png.Width, png.Height));
ImageList1.Add(bmp, nil);
AdvGlowBtn.Images:= ImageList1;
AdvGlowBtn.Layout:= blGlyphTop;
AdvGlowBtn.WordWrap:= False;
AdvGlowBtn.AutoSize:= True;
AdvGlowBtn.ImageIndex:= ImageList1.Count-1;
bmp.Free;
finally
FreeAndNil(png);
FreeAndNil(MS);
end;
At first you have to enable the runtime themes (Project Manager) otherwise you will have no transparency of your images.
And this is the code to load the PNG image into your ImageList1
bmp := TBitmap.Create;
try
// everything done before to bmp has no effect
bmp.Assign( png );
// if for some reason the loaded image is smaller
// set the size to avoid the invalid image size error
bmp.Width := ImageList1.Width;
bmp.Height := ImageList1.Height;
AdvGlowBtn.Images:= ImageList1;
...
// now add the Bitmap to the ImageList
AdvGlowBtn.ImageIndex := ImageList1.Add( bmp, nil );
finally
bmp.Free;
end;
I have an old project in Delphi 5 and I still using it sometimes.
This is my solution using the png object.
procedure ImageList2Alpha(const ImageList: TImageList);
const
Mask: array[Boolean] of Longint = (0, ILC_MASK);
var
TempList: TImageList;
begin
if Assigned(ImageList) then
begin
TempList := TImageList.Create(nil);
try
TempList.Assign(ImageList);
with ImageList do
begin
Handle := ImageList_Create(Width, Height, ILC_COLOR32 or Mask[Masked], 0, AllocBy);
if not HandleAllocated then
raise EInvalidOperation.Create(SInvalidImageList);
end;
Imagelist.AddImages(TempList);
finally
FreeAndNil(TempList);
end;
end;
end;
procedure LoadPngToBmp(var Dest: TBitmap; AFilename: TFilename);
type
TRGB32 = packed record
B, G, R, A : Byte;
end;
PRGBArray32 = ^TRGBArray32;
TRGBArray32 = array[0..0] of TRGB32;
type
TRG24 = packed record
rgbtBlue, rgbtGreen, rgbtRed : Byte;
end;
PRGBArray24 = ^TPRGBArray24;
TPRGBArray24 = array[0..0] of TRG24;
type
TByteArray = Array[Word] of Byte;
PByteArray = ^TByteArray;
TPByteArray = array[0..0] of TByteArray;
var
BMP : TBitmap;
PNG: TPNGObject;
x, y: Integer;
BmpRow: PRGBArray32;
PngRow : PRGBArray24;
AlphaRow: PByteArray;
begin
Bmp := TBitmap.Create;
PNG := TPNGObject.Create;
try
if AFilename <> '' then
begin
PNG.LoadFromFile(AFilename);
BMP.PixelFormat := pf32bit;
BMP.Height := PNG.Height;
BMP.Width := PNG.Width;
if ( PNG.TransparencyMode = ptmPartial ) then
begin
for Y := 0 to BMP.Height-1 do
begin
BmpRow := PRGBArray32(BMP.ScanLine[Y]);
PngRow := PRGBArray24(PNG.ScanLine[Y]);
AlphaRow := PByteArray(PNG.AlphaScanline[Y]);
for X := 0 to BMP.Width - 1 do
begin
with BmpRow[X] do
begin
with PngRow[X] do
begin
R := rgbtRed; G := rgbtGreen; B := rgbtBlue;
end;
A := Byte(AlphaRow[X]);
end;
end;
end;
end else
begin
for Y := 0 to BMP.Height-1 do
begin
BmpRow := PRGBArray32(BMP.ScanLine[Y]);
PngRow := PRGBArray24(PNG.ScanLine[Y]);
for X := 0 to BMP.Width - 1 do
begin
with BmpRow[X] do
begin
with PngRow[X] do
begin
R := rgbtRed; G := rgbtGreen; B := rgbtBlue;
end;
A := 255;
end;
end;
end;
end;
Dest.Assign(BMP);
end;
finally
Bmp.Free;
PNG.Free;
end;
end;
Call ImageList2Alpha(YourImageList) on the OnCreate of the Form (FormCreate), and the ImageList will be ready to store your Bitmaps32 keeping the transparency.
Call the LoadPngToBmp procedure to convert a PNG to Bitmap32 and then, store it on your ImageList.
The TBitmap class uses Windows own libraries to manipulate Bitmaps. Depending on you Windows version, the underlying Operating System libraries does not support 32 bits BMPs, despite the libraries header files declares a BITMAPQUAD struct.
For newer versions of Windows (Vista and above afaik), the field BITMAPQUAD.reserved is used to store the alpha channel. For older versions, this field must remain zero (0x00).
If you are using a "recent" version of Windows, the only possible explanation I see is that the TBitmap class were not updated to support the alpha channel.
Using the class TPNGImage should not be an issue instead of converting it to BMP before using, unless you have some more specific needs.
Use it like that:
ABitmap.SetSize(png.Width, png.Height);
png.AssignTo(ABitmap);
I am trying to load jpg into an imagelist by converting the .jpg to a bmp and then saving it to imagelist1.
From top to bottom of the code snip.
The Selectdir works and fileexists parts work. This is used to load in all the Images in a folder.All images are named like so 0.jpg / 1.jpg ect..
I then load the jpg to a tpicture. Set the bmp width /height and load the bmp with same image as jpg , i then add the bmp to the imagelist. And when its done it should show the first image 0.jpg
Two issues, first if i did it like so it would only show a small area (top left) of the bmp
but it was the correct image. I assume this is due to the option crop. which i cant seem to figure out how to make it select center during runtime?
Second, If i put
Imagelist1.width := currentimage.width;
Imagelist1.height := currentimage.height;
Then it shows last image. like Imagelist1.GetBitmap() did not work?
so i assume a fix for either one would be great!
cheers
squills
procedure TForm1.Load1Click(Sender: TObject);
var
openDialog : TOpenDialog;
dir :string;
MyPicture :TPicture;
currentimage :Tbitmap;
image : integer;
clTrans : TColor;
begin
Image := 0 ;
//lets user select a dir
SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt],SELDIRHELP);
myPicture :=Tpicture.Create;
currentimage := TBitmap.Create;
//keeps adding images as long as the file path exsist.
//thus comic pages should be renumbed to 0-XX
while FileExists(Dir+'\'+inttostr(image)+'.jpg') do
begin
try
MyPicture.LoadFromFile(Dir+'\'+inttostr(image)+'.jpg'); //load image to jpg holder
currentimage.Width := mypicture.Width; //set width same as jpg
currentimage.Height:= mypicture.Height; //set height same as jpg
currentimage.Canvas.Draw(0, 0, myPicture.Graphic); //draw jpg on bmp
clTrans:=currentimage.TransparentColor; //unknown if needed?
//Imagelist1.Width := currentimage.Width;
//imagelist1.Height := currentimage.Height;
Imagelist1.Addmasked(Currentimage,clTrans); //add to imagelist
finally
image := image +1; //add one so it adds next page
end;
end;
ImageList1.GetBitmap(0,zImage1.Bitmap);
mypicture.Free;
currentimage.Free;
end;
You're adding a lot of unnecessary overhead by using the TImage every time.
Try something like this (untested, because I don't have a folder full of images named this way - it compiles, though <g>). You'll need to add Jpeg to your implementation uses clause if it's not already there, of course.
procedure TForm2.Button1Click(Sender: TObject);
var
DirName: string;
begin
DirName := 'D:\Images';
if SelectDirectory('Select Image Path',
'D:\TempFiles',
DirName,
[sdNewUI],
Self) then
LoadImages(DirName);
end;
procedure TForm2.LoadImages(const Dir: string);
var
i: Integer;
CurFileName: string;
JpgIn: TJPEGImage;
BmpOut: TBitmap;
begin
i := 1;
while True do
begin
CurFileName := Format('%s%d.jpg',
[IncludeTrailingPathDelimiter(Dir), i]);
if not FileExists(CurFileName) then
Break;
JpgIn := TJPEGImage.Create;
try
JpgIn.LoadFromFile(CurFileName);
// If you haven't initialized your ImageList width and height, it
// defaults to 16 x 16; we can set it here, if all the images are
// the same dimensions.
if (ImageList1.Count = 0) then
ImageList1.SetSize(JpgIn.Width, JpgIn.Height);
BmpOut := TBitmap.Create;
try
BmpOut.Assign(JpgIn);
ImageList1.Add(BmpOut, nil);
finally
BmpOut.Free;
end;
finally
JpgIn.Free;
end;
Inc(i);
end;
if ImageList1.Count > 0 then
begin
BmpOut := TBitmap.Create;
try
ImageList1.GetBitmap(0, BmpOut);
Image1.Picture.Assign(BmpOut);
finally
BmpOut.Free;
end;
end;
end;
I'm using Delphitwain (delphitwain.sourceforge.net) to add scan functionality to my app. Scanning is working fine and I can save bmp and jpeg files. Now I need to:
save in 300dpi (the scanner is capable)
save in TIFF format
After digging around, I found 2 tips:
http://www.delphipraxis.net/132787-farbstich-nach-bitmap-operation.html
http://synopse.info/fossil/wiki?name=GDI%2B
Here is my final code:
procedure TForm1.GoAcquireClick(Sender: TObject);
begin
Counter := 0;
Twain.SourceManagerLoaded := TRUE;
Twain.LoadSourceManager;
Twain.TransferMode := ttmMemory;
with Twain.Source[ 0 ] do
begin
Loaded := TRUE;
SetIXResolution(300);
SetIYResolution(300);
SetIBitDepth(1);
EnableSource(true, true);
while Enabled do Application.ProcessMessages;
end;
end;
procedure TForm1.TwainTwainAcquire(Sender: TObject; const Index: Integer;
Image: TBitmap; var Cancel: Boolean);
var
TiffHolder: TSynPicture;
begin
Inc( Counter );
Current := Counter;
ImageHolder.Picture.Assign( Image );
ImageHolder.Picture.Bitmap.Monochrome := true;
ImageHolder.Picture.Bitmap.Pixelformat := pf1Bit;
SynGDIPlus.SaveAs(ImageHolder.Picture, format('c:\temp\teste%d.tif',[ Counter ]), gptTIF );
end;
Result: the image still is 96dpi and were saved as BMP (even with TIF extension).
What am I missing?
The GDI+ library is able to save tiff pictures.
The SynGdiPlus unit use {557CF405-1A04-11D3-9A73-0000F81EF32E} for its TIFF encoder.
From the TSynPicture.SaveAs code, I see two possibilities:
Either you don't have the corresponding TIFF encoder installed;
Either there is some missing parameter expected by the TIFF encoder.
Try this version:
type
/// the optional TIFF compression levels
// - use e.g. ord(evCompressionCCITT4) to save a TIFF picture as CCITT4
TGDIPPEncoderValue = (
evColorTypeCMYK,
evColorTypeYCCK,
evCompressionLZW,
evCompressionCCITT3,
evCompressionCCITT4,
evCompressionRle,
evCompressionNone,
(...)
evFrameDimensionPage);
const
EncoderCompression: TGUID = '{e09d739d-ccd4-44ee-8eba-3fbf8be4fc58}';
function TSynPicture.SaveAs(Stream: TStream; Format: TGDIPPictureType;
CompressionQuality: integer): TGdipStatus;
var fStream: IStream;
Len,Dummy: Int64;
tmp: pointer;
Params: TEncoderParameters;
PParams: pointer;
MS: TMemoryStream absolute Stream;
begin
if not Gdip.Exists or (Stream=nil) or (fImage=0) then begin
result := stInvalidParameter;
exit;
end;
Params.Count := 1;
Params.Parameter[0].Type_ := EncoderParameterValueTypeLong;
Params.Parameter[0].NumberOfValues := 1;
Params.Parameter[0].Value := #CompressionQuality;
PParams := nil;
case Format of
gptJPG: if CompressionQuality>=0 then begin
Params.Parameter[0].Guid := EncoderQuality;
PParams := #Params;
end;
gptTIF: begin
if not (TGDIPPEncoderValue(CompressionQuality) in [
evCompressionLZW, evCompressionCCITT3, evCompressionCCITT4,
evCompressionRle, evCompressionNone]) then
// default tiff compression is LZW
CompressionQuality := ord(evCompressionLZW);
Params.Parameter[0].Guid := EncoderCompression;
PParams := #Params;
end;
end;
CreateStreamOnHGlobal(0, true, fStream);
(...)
It will add the EncoderCompression parameter for TIFF pictures, which seems to be required.
I've updated the source code repository version to include this correction.
Saving TIFF files is hard in Delphi. I don't know any free/open source modules that do this.
ImageEn works.
In the past I have used saving as bmp and converting to tiff with irfanview through createprocess with the commandline
'i_view32.exe c:\temp\scanned.bmp /bpp=1 /convert=c:\temp\scanned.tif'