Forum > RichMemo

Image Resizing

(1/1)

rick2691:
skalogryz,

I have always had a problem with image resizing. What gets generated from a file has the correct picture.width and picture.height, yet what gets produced in the document still shows the same data, but it is larger than its data.

This means that it has been expanded visually, and the picture has lost intelligence (jaggy). In the past it was a smaller expansion than it is now. Now, it is about twice the data dimensions.

Previously I had done a resize, and since it was slight, it was only an ugly result ... but I could let go. Now, with it being bigger, the resize result is beyond ugly.

Here is the curious part ... If I do a mechanical copy/paste, from a graphics app into richmemo, it imports with correct data and real size. Moreover, the metrics have been converted by Windows into a richedit format (a number block). Perhaps all of this is happening because of Windows 11.

But I can't find anything that is making richmemo double the sizing when an import is coded. However, I suspect that it is the old resizing problem, which is currently being exaggerated.

Rick

skalogryz:
windows specific problems.
if open the file in Wordpad, is it looking as expected or doubled as well?

is there a file sample?

rick2691:
Read from file, it is big in WordPad, but it has high resolution.
Read from file, in RichMemo it is big, but a jaggy low resolution.

Copy paste from Graphics app to Wordpad, it is the same size and high resolution.
Copy paste from Graphics app to RichMemo, it is half size and high resolution.

When I print RichMemo to paper it has the same sizing and resolution as the screen.

Formerly it was a third bigger, now it is twice bigger.

Rick

rick2691:
This is the code I am using, which you and others developed for me some years back.


