
The images can also be saved as a bitmap.
Code: Select all
;GDI image finder
;================
; This source is released under zlib-licence
OpenWindow(1,0,0,800,600,"GDI image finder")
StopButton = ButtonGadget(#PB_Any,0,0,100,20,"Stop")
InputGadget = StringGadget(#PB_Any,200,0,100,20,"")
SaveButton = ButtonGadget(#PB_Any,300,0,100,20,"Save")
TABPOS = 1
PanelGadget(0, 0, 20, 800, 580)
AddGadgetItem (0, -1, "Img"+Str(TABPOS))
InnerWidth = GetGadgetAttribute(0, #PB_Panel_ItemWidth)
InnerHeight = GetGadgetAttribute(0, #PB_Panel_ItemHeight)
ImgWidth = InnerWidth
ImgHeight = 1
ScrollAreaGadget(TABPOS, 0, 0, InnerWidth, InnerHeight, ImgWidth, 800, 10)
Repeat
If hBmp < $7FFFFFFF
hBmp + 1
If GetObjectType_(hBmp) = #OBJ_BITMAP
Found + 1
bmp.BITMAP
GetObject_(hBmp,SizeOf(BITMAP), bmp)
ImageGadget(#PB_Any, 0, ImgHeight, bmp\bmWidth, bmp\bmHeight, hBmp)
TextGadget(#PB_Any , bmp\bmWidth + 16, ImgHeight, 200, 16, Str(hBmp))
If bmp\bmWidth + 16 + 200 > ImgWidth
ImgWidth = bmp\bmWidth + 16 + 200
SetGadgetAttribute(TABPOS, #PB_ScrollArea_InnerWidth, ImgWidth)
EndIf
ImgHeight + bmp\bmHeight + 16
SetGadgetAttribute(TABPOS, #PB_ScrollArea_InnerHeight, ImgHeight)
EndIf
If ImgHeight => 32000
TABPOS + 1
ImgHeight = 1
AddGadgetItem (0, -1, "Img"+Str(TABPOS))
ScrollAreaGadget(TABPOS, 0, 0, InnerWidth, InnerHeight, ImgWidth, 800, 10)
EndIf
Count + 1
Else
Count = 0
EndIf
If Count % 10000 = 0 Or hBmp >= $7FFFFFFF
Repeat
If hBmp < $7FFFFFFF
SetWindowTitle(1, "GDI image finder " + Str(hBmp) + "/" +Str($7FFFFFFF) + " Found:" + Str(Found))
EndIf
Event = WindowEvent()
If Event = #PB_Event_CloseWindow :Quit = #True:EndIf
If Event = #PB_Event_Gadget
If EventGadget() = StopButton:hBmp = $7FFFFFFF:EndIf
If EventGadget() = SaveButton
Bitmap = Val(GetGadgetText(InputGadget))
If GetObjectType_(Bitmap) = #OBJ_BITMAP
bmp.BITMAP
GetObject_(Bitmap,SizeOf(BITMAP), bmp)
CreateImage(1,bmp\bmWidth,bmp\bmHeight, 32)
StartDrawing(ImageOutput(1))
DrawImage(Bitmap,0,0)
StopDrawing()
File$ = SaveFileRequester("Save as Bitmap","noname.bmp", "Bitmap(*.bmp)|*.bmp", 0)
If SaveImage(1, File$) =0
MessageRequester("ERROR","Can't save image!")
EndIf
Else
MessageRequester("ERROR","No valid BitmapID!")
EndIf
EndIf
EndIf
Until Event = 0
EndIf
Until Quit
Full-Package