win 11 gfx win slightly dark

General discussion for topics related to the FreeBASIC project or its community.
Post Reply
dafhi
Posts: 1640
Joined: Jun 04, 2005 9:51

win 11 gfx win slightly dark

Post by dafhi »

while comparing images between win11 viewer and fb win, i noticed a lack of vibrance in fb win.
thinking it was my image algorithm, i went through a bunch of code, actually found some things that needed fixin', and retried.

still noticeable.
i then blit original bmp into fb window, same.

i filled solid white and compared to windows white, which looked correct.

Linux doesn't have the issue. Could be driver, no clue.
HP Spectre 3k x 2k oled - Intel 1165g7

was good though; found something in my code that would have gone unnoticed for who knows how long ¯\_(ツ)_/¯
dafhi
Posts: 1640
Joined: Jun 04, 2005 9:51

Re: win 11 gfx win slightly dark

Post by dafhi »

there is some gnarly stuff going on with w11. if i bsave the window, the .bmp quality is poor.
if i take a winkey-shift-s screengrab, quality looks normal
St_W
Posts: 1619
Joined: Feb 11, 2009 14:24
Location: Austria
Contact:

Re: win 11 gfx win slightly dark

Post by St_W »

maybe something related to scaling? Could be verified by setting scaling to 100% in display settings and testing whether the issue still persists.

but just guessing ...
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: win 11 gfx win slightly dark

Post by dodicat »

What about text mode dafhi?

Code: Select all



Sub _bsave( file As String, p As Any Ptr, sz As Integer ) 

  Dim As Integer ff 
  ff = FreeFile 
  
  Open file For Binary As ff 
    fb_fileput( ff, 0, ByVal p, sz ) 
    
  Close 
  
End Sub 

Sub _bload( file As String, p As Any Ptr ) 

  Dim As Integer ff 
  ff = FreeFile 
  
  Open file For Binary As ff 
    fb_fileget( ff, 0, ByVal p, LOF( ff ) ) 
    
  Close 
  
End Sub

screen 20,32
dim as any ptr im=imagecreate(1024/2,768/2,rgb(0,100,255))
circle im,(300,200),50,rgb(200,0,0),,,,f

dim as ulong size
imageinfo im,,,,,,size

dim as any ptr im2=imagecreate(1024/2,768/2)
_bsave("Mytestbitmap.bmp",im,size)
_bload("Mytestbitmap.bmp",im2)

put(0,0),im2,pset

sleep


 
dafhi
Posts: 1640
Joined: Jun 04, 2005 9:51

Re: win 11 gfx win slightly dark

Post by dafhi »

dodicat the bmp didn't load either in photo viewer or gimp

regular bsave. the issue appears to be win11 photo viewer, which somehow 'detects' some kind of formatting, and then compresses the result and displays that

gimp loads it 'fine'

[edit] scaling is not the issue
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: win 11 gfx win slightly dark

Post by dodicat »

What about this one (Mainly by UEZ).

Code: Select all



#if sizeof(integer)=8
#include "windows.bi"
#endif
#Include  "win/gdiplus.bi"

#include "file.bi"
'An idea from UEZ in another thread.

Function Pload(Picture as String,byref i as any ptr=0) as long
    #define putpixel(_x,_y,colour)    *cptr(ulong ptr,row+ (_y)*pitch+ (_x) shl 2)  =(colour)
    static as integer pitch,yy,xx
    static as any ptr row
    if i then
     Imageinfo i,xx,yy,,pitch,row
 else
     screeninfo xx,yy,,,pitch
     row=screenptr
 end if
 xx-=1:yy-=1
  
   Dim As uinteger TMP 
   GDIPLUS.GdiplusStartup(@TMP,@type<GDIPLUS.GDIPLUSSTARTUPINPUT>(1),0)
   Dim as any Ptr Img
   if GDIPLUS.GdipLoadImageFromFile(Picture,@Img)>0 then return 0
   Dim As Single w,h
   GDIPLUS.GdipGetImageDimension(Img,@w,@h)
   if w*h=0 then return 0
   Dim As GDIPLUS.BitmapData Pdata
   Dim As Rect R=Type(0,0,w-1,h-1)
   GDIPLUS.GdipBitmapLockBits(Img,Cast(Any Ptr,@R),GDIPLUS.ImageLockModeRead,PixelFormat32bppARGB,@Pdata)
   screenlock
   For y as long = 0 To h-1
       if y>0 andalso y<yy then
      For x as long = 0 To w-1 
           if x>0 andalso x<xx then
        putpixel(x,y,(Cast(ulong Ptr,Pdata.Scan0)[y*w+x]))
        end if
      Next
      end if
   Next
   screenunlock
return w*h
End Function


sub getsize(picture as string,byref w as single,byref h as single) 'unused
    Dim As uinteger TMP 
   GDIPLUS.GdiplusStartup(@TMP,@type<GDIPLUS.GDIPLUSSTARTUPINPUT>(1),0)
   Dim as any Ptr Img
   if GDIPLUS.GdipLoadImageFromFile(Picture,@Img)>0 then exit sub
   GDIPLUS.GdipGetImageDimension(Img,@w,@h)
end sub