--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---//================================================================== begin: DIB Codes start { TOleRichEdit }   // DIB: device-independant bitmap                   // The information to be included in RTF from a Windows                   // device-independent bitmap is the concatenation of the                   // BITMAPINFO structure followed by the actual pixel data. function BytesPerScanline(PixelsPerScanline, BitsPerPixel, Alignment: Longint): Longint;begin  Dec(Alignment);  Result:= ((PixelsPerScanline * BitsPerPixel) + Alignment) and not Alignment;  Result:= Result div 8;end; procedure InitializeBitmapInfoHeader(Bitmap: HBITMAP; var BI: TBitmapInfoHeader;  Colors: Integer);var  DS: TDIBSection;  Bytes: Integer;begin  DS.dsbmih.biSize := 0;  Bytes:= GetObject(Bitmap, SizeOf(DS), @DS);  if Bytes=0 then {InvalidBitmap}  else if (Bytes>=(sizeof(DS.dsbm) + sizeof(DS.dsbmih)))          and (DS.dsbmih.biSize>=DWORD(sizeof(DS.dsbmih)))          then BI:= DS.dsbmih          else begin               FillChar(BI, sizeof(BI), 0);               with BI, DS.dsbm do                    begin                      biSize:= SizeOf(BI);                      biWidth:= bmWidth;                      biHeight:= bmHeight;                    end;               end;  case Colors of       2: BI.biBitCount:= 1;       3..16: begin              BI.biBitCount:= 4;              BI.biClrUsed:= Colors;              end;       17..256: begin                BI.biBitCount:= 8;                BI.biClrUsed:= Colors;                end;       else       BI.biBitCount := DS.dsbm.bmBitsPixel * DS.dsbm.bmPlanes;       end;  BI.biPlanes:= 1;  if BI.biClrImportant>BI.biClrUsed then     BI.biClrImportant:= BI.biClrUsed;  if BI.biSizeImage=0 then     BI.biSizeImage:= BytesPerScanLine(BI.biWidth, BI.biBitCount, 32) * Abs(BI.biHeight);end; procedure InternalGetDIBSizes(Bitmap: HBITMAP; var InfoHeaderSize: DWORD;  var ImageSize: DWORD; Colors: Integer);var  BI: TBitmapInfoHeader;begin  InitializeBitmapInfoHeader(Bitmap, BI, Colors);  if BI.biBitCount>8 then     begin     InfoHeaderSize:= SizeOf(TBitmapInfoHeader);     if (BI.biCompression and BI_BITFIELDS)<>0 then Inc(InfoHeaderSize, 12);     end     else     if BI.biClrUsed=0        then InfoHeaderSize:= SizeOf(TBitmapInfoHeader)             + SizeOf(TRGBQuad) * (1 shl BI.biBitCount)        else InfoHeaderSize := SizeOf(TBitmapInfoHeader)             + SizeOf(TRGBQuad) * BI.biClrUsed;  ImageSize:= BI.biSizeImage;end; procedure GetDIBSizes(Bitmap: HBITMAP; var InfoHeaderSize: DWORD;  var ImageSize: DWORD);begin  InternalGetDIBSizes(Bitmap, InfoHeaderSize, ImageSize, 0);end; function InternalGetDIB(Bitmap: HBITMAP; Palette: HPALETTE;  var BitmapInfo; var Bits; Colors: Integer): Boolean;var  OldPal: HPALETTE;  DC: HDC;begin  InitializeBitmapInfoHeader(Bitmap, TBitmapInfoHeader(BitmapInfo), Colors);  OldPal:= 0;  DC:= CreateCompatibleDC(0);  try    if Palette<>0 then       begin       OldPal:= SelectPalette(DC, Palette, False);       RealizePalette(DC);       end;    Result:= GetDIBits(DC, Bitmap, 0, TBitmapInfoHeader(BitmapInfo).biHeight, @Bits,                       TBitmapInfo(BitmapInfo), DIB_RGB_COLORS)                       <>0;  finally    if OldPal<>0 then SelectPalette(DC, OldPal, False);    DeleteDC(DC);  end;end; function GetDIB(Bitmap: HBITMAP; Palette: HPALETTE; var BitmapInfo; var Bits): Boolean;begin  Result:= InternalGetDIB(Bitmap, Palette, BitmapInfo, Bits, 0);end; function BitmapToRTF(pict: TBitmap): string;  // employs the abovevar    bi,bb,rtf: string;    bis,bbs: Cardinal;    achar: ShortString;    hexpict: string;    I: Integer;begin    GetDIBSizes(pict.Handle,bis,bbs);    SetLength(bi,bis);    SetLength(bb,bbs);    GetDIB(pict.Handle,pict.Palette,PChar(bi)^,PChar(bb)^);    rtf:= '{\rtf1{\pict\dibitmap ';  // ** initiate rtf code **    SetLength(hexpict,(Length(bb) + Length(bi)) * 2);    I:= 2;    for bis:= 1 to Length(bi) do        begin        achar:= Format('%x',[Integer(bi[bis])]);        if Length(achar) = 1 then achar:= '0' + achar;        hexpict[I-1]:= achar[1];        hexpict[I]:= achar[2];        Inc(I,2);        end;    for bbs:= 1 to Length(bb) do        begin        achar:= Format('%x',[Integer(bb[bbs])]);        if Length(achar) = 1 then        achar:= '0' + achar;        hexpict[I-1]:= achar[1];        hexpict[I]:= achar[2];        Inc(I,2);        end;    rtf:= rtf + hexpict + ' }}'; // ** complete rtf code **     Result:= rtf;  // ** report rtf code **end; //=================================================================== End: DIB codes   
These are the codes that I use for implementing the above codes:


