Thumbnails and View Images for Windows

[RASHAD]

Thumbnails with any size and View Images for :
"bmp","jpg","jpeg","jpe","jfif","png","tif","tiff","gif","emf","wmf", "ico","rle","jp2","cur","tga","ppm","pgm"

Code: Select all

CompilerIf Not #PB_Compiler_Unicode 
  MessageRequester("Info","Please Compile in Unicode Mode", #PB_MessageRequester_Ok|#MB_ICONWARNING)
  End
CompilerEndIf

UseJPEG2000ImageDecoder()
UseTGAImageDecoder()

#HDF_IMAGE           = 2048
#HDI_IMAGE           = 32

#Jpeg_Encoder = "image/jpeg"
#Gif_Encoder = "image/gif"
#Bmp_Encoder = "image/bmp"
#Png_Encoder = "image/png"
#Tif_Encoder = "image/tiff"

Global  oldproc,Var.lv_item ,VarHeader.HDITEM,iinf.ICONINFO,header_h,Icwnd
Global *token, *Image, encoderCLSID.GUID,Image
Image = 0

Var\mask     =  #LVIF_IMAGE
VarHeader\mask = #HDI_IMAGE
VarHeader\fmt = #HDF_IMAGE

Structure PPMColor
  r.a
  g.a
  b.a
EndStructure

Structure PGMColor
  c.a
EndStructure

Structure RectF
  x.f
  y.f
  width.f
  height.f
EndStructure
 
Structure GdiplusStartupInput
  GdiPlusVersion.i
  *DebugEventCallback.DebugEventProc
  SuppressBackgroundThread.i
  SuppressExternalCodecs.i
EndStructure

Structure ImageCodecInfo
  clsid.CLSID
  formatID.GUID
  *codecName
  *dllName
  *formatDescription
  *filenameExtension
  *mimeType
  flags.l
  version.l
  sigCount.l
  sigSize.l
  *sigPattern.byte
  *sigMask.byte
EndStructure

Procedure.i Gdiplus_New(version = 1, *hEventCB = #Null, Codecs = #False, bgThread = #False)
  OpenLibrary(0, "gdiplus.dll")
  Protected *token, input.GdiplusStartupInput
  With input
    \GdiPlusVersion = version
    \DebugEventCallback = *hEventCB
    \SuppressExternalCodecs = Codecs
    \SuppressBackgroundThread = bgThread
  EndWith
  CallFunction(0, "GdiplusStartup", @*token, @input, #Null)
  ProcedureReturn *token
EndProcedure

Procedure GetEncoderClsid(format$, *Clsid.CLSID)
  Protected number , Size , *pImageCodecInfo.ImageCodecInfo, i, *memory 
  CallFunction(0,"GdipGetImageEncodersSize",@number, @Size)
  If Size = 0
       ProcedureReturn -1
  EndIf 
  *memory = AllocateMemory(Size)
  If *memory = #Null
       ProcedureReturn -1
  EndIf 
  *pImageCodecInfo = *memory
  CallFunction(0,"GdipGetImageEncoders",number, Size, *pImageCodecInfo) 
  For i = 1 To number
    If format$ = PeekS(*pImageCodecInfo\MimeType, -1, #PB_Unicode)
      CopyMemory(*pImageCodecInfo\clsid, *Clsid, SizeOf(CLSID))
      FreeMemory(*memory)
      ProcedureReturn i
    EndIf
    *pImageCodecInfo + SizeOf(ImageCodecInfo)
  Next
  FreeMemory(*memory)
  ProcedureReturn -1
EndProcedure

Procedure SetImg(gad,Row,Col,iImg)
  Var\iItem    = Row
  Var\iSubItem = Col
  Var\iImage   = iImg ;Index of image in the list
  SendMessage_(GadgetID(gad), #LVM_SETITEM, 0, @Var)
EndProcedure

Procedure SetHeaderImage(Header,Col)
  VarHeader\iImage = 1
  SendMessage_(Header , #HDM_SETITEM, Col, @VarHeader)
EndProcedure

Procedure Hheight(hWnd, uMsg, wParam, lParam)
  Select uMsg
    Case #HDM_LAYOUT
      result = CallWindowProc_(oldproc, hwnd, uMsg, wParam, lParam)
      *hdlayout.HD_LAYOUT = lParam
      If *hdlayout\prc <> 0
        *rect.RECT = *hdlayout\prc
        *rect\top = header_h
      EndIf
      If *hdlayout\pwpos <> 0
        *windowpos.WINDOWPOS = *hdlayout\pwpos
        *windowpos\cy = header_h
      EndIf
   
    Default
      result = CallWindowProc_(oldproc, hWnd, uMsg, wParam, lParam)
 
  EndSelect
  ProcedureReturn result
EndProcedure

Procedure LoadPPGM(Image,filename$)
  Result = ReadFile(#PB_Any, filename$,#PB_Ascii)
  If Result
    If CreateImage(Image, 1, 1)
      Format$ = ReadString(Result)
      Dimensions$ = ReadString(Result)
      If Val(StringField(Dimensions$, 1, " ")) = 0
        Dimensions$ = ReadString(Result)
      EndIf
      w  = Val(StringField(Dimensions$, 1, " "))
      h  = Val(StringField(Dimensions$, 2, " "))
      ResizeImage(Image, w, h)
      StartDrawing(ImageOutput(Image))
      max = Val(ReadString(Result))
      Select Format$
        Case "P2"
          Stringlen = Lof(Result) - Loc(Result)
          content$  = Space(Stringlen*SizeOf(Character)+1)
          Dim color.s(0)
          ReadData(Result, @content$, Stringlen)
          content$ = PeekS(@content$,-1,#PB_Ascii)
          CreateRegularExpression(1, "\d+")
          ExtractRegularExpression(1, content$, color())
          For y = 0 To h - 1
            For x = 0 To w - 1
              pos = (y*w + x)*1
              Plot(x, y,RGB(Val(color(pos)),Val(color(pos)),Val(color(pos))))
            Next
          Next
       
        Case "P3"
          Stringlen = Lof(Result) - Loc(Result)
          content$  = Space(Stringlen*SizeOf(Character)+1)
          Dim color.s(0)
          ReadData(Result, @content$, Stringlen)
          content$ = PeekS(@content$,-1,#PB_Ascii)
          CreateRegularExpression(1, "\d+")
          ExtractRegularExpression(1, content$, color())
          For y = 0 To h - 1
            For x = 0 To w - 1
              pos = (y*w + x)*3
              r=Val(color(pos))*255 / max
              g=Val(color(pos+1))*255 / max
              b=Val(color(pos+2))*255 / max
              Plot(x, y, RGB(r,g,b))
            Next
          Next
         
        Case "P5"
          Bufferlen = Lof(Result) - Loc(Result)
          *Buffer   = AllocateMemory(Bufferlen)
            ReadData(Result, *Buffer, Bufferlen)
            For y = 0 To h - 1
              For x = 0 To w - 1
                *gray.PGMColor = pos + *Buffer
                Plot(x, y,RGB(*gray\c,*gray\c,*gray\c))
                pos + 1
              Next
            Next
         
        Case "P6"
          Bufferlen = Lof(Result) - Loc(Result)
          *Buffer   = AllocateMemory(Bufferlen)
          ReadData(Result, *Buffer, Bufferlen)
          For y = 0 To h - 1
            For x = 0 To w - 1
              *color.PPMColor = pos + *Buffer
              Plot(x, y, RGB(*color\r*255 / max, *color\g*255 / max, *color\b*255 / max))
              pos + 3
            Next
          Next
      EndSelect
      StopDrawing()     
      CloseFile(Result)
      ProcedureReturn 1
    EndIf
  EndIf
EndProcedure

LoadFont(0,"Consolas",14)

OpenWindow(0,0,0,800,600,"Load any Image",#PB_Window_SystemMenu|#PB_Window_ScreenCentered| #PB_Window_MaximizeGadget| #PB_Window_SizeGadget)
ListIconGadget(0,10,10,780,500,"",0,#PB_ListIcon_MultiSelect |#PB_ListIcon_FullRowSelect|#PB_ListIcon_GridLines)
OpenWindow(1,0,0,600,400,"View Image",#PB_Window_ScreenCentered,WindowID(0)); |#PB_Window_Invisible)
ScrollAreaGadget(1,0,0,600,400,1920,1200)
  ImageGadget(3,0,0,800,600,0)
CloseGadgetList()
UseGadgetList(WindowID(0))
ButtonGadget(10,10,560,50,20,"RUN")

SendMessage_(GadgetID(0), #LVM_SETEXTENDEDLISTVIEWSTYLE , #LVS_EX_SUBITEMIMAGES, #LVS_EX_SUBITEMIMAGES)
Header = SendMessage_(GadgetID(0), #LVM_GETHEADER, 0, 0)

SetGadgetFont(0,FontID(0))
AddGadgetColumn(0, 1, "Column 1",250)
AddGadgetColumn(0, 2, "Column 2",255)
AddGadgetColumn(0, 3, "Column 3",255)

ILwnd = ImageList_Create_(64,64,#ILC_COLOR32, 0, 200)
SendMessage_(GadgetID(0), #LVM_SETIMAGELIST, #LVSIL_SMALL, ILwnd)

For i = 0 To 200
  AddGadgetItem(0, -1, Chr(10)+"  "+Str(i)+Chr(10)+ "  222"+Chr(10)+"  333"+Chr(10)+ "  444")
Next

oldproc = SetWindowLongPtr_(Header, #GWL_WNDPROC, @Hheight())
Image = 1
header_h = 64

ColumnCount = SendMessage_(header,  #HDM_GETITEMCOUNT, 0, 0)
Dim order(ColumnCount-1)
For c = 0 To ColumnCount-1
  order(c) = c+1
Next
SendMessage_(GadgetID(0), #LVM_SETCOLUMNORDERARRAY, ColumnCount, @order())

Repeat           
  Select WaitWindowEvent()     
    Case #PB_Event_CloseWindow
        CallFunction(0,"GdipDeleteGraphics",*Localgfx) 
        CallFunction(0,"GdiplusShutdown",*token)
        CloseLibrary(0)
        Quit = 1       
   
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 0
          FileName$ = path$+GetGadgetItemText(0,GetGadgetState(0),1)
          Ext$ = LCase(GetExtensionPart(FileName$))
          Select Ext$
            Case "bmp","jpg","jpeg","jpe","jfif","png","tif","tiff","gif","emf","wmf", "ico","rle"
              CallFunction(0,"GdipCreateBitmapFromFile",@FileName$, @*image)
              CallFunction(0,"GdipCreateHBITMAPFromBitmap",*Image, @HBITMAP,0)
              SetGadgetState(3,HBITMAP)
            Case "cur"
              hCursor = LoadCursorFromFile_(@FileName$)
              SetGadgetState(3,hCursor)
              DeleteObject_(hCursor)
            Case "jp2","tga"
              If IsImage(0)
                FreeImage(0)
              EndIf
              LoadImage(0,FileName$)
              SetGadgetState(3,ImageID(0))
            Case "ppm","pgm"
              If IsImage(0)
                FreeImage(0)
              EndIf
              LoadPPGM(0, FileName$)
              SetGadgetState(3,ImageID(0))
          EndSelect             
       
        Case 10
          ;FileName$ = OpenFileRequester("Open image", "", "All supported formats|*.bmp;*.gif;*.jpg;*.jpeg;*.jfif;*jpe;*.png|BMP image (*.bmp)|*.bmp|JPEG image (*.jpg;*.jpeg)|*.jpg;*.jpeg|GIF image (*.gif)|*.gif|PNG image (*.png)|*.png", 0)
          ;If FileName$
          Path$ = PathRequester("Directory", "E:\")
          If ExamineDirectory(0, Path$, "*.*")         
            *token = Gdiplus_New()
            Repeat
              NextEntry     = NextDirectoryEntry(0)                   
              FileName$     = DirectoryEntryName(0)
              File$ = Path$+FileName$
              Ext$ = LCase(GetExtensionPart(FileName$))
              If FileSize(File$)  > 0; And FileSize(Path$ + FileName$) < 100000
                Select Ext$
                  Case "bmp","jpg","jpeg","jpe","jfif","png","tif","tiff","gif","emf","wmf","ico","rle"
                    If *token                   
                      CallFunction(0,"GdipCreateBitmapFromFile",@File$, @*image)
                      CallFunction(0,"GdipCreateHBITMAPFromBitmap", *Image,@HBITMAP,0)
                      If HBITMAP
                        imgH = CopyImage_(HBITMAP,#IMAGE_BITMAP,64,64,0)
                        DeleteObject_(HBITMAP)
                        iinf\hbmMask = imgH
                        iinf\hbmColor = imgH 
                        Icwnd = CreateIconIndirect_(iinf)
                        item = ImageList_AddIcon_(ILwnd,Icwnd)
                        DeleteObject_(imgH)
                        DestroyIcon_(Icwnd)                                       
                        SetGadgetItemText(0,item, FileName$,1)
                        CallFunction(0,"GdipDisposeImage",*image)
                      EndIf
                    EndIf
                   
                  Case "cur"
                    hCursor = LoadCursorFromFile_(@File$)
                    If hCursor
                      item = ImageList_AddIcon_(ILwnd,hCursor)
                      DeleteObject_(hCursor)
                      SetGadgetItemText(0,item, FileName$,1)   
                    EndIf
                   
                  Case "jp2","tga"
                    LoadImage(0,File$)
                    If IsImage(0)
                      imgH = CopyImage_(ImageID(0),#IMAGE_BITMAP,64,64,0)
                      FreeImage(0)
                      iinf\hbmMask = imgH
                      iinf\hbmColor = imgH 
                      Icwnd = CreateIconIndirect_(iinf)
                      item = ImageList_AddIcon_(ILwnd,Icwnd)
                      DeleteObject_(imgH)
                      DestroyIcon_(Icwnd)                                       
                      SetGadgetItemText(0,item, FileName$,1)
                    EndIf                 
                 
                  Case "ppm","pgm"
                    LoadPPGM(Image, File$)
                    If IsImage(Image)
                      imgH = CopyImage_(ImageID(image),#IMAGE_BITMAP,64,64,0)
                      FreeImage(image)
                      iinf\hbmMask = imgH
                      iinf\hbmColor = imgH 
                      Icwnd = CreateIconIndirect_(iinf)
                      item = ImageList_AddIcon_(ILwnd,Icwnd)
                      DeleteObject_(imgH)
                      DestroyIcon_(Icwnd)                                       
                      SetGadgetItemText(0,item, FileName$,1)
                    EndIf
                 
                EndSelect
              EndIf
            Until NextEntry = 0
          EndIf
          For x = 0 To item           
            SetImg(0,x,1,x)
          Next
      EndSelect
  EndSelect
Until Quit = 1
End

[RASHAD]

Added flip Hal. , Val. & Rotate

Code: Select all

Global fimg ,Center
Global Dim p.POINT(2)

CompilerIf Not #PB_Compiler_Unicode 
  MessageRequester("Info","Please Compile in Unicode Mode", #PB_MessageRequester_Ok|#MB_ICONWARNING)
  End
CompilerEndIf

UseJPEG2000ImageDecoder()
UseTGAImageDecoder()

#HDF_IMAGE           = 2048
#HDI_IMAGE           = 32

#Jpeg_Encoder = "image/jpeg"
#Gif_Encoder = "image/gif"
#Bmp_Encoder = "image/bmp"
#Png_Encoder = "image/png"
#Tif_Encoder = "image/tiff"

Global  oldproc,Var.lv_item ,VarHeader.HDITEM,iinf.ICONINFO,header_h,Icwnd
Global *token, *Image, encoderCLSID.GUID,Image
Image = 0

Var\mask     =  #LVIF_IMAGE
VarHeader\mask = #HDI_IMAGE
VarHeader\fmt = #HDF_IMAGE

Structure PPMColor
  r.a
  g.a
  b.a
EndStructure

Structure PGMColor
  c.a
EndStructure

Structure RectF
  x.f
  y.f
  width.f
  height.f
EndStructure
 
Structure GdiplusStartupInput
  GdiPlusVersion.i
  *DebugEventCallback.DebugEventProc
  SuppressBackgroundThread.i
  SuppressExternalCodecs.i
EndStructure

Structure ImageCodecInfo
  clsid.CLSID
  formatID.GUID
  *codecName
  *dllName
  *formatDescription
  *filenameExtension
  *mimeType
  flags.l
  version.l
  sigCount.l
  sigSize.l
  *sigPattern.byte
  *sigMask.byte
EndStructure

Procedure.i Gdiplus_New(version = 1, *hEventCB = #Null, Codecs = #False, bgThread = #False)
  OpenLibrary(0, "gdiplus.dll")
  Protected *token, input.GdiplusStartupInput
  With input
    \GdiPlusVersion = version
    \DebugEventCallback = *hEventCB
    \SuppressExternalCodecs = Codecs
    \SuppressBackgroundThread = bgThread
  EndWith
  CallFunction(0, "GdiplusStartup", @*token, @input, #Null)
  ProcedureReturn *token
EndProcedure

Procedure GetEncoderClsid(format$, *Clsid.CLSID)
  Protected number , Size , *pImageCodecInfo.ImageCodecInfo, i, *memory 
  CallFunction(0,"GdipGetImageEncodersSize",@number, @Size)
  If Size = 0
       ProcedureReturn -1
  EndIf 
  *memory = AllocateMemory(Size)
  If *memory = #Null
       ProcedureReturn -1
  EndIf 
  *pImageCodecInfo = *memory
  CallFunction(0,"GdipGetImageEncoders",number, Size, *pImageCodecInfo) 
  For i = 1 To number
    If format$ = PeekS(*pImageCodecInfo\MimeType, -1, #PB_Unicode)
      CopyMemory(*pImageCodecInfo\clsid, *Clsid, SizeOf(CLSID))
      FreeMemory(*memory)
      ProcedureReturn i
    EndIf
    *pImageCodecInfo + SizeOf(ImageCodecInfo)
  Next
  FreeMemory(*memory)
  ProcedureReturn -1
EndProcedure

Procedure SetImg(gad,Row,Col,iImg)
  Var\iItem    = Row
  Var\iSubItem = Col
  Var\iImage   = iImg ;Index of image in the list
  SendMessage_(GadgetID(gad), #LVM_SETITEM, 0, @Var)
EndProcedure

Procedure SetHeaderImage(Header,Col)
  VarHeader\iImage = 1
  SendMessage_(Header , #HDM_SETITEM, Col, @VarHeader)
EndProcedure

Procedure Hheight(hWnd, uMsg, wParam, lParam)
  Select uMsg
    Case #HDM_LAYOUT
      result = CallWindowProc_(oldproc, hwnd, uMsg, wParam, lParam)
      *hdlayout.HD_LAYOUT = lParam
      If *hdlayout\prc <> 0
        *rect.RECT = *hdlayout\prc
        *rect\top = header_h
      EndIf
      If *hdlayout\pwpos <> 0
        *windowpos.WINDOWPOS = *hdlayout\pwpos
        *windowpos\cy = header_h
      EndIf
   
    Default
      result = CallWindowProc_(oldproc, hWnd, uMsg, wParam, lParam)
 
  EndSelect
  ProcedureReturn result
EndProcedure

Procedure LoadPPGM(Image,filename$)
  Result = ReadFile(#PB_Any, filename$,#PB_Ascii)
  If Result
    If CreateImage(Image, 1, 1)
      Format$ = ReadString(Result)
      Dimensions$ = ReadString(Result)
      If Val(StringField(Dimensions$, 1, " ")) = 0
        Dimensions$ = ReadString(Result)
      EndIf
      w  = Val(StringField(Dimensions$, 1, " "))
      h  = Val(StringField(Dimensions$, 2, " "))
      ResizeImage(Image, w, h)
      StartDrawing(ImageOutput(Image))
      max = Val(ReadString(Result))
      Select Format$
        Case "P2"
          Stringlen = Lof(Result) - Loc(Result)
          content$  = Space(Stringlen*SizeOf(Character)+1)
          Dim color.s(0)
          ReadData(Result, @content$, Stringlen)
          content$ = PeekS(@content$,-1,#PB_Ascii)
          CreateRegularExpression(1, "\d+")
          ExtractRegularExpression(1, content$, color())
          For y = 0 To h - 1
            For x = 0 To w - 1
              pos = (y*w + x)*1
              Plot(x, y,RGB(Val(color(pos)),Val(color(pos)),Val(color(pos))))
            Next
          Next
       
        Case "P3"
          Stringlen = Lof(Result) - Loc(Result)
          content$  = Space(Stringlen*SizeOf(Character)+1)
          Dim color.s(0)
          ReadData(Result, @content$, Stringlen)
          content$ = PeekS(@content$,-1,#PB_Ascii)
          CreateRegularExpression(1, "\d+")
          ExtractRegularExpression(1, content$, color())
          For y = 0 To h - 1
            For x = 0 To w - 1
              pos = (y*w + x)*3
              r=Val(color(pos))*255 / max
              g=Val(color(pos+1))*255 / max
              b=Val(color(pos+2))*255 / max
              Plot(x, y, RGB(r,g,b))
            Next
          Next
         
        Case "P5"
          Bufferlen = Lof(Result) - Loc(Result)
          *Buffer   = AllocateMemory(Bufferlen)
            ReadData(Result, *Buffer, Bufferlen)
            For y = 0 To h - 1
              For x = 0 To w - 1
                *gray.PGMColor = pos + *Buffer
                Plot(x, y,RGB(*gray\c,*gray\c,*gray\c))
                pos + 1
              Next
            Next
         
        Case "P6"
          Bufferlen = Lof(Result) - Loc(Result)
          *Buffer   = AllocateMemory(Bufferlen)
          ReadData(Result, *Buffer, Bufferlen)
          For y = 0 To h - 1
            For x = 0 To w - 1
              *color.PPMColor = pos + *Buffer
              Plot(x, y, RGB(*color\r*255 / max, *color\g*255 / max, *color\b*255 / max))
              pos + 3
            Next
          Next
      EndSelect
      StopDrawing()     
      CloseFile(Result)
      ProcedureReturn 1
    EndIf
  EndIf
EndProcedure

Procedure flipHal(img ,ww ,hh)
  fimg = CreateImage(#PB_Any,ww,hh,32)
  StartVectorDrawing(ImageVectorOutput(fimg))
    ResetCoordinates()
    MovePathCursor(ww,0)   
    FlipCoordinatesX(180)
    DrawVectorImage(img, 255)
  StopVectorDrawing()
  ProcedureReturn fimg
EndProcedure

Procedure flipVal(img ,ww ,hh)
  fimg = CreateImage(#PB_Any,ww,hh,32)
  StartVectorDrawing(ImageVectorOutput(fimg))
    ResetCoordinates()
    MovePathCursor(0,hh)   
    FlipCoordinatesY(180)
    DrawVectorImage(img, 255)
  StopVectorDrawing()
  ProcedureReturn fimg
EndProcedure

Procedure Rotate(img,ww,hh,Deg)
  Protected Cos.f = Cos(Radian(-Deg))
  Protected Sin.f = Sin(Radian(-Deg))
  imgw = Abs(hh*Sin(Radian(-45)))+Abs(ww*Cos(Radian(-45)))
  Center = imgw/2
  p(0)\x=Center-0.5*ww*Cos-0.5*hh*Sin
  p(0)\y=Center+0.5*ww*Sin-0.5*hh*Cos
  p(1)\x=Center+0.5*ww*Cos-0.5*hh*Sin
  p(1)\y=Center-0.5*ww*Sin-0.5*hh*Cos
  p(2)\x=Center-0.5*ww*Cos+0.5*hh*Sin
  p(2)\y=Center+0.5*ww*Sin+0.5*hh*Cos

  fimg  = CreateImage(#PB_Any,imgw,imgw)

  ImageDc = CreateCompatibleDC_(0)
  SelectObject_(ImageDc,img)
  dc=StartDrawing(ImageOutput(fimg))
    PlgBlt_(dc,@p(),ImageDc,0,0,ww,hh,0,0,0)
  StopDrawing()
  DeleteDC_(ImageDc)
  
  ProcedureReturn fimg
EndProcedure

LoadFont(0,"Consolas",14)

OpenWindow(0,0,0,800,600,"Load any Image",#PB_Window_SystemMenu|#PB_Window_ScreenCentered| #PB_Window_MaximizeGadget| #PB_Window_SizeGadget)
ListIconGadget(0,10,10,780,500,"",0,#PB_ListIcon_MultiSelect |#PB_ListIcon_FullRowSelect|#PB_ListIcon_GridLines)
ButtonGadget(10,10,560,50,20,"RUN")

OpenWindow(1,0,0,600,400,"View Image",#PB_Window_ScreenCentered);,WindowID(0)); |#PB_Window_Invisible)
ScrollAreaGadget(1,0,0,600,350,1920,1200)
  ImageGadget(3,0,0,800,600,0)
CloseGadgetList()
ButtonGadget(4,10,365,80,25,"Flip Hal.")
ButtonGadget(5,95,365,80,25,"Flip Val.")
ButtonGadget(6,180,365,80,25,"Rotate")
SpinGadget(7,265,365,50,24,0,359,#PB_Spin_Numeric)
SetGadgetState(7,145)

SendMessage_(GadgetID(0), #LVM_SETEXTENDEDLISTVIEWSTYLE , #LVS_EX_SUBITEMIMAGES, #LVS_EX_SUBITEMIMAGES)
Header = SendMessage_(GadgetID(0), #LVM_GETHEADER, 0, 0)

SetGadgetFont(0,FontID(0))
AddGadgetColumn(0, 1, "Column 1",250)
AddGadgetColumn(0, 2, "Column 2",255)
AddGadgetColumn(0, 3, "Column 3",255)

ILwnd = ImageList_Create_(64,64,#ILC_COLOR32, 0, 200)
SendMessage_(GadgetID(0), #LVM_SETIMAGELIST, #LVSIL_SMALL, ILwnd)

For i = 0 To 200
  AddGadgetItem(0, -1, Chr(10)+"  "+Str(i)+Chr(10)+ "  222"+Chr(10)+"  333"+Chr(10)+ "  444")
Next

oldproc = SetWindowLongPtr_(Header, #GWL_WNDPROC, @Hheight())
Image = 1
header_h = 64

ColumnCount = SendMessage_(header,  #HDM_GETITEMCOUNT, 0, 0)
Dim order(ColumnCount-1)
For c = 0 To ColumnCount-1
  order(c) = c+1
Next
SendMessage_(GadgetID(0), #LVM_SETCOLUMNORDERARRAY, ColumnCount, @order())

Repeat           
  Select WaitWindowEvent()     
    Case #PB_Event_CloseWindow
        CallFunction(0,"GdipDeleteGraphics",*Localgfx) 
        CallFunction(0,"GdiplusShutdown",*token)
        CloseLibrary(0)
        Quit = 1       
   
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 0
          If HBITMAP                              
            DeleteObject_(HBITMAP)
          EndIf
          If hCursor
            DeleteObject_(hCursor)
          EndIf
          If IsImage(0)
            FreeImage(0)
          EndIf
          If IsImage(fimg)
            FreeImage(fimg)
          EndIf
          FileName$ = path$+GetGadgetItemText(0,GetGadgetState(0),1)
          Ext$ = LCase(GetExtensionPart(FileName$))
          Select Ext$
            Case "bmp","jpg","jpeg","jpe","jfif","png","tif","tiff","gif","emf","wmf", "ico","rle"
              CallFunction(0,"GdipCreateBitmapFromFile",@FileName$, @*image)
              CallFunction(0,"GdipCreateHBITMAPFromBitmap",*Image, @HBITMAP,0)
              SetGadgetState(3,HBITMAP)
              
            Case "cur"
              hCursor = LoadCursorFromFile_(@FileName$)
              SetGadgetState(3,hCursor)
                        
            Case "jp2","tga"
              LoadImage(0,FileName$)
              SetGadgetState(3,ImageID(0))
              
            Case "ppm","pgm"
              LoadPPGM(0,FileName$)
              SetGadgetState(3,ImageID(0))      
 
          EndSelect
          
        Case 4
          Select Ext$
            Case "bmp","jpg","jpeg","jpe","jfif","png","tif","tiff","gif","emf","wmf", "ico","rle"
              CallFunction(0,"GdipGetImageDimension",*image, @width.f, @height.f)
              If IsImage(fimg)
                flipHal(ImageID(fimg) ,width ,height)
              Else 
                flipHal(HBITMAP ,width ,height)
              EndIf
              SetGadgetState(3,ImageID(fimg))
                            
            Case "cur"
              
            Case "jp2","tga","ppm","pgm"
              If IsImage(fimg)
                flipHal(ImageID(fimg) ,ImageWidth(0),ImageHeight(0))
              Else
                flipHal(ImageID(0) ,ImageWidth(0),ImageHeight(0))
              EndIf              
              SetGadgetState(3,ImageID(fimg))
          EndSelect
        
        Case 5
          Select Ext$
            Case "bmp","jpg","jpeg","jpe","jfif","png","tif","tiff","gif","emf","wmf", "ico","rle"
              CallFunction(0,"GdipGetImageDimension",*image, @width.f, @height.f)
              If IsImage(fimg)
                flipVal(ImageID(fimg) ,width ,height)
              Else 
                flipVal(HBITMAP ,width ,height)
              EndIf
              SetGadgetState(3,ImageID(fimg))
                            
            Case "cur"
              
            Case "jp2","tga","ppm","pgm"
              If IsImage(fimg)                
                flipVal(ImageID(fimg) ,ImageWidth(0),ImageHeight(0))
              Else                
                flipVal(ImageID(0) ,ImageWidth(0),ImageHeight(0))
              EndIf
              SetGadgetState(3,ImageID(fimg))
          EndSelect
        
        Case 6
          Select Ext$
            Case "bmp","jpg","jpeg","jpe","jfif","png","tif","tiff","gif","emf","wmf", "ico","rle"
              CallFunction(0,"GdipGetImageDimension",*image, @width.f, @height.f)
              Rotate(HBITMAP ,width ,height,GetGadgetState(7))
              SetGadgetState(3,ImageID(fimg))
                            
            Case "cur"
              
            Case "jp2","tga","ppm","pgm"
              Rotate(ImageID(0) ,ImageWidth(0),ImageHeight(0),GetGadgetState(7))
              SetGadgetState(3,ImageID(fimg))
          EndSelect
                     
       
        Case 10
          ;FileName$ = OpenFileRequester("Open image", "", "All supported formats|*.bmp;*.gif;*.jpg;*.jpeg;*.jfif;*jpe;*.png|BMP image (*.bmp)|*.bmp|JPEG image (*.jpg;*.jpeg)|*.jpg;*.jpeg|GIF image (*.gif)|*.gif|PNG image (*.png)|*.png", 0)
          ;If FileName$
          Path$ = PathRequester("Directory", "E:\")
          If ExamineDirectory(0, Path$, "*.*")         
            *token = Gdiplus_New()
            Repeat
              NextEntry     = NextDirectoryEntry(0)                   
              FileName$     = DirectoryEntryName(0)
              File$ = Path$+FileName$
              Ext$ = LCase(GetExtensionPart(FileName$))
              If FileSize(File$)  > 0; And FileSize(Path$ + FileName$) < 100000
                Select Ext$
                  Case "bmp","jpg","jpeg","jpe","jfif","png","tif","tiff","gif","emf","wmf","ico","rle"
                    If *token                   
                      CallFunction(0,"GdipCreateBitmapFromFile",@File$, @*image)
                      CallFunction(0,"GdipCreateHBITMAPFromBitmap", *Image,@HBITMAP,0)
                      If HBITMAP
                        imgH = CopyImage_(HBITMAP,#IMAGE_BITMAP,64,64,0)
                        DeleteObject_(HBITMAP)
                        iinf\hbmMask = imgH
                        iinf\hbmColor = imgH 
                        Icwnd = CreateIconIndirect_(iinf)
                        item = ImageList_AddIcon_(ILwnd,Icwnd)
                        DeleteObject_(imgH)
                        DestroyIcon_(Icwnd)                                       
                        SetGadgetItemText(0,item, FileName$,1)
                        CallFunction(0,"GdipDisposeImage",*image)
                      EndIf
                    EndIf
                   
                  Case "cur"
                    hCursor = LoadCursorFromFile_(@File$)
                    If hCursor
                      item = ImageList_AddIcon_(ILwnd,hCursor)
                      DeleteObject_(hCursor)
                      SetGadgetItemText(0,item, FileName$,1)   
                    EndIf
                   
                  Case "jp2","tga"
                    LoadImage(0,File$)
                    If IsImage(0)
                      imgH = CopyImage_(ImageID(0),#IMAGE_BITMAP,64,64,0)
                      FreeImage(0)
                      iinf\hbmMask = imgH
                      iinf\hbmColor = imgH 
                      Icwnd = CreateIconIndirect_(iinf)
                      item = ImageList_AddIcon_(ILwnd,Icwnd)
                      DeleteObject_(imgH)
                      DestroyIcon_(Icwnd)                                       
                      SetGadgetItemText(0,item, FileName$,1)
                    EndIf
                    
                  Case "ppm","pgm"
                    If IsImage(0)
                      FreeImage(0)
                    EndIf
                    LoadPPGM(Image, File$)
                    If IsImage(Image)
                      imgH = CopyImage_(ImageID(image),#IMAGE_BITMAP,64,64,0)
                      FreeImage(image) 
                      iinf\hbmMask = imgH
                      iinf\hbmColor = imgH  
                      Icwnd = CreateIconIndirect_(iinf)
                      item = ImageList_AddIcon_(ILwnd,Icwnd)
                      DeleteObject_(imgH)
                      DestroyIcon_(Icwnd)                                        
                      SetGadgetItemText(0,item, FileName$,1)
                    EndIf 
                 
                EndSelect
              EndIf
            Until NextEntry = 0
          EndIf
          For x = 0 To item           
            SetImg(0,x,1,x)
          Next
      EndSelect
  EndSelect
Until Quit = 1
End

Edit : Bug fixed
Edit 2:Modified

[RASHAD]

You are welcome
Previous post updated

[Michael Vogel]

Fine (as usual)

For faster jpeg handling I would recommend to use the Turbo Jpeg Library which is speeds up everything.

[RASHAD]

Hi MV thanks
For your sake next is the new version
Feel free to comment and change
But post any new version
Compile as thread safe

Code: Select all

Global fimg,ww.f,hh.f,deg,HBITMAP,Thread,ILwnd,Path$,Finish

CompilerIf Not #PB_Compiler_Unicode 
  MessageRequester("Info","Please Compile in Unicode Mode", #PB_MessageRequester_Ok|#MB_ICONWARNING)
  End
CompilerEndIf

UseJPEG2000ImageDecoder()
UseTGAImageDecoder()

#HDF_IMAGE           = 2048
#HDI_IMAGE           = 32

#Jpeg_Encoder = "image/jpeg"
#Gif_Encoder = "image/gif"
#Bmp_Encoder = "image/bmp"
#Png_Encoder = "image/png"
#Tif_Encoder = "image/tiff"

Global  oldproc,Var.lv_item ,VarHeader.HDITEM,iinf.ICONINFO,header_h,Icwnd
Global *token, *Image, encoderCLSID.GUID,Image
Image = 0

Var\mask     =  #LVIF_IMAGE
VarHeader\mask = #HDI_IMAGE
VarHeader\fmt = #HDF_IMAGE

Structure PPMColor
  r.a
  g.a
  b.a
EndStructure

Structure PGMColor
  c.a
EndStructure

Structure RectF
  x.f
  y.f
  width.f
  height.f
EndStructure
 
Structure GdiplusStartupInput
  GdiPlusVersion.i
  *DebugEventCallback.DebugEventProc
  SuppressBackgroundThread.i
  SuppressExternalCodecs.i
EndStructure

Structure ImageCodecInfo
  clsid.CLSID
  formatID.GUID
  *codecName
  *dllName
  *formatDescription
  *filenameExtension
  *mimeType
  flags.l
  version.l
  sigCount.l
  sigSize.l
  *sigPattern.byte
  *sigMask.byte
EndStructure

Procedure.i Gdiplus_New(version = 1, *hEventCB = #Null, Codecs = #False, bgThread = #False)
  OpenLibrary(0, "gdiplus.dll")
  Protected *token, input.GdiplusStartupInput
  With input
    \GdiPlusVersion = version
    \DebugEventCallback = *hEventCB
    \SuppressExternalCodecs = Codecs
    \SuppressBackgroundThread = bgThread
  EndWith
  CallFunction(0, "GdiplusStartup", @*token, @input, #Null)
  ProcedureReturn *token
EndProcedure

Procedure GetEncoderClsid(format$, *Clsid.CLSID)
  Protected number , Size , *pImageCodecInfo.ImageCodecInfo, i, *memory 
  CallFunction(0,"GdipGetImageEncodersSize",@number, @Size)
  If Size = 0
       ProcedureReturn -1
  EndIf 
  *memory = AllocateMemory(Size)
  If *memory = #Null
       ProcedureReturn -1
  EndIf 
  *pImageCodecInfo = *memory
  CallFunction(0,"GdipGetImageEncoders",number, Size, *pImageCodecInfo) 
  For i = 1 To number
    If format$ = PeekS(*pImageCodecInfo\MimeType, -1, #PB_Unicode)
      CopyMemory(*pImageCodecInfo\clsid, *Clsid, SizeOf(CLSID))
      FreeMemory(*memory)
      ProcedureReturn i
    EndIf
    *pImageCodecInfo + SizeOf(ImageCodecInfo)
  Next
  FreeMemory(*memory)
  ProcedureReturn -1
EndProcedure

Procedure SetImg(gad,Row,Col,iImg)
  Var\iItem    = Row
  Var\iSubItem = Col
  Var\iImage   = iImg ;Index of image in the list
  SendMessage_(GadgetID(gad), #LVM_SETITEM, 0, @Var)
EndProcedure

Procedure SetHeaderImage(Header,Col)
  VarHeader\iImage = 1
  SendMessage_(Header , #HDM_SETITEM, Col, @VarHeader)
EndProcedure

Procedure Hheight(hWnd, uMsg, wParam, lParam)
  Select uMsg
    Case #HDM_LAYOUT
      result = CallWindowProc_(oldproc, hwnd, uMsg, wParam, lParam)
      *hdlayout.HD_LAYOUT = lParam
      If *hdlayout\prc <> 0
        *rect.RECT = *hdlayout\prc
        *rect\top = header_h
      EndIf
      If *hdlayout\pwpos <> 0
        *windowpos.WINDOWPOS = *hdlayout\pwpos
        *windowpos\cy = header_h
      EndIf
   
    Default
      result = CallWindowProc_(oldproc, hWnd, uMsg, wParam, lParam)
 
  EndSelect
  ProcedureReturn result
EndProcedure

Procedure LoadPPGM(Image,filename$)
  Result = ReadFile(#PB_Any, filename$,#PB_Ascii)
  If Result
    If CreateImage(Image, 1, 1)
      Format$ = ReadString(Result)
      Dimensions$ = ReadString(Result)
      If Val(StringField(Dimensions$, 1, " ")) = 0
        Dimensions$ = ReadString(Result)
      EndIf
      w  = Val(StringField(Dimensions$, 1, " "))
      h  = Val(StringField(Dimensions$, 2, " "))
      ResizeImage(Image, w, h)
      StartDrawing(ImageOutput(Image))
      max = Val(ReadString(Result))
      Select Format$
        Case "P2"
          Stringlen = Lof(Result) - Loc(Result)
          content$  = Space(Stringlen*SizeOf(Character)+1)
          Dim color.s(0)
          ReadData(Result, @content$, Stringlen)
          content$ = PeekS(@content$,-1,#PB_Ascii)
          CreateRegularExpression(1, "\d+")
          ExtractRegularExpression(1, content$, color())
          For y = 0 To h - 1
            For x = 0 To w - 1
              pos = (y*w + x)*1
              Plot(x, y,RGB(Val(color(pos)),Val(color(pos)),Val(color(pos))))
            Next
          Next
       
        Case "P3"
          Stringlen = Lof(Result) - Loc(Result)
          content$  = Space(Stringlen*SizeOf(Character)+1)
          Dim color.s(0)
          ReadData(Result, @content$, Stringlen)
          content$ = PeekS(@content$,-1,#PB_Ascii)
          CreateRegularExpression(1, "\d+")
          ExtractRegularExpression(1, content$, color())
          For y = 0 To h - 1
            For x = 0 To w - 1
              pos = (y*w + x)*3
              r=Val(color(pos))*255 / max
              g=Val(color(pos+1))*255 / max
              b=Val(color(pos+2))*255 / max
              Plot(x, y, RGB(r,g,b))
            Next
          Next
         
        Case "P5"
          Bufferlen = Lof(Result) - Loc(Result)
          *Buffer   = AllocateMemory(Bufferlen)
            ReadData(Result, *Buffer, Bufferlen)
            For y = 0 To h - 1
              For x = 0 To w - 1
                *gray.PGMColor = pos + *Buffer
                Plot(x, y,RGB(*gray\c,*gray\c,*gray\c))
                pos + 1
              Next
            Next
         
        Case "P6"
          Bufferlen = Lof(Result) - Loc(Result)
          *Buffer   = AllocateMemory(Bufferlen)
          ReadData(Result, *Buffer, Bufferlen)
          For y = 0 To h - 1
            For x = 0 To w - 1
              *color.PPMColor = pos + *Buffer
              Plot(x, y, RGB(*color\r*255 / max, *color\g*255 / max, *color\b*255 / max))
              pos + 3
            Next
          Next
      EndSelect
      StopDrawing()     
      CloseFile(Result)
      ProcedureReturn 1
    EndIf
  EndIf
EndProcedure

Procedure flipHal(img ,ww ,hh)
  fimg = CreateImage(#PB_Any,ww,hh,32)
  StartVectorDrawing(ImageVectorOutput(fimg))
    ResetCoordinates()
    MovePathCursor(ww,0)   
    FlipCoordinatesX(180)
    DrawVectorImage(img, 255)
  StopVectorDrawing()
  ProcedureReturn fimg
EndProcedure

Procedure flipVal(img ,ww ,hh)
  fimg = CreateImage(#PB_Any,ww,hh,32)
  StartVectorDrawing(ImageVectorOutput(fimg))
    ResetCoordinates()
    MovePathCursor(0,hh)   
    FlipCoordinatesY(180)
    DrawVectorImage(img, 255)
  StopVectorDrawing()
  ProcedureReturn fimg
EndProcedure

Procedure Rotate(img,ww,hh,Deg)
  fimg = CreateImage(#PB_Any,ww*Cos(Radian(deg)) + hh*Sin(Radian(deg)),hh*Cos(Radian(deg))+ ww*Sin(Radian(deg)),32)  
  StartVectorDrawing(ImageVectorOutput(fimg))
    VectorSourceColor($FFFFFFFF)
    FillVectorOutput()
    ResetCoordinates()
    MovePathCursor(hh*Sin(Radian(deg)),0)   
    RotateCoordinates(ww*Sin(Radian(deg)),0,deg)
    DrawVectorImage(img, 255)
  StopVectorDrawing()
  ProcedureReturn fimg
EndProcedure

Procedure sizeCB()
  ResizeGadget(1,0,0,WindowWidth(1),WindowHeight(1)-50)
  ResizeGadget(20,10,WindowHeight(1)-35,600,25)
  ResizeGadget(10,10,WindowHeight(0)-35,50,25)
  ResizeGadget(12,70,WindowHeight(0)-35,50,25)
EndProcedure

Procedure PopulateLI(par)
  Finish = 0
  SetGadgetText(12,"WAIT")
  DisableGadget(20,1)
  If ILwnd
     ImageList_Destroy_(ILwnd)
  EndIf
  ClearGadgetItems(0)
  ILwnd = ImageList_Create_(64,64,#ILC_COLOR32, 0, 200)
  SendMessage_(GadgetID(0), #LVM_SETIMAGELIST, #LVSIL_SMALL, ILwnd)
  Path$ = PathRequester("Directory", "E:\")
  If ExamineDirectory(0, Path$, "*.*")         
    *token = Gdiplus_New()
    Repeat
      NextEntry     = NextDirectoryEntry(0)                   
      FileName$     = DirectoryEntryName(0)
      File$ = Path$+FileName$
      Ext$ = LCase(GetExtensionPart(FileName$))
      If FileSize(File$)  > 0; And FileSize(Path$ + FileName$) < 100000
        Select Ext$
          Case "bmp","jpg","jpeg","jpe","jfif","png","tif","tiff","gif","emf","wmf","ico","rle"
            If *token                   
              CallFunction(0,"GdipCreateBitmapFromFile",@File$, @*image)
              CallFunction(0,"GdipCreateHBITMAPFromBitmap", *Image,@HBITMAP,0)
              If HBITMAP
                imgH = CopyImage_(HBITMAP,#IMAGE_BITMAP,64,64,0)
                DeleteObject_(HBITMAP)
                iinf\hbmMask = imgH
                iinf\hbmColor = imgH 
                Icwnd = CreateIconIndirect_(iinf)
                item = ImageList_AddIcon_(ILwnd,Icwnd)
                DeleteObject_(imgH)
                DestroyIcon_(Icwnd)
                AddGadgetItem(0, -1, Chr(10)+ FileName$ + Chr(10)+ "  222" + Chr(10) + "  333"+Chr(10)+ "  444")
                SetImg(0,item,1,item)
                CallFunction(0,"GdipDisposeImage",*image)
              EndIf
            EndIf
           
          Case "cur"
            hCursor = LoadCursorFromFile_(@File$)
            If hCursor
              item = ImageList_AddIcon_(ILwnd,hCursor)
              DeleteObject_(hCursor)
              AddGadgetItem(0, -1, Chr(10) + FileName$ + Chr(10) + "  222" + Chr(10) + "  333"+Chr(10)+ "  444")
              SetImg(0,item,1,item)  
            EndIf
           
          Case "jp2","tga"
            LoadImage(0,File$)
            If IsImage(0)
              imgH = CopyImage_(ImageID(0),#IMAGE_BITMAP,64,64,0)
              FreeImage(0)
              iinf\hbmMask = imgH
              iinf\hbmColor = imgH 
              Icwnd = CreateIconIndirect_(iinf)
              item = ImageList_AddIcon_(ILwnd,Icwnd)
              DeleteObject_(imgH)
              DestroyIcon_(Icwnd)
              AddGadgetItem(0, -1, Chr(10) + FileName$ + Chr(10)+ "  222" + Chr(10) + "  333"+Chr(10)+ "  444")
              SetImg(0,item,1,item)
            EndIf
            
          Case "ppm","pgm"
            If IsImage(0)
              FreeImage(0)
            EndIf
            LoadPPGM(Image, File$)
            If IsImage(Image)
              imgH = CopyImage_(ImageID(image),#IMAGE_BITMAP,64,64,0)
              FreeImage(image) 
              iinf\hbmMask = imgH
              iinf\hbmColor = imgH  
              Icwnd = CreateIconIndirect_(iinf)
              item = ImageList_AddIcon_(ILwnd,Icwnd)
              DeleteObject_(imgH)
              DestroyIcon_(Icwnd)
              AddGadgetItem(0, -1, Chr(10) + FileName$ + Chr(10)+ "  222" + Chr(10) + "  333"+Chr(10)+ "  444")
              SetImg(0,item,1,item)
            EndIf 
         
        EndSelect
      EndIf
    Until NextEntry = 0
  EndIf
  Delay(50)
  Finish = 1
  SetGadgetText(12,"GO")
  DisableGadget(20,0)          
EndProcedure

LoadFont(0,"Consolas",14)

OpenWindow(0,0,0,800,600,"Load any Image",#PB_Window_SystemMenu|#PB_Window_ScreenCentered| #PB_Window_MaximizeGadget| #PB_Window_SizeGadget)
ListIconGadget(0,10,10,780,500,"",0,#PB_ListIcon_MultiSelect |#PB_ListIcon_FullRowSelect|#PB_ListIcon_GridLines)
ButtonGadget(10,10,565,50,25,"RUN")
TextGadget(12,70,565,80,25,"START",#SS_CENTER|#SS_CENTERIMAGE)
SetGadgetColor(12,#PB_Gadget_FrontColor,$0000FF)
SetGadgetFont(12,FontID(0))

OpenWindow(1,0,0,600,400,"View Image",#PB_Window_SystemMenu  |#PB_Window_ScreenCentered |#PB_Window_SizeGadget);,WindowID(0)); |#PB_Window_Invisible)
ScrollAreaGadget(1,0,0,600,350,3000,3000)
  ImageGadget(3,0,0,800,600,0)
CloseGadgetList()

ContainerGadget(20,10,365,600,25)
  ButtonGadget(4,0,0,60,25,"Flip Hal.")
  ButtonGadget(5,65,0,60,25,"Flip Val.")
  ButtonGadget(6,130,0,60,25,"Rotate")
  SpinGadget(7,195,0,50,24,0,360,#PB_Spin_Numeric)
  SetGadgetState(7,145)
  ButtonGadget(8,520,0,60,25,"Save As..")
CloseGadgetList()

SendMessage_(GadgetID(0), #LVM_SETEXTENDEDLISTVIEWSTYLE , #LVS_EX_SUBITEMIMAGES, #LVS_EX_SUBITEMIMAGES)
Header = SendMessage_(GadgetID(0), #LVM_GETHEADER, 0, 0)

SetGadgetFont(0,FontID(0))
AddGadgetColumn(0, 1, "Column 1",250)
AddGadgetColumn(0, 2, "Column 2",255)
AddGadgetColumn(0, 3, "Column 3",255)

oldproc = SetWindowLongPtr_(Header, #GWL_WNDPROC, @Hheight())
Image = 1
header_h = 64

ColumnCount = SendMessage_(header,  #HDM_GETITEMCOUNT, 0, 0)
Dim order(ColumnCount-1)
For c = 0 To ColumnCount-1
  order(c) = c+1
Next
SendMessage_(GadgetID(0), #LVM_SETCOLUMNORDERARRAY, ColumnCount, @order())

BindEvent(#PB_Event_SizeWindow,@sizeCB())
Repeat           
  Select WaitWindowEvent()     
    Case #PB_Event_CloseWindow
        CallFunction(0,"GdipDeleteGraphics",*Localgfx) 
        CallFunction(0,"GdiplusShutdown",*token)
        CloseLibrary(0)
        Quit = 1       
   
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 0
          If HBITMAP                              
            DeleteObject_(HBITMAP)
          EndIf
          If hCursor
            DeleteObject_(hCursor)
          EndIf
          If IsImage(0)
            FreeImage(0)
          EndIf
          If IsImage(fimg)
            FreeImage(fimg)
          EndIf
          Run = 0
          FileName$ = path$+GetGadgetItemText(0,GetGadgetState(0),1)
          Ext$ = LCase(GetExtensionPart(FileName$))
          Select Ext$
            Case "bmp","jpg","jpeg","jpe","jfif","png","tif","tiff","gif","emf","wmf", "ico","rle"
              CallFunction(0,"GdipCreateBitmapFromFile",@FileName$, @*image)
              CallFunction(0,"GdipCreateHBITMAPFromBitmap",*Image, @HBITMAP,0)
              SetGadgetState(3,HBITMAP)
              
            Case "cur"
              hCursor = ImageList_GetIcon_(ILwnd,GetGadgetState(0),#ILD_IMAGE) ; | #ILD_MASK
              ImageList_GetIconSize_(ILwnd,@cx,@cy)
              SetGadgetState(3,hCursor)
                        
            Case "jp2","tga"
              LoadImage(0,FileName$)
              SetGadgetState(3,ImageID(0))
              
            Case "ppm","pgm"
              LoadPPGM(0,FileName$)
              SetGadgetState(3,ImageID(0))      
 
          EndSelect
          
        Case 4
          Select Ext$
            Case "bmp","jpg","jpeg","jpe","jfif","png","tif","tiff","gif","emf","wmf", "ico","rle"
              If Finish = 1
                CallFunction(0,"GdipGetImageDimension",*image, @ww.f, @hh.f)
                If IsImage(fimg)
                  flipHal(ImageID(fimg) ,ImageWidth(fimg),ImageHeight(fimg))
                Else 
                  flipHal(HBITMAP ,ww,hh)
                EndIf
                SetGadgetState(3,ImageID(fimg))
              EndIf
                              
            Case "cur"
              If Finish = 1
                If IsImage(fimg)
                  flipHal(ImageID(fimg) ,cx,cy)
                Else
                  flipHal(hCursor ,cx,cy)
                EndIf              
                SetGadgetState(3,ImageID(fimg))
              EndIf
              
            Case "jp2","tga","ppm","pgm"
              If Finish = 1
                If IsImage(fimg)
                  flipHal(ImageID(fimg) ,ImageWidth(fimg),ImageHeight(fimg))
                Else
                  flipHal(ImageID(0) ,ImageWidth(0),ImageHeight(0))
                EndIf              
                SetGadgetState(3,ImageID(fimg))
              EndIf
          EndSelect
        
        Case 5
          Select Ext$
            Case "bmp","jpg","jpeg","jpe","jfif","png","tif","tiff","gif","emf","wmf", "ico","rle"
              If Finish = 1
                CallFunction(0,"GdipGetImageDimension",*image, @ww.f, @hh.f)
                If IsImage(fimg)
                  flipVal(ImageID(fimg) ,ImageWidth(fimg),ImageHeight(fimg))
                Else 
                  flipVal(HBITMAP ,ww,hh)
                EndIf
                SetGadgetState(3,ImageID(fimg))
              EndIf
                            
            Case "cur"
              If Finish = 1
                If IsImage(fimg)                
                  flipVal(ImageID(fimg) ,cx,cy)
                Else                
                  flipVal(hCursor ,cx,cy)
                EndIf
                SetGadgetState(3,ImageID(fimg))
              EndIf
              
            Case "jp2","tga","ppm","pgm"
              If Finish = 1
                If IsImage(fimg)                
                  flipVal(ImageID(fimg) ,ImageWidth(fimg),ImageHeight(fimg))
                Else                
                  flipVal(ImageID(0) ,ImageWidth(0),ImageHeight(0))
                EndIf
                SetGadgetState(3,ImageID(fimg))
              EndIf
          EndSelect
        
        Case 6
          Select Ext$
            Case "bmp","jpg","jpeg","jpe","jfif","png","tif","tiff","gif","emf","wmf", "ico","rle"
              If Finish = 1
                CallFunction(0,"GdipGetImageDimension",*image, @ww.f, @hh.f)
                deg = GetGadgetState(7)
                If deg >= 90 And deg =< 180
                  deg = deg - 90
                  Rotate(HBITMAP,ww,hh,90)
                  Rotate(ImageID(fimg) ,ImageWidth(fimg),ImageHeight(fimg),deg)
                ElseIf deg >= 180 And deg =< 270
                  deg = deg - 180
                  Rotate(HBITMAP,ww,hh,90)
                  Rotate(ImageID(fimg) ,ImageWidth(fimg),ImageHeight(fimg),90)
                  Rotate(ImageID(fimg) ,ImageWidth(fimg),ImageHeight(fimg),deg)
                ElseIf deg >= 270 And deg =< 360
                  deg = deg - 270
                  Rotate(HBITMAP,ww,hh,90)
                  Rotate(ImageID(fimg) ,ImageWidth(fimg),ImageHeight(fimg),90)
                  Rotate(ImageID(fimg) ,ImageWidth(fimg),ImageHeight(fimg),90)
                  Rotate(ImageID(fimg) ,ImageWidth(fimg),ImageHeight(fimg),deg)
                Else                             
                  If IsImage(fimg)
                    Rotate(ImageID(fimg) ,ImageWidth(fimg),ImageHeight(fimg),GetGadgetState(7))
                  Else                               
                    Rotate(HBITMAP,ww,hh,GetGadgetState(7))
                  EndIf
                EndIf
                SetGadgetState(3,ImageID(fimg))
              EndIf
                            
            Case "cur"
              
            Case "jp2","tga","ppm","pgm"
              If Finish = 1              
                deg = GetGadgetState(7)
                If deg >= 90 And deg =< 180
                  deg = deg - 90
                  Rotate(ImageID(0) ,ImageWidth(0),ImageHeight(0),90)
                  Rotate(ImageID(fimg) ,ImageWidth(fimg),ImageHeight(fimg),deg)
                ElseIf deg >= 180 And deg =< 270
                  deg = deg - 180
                  Rotate(ImageID(0) ,ImageWidth(0),ImageHeight(0),90)
                  Rotate(ImageID(fimg) ,ImageWidth(fimg),ImageHeight(fimg),90)
                  Rotate(ImageID(fimg) ,ImageWidth(fimg),ImageHeight(fimg),deg)
                ElseIf deg >= 270 And deg =< 360
                  deg = deg - 270
                  Rotate(ImageID(0) ,ImageWidth(0),ImageHeight(0),90)
                  Rotate(ImageID(fimg) ,ImageWidth(fimg),ImageHeight(fimg),90)
                  Rotate(ImageID(fimg) ,ImageWidth(fimg),ImageHeight(fimg),90)
                  Rotate(ImageID(fimg) ,ImageWidth(fimg),ImageHeight(fimg),deg)
                Else
                  If IsImage(fimg)
                    Rotate(ImageID(fimg) ,ImageWidth(fimg),ImageHeight(fimg),GetGadgetState(7))
                  Else
                    Rotate(ImageID(0) ,ImageWidth(0),ImageHeight(0),GetGadgetState(7))
                  EndIf              
                EndIf
                SetGadgetState(3,ImageID(fimg))
              EndIf
          EndSelect               
       
        Case 10
          If IsThread(Thread)      
            KillThread(Thread)
          EndIf
          Thread = CreateThread(@PopulateLI(),32)

      EndSelect
  EndSelect
Until Quit = 1
End

Edit : Modified
Edit2 : Bug fixed

[RASHAD]

Previous post updated

[Kwai chang caine]

Waoooouuuuhh !!!! Splendid !!!
Works great here
Thanks a lot for sharing this useful code

Decidedly a better ListIcon miss in PB
However, the grid is one of the more important gadget we need for make utilities program

They are so much code in the forum, but the more hard, is to mix all the functions af all this code, for have a little bit an EXCEL like.
In fact, perhaps i'm wrong, but each time i have use a new super code, that a kind member give to us, they are always one thing it not can do

Your code is faster like a virtual listicon, for numerous lines ? (I love the VL thanks to you )