- Next is one of my projects did not finish it, now it is yours
- Supported formats :
"bmp","tif","tiff","png","jpg","jpeg","jp2","ico","rle","emf","wmf","tga","ppm" And "pgm"
- Many tips are included like Recycle pick what you like
- You are free to add ,delete,modify
Have fun
Part #1:
Code: Select all
UseTGAImageDecoder()
UsePNGImageDecoder()
UseJPEG2000ImageDecoder()
UseJPEG2000ImageEncoder()
UseGIFImageDecoder()
#SmoothingModeInvalid = -1
#SmoothingModeDefault = 0
#SmoothingModeHighSpeed = 1
#SmoothingModeHighQuality = 2
#SmoothingModeNone = 3
#SmoothingModeAntiAlias = 4
; CodecInfo\MimeType
#Jpeg_Encoder = "image/jpeg"
#Gif_Encoder = "image/gif"
#Bmp_Encoder = "image/bmp"
#Png_Encoder = "image/png"
#Tif_Encoder = "image/tiff"
#EncoderParameterValueTypeLong = 4
#TBS_TOOLTIPS = $0100
#FOF_NORECURSION = $1000
#BFFM_SETSELECTIONA = #WM_USER + 102;
#BFFM_SETSELECTIONW = #WM_USER + 103;
Global *token, *Image,*Localgfx, *dimensionID.GUID, dimensionsCount = 0,encoderCLSID.GUID
Global Num,Quit,Count,Result,Width.i,Height.i,FileName$,sFile$,nFileName$,load,NEW_Image,tgaflag, mWheel.f,imgh,Folder.S
Global NewList img$()
;m = AllocateMemory(#MAX_PATH)
NEW_Image = 1
mWheel.f = 1
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
Structure EncoderParameter
Guid.GUID
NumberOfValues.l
Type.l
Value.l
EndStructure
Structure EncoderParameters
Count.l
Parameter.EncoderParameter[1]
EndStructure
Global STYLE
CompilerIf #PB_Compiler_Unicode
STYLE = #BFFM_SETSELECTIONW
CompilerElse
STYLE = #BFFM_SETSELECTIONA
CompilerEndIf
Procedure PathCB(hWnd, uMsg, lParam, lData)
Select uMsg
Case #BFFM_INITIALIZED
;SetWindowLongPtr_(hWnd,#GWL_STYLE,GetWindowLongPtr_(hWnd,#GWL_STYLE) &~ #WS_CAPTION)
SetWindowPos_(hWnd, #HWND_TOPMOST , WindowX(0),WindowY(0)+65,-1,-1 ,#SWP_NOSIZE )
If lData
SendMessage_ (hwnd, STYLE, 1, lData)
Delay(100)
PostMessage_ (hwnd, STYLE, 1, lData)
EndIf
;Case #BFFM_SELCHANGED
;SendMessage_(hwnd, #BFFM_SETSTATUSTEXT, 0,PeekS(lparam))
EndSelect
EndProcedure
Procedure.S PathRequesterAPI( StatusText.S, Path.S)
Folder.S = Space(#MAX_PATH)
bi.BROWSEINFO
bi\ulFlags = #BIF_NONEWFOLDERBUTTON|#BIF_NEWDIALOGSTYLE |#BIF_RETURNONLYFSDIRS
bi\lpfn = @PathCB()
bi\lParam = @Path
bi\lpszTitle = @StatusText
Result = SHBrowseForFolder_(@bi)
SHGetPathFromIDList_(Result, @Folder)
CoTaskMemFree_(Result)
ProcedureReturn Folder
EndProcedure
Procedure.f Max(n.f,m.f)
If n >= m
Max.f = n
Else
Max.f = m
EndIf
ProcedureReturn Max
EndProcedure
; Procedure.l Max(n1.l,n2.l)
; !MOV Eax,dword[p.v_n1]
; !MOV Ecx,dword[p.v_n2]
; !CMP Ecx,Eax
; !cmovg Eax,Ecx
; ProcedureReturn
; EndProcedure
Procedure.l ARGB(rgb.l, a.b = 255)
!MOV eax, [p.v_rgb]
!BSWAP eax
!SHR eax, 8
!MOV [p.v_rgb], eax
!MOV eax, [p.v_a]
!MOV dword [p.v_rgb+3], eax
ProcedureReturn rgb
EndProcedure
Procedure StringToBStr (string$) ; By Zapman Inspired by Fr34k
Protected Unicode$ = Space(Len(String$)* 2 + 2)
Protected bstr_string.l
PokeS(@Unicode$, String$, -1, #PB_Unicode)
bstr_string = SysAllocString_(@Unicode$)
ProcedureReturn bstr_string
EndProcedure
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 Draw_Image()
CallFunction(0,"GdipImageSelectActiveFrame",*image, ?FrameDimensionPage, Num)
CallFunction(0,"GdipGetImageWidth",*image, @Width.i)
CallFunction(0,"GdipGetImageHeight",*image, @Height.i)
If IsImage(0)
FreeImage(0)
EndIf
CreateImage(0,Width,Height)
dc = StartDrawing(ImageOutput(0)) ; Your line
If CallFunction(0,"GdipCreateFromHDC",dc, @*Localgfx) = 0
CallFunction(0,"GdipGraphicsClear",*Localgfx,$FFFFFFFF)
CallFunction(0,"GdipDrawImageRectI",*Localgfx, *image, 0,0, width, height)
EndIf
StopDrawing()
StatusBarText(0, 1, "Width = " + Str(ImageWidth(0)),#PB_StatusBar_Center)
StatusBarText(0, 2, "Height = " + Str(ImageHeight(0)),#PB_StatusBar_Center)
StartDrawing(CanvasOutput(0))
Box(0,0,GadgetWidth(0),GadgetHeight(0),$FFFFFF)
DrawAlphaImage(ImageID(0),GadgetWidth(0)/2-width/2,GadgetHeight(0)/2-height/2)
StopDrawing()
EndProcedure
Procedure GetEncoderClsid(format$, *Clsid.CLSID)
Protected number
Protected Size
Protected *pImageCodecInfo.ImageCodecInfo
Protected 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 sTGAformat()
If tgaflag = 0
img = 0
Else
img = 2
EndIf
StartDrawing(ImageOutput(img))
If CreateFile(0,sFile$)
Restore Header
For tmp=1 To 12
Read Header
WriteByte(0,Header)
Next
WriteWord(0,ImageWidth(img))
WriteWord(0,ImageHeight(img))
WriteByte(0,24)
WriteByte(0,32)
For y=0 To ImageHeight(img)-1
For x=0 To ImageWidth(img)-1
color=Point(x,y)
WriteByte(0,Blue(color))
WriteByte(0,Green(color))
WriteByte(0,Red(color))
Next
Next
CloseFile(0)
EndIf
StopDrawing()
EndProcedure
Procedure sEMFformat()
emf_hDC = CreateEnhMetaFile_(0, @sFile$, 0, 0)
If emf_hDC
img_hDC = CreateCompatibleDC_(emf_hDC)
oldImage = SelectObject_(img_hDC, ImageID(0))
BitBlt_(emf_hDC, 0, 0, Width,Height, img_hDC, 0, 0, #SRCCOPY)
SelectObject_(img_hDC, oldImage)
DeleteDC_(img_hDC)
hEMF = CloseEnhMetaFile_(emf_hDC)
DeleteEnhMetaFile_(hEMF)
EndIf
EndProcedure
Procedure sWMFformat()
tmpEMF$ = GetHomeDirectory()+"tmp_EMF.emf"
emf_hDC = CreateEnhMetaFile_(0, @tmpEMF$, 0, 0)
If emf_hDC
img_hDC = CreateCompatibleDC_(emf_hDC)
oldImage = SelectObject_(img_hDC, ImageID(0))
BitBlt_(emf_hDC, 0, 0, Width,Height, img_hDC, 0, 0, #SRCCOPY)
SelectObject_(img_hDC, oldImage)
DeleteDC_(img_hDC)
hEMF = CloseEnhMetaFile_(emf_hDC)
DeleteEnhMetaFile_(hEMF)
;**********************
hDc = GetDC_(GetDesktopWindow_());
hDcComp = CreateCompatibleDC_(hDc);
ReleaseDC_(GetDesktopWindow_(), hDc);
SetMapMode_(hDcComp,#MM_ANISOTROPIC);
hEmf = GetEnhMetaFile_(@tmpEMF$)
uSize = GetWinMetaFileBits_(hEmf, 0, #Null, #MM_ANISOTROPIC, hDcComp);
*pBuffer = GlobalAlloc_(#GPTR, uSize) ;
GetWinMetaFileBits_(hEmf, uSize, *pBuffer, #MM_ANISOTROPIC, hDcComp) ;
hWmf = SetMetaFileBitsEx_(uSize, *pBuffer)
PlayMetaFile_(hDcComp, hWmf);
hWmfNew = CopyMetaFile_(hWmf, sFile$)
DeleteMetaFile_(hWmfNew);
DeleteMetaFile_(hWmf) ;
DeleteEnhMetaFile_(hEmf);
GlobalFree_(*pBuffer) ;
DeleteDC_(hDcComp) ;
DeleteFile(tmpEMF$)
EndIf
EndProcedure
Procedure LoadImagePPM(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, " "))
If w = 0 Or h = 0
ProcedureReturn 1
EndIf
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 ImageGrayout(image)
Protected w, h, x, y, r, g, b, gray, color
w = ImageWidth(image)
h = ImageHeight(image)
StartDrawing(ImageOutput(image))
For x = 0 To w - 1
For y = 0 To h - 1
color = Point(x, y)
r = Red(color)
g = Green(color)
b = Blue(color)
gray = 0.2126*r + 0.7152*g + 0.0722*b
Plot(x, y, RGB(gray, gray, gray))
Next
Next
StopDrawing()
EndProcedure
Procedure ImageToColor(image)
Protected w, h, x, y, v, gray
w = ImageWidth(image)
h = ImageHeight(image)
StartDrawing(ImageOutput(image))
For x = 0 To w - 1
For y = 0 To h - 1
gray = Point(x, y)
v = Red(gray) ;for gray, each of the color's components is the same
;color = RGB(0.2126*v, 0.7152*v, 0.0722*v)
Plot(x, y, RGB(v, v, v))
Next
Next
StopDrawing()
EndProcedure
Procedure SaveImageAsPPM(Image, file$, Binary = 1)
; Author Roger Rösch (Nickname Macros)
IDFiIe = CreateFile(#PB_Any, file$)
If IDFiIe
If StartDrawing(ImageOutput(Image))
WriteStringN(IDFiIe, "P" + Str(3 + 3*Binary))
WriteStringN(IDFiIe, "#Created with PureBasic using a Function created from Macros for Rosettacode.org ")
width = ImageWidth(Image)
height = ImageHeight(Image)
WriteStringN(IDFiIe, Str(width) + " " + Str(height))
WriteStringN(IDFiIe, "255")
If Binary = 0
For y = 0 To height - 1
For x = 0 To width - 1
color = Point(x, y)
WriteString(IDFiIe, Str(Red(color)) + " " + Str(Green(color)) + " " + Str(Blue(color)) + " ")
Next
WriteStringN(IDFiIe, "")
Next
Else ; Save in Binary Format
For y = 0 To height - 1
For x = 0 To width - 1
color = Point(x, y)
WriteByte(IDFiIe, Red(color))
WriteByte(IDFiIe, Green(color))
WriteByte(IDFiIe, Blue(color))
Next
Next
EndIf
StopDrawing()
EndIf
CloseFile(IDFiIe)
EndIf
EndProcedure
Procedure _DrawImage(FileName$)
If IsImage(NEW_Image)
FreeImage(NEW_Image)
EndIf
StatusBarText(0, 0," "+GetFilePart(FileName$))
SetCursor_(LoadCursor_(0,#IDC_WAIT))
Select LCase(GetExtensionPart(FileName$))
Case "tga"
LoadImage(0,FileName$)
If IsImage(0)
CopyImage(0,NEW_Image)
StatusBarText(0, 1, "Width = " + Str(ImageWidth(NEW_Image)),#PB_StatusBar_Center)
StatusBarText(0, 2, "Height = " + Str(ImageHeight(NEW_Image)),#PB_StatusBar_Center)
StartDrawing(CanvasOutput(0))
Box(0,0,GadgetWidth(0),GadgetHeight(0),$FFFFFF)
DrawAlphaImage(ImageID(NEW_Image),GadgetWidth(0)/2-ImageWidth(NEW_Image)/2,GadgetHeight(0)/2-ImageHeight(NEW_Image)/2)
StopDrawing()
Else
MessageRequester("Error", "Format Not supported", #MB_OK |#MB_ICONERROR)
EndIf
Case "cur"
hCursor = LoadCursorFromFile_(FileName$)
If hCursor
SetGadgetAttribute(1,#PB_Button_Image,hCursor)
Else
MessageRequester("Error", "Format Not supported", #MB_OK |#MB_ICONERROR)
EndIf
Case "ppm","pgm"
LoadImagePPM(0, FileName$)
If IsImage(0)
CopyImage(0,NEW_Image)
StatusBarText(0, 1, "Width = " + Str(ImageWidth(NEW_Image)),#PB_StatusBar_Center)
StatusBarText(0, 2, "Height = " + Str(ImageHeight(NEW_Image)),#PB_StatusBar_Center)
StartDrawing(CanvasOutput(0))
Box(0,0,GadgetWidth(0),GadgetHeight(0),$FFFFFF)
DrawAlphaImage(ImageID(NEW_Image),GadgetWidth(0)/2-ImageWidth(NEW_Image)/2,GadgetHeight(0)/2-ImageHeight(NEW_Image)/2)
StopDrawing()
Else
MessageRequester("Error", "Format Not supported", #MB_OK |#MB_ICONERROR)
EndIf
Case "jp2"
LoadImage(0,FileName$)
If IsImage(0)
CopyImage(0,NEW_Image)
StatusBarText(0, 1, "Width = " + Str(ImageWidth(NEW_Image)),#PB_StatusBar_Center)
StatusBarText(0, 2, "Height = " + Str(ImageHeight(NEW_Image)),#PB_StatusBar_Center)
StartDrawing(CanvasOutput(0))
Box(0,0,GadgetWidth(0),GadgetHeight(0),$FFFFFF)
DrawAlphaImage(ImageID(NEW_Image),GadgetWidth(0)/2-ImageWidth(NEW_Image)/2,GadgetHeight(0)/2-ImageHeight(NEW_Image)/2)
StopDrawing()
Else
MessageRequester("Error", "Format Not supported", #MB_OK |#MB_ICONERROR)
EndIf
Case "gif"
LoadImage(0,FileName$)
StatusBarText(0, 1, "Width = " + Str(ImageWidth(0)),#PB_StatusBar_Center)
StatusBarText(0, 2, "Height = " + Str(ImageHeight(0)),#PB_StatusBar_Center)
If ImageFrameCount(0) > 1
AddWindowTimer(0, 0, 1)
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
Quit6 = 1 : Quit = 1
Case #PB_Event_Timer
SetImageFrame(0, Frame)
;
RemoveWindowTimer(0, 0)
If GetImageFrameDelay(0) > 0
AddWindowTimer(0, 0, GetImageFrameDelay(0))
Else
RemoveWindowTimer(0, 0)
Quit6 = 1
EndIf
CopyImage(0,NEW_Image)
StartDrawing(CanvasOutput(0))
Box(0,0,GadgetWidth(0),GadgetHeight(0),$FFFFFF)
DrawAlphaImage(ImageID(NEW_Image),GadgetWidth(0)/2-ImageWidth(NEW_Image)/2,GadgetHeight(0)/2-ImageHeight(NEW_Image)/2)
StopDrawing()
; Go to next frame
Frame+1
If Frame >= ImageFrameCount(0) ; Cycle back to first frame, to play in loop
Frame = 0
EndIf
Case #PB_Event_Gadget
Select EventGadget()
Case 1
RemoveWindowTimer(0, 0)
Quit6 = 1
Case 3
RemoveWindowTimer(0, 0)
Quit6 = 1
Beep_(800,100)
mWheel = 1
If Num > 0
Num - 1
_DrawImage(img$())
Else
Num = Count - 1
PreviousElement(img$())
_DrawImage(img$())
EndIf
Case 5
RemoveWindowTimer(0, 0)
Quit6 = 1
Beep_(800,100)
mWheel = 1
If Num < Count - 1
Num + 1
_DrawImage(img$())
Else
Num = 0
NextElement(img$())
_DrawImage(img$())
EndIf
EndSelect
EndSelect
Until Quit6 = 1
SetActiveWindow(0)
EndIf
Case "bmp","tif","tiff","png","jpg","jpeg","ico","rle"
*token = Gdiplus_New()
If *token
If CallFunction(0,"GdipLoadImageFromFile",StringToBStr(FileName$), @*Image) = 0 ;"e:\MPage_4.tif"
If CallFunction(0,"GdipImageGetFrameDimensionsCount",*image, @dimensionsCount) = 0
If dimensionsCount
*dimensionID = AllocateMemory(SizeOf(GUID)*dimensionsCount)
If *dimensionID
CallFunction(0,"GdipImageGetFrameCount",*image, ?FrameDimensionPage, @count)
FreeMemory(*dimensionID)
EndIf
EndIf
EndIf
Draw_Image()
Else
MessageRequester("Error", "Format Not supported", #MB_OK |#MB_ICONERROR)
EndIf
EndIf
EndSelect
EndProcedure
Procedure Clean()
nFileName$ = GetTemporaryDirectory()+"nSave.bmp"
If FileSize(nFileName$) > 0
CallFunction(0,"GdipDisposeImage",*image) ;Very Important
CallFunction(0,"GdipDeleteGraphics",*Localgfx)
CallFunction(0,"GdiplusShutdown",*token)
SHFileOp.SHFILEOPSTRUCT
m = AllocateMemory( ( Len(nFileName$)+2 ) * SizeOf(Character) )
If m
PokeS(m,nFileName$)
SHFileOp\pFrom = m
SHFileOp\wFunc = #FO_DELETE
SHFileOp\fFlags = #FOF_SILENT|#FOF_NOERRORUI |#FOF_NOCONFIRMATION
result = SHFileOperation_(SHFileOp)
FreeMemory(m)
nFileName$=""
EndIf
EndIf
EndProcedure
Procedure WindowProc(hWnd,uMsg,wParam,lParam)
Result = #PB_ProcessPureBasicEvents
Select uMsg
Case #WM_NCPAINT
SendMessage_(hWnd, #WM_NCACTIVATE, 1, 0)
Case #WM_NCACTIVATE
If wParam = 0
ProcedureReturn 1
EndIf
Case #WM_SIZE
ResizeGadget(0,1,30,WindowWidth(0)-2,WindowHeight(0)- 60)
StartDrawing(CanvasOutput(0))
Box(0,0,GadgetWidth(0),GadgetHeight(0),$FFFFFF)
If IsImage(NEW_Image)
DrawAlphaImage(ImageID(NEW_Image),GadgetWidth(0)/2-ImageWidth(NEW_Image)/2,GadgetHeight(0)/2-ImageHeight(NEW_Image)/2)
ElseIf IsImage(0)
DrawAlphaImage(ImageID(0),GadgetWidth(0)/2-ImageWidth(0)/2,GadgetHeight(0)/2-ImageHeight(0)/2)
EndIf
StopDrawing()
EndSelect
ProcedureReturn Result
EndProcedure
Procedure aboutCB()
;SetWindowCallback(0)
DisableWindow(0,1)
about = OpenWindow(#PB_Any,0,0,400,200,"",#PB_Window_WindowCentered|#PB_Window_BorderLess|#WS_BORDER |#WS_VISIBLE,WindowID(0))
UseGadgetList(WindowID(about))
font1 = LoadFont(#PB_Any,"Tahoma",10)
font2 = LoadFont(#PB_Any,"Georgia",24)
aimg = ImageGadget(#PB_Any,0,0,400,200,0,#PB_Image_Border)
iimg = CreateImage(#PB_Any,400,200,24)
StartDrawing(ImageOutput(iimg))
Box(0,0,400,300,$C8EFF3)
DrawingMode(#PB_2DDrawing_Transparent)
DrawingFont(FontID(font1))
DrawText(20,37,"Main Coder :",0)
DrawingFont(FontID(font2))
DrawText(121,19,"M.M.RASHAD",$0)
DrawText(120,20,"M.M.RASHAD",$0000FF)
DrawingFont(FontID(font1))
DrawText(120,80,"email : mmrashad2100@hotmail.com",$0)
DrawText(120,100,"Mobile : 0505279242",$0)
DrawText(120,120,"RASHAD Software "+Chr(169)+ " 2017" ,$0)
StopDrawing()
SetGadgetState(aimg,ImageID(iimg))
AnimateWindow_(WindowID(about),5000,#AW_BLEND |#AW_ACTIVATE)
While WindowEvent() : Wend
Delay(3000)
While WindowEvent() : Wend
AnimateWindow_(WindowID(about),5000,#AW_CENTER| #AW_HIDE)
CloseWindow(about)
DisableWindow(0,0)
;SetWindowCallback(@WindowProc())
EndProcedure
CatchImage(10, ?LoadImage)
ResizeImage(10,30,30)
CatchImage(11, ?arrow_left)
ResizeImage(11,24,24)
CatchImage(12, ?arrow_right)
ResizeImage(12,24,24)
CatchImage(13, ?Save)
ResizeImage(13,22,22)
CatchImage(14, ?help_4)
ResizeImage(14,28,28)
CatchImage(15, ?Copy)
ResizeImage(15,22,22)
CatchImage(16, ?Delete)
ResizeImage(16,22,22)
CatchImage(17, ?Find)
ResizeImage(17,24,24)
CatchImage(18, ?Print)
ResizeImage(18,32,32)
CatchImage(19, ?deletefile)
ResizeImage(19,24,24)
CatchImage(20, ?recycling2)
ResizeImage(20,24,24)
CatchImage(22, ?settings2)
;ResizeImage(20,24,24)
LoadFont(0,"Tahoma",14)
HandCur = LoadCursor_(0, #IDC_HAND)
OpenWindow(0, 0, 0, 800, 600, "Image Manager",#PB_Window_MinimizeGadget| #PB_Window_MaximizeGadget| #PB_Window_SizeGadget| #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
SetWindowColor(0,$DEDEDE)
WindowBounds(0,600,450,#PB_Default,#PB_Default)
CanvasGadget(0, 1, 30, 798,540,#PB_Canvas_Border)
Dim gtext$(16)
ImageGadget(1,5,-1,30,30,ImageID(10))
gtext$(1) = "Select Folder"
ImageGadget(3,45,2,30,30,ImageID(11))
gtext$(3) = "Previous Image"
ImageGadget(5,75,2,30,30,ImageID(12))
gtext$(5) = "Next Image"
ImageGadget(7,130,4,30,30,ImageID(15))
gtext$(7) = "Copy"
ImageGadget(8,160,4,30,30,ImageID(20))
gtext$(8) = "Recycle"
ImageGadget(9,190,4,30,30,ImageID(19))
gtext$(9) = "Delete"
ImageGadget(10,240,2,30,30,ImageID(17))
gtext$(10) = "Find"
ImageGadget(12,270,4,30,30,ImageID(13))
gtext$(12) = "Save As.."
ImageGadget(13,295,0,30,30,ImageID(18))
gtext$(13) = "Print"
TrackBarGadget(14,340,4 ,150,22,1,100,#TBS_TOOLTIPS)
gtext$(14) = "JPG Compression Ratio"
SetGadgetState(14,70)
ImageGadget(15,510,3,30,30,ImageID(22))
gtext$(15) = "Settings & Tools"
ImageGadget(16,540,1,30,30,ImageID(14))
gtext$(16) = "Help"
ttip = CreateWindowEx_(0, "Tooltips_Class32", "", #TTS_ALWAYSTIP|#TTS_BALLOON, 0, 0, 0, 0, 0, 0, 0, 0)
SetWindowTheme_(ttip, @null.w, @null.w)
SendMessage_(ttip,#TTM_SETTIPTEXTCOLOR,#Red,0)
SendMessage_(ttip,#TTM_SETTIPBKCOLOR,$CBFEFD,0)
SendMessage_(ttip,#TTM_SETMAXTIPWIDTH,0,180)
SendMessage_(ttip, #TTM_SETDELAYTIME, #TTDT_AUTOPOP,5000)
ti.TOOLINFO
ti\cbSize = SizeOf(ti)
ti\uFlags = #TTF_IDISHWND | #TTF_SUBCLASS
CreatePopupImageMenu(0,#PB_Menu_ModernLook)
MenuItem(0, "Original Image")
MenuItem(1, "New Image")
If CreateStatusBar(0, WindowID(0))
SendMessage_(StatusBarID(0), #SB_SETMINHEIGHT, 28, 0)
SendMessage_(StatusBarID(0), #WM_SIZE, 0,0)
SendMessage_(StatusBarID(0), #WM_SETFONT, FontID(0),0)
AddStatusBarField(460)
AddStatusBarField(160)
AddStatusBarField(160)
EndIf
; SBH = StatusBarHeight(0)
StatusBarText(0, 0, "Ready",#PB_StatusBar_Center)
StatusBarText(0, 1, "Width = 0",#PB_StatusBar_Center)
StatusBarText(0, 2, "Height = 0",#PB_StatusBar_Center)
SetActiveWindow(0)
SetWindowCallback(@WindowProc())
hdc = GetDC_(0)
For gad = 3 To 15
If IsGadget(gad) <> 0
DisableGadget(gad,1)
EndIf
Next
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
CallFunction(0,"GdipDisposeImage",*image) ;Very Important
CallFunction(0,"GdipDeleteGraphics",*Localgfx)
CallFunction(0,"GdiplusShutdown",*token)
CloseLibrary(0)
Quit = 1
Case #WM_MOUSEMOVE
GetCursorPos_ (@pi.POINT)
wGad = WindowFromPoint_(pi\y << 32 + pi\x)
gad = GetDlgCtrlID_(wGad)
Select gad
Case 1 To 16
SetCursor_(HandCur)
ti\uId= GadgetID(gad)
SendMessage_(ttip, #TTM_SETDELAYTIME, #TTDT_INITIAL,10)
Text$ = gtext$(gad)
ti\lpszText = @Text$
SendMessage_(ttip, #TTM_ADDTOOL, 0, ti)
EndSelect
Case #WM_KEYDOWN
If IsImage(0)
If EventwParam() = 40
mWheel - 0.1
ElseIf EventwParam() = 38
mWheel + 0.1
EndIf
If mWheel > 5
mWheel= 5
EndIf
If mWheel < 0.1
mWheel = 0.1
EndIf
SetCursor_(LoadCursor_(0,#IDC_WAIT))
CopyImage(0,NEW_Image)
ResizeImage(NEW_Image,ImageWidth(0)*mWheel ,ImageHeight(0)*mWheel)
StatusBarText(0, 1, "Width = " + Str(ImageWidth(NEW_Image)),#PB_StatusBar_Center)
StatusBarText(0, 2, "Height = " + Str(ImageHeight(NEW_Image)),#PB_StatusBar_Center)
StartDrawing(CanvasOutput(0))
Box(0,0,GadgetWidth(0),GadgetHeight(0),$FFFFFF)
DrawAlphaImage(ImageID(NEW_Image),GadgetWidth(0)/2-ImageWidth(NEW_Image)/2,GadgetHeight(0)/2-ImageHeight(NEW_Image)/2)
StopDrawing()
SetCursor_(LoadCursor_(0,#IDC_ARROW))
Else
MessageRequester("Error", "No image loaded", #MB_OK |#MB_ICONERROR)
EndIf
Case #PB_Event_Menu
Select EventMenu()
Case 0,1
If IsImage(0)
sFile$ = SaveFileRequester("Please choose file to save",""," All supported formats|*.bmp;*.gif; *.jpg; *.jpeg; *.wmf; *.emf; *.png; *.tif;*.tiff;*.tga| TGA image (*.tga)| *.tga| TIF image (*.tif)| *.tif| TIFF image (*.tiff)| *.tiff| PNG image (*.png)| *.png| BMP image (*.bmp)| *.bmp| JPEG image (*.jpg;*.jpeg)|*.jpg;*.jpeg| GIF image (*.gif)|*.gif| Windows Metafile (*.wmf)|*.wmf| Enhanced Metafile (*.emf)|*.emf",0)
If GetExtensionPart(sFile$) = ""
If SelectedFilePattern() = 0 Or SelectedFilePattern() = 6
sFile$ + ".jpg"
ElseIf SelectedFilePattern() = 1
sFile$ + ".tga"
ElseIf SelectedFilePattern() = 2 Or SelectedFilePattern() = 3
sFile$ + ".tif"
ElseIf SelectedFilePattern() = 4
sFile$ + ".png"
ElseIf SelectedFilePattern() = 5
sFile$ + ".bmp"
ElseIf SelectedFilePattern() = 7
sFile$ + ".gif"
ElseIf SelectedFilePattern() = 8
sFile$ + ".wmf"
ElseIf SelectedFilePattern() = 9
sFile$ + ".emf"
EndIf
EndIf
Select LCase(GetExtensionPart(sFile$))
Case "bmp"
CallFunction(0, "GdipCreateBitmapFromHBITMAP", ImageID(0), 0, @*image)
nFileName$ = GetTemporaryDirectory()+"nSave.bmp"
If EventMenu() = 0
SaveImage(0,nFileName$,#PB_ImagePlugin_BMP)
Else
CopyImage(0,New_Image)
ResizeImage(New_Image,ImageWidth(0)*mWheel,ImageHeight(0)*mWheel)
SaveImage(New_Image,nFileName$,#PB_ImagePlugin_BMP)
EndIf
_DrawImage(nFileName$)
GetEncoderClsid(#Bmp_Encoder, @encoderCLSID)
CallFunction(0,"GdipSaveImageToFile",*Image, StringToBStr(sFile$), @encoderCLSID, 0)
Clean()
Case "jpg"
CallFunction(0, "GdipCreateBitmapFromHBITMAP", ImageID(0), 0, @*image)
nFileName$ = GetTemporaryDirectory()+"nSave.bmp"
Debug mWheel
If EventMenu() = 0
SaveImage(0,nFileName$,#PB_ImagePlugin_BMP)
Else
CopyImage(0,New_Image)
ResizeImage(New_Image,ImageWidth(0)*mWheel,ImageHeight(0)*mWheel)
SaveImage(New_Image,nFileName$,#PB_ImagePlugin_BMP)
EndIf
_DrawImage(nFileName$)
quality.l = 70 ; qualities can range from 0 - 100, with 100 being best
With encoderparams.EncoderParameters
\Count = 1
\Parameter[0]\Type = #EncoderParameterValueTypeLong
\Parameter[0]\NumberOfValues = 1
\parameter[0]\Value = @quality
EndWith
GetEncoderClsid(#Jpeg_Encoder, @encoderCLSID)
CopyMemory(?clsid_EncoderQuality, encoderparams\parameter[0]\Guid, SizeOf(GUID))
CallFunction(0, "GdipSaveImageToFile", *Image, StringToBStr(sFile$), @encoderCLSID, @encoderparams)
Clean()
Case "png"
CallFunction(0, "GdipCreateBitmapFromHBITMAP", ImageID(0), 0, @*image)
nFileName$ = GetTemporaryDirectory()+"nSave.bmp"
If EventMenu() = 0
SaveImage(0,nFileName$,#PB_ImagePlugin_BMP)
Else
CopyImage(0,New_Image)
ResizeImage(New_Image,ImageWidth(0)*mWheel,ImageHeight(0)*mWheel)
SaveImage(New_Image,nFileName$,#PB_ImagePlugin_BMP)
EndIf
_DrawImage(nFileName$)
GetEncoderClsid(#Png_Encoder, @encoderCLSID)
CallFunction(0,"GdipSaveImageToFile",*Image, StringToBStr(sFile$), @encoderCLSID, 0)
Clean()
Case "tif"
CallFunction(0, "GdipCreateBitmapFromHBITMAP", ImageID(0), 0, @*image)
nFileName$ = GetTemporaryDirectory()+"nSave.bmp"
If EventMenu() = 0
SaveImage(0,nFileName$,#PB_ImagePlugin_BMP)
Else
CopyImage(0,New_Image)
ResizeImage(New_Image,ImageWidth(0)*mWheel,ImageHeight(0)*mWheel)
SaveImage(New_Image,nFileName$,#PB_ImagePlugin_BMP)
EndIf
_DrawImage(nFileName$)
GetEncoderClsid(#Tif_Encoder, @encoderCLSID)
CallFunction(0,"GdipSaveImageToFile",*Image, StringToBStr(sFile$), @encoderCLSID, 0)
Clean()
Case "gif"
CallFunction(0, "GdipCreateBitmapFromHBITMAP", ImageID(0), 0, @*image)
nFileName$ = GetTemporaryDirectory()+"nSave.bmp"
If EventMenu() = 0
SaveImage(0,nFileName$,#PB_ImagePlugin_BMP)
Else
CopyImage(0,New_Image)
ResizeImage(New_Image,ImageWidth(0)*mWheel,ImageHeight(0)*mWheel)
SaveImage(New_Image,nFileName$,#PB_ImagePlugin_BMP)
EndIf
_DrawImage(nFileName$)
GetEncoderClsid(#Gif_Encoder, @encoderCLSID)
CallFunction(0,"GdipSaveImageToFile",*Image, StringToBStr(sFile$), @encoderCLSID, 0)
Clean()
Case "jp2"
If EventMenu() = 0
SaveImage(0,sFile$,#PB_ImagePlugin_JPEG2000,GetGadgetState(14)/10)
Else
SaveImage(New_Image,sFile$,#PB_ImagePlugin_JPEG2000,GetGadgetState(14)/10)
EndIf
Case "tga"
If EventMenu() = 0
tgaflag = 0
Else
tgaflag = 1
CopyImage(0,2)
ResizeImage(2,ImageWidth(0)*mWheel,ImageHeight(0)*mWheel)
EndIf
sTGAformat()
; Case "emf"
; sEMFformat()
;
; Case "wmf"
; sWMFformat()
;
; Case "ppm"
;
; Case "pgm"
EndSelect
Else
MessageRequester("Error","No Image to SAVE",#PB_MessageRequester_Ok|#MB_ICONERROR)
EndIf
EndSelect
Case #PB_Event_Gadget
Select EventGadget()
Case 0
Select EventType()
Case #PB_EventType_MouseWheel
If load = 1
If mwheel.f > 5
mwheel.f = 5
EndIf
If mwheel.f < 0.1
mwheel.f = 0.1
EndIf
value = GetGadgetAttribute(0,#PB_Canvas_WheelDelta )
mwheel.f = mwheel + value/10
SetCursor_(LoadCursor_(0,#IDC_WAIT))
CopyImage(0,NEW_Image)
ResizeImage(NEW_Image,ImageWidth(0)*mWheel ,ImageHeight(0)*mWheel)
StatusBarText(0, 1, "Width = " + Str(ImageWidth(NEW_Image)),#PB_StatusBar_Center)
StatusBarText(0, 2, "Height = " + Str(ImageHeight(NEW_Image)),#PB_StatusBar_Center)
StartDrawing(CanvasOutput(0))
Box(0,0,GadgetWidth(0),GadgetHeight(0),$FFFFFF)
DrawAlphaImage(ImageID(NEW_Image),GadgetWidth(0)/2-ImageWidth(NEW_Image)/2,GadgetHeight(0)/2-ImageHeight(NEW_Image)/2)
StopDrawing()
SetCursor_(LoadCursor_(0,#IDC_ARROW))
Else
MessageRequester("Error","No Loaded Image ...",#PB_MessageRequester_Ok|#MB_ICONERROR)
EndIf
EndSelect
Case 1 ;Load Image
Select EventType()
Case #PB_EventType_LeftClick
Beep_(800,100)
For gad = 3 To 15
If IsGadget(gad) <> 0
DisableGadget(gad,0)
EndIf
Next
Directory$ = PathRequesterAPI( "Select folder :", GetUserDirectory(#PB_Directory_Pictures))
Directory$+"\"
ExamineDirectory(0,Directory$, "*.*")
ClearList(img$())
While NextDirectoryEntry(0)
If DirectoryEntryType(0) = #PB_DirectoryEntry_File
FileName2$ = DirectoryEntryName(0)
ext2$ = LCase(GetExtensionPart(FileName2$))
If ext2$ = "bmp" Or ext2$ = "rle" Or ext2$ = "ico" Or ext2$ = "gif" Or ext2$ = "jpg" Or ext2$ = "jpeg" Or ext2$ = "jp2" Or ext2$ = "wmf" Or ext2$ = "emf" Or ext2$ = "png" Or ext2$ = "tif" Or ext2$ = "tiff" Or ext2$ = "tga" Or ext2$ = "ppm" Or ext2$ = "pgm"
AddElement(img$())
img$() = Directory$+FileName2$
EndIf
EndIf
Wend
FinishDirectory(0)
SelectElement(img$(), 0)
If IsImage(0)
FreeImage(0)
EndIf
If IsImage(1)
FreeImage(1)
EndIf
load = 1
ResizeGadget(0,0,30,WindowWidth(0),WindowHeight(0)- 60)
If ListSize(img$()) > 0
_DrawImage(img$())
Else
MessageRequester("Info","No items available ",#MB_OK |#MB_ICONINFORMATION)
EndIf
EndSelect
Case 3 ;Previous Image
Select EventType()
Case #PB_EventType_LeftClick
If ListSize(img$()) > 0
Beep_(800,100)
mWheel = 1
If Num > 0
Num - 1
_DrawImage(img$())
Else
Num = Count - 1
PreviousElement(img$())
_DrawImage(img$())
EndIf
Else
MessageRequester("Info","No items available ",#MB_OK |#MB_ICONINFORMATION)
EndIf
EndSelect
Case 5 ;Next Image
Select EventType()
Case #PB_EventType_LeftClick
If ListSize(img$()) > 0
Beep_(800,100)
mWheel = 1
If Num < Count - 1
Num + 1
_DrawImage(img$())
Else
Num = 0
NextElement(img$())
_DrawImage(img$())
EndIf
Else
MessageRequester("Info","No items available ",#MB_OK |#MB_ICONINFORMATION)
EndIf
EndSelect
Case 7 ;Copy Image
Select EventType()
Case #PB_EventType_LeftClick
Beep_(800,100)
ClearClipboard()
SetClipboardImage(0)
CopyImage(0,1)
ResizeImage(1,ImageWidth(0)*mWheel ,ImageHeight(0)*mWheel)
SetClipboardImage(1)
FreeImage(1)
EndSelect
Case 8 ;Recycle Image
Select EventType()
Case #PB_EventType_LeftClick
CallFunction(0,"GdipDisposeImage",*image) ;Very Important
CallFunction(0,"GdipDeleteGraphics",*Localgfx)
CallFunction(0,"GdiplusShutdown",*token)
Beep_(800,100)
Result = MessageRequester("Attention","Recycle Image ?",#PB_MessageRequester_YesNo|#MB_ICONQUESTION)
If Result = #PB_MessageRequester_Yes
dFile$ = img$()
; If LCase(GetExtensionPart(dFile$)) = "gif"
; RemoveWindowTimer(0, 0)
; NextElement(img$())
; EndIf
DeleteElement(img$(),1)
SHFileOp.SHFILEOPSTRUCT
m = AllocateMemory(( Len(dFile$)+2 ) * SizeOf(Character) )
If m
PokeS(m,dFile$)
SHFileOp\pFrom = m
SHFileOp\wFunc = #FO_DELETE
SHFileOp\fFlags = #FOF_ALLOWUNDO|#FOF_SILENT
result = SHFileOperation_(SHFileOp)
FreeMemory(m)
EndIf
_DrawImage(img$())
EndIf
EndSelect
Case 9 ;Delete Image
Select EventType()
Case #PB_EventType_LeftClick
CallFunction(0,"GdipDisposeImage",*image) ;Very Important
CallFunction(0,"GdipDeleteGraphics",*Localgfx)
CallFunction(0,"GdiplusShutdown",*token)
Beep_(800,100)
Result = MessageRequester("Attention","Delete Image permanent?",#PB_MessageRequester_YesNo|#MB_ICONQUESTION)
If Result = #PB_MessageRequester_Yes
dFile$ = img$()
DeleteElement(img$(),1)
;NextElement(img$())
SHFileOp.SHFILEOPSTRUCT
m = AllocateMemory(( Len(dFile$)+2 ) * SizeOf(Character) )
If m
PokeS(m,dFile$)
SHFileOp\pFrom = m
SHFileOp\wFunc = #FO_DELETE
SHFileOp\fFlags = #FOF_SILENT|#FOF_NOCONFIRMATION
result = SHFileOperation_(SHFileOp)
FreeMemory(m)
EndIf
_DrawImage(img$())
EndIf
EndSelect
Case 10 ;Find Image
Case 12 ;Save As
Select EventType()
Case #PB_EventType_LeftClick
Beep_(800,100)
DisplayPopupMenu(0, WindowID(0),GadgetX(12,#PB_Gadget_ScreenCoordinate),GadgetY(12,#PB_Gadget_ScreenCoordinate)+30)
EndSelect
Case 13 ;Print Image
Select EventType()
Case #PB_EventType_LeftClick
Beep_(800,100)
If IsImage(NEW_Image)
If PrintRequester()
If StartPrinting("PureBasic Test")
If StartDrawing(PrinterOutput())
DrawAlphaImage(ImageID(NEW_Image), 200, 600)
StopDrawing()
EndIf
StopPrinting()
EndIf
EndIf
Else
MessageRequester("Attention","No Image ?",#PB_MessageRequester_Ok| #MB_ICONQUESTION)
EndIf
EndSelect
Case 14 ;JPG compression ratio
SetFocus_(WindowID(0))
Case 15 ;Settings
Case 16 ;Help
Select EventType()
Case #PB_EventType_LeftClick
Beep_(800,100)
aboutCB()
EndSelect
EndSelect
EndSelect
Until Quit = 1
End