--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---procedure LoadBitmapFromClipboard(Bitmap: TBitmap);begin  //if Clipboard.HasFormat(PredefinedClipboardFormat(pcfDelphiBitmap)) then    //Bitmap.LoadFromClipboardFormat(PredefinedClipboardFormat(pcfDelphiBitmap));  if Clipboard.HasFormat(PredefinedClipboardFormat(pcfBitmap)) then     Bitmap.LoadFromClipboardFormat(PredefinedClipboardFormat(pcfBitmap));end; procedure SaveBitmapToClipboard(Bitmap: TPicture);  // TBitmap);begin  Clipboard.Assign(Bitmap);end; procedure TCmdForm.MnuDiskImageClick(Sender: TObject);var  pic: TPicture;  SS: TStringStream;  // TStringStream;  // TMemoryStream;  sz: TSize;  picw, pich: longint;begin  pic:= TPicture.Create;  LoadBitmapFromClipboard(pic.bitmap);  try SS:= TStringStream.Create(BitmapToRTF(pic.bitmap)); // build RTF mask         //SS:= BitmapToRTF(pic.bitmap)         PutRTFSelection(PageMemo, SS);     // TStringStream         finally         pic.Free;  // release pic image-data         SS.Free; // release RTF mask-data         end;end; procedure TCmdForm.MnuDiskImageClick(Sender: TObject);var  pic: TPicture;  SS: TStringStream;  // TStringStream;  // TMemoryStream;  sz: TSize;  picw, pich: longint;  //CF: TClipboardFormat; begin  if PageMemoOn and (not PagePassive) then  begin   OpenDialog1.Title:= 'Select Image-File';  OpenDialog1.Filter:= 'JPG (*.jpg)|*.jpg|PNG (*.png)|*.png|TIF (*.tif)|*.tif|BMP (*.bmp)|*.bmp';  OpenDialog1.FileName:= '';  if OpenDialog1.Execute then     begin     pic:= TPicture.Create;     try pic.LoadFromFile(OpenDialog1.FileName);  // load image file         except on e:Exception do                begin                pic.Free;                ShowMessage('Unknown Image Format: '+OpenDialog1.FileName+#13#10+e.Message);                Exit;  // conclude procedure                end;         end;     pich:= pic.height;  // has correct sizing     picw:= pic.width;   // w600 h776 //showmessage('1 PicH='+inttostr(pich)+'  PicW'+inttostr(picw)+//            '  Beg='+inttostr(PageMemo.SelStart)+'  Run='+inttostr(PageMemo.SelLength));  // pich=776 ** good **      try SS:= TStringStream.Create(BitmapToRTF(pic.bitmap)); // build RTF mask         //SS:= BitmapToRTF(pic.bitmap)         PutRTFSelection(PageMemo, SS);     // TStringStream         finally         pic.Free;  // release pic image-data         SS.Free; // release RTF mask-data          {         PointSize     = 72.0;         RtfSizeToInch = 2.54 * 1000.0;         SizeFactor    = 1 / PointSize * RtfSizeToInch; // pt to 0.01 mlmete         RevSizeFactor = 1 / SizeFactor;         }          // something wrong with RTF image insert method         // the image must be reduced in size         // this is a work-around:          PageMemo.SelStart:= PageMemo.SelStart-1; // modified selection         PageMemo.SelLength:= 1;  // modified length         GetOleObjectSize(PageMemo, PageMemo.SelStart, sz); //showmessage('2 PicH='+inttostr(sz.cy)+'  PicW'+inttostr(sz.cx)+//            '  Beg='+inttostr(PageMemo.SelStart)+'  Run='+inttostr(PageMemo.SelLength));  // pich=582          IMGresize:= 1.00;  // 0.484693878; // (sz.cy / pich);         sz.cx:=trunc(sz.cx * IMGresize); // width         sz.cy:=trunc(sz.cy * IMGresize); // height         SetOleObjectSize(Pagememo, PageMemo.SelStart, sz); //showmessage('3 PicH='+inttostr(sz.cy)+'  PicW'+inttostr(sz.cx)+ //           '  Beg='+inttostr(PageMemo.SelStart)+'  Run='+inttostr(PageMemo.SelLength));         end;     end;  end else showmessage('Main editor frame must be active.');end; 
Rick

rick2691:
I have found a number of Delphi examples to import an image.

Their coding has been identical to ours, but two functions that we have do not have to be coded. They internal to their resource unit.

GetDIBSizes(pict.Handle, bis, bbs);
GetDIB(pict.Handle, pict.Palette, PChar(bi)^, PChar(bb)^);

Perhaps the problem is there. However, none of them are complaining about an oversized display and low resolution. I can only assume that their resource unit handles the import differently.

Also, I am only calling it an oversized display because a manual copy/paste comes in a half-size smaller. It's the image resolution that can't be managed.

Rick

Navigation

[0] Message Index

Go to full version