purebasic.info

PureBasic forum
Текущее время: Вс окт 21, 2018 6:13 pm

Часовой пояс: UTC + 3 часа




Начать новую тему Ответить на тему  [ Сообщений: 8 ] 
Автор Сообщение
 Заголовок сообщения: Просмотрщик изображений API
СообщениеДобавлено: Пн дек 02, 2013 2:09 pm 
Не в сети
доцент

Зарегистрирован: Сб июл 13, 2013 3:39 pm
Сообщений: 46
Благодарил (а): 10 раз.
Поблагодарили: 3 раз.
Пункты репутации: 0
Пример простого просмотрщика изображений на GDI+.
Показывает уменьшенные копии изображения, загружает форматы bmp .gif .jpeg .jpg .png .tif .tiff
Поддерживает альфа-канал
Компилируется в приложения размером 27,5 КБ :wink:
Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
 
Enumeration #PB_Compiler_EnumerationValue
  #Window_0
  #Image
  #Menu
  #MenuItem_open
  #GDIPlus
  #GDI
EndEnumeration
;{ Structure
Structure GDIPSTARTUPINPUT
  Version.l
  *Callback
  NoThread.b
  NoCodecs.b
EndStructure
 
Structure ULONG_PTR
  Data.l
EndStructure
;}
;{ Prototype
;=============================================GDI
OpenLibrary(#GDI,"gdi32.dll")
Prototype CreateBitmap(iWidth, iHeight, iPlanes=1, iBitsPerPel=1, *pBits=0)
Global CreateBitmap.CreateBitmap = GetFunction(#GDI,"CreateBitmap")
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Prototype GetBkColor(hDC)
Global GetBkColor.GetBkColor = GetFunction(#GDI,"GetBkColor")
;============================================= GDIPlus
OpenLibrary(#GDIPlus,"GDIPlus.dll")
Prototype GdiplusStartup(*struct, *ulongptr,*ptr)
Global GdiplusStartup.GdiplusStartup = GetFunction(#GDIPlus,"GdiplusStartup")
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Prototype GdipCreateBitmapFromHBITMAP(hBmp, hPal=0,*ptr=0)
Global GdipCreateBitmapFromHBITMAP.GdipCreateBitmapFromHBITMAP = GetFunction(#GDIPlus,"GdipCreateBitmapFromHBITMAP")
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Prototype GdipGraphicsClear(hGraphics, iARGB = $FF000000)
Global GdipGraphicsClear.GdipGraphicsClear = GetFunction(#GDIPlus,"GdipGraphicsClear")
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Prototype GdipGetImageGraphicsContext(hImage, *ptr=0)
Global GdipGetImageGraphicsContext.GdipGetImageGraphicsContext = GetFunction(#GDIPlus,"GdipGetImageGraphicsContext")
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Prototype GdipLoadImageFromFile(sFileName.p-unicode, *ptr=0)
Global GdipLoadImageFromFile.GdipLoadImageFromFile = GetFunction(#GDIPlus,"GdipLoadImageFromFile")
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Prototype GdipGetImageWidth(hImage, *uint=-1)
Global GdipGetImageWidth.GdipGetImageWidth = GetFunction(#GDIPlus,"GdipGetImageWidth")
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Prototype GdipGetImageHeight(hImage, *uint=0)
Global GdipGetImageHeight.GdipGetImageHeight = GetFunction(#GDIPlus,"GdipGetImageHeight")
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Prototype GdipDrawImageRectI(hGraphics, hImage, iX, iY, iW, iH)
Global GdipDrawImageRectI.GdipDrawImageRectI = GetFunction(#GDIPlus,"GdipDrawImageRectI")
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Prototype GdipDisposeImage(hImage)
Global GdipDisposeImage.GdipDisposeImage = GetFunction(#GDIPlus,"GdipDisposeImage")
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Prototype GdipDeleteGraphics(hGraphics)
Global GdipDeleteGraphics.GdipDeleteGraphics = GetFunction(#GDIPlus,"GdipDeleteGraphics")
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Prototype GdipCreateHBITMAPFromBitmap(hBitmap, *ptr=0, iARGB = $FF000000)
Global GdipCreateHBITMAPFromBitmap.GdipCreateHBITMAPFromBitmap = GetFunction(#GDIPlus,"GdipCreateHBITMAPFromBitmap")
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Prototype GdiplusShutdown(*giGDIPToken)
Global GdiplusShutdown.GdiplusShutdown = GetFunction(#GDIPlus,"GdiplusShutdown")
;}=============================================
Procedure _GetScale(iW, iH, iWH, *rect.Rect)
    If iW <= iWH And iH <= iWH
       *rect\bottom = iW
       *rect\left = iH
       *rect\top = (iWH -*rect\bottom) / 2
       *rect\right = (iWH -*rect\left) / 2
    ElseIf iW > iH
       *rect\bottom = iWH
       *rect\left = iH / (iW / iWH)
       *rect\top = 0
       *rect\right = (iWH -*rect\left) / 2
    ElseIf iW < iH
       *rect\bottom = iW / (iH / iWH)
       *rect\left = iWH
       *rect\top = (iWH -*rect\bottom) / 2
       *rect\right = 0
    ElseIf iW = iH
       *rect\bottom = iWH
       *rect\left = iWH
       *rect\top = 0
       *rect\right = 0
    EndIf
    ProcedureReturn *rect
  EndProcedure
 
  Procedure _GetImage(sFile.s, iWH, iBkClr = $FFFFFF)
    GDIPSTARTUPINPUT.GDIPSTARTUPINPUT
    ULONG_PTR.ULONG_PTR
    GDIPSTARTUPINPUT\Version = 1
    rect.Rect
    GdiplusStartup(@ULONG_PTR, @GDIPSTARTUPINPUT, 0) ;Инициализация GDI+
    hBmp1=CreateBitmap(iWH, iWH, 1, 32); Создает bitmap
    GdipCreateBitmapFromHBITMAP(hBmp1, 0, @hBitmap);Создает объект Bitmap используя дескриптор Bitmap
    GdipGetImageGraphicsContext(hBitmap, @hGraphic);Возвращает графический контекст изображения
    DeleteObject_(hBmp1);Удаляет объект
    GdipGraphicsClear(hGraphic, ($FF000000 | iBkClr));Очищает графический объект указанным цветом
    GdipLoadImageFromFile(sFile, @hImage);Создаёт объект изображения на основе файла
    GdipGetImageWidth(hImage, @iW);Возвращает ширину изображения
    GdipGetImageHeight(hImage, @iH);Возвращает высоту изображения
    _GetScale(iW, iH, iWH, @rect.Rect)
    GdipDrawImageRectI(hGraphic, hImage, rect\top, rect\right, rect\bottom, rect\left);Рисует изображение в указанном месте
    GdipDisposeImage(hImage);Удаляет объект изображения
    GdipDeleteGraphics(hGraphic);Удаляет графический объект
    GdipCreateHBITMAPFromBitmap(hBitmap, @hBmp2);Создаёт дескриптор Bitmap из объекта Bitmap
    GdipDeleteGraphics(hBitmap);Удаляет графический объект
    SendMessage_(GadgetID(#Image), #STM_SETIMAGE, 0 ,hBmp2);Отправляет сообщение окну-контролу
    GdiplusShutdown(@ULONG_PTR);Очищает GDI+
  EndProcedure
 
Procedure _GetGuiBkColor()
 hDC= GetDC_(WindowID(#Window_0));Возвращает дескриптор клиентской области окна
 aBGR=GetBkColor(hDC);Возвращает фоновый цвет окна
 ReleaseDC_(WindowID(#Window_0),hDC);Освобождает дескриптор
 ProcedureReturn ((aBGR & $00FF00)  | ((aBGR & $0000FF) <<16) | ((aBGR & $FF0000) >>16))
EndProcedure
 
OpenWindow (#Window_0,  0,  0,  360, 400,  "Image Explorer", #PB_Window_MinimizeGadget | #PB_Window_ScreenCentered)
ImageGadget(#Image,  15, 20, 330, 330, 0)
CreateMenu(#Menu, WindowID(#Window_0))
MenuTitle("&Файл")
MenuItem(#MenuItem_open, "Открыть")
 
 
 
Repeat
  Event = WaitWindowEvent()  
 If (Event = #PB_Event_Menu)
        File$ = OpenFileRequester("Please choose file to load", "", "Image (*.bmp;*.gif;*.jpeg;*.jpg;*.png;*.tif;*.tiff)" , 0)
        If File$  : _GetImage(File$, 330 ,($FF000000 | _GetGuiBkColor())) : EndIf
  EndIf
Until Event = #PB_Event_CloseWindow
CloseLibrary(#GDI) : CloseLibrary(#GDIPlus)
End
 



Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: Просмотрщик изображений API
СообщениеДобавлено: Пн дек 02, 2013 5:31 pm 
Не в сети
PureBasic Coder
Аватар пользователя

Зарегистрирован: Чт ноя 10, 2011 10:50 am
Сообщений: 4049
Откуда: Ростов-на-Дону
Благодарил (а): 70 раз.
Поблагодарили: 81 раз.
Пункты репутации: 24
Цитата:
Показывает уменьшенные копии изображения
Можно как-нибудь задать свои размеры? Если да, тогда коду цены не будет (только GIF прикрутим и всё)

_________________
Пурик - лучший язык программирования


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: Просмотрщик изображений API
СообщениеДобавлено: Пн дек 02, 2013 6:19 pm 
Не в сети
доцент

Зарегистрирован: Сб июл 13, 2013 3:39 pm
Сообщений: 46
Благодарил (а): 10 раз.
Поблагодарили: 3 раз.
Пункты репутации: 0
Никита Однороб писал(а):
Цитата:
Показывает уменьшенные копии изображения
Можно как-нибудь задать свои размеры? Если да, тогда коду цены не будет (только GIF прикрутим и всё)

Разумеется можно :mrgreen: обрати внимание на процедуру
_GetScale(iW, iH, iWH, @rect.Rect)
для выравнивания по центру, и на
GdipDrawImageRectI(hGraphic, hImage, rect\top, rect\right, rect\bottom, rect\left)
собственно где и задаются размеры.
По поводу GIF там всё ок :lol: поддержка есть только без анимации,
а вообще тип загружаемых изображений зависит от кодеков установленных в системе


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: Просмотрщик изображений API
СообщениеДобавлено: Пн дек 02, 2013 6:39 pm 
Не в сети
профессор

Зарегистрирован: Вс июн 10, 2012 8:18 am
Сообщений: 1294
Благодарил (а): 60 раз.
Поблагодарили: 49 раз.
Пункты репутации: 14
Walt писал(а):
Показывает уменьшенные копии изображения

А в полный размер?


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: Просмотрщик изображений API
СообщениеДобавлено: Пн дек 02, 2013 6:58 pm 
Не в сети
профессор
Аватар пользователя

Зарегистрирован: Чт июн 25, 2009 1:02 pm
Сообщений: 2286
Откуда: Russia — Belarus
Благодарил (а): 6 раз.
Поблагодарили: 72 раз.
Пункты репутации: 11
Эх Walt, надо было это брать как болванку:
viewtopic.php?f=10&t=3270

_________________
EnableExplicit User


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: Просмотрщик изображений API
СообщениеДобавлено: Пн дек 02, 2013 7:02 pm 
Не в сети
МОДЕРАТОР

Зарегистрирован: Вт дек 05, 2006 8:46 am
Сообщений: 6384
Благодарил (а): 20 раз.
Поблагодарили: 198 раз.
Пункты репутации: 48
Так как то привычнее загружать файлы:
Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
Interface nIDXSurfaceFactory
  QueryInterface(a, b)
  AddRef()
  Release()
  CreateSurface(a, b, c, d, e, f, g, h)
  CreateFromDDSurface(a, b, c, d, e, f)
  LoadImage(a.p-bstr, b, c, d, e, f)
  LoadImageFromStream(a, b, c, d, e, f)
  CopySurfaceToNewFormat(a, b, c, d, e)
  CreateD3DRMTexture(a, b, c, d, e)
  BitBlt(a, b, c, d, e)
EndInterface
 
#DXLOCKF_READ=0
#CLSCTX_INPROC_SERVER=1
 
Procedure LoadImageEx(Image,FileName.s,Flags=0)
  result=CoInitialize_(0)
  If result=#S_FALSE Or result=#S_OK
   
    CoCreateInstance_(?CLSID_DXTransformFactory,0,#CLSCTX_INPROC_SERVER,?IID_IDXTransformFactory,@dxtf.IDXTransformFactory)
   
    If dxtf
      dxtf\QueryService(?IID_IDXSurfaceFactory,?IID_IDXSurfaceFactory,@dxsf.nIDXSurfaceFactory)
      If dxsf
        dxsf\LoadImage(FileName,0,0,0,?IID_IDXSurface,@surf.IDXSurface)
        If surf
         
          surf\LockSurfaceDC(0,#INFINITE,#DXLOCKF_READ,@lock.IDXDCLock)
          If lock
            DC=lock\GetDC()
           
            If DC
              GetClipBox_(DC,re.rect)
             
              If Image=#PB_Any
                result=CreateImage(#PB_Any,re\right,re\bottom,Flags)
                Image=result
              Else
                result=CreateImage(Image,re\right,re\bottom,Flags)
              EndIf
             
              If result
               
                DestDC=StartDrawing(ImageOutput(Image))
                If DestDC
                  Success=BitBlt_(DestDC,0,0,re\right,re\bottom,DC,0,0,#SRCCOPY)
                  StopDrawing()        
                EndIf
               
                If Success=#False:FreeImage(Image):EndIf
              EndIf
            EndIf
           
            Lock\Release()    
          EndIf
         
          surf\Release()
        EndIf
       
        dxsf\Release()
      EndIf
     
      dxtf\Release()
    EndIf
   
    ;CoUninitialize_() ; dosn't work with this ?!?
  EndIf
 
  If Success:ProcedureReturn result:EndIf
  ProcedureReturn #False
  DataSection
  CLSID_DXTransformFactory:
 Data.l $D1FE6762
  Data.w $FC48,$11D0
  Data.b $88,$3A,$3C,$8B,$00,$C1,$00,$00
 
  IID_IDXTransformFactory:
 Data.l $6A950B2B
  Data.w $A971,$11D1
  Data.b $81,$C8,$00,$00,$F8,$75,$57,$DB
 
  IID_IDXSurfaceFactory:
 Data.l $144946F5
  Data.w $C4D4,$11D1
  Data.b $81,$D1,$00,$00,$F8,$75,$57,$DB
 
  IID_IDXSurface:
 Data.l $B39FD73F
  Data.w $E139,$11D1
  Data.b $90,$65,$00,$C0,$4F,$D9,$18,$9D
  EndDataSection
EndProcedure
 
OpenWindow(1,0,0,640,480,"LoadImageEx test")
File$ = OpenFileRequester("Please choose file to load", "", "Image (*.bmp;*.gif;*.jpeg;*.jpg;*.png;*.tif;*.tiff)" , 0)
If File$  :LoadImageEx(1,File$,32)
  Debug "Размер " +Str(ImageWidth(1)) +"x"+ Str(ImageHeight(1)) ; Работают стандартные функции Пурика!
   EndIf
Repeat
StartDrawing(WindowOutput(1))
DrawImage(ImageID(1),0,0)
StopDrawing()
 
Until WindowEvent()=#PB_Event_CloseWindow
 
 



Когда работаешь с номерами файлов пуриковского формата, то можно легко использовать стандартные процедуры для работы с изображениями.

_________________
read-only


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: Просмотрщик изображений API
СообщениеДобавлено: Пн дек 02, 2013 8:01 pm 
Не в сети
доцент

Зарегистрирован: Сб июл 13, 2013 3:39 pm
Сообщений: 46
Благодарил (а): 10 раз.
Поблагодарили: 3 раз.
Пункты репутации: 0
kvitaliy писал(а):
Так как то привычнее загружать файлы:

kvitaliy хороший пример, честно признаться на пурике я с интерфейсами не работал :oops:
а по поводу стандартных процедур это я знаю просто привычка :mrgreen:

qpAHToMAS писал(а):
Эх Walt, надо было это брать как болванку: viewtopic.php?f=10&t=3270

Так у меня всего пример, а не серьёзное приложения, я как начал кодить на пурике сразу обратил внимание что стандартные кодеки не прилично много весят, вот и получился не большой пример как от них избавится, кстати пример kvitaliy мне больше понравился )


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: Просмотрщик изображений API
СообщениеДобавлено: Пт фев 28, 2014 8:53 am 
Не в сети
профессор
Аватар пользователя

Зарегистрирован: Вс дек 09, 2012 9:02 pm
Сообщений: 773
Откуда: Дагестан
Благодарил (а): 0 раз.
Поблагодарили: 11 раз.
Пункты репутации: 0
Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Procedure GetWindowPixelColor(Window,x,y)
 StartDrawing(WindowOutput(Window))
  Color = Point(x,y) ; цвет пикселя
  StopDrawing()
 ProcedureReturn Color
EndProcedure
 
    Procedure _GetGuiBkColor()
     hDC= GetDC_(WindowID(#Window_0));Возвращает дескриптор клиентской области окна
     
     aBGR= GetWindowPixelColor(#Window_0,0,0);GetStockObject_(#HOLLOW_BRUSH);GetBkColor(hDC);Возвращает фоновый цвет окна
     
     ReleaseDC_(WindowID(#Window_0),hDC);Освобождает дескриптор
     ProcedureReturn ((aBGR & $00FF00)  | ((aBGR & $0000FF) <<16) | ((aBGR & $FF0000) >>16))
    EndProcedure

замените будет прозрачность а не белый фон.


Вернуться наверх
 Профиль  
 
Показать сообщения за:  Сортировать по:  
Начать новую тему Ответить на тему  [ Сообщений: 8 ] 

Часовой пояс: UTC + 3 часа


Кто сейчас на форуме

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 3


Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Найти:
Перейти:  
Создано на основе phpBB® Forum Software © phpBB Group (блог о phpBB)
Сборка создана CMSart Studio
Русская поддержка phpBB