Function pSave(Image As Any Ptr, Filename As wstring, JPGQual As Ulong = 80) As Boolean 'coded by UEZ
   Dim As Integer w, h, bypp, pitch
   Dim pixdata As Any Ptr
   If Imageinfo(Image, w, h, bypp, pitch, pixdata) <> 0 Then Return False
   
   #Define PixelGet(_x, _y)   (*Cptr(Ulong ptr, pixdata + (_y) * pitch + (_x) Shl 2))
   
   Dim GDIPlusStartupInput As GDIPLUS.GDIPLUSSTARTUPINPUT 
   Dim As ULONG_PTR GDIPlusToken 
   GDIPlusStartupInput.GdiplusVersion = 1   
   If (GDIPLUS.GdiplusStartup(@GDIPlusToken, @GDIPlusStartupInput, NULL) <> 0) Then Return 0
   Dim As Uinteger  x, y, RowOffset
   Dim As Any Ptr hBitmap
   Dim As GDIPLUS.BitmapData tBitmapData
   Dim As Rect tRect = Type(0, 0, w - 1, h - 1)
   GDIPLUS.GdipCreateBitmapFromScan0(w, h, 0, PixelFormat32bppARGB, 0, @hBitmap)
   GDIPLUS.GdipBitmapLockBits(hBitmap, Cast(Any Ptr, @tRect), GDIPLUS.ImageLockModeWrite, PixelFormat32bppARGB, @tBitmapData)
   For y = 0 To h - 1
      RowOffset = y * w
      For x = 0 To w - 1
         Cast(ULong Ptr, tBitmapData.Scan0)[RowOffset + x] =PixelGet(x, y)' point(x,y,Image)'PixelGet(x, y)
      Next      
   Next
   GDIPLUS.GdipBitmapUnlockBits(hBitmap, @tBitmapData)
   
   Dim As Byte iErr = 0

   Dim As Ulong count, size
   GDIPLUS.GdipGetImageEncodersSize(@count, @size)
   
   Dim As CLSID clsid
   Dim As GDIPLUS.ImageCodecInfo Ptr pImageCodecInfo
   pImageCodecInfo = Allocate(size)
   GDIPLUS.GdipGetImageEncoders(count, size, pImageCodecInfo)
   
   #Define _MimeType(x)   (*Cast(Wstring Ptr, pImageCodecInfo[x].MimeType))
   #Define FnSuffix   (Right(Filename, 4))   
   
   For i As Ulong = 0 To count - 1
      If _MimeType(i) = "image/bmp" And FnSuffix = ".bmp" Then
         If (GDIPLUS.GdipSaveImageToFile(hBitmap, Wstr(Filename), @pImageCodecInfo[i].Clsid, NULL) <> 0) Then iErr += 1
      Elseif _MimeType(i) = "image/jpeg" And (FnSuffix = ".jpg" Or Right(Filename, 5) = ".jpeg") Then
         JPGQual = Iif(JPGQual < 0, 0, Iif(JPGQual > 100, 100, JPGQual))
         Dim tParams As GDIPLUS.EncoderParameters
         Dim EncoderQuality As String = "{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"
         tParams.Count = 1
         CLSIDFromString(Wstr(EncoderQuality), @tParams.Parameter(0).GUID)
         With tParams.Parameter(0)
            .NumberOfValues = 1
            .Type = GDIPLUS.EncoderParameterValueTypeLong
            .Value = Varptr(JPGQual)
         End With
         If GDIPLUS.GdipSaveImageToFile(hBitmap, Wstr(Filename), @pImageCodecInfo[i].Clsid, @tParams) <> 0 Then iErr += 1          
      Elseif _MimeType(i) = "image/gif" And FnSuffix = ".gif" Then
         If (GDIPLUS.GdipSaveImageToFile(hBitmap, Wstr(Filename), @pImageCodecInfo[i].Clsid, NULL) <> 0) Then iErr += 1
      Elseif _MimeType(i) = "image/tiff" And (FnSuffix = ".tif" Or Right(Filename, 5) = ".tiff") Then
         If (GDIPLUS.GdipSaveImageToFile(hBitmap, Wstr(Filename), @pImageCodecInfo[i].Clsid, NULL) <> 0) Then iErr += 1
      Elseif _MimeType(i) = "image/png" And FnSuffix = ".png" Then
         If (GDIPLUS.GdipSaveImageToFile(hBitmap, Wstr(Filename), @pImageCodecInfo[i].Clsid, NULL) <> 0) Then iErr += 1     
      Else
         iErr += 1
      End If
   Next

   Deallocate(pImageCodecInfo)

   GDIPLUS.GdipDisposeImage(hBitmap)
   GDIPLUS.GdiplusShutdown(GDIPlusToken)
   If iErr > 0 Then Return False

   Return True
End Function


screen 20,32,,64
 Dim As Any Ptr Image = Imagecreate(1024,768,0)
 for n as long=1 to 100
       circle image,(rnd*1024,rnd*768),20+rnd*200,rgba(rnd*255,rnd*255,rnd*255,rnd*255),,,,f
 next
 put(0,0),image,pset
 print "press a key"
 sleep
 cls
 psave(image,"circles.bmp")
 windowtitle "circles.bmp"
 pload("circles.bmp")
 

sleep
 
dafhi
Posts: 1640
Joined: Jun 04, 2005 9:51

Re: win 11 gfx win slightly dark

Post by dafhi »

theres a black line at top after image loads

looks fine in photo viewer.
Post Reply