FreeBasic похожий на PureBasic

Вобщем дело ясное, что дело темное. Попробовал на XP prof SP3 со всеми обновлениями (в настройках стоит автообновление) - результат тотже. Попробовал бегунок сместить на середину аппаратного ускорения графики - также черный фон. Интересно что влияет на это

DEPOzit пишет:Вобщем дело ясное, что дело темное. Попробовал на XP prof SP3 со всеми обновлениями (в настройках стоит автообновление) - результат тотже. Попробовал бегунок сместить на середину аппаратного ускорения графики - также черный фон. Интересно что влияет на это

Сам бы хотел знать . Специально скачал пакет SP3 и поставил на виртуалку, результат тот же. Х.З. в чем дело. Если у тебя стоит win 7 , можешь попробовать свои примеры, они должны работать корректно. Что нужно менять в Win XP об этом наверно только мелкосовтцы знают (хитрая оказалась библиотека GDI+) . Насчет такой проблемы с функцией GdipCreateHBITMAPFromBitmap, пару вопросов звучало в инете , но никто ничего ответить по этому поводу не смог.

Денис! Я написал кое-какой костыль, попробуй, по идее должно работать:

Код:


#Include "window9.bi"

Dim As Integer event
Dim As HBITMAP HIMAGE
Dim As HWND hwnd
hwnd=OpenWindow("1",300,10,100,140)

Using GDIPLUS
Dim Shared ULONG_PTR_01 As ULONG_PTR
Dim GDIPLUSSTARTUPINPUT_01 As GDIPLUSSTARTUPINPUT
GDIPLUSSTARTUPINPUT_01.GdiplusVersion = 1
If (GdiplusStartup(@ULONG_PTR_01, @GDIPLUSSTARTUPINPUT_01, NULL) <> 0) Then
   Print "FAIL"
EndIf

Function Extract_Icon2 (ByVal FileName As String,ByVal number As Integer, ByVal col As ARGB=&hfff0F0F0) As HBITMAP Export
   Dim As GPIMAGE Ptr GPIMAGE_01,GPIMAGE_02
   Dim As Integer w,h
   Dim As PVOID GpGraphics
   Dim hhbitmap As HBITMAP
   Var  hicon= ExtractIcon(0,FileName,number)
   GdipCreateBitmapFromHICON(hicon,@GPIMAGE_01 )
   GdipCloneImage(GPIMAGE_01,@GPIMAGE_02)
   GdipGetImageGraphicsContext(GPIMAGE_01,@GpGraphics)
   GdipGraphicsClear(GpGraphics,Col)
   GdipDrawImage(GpGraphics,GPIMAGE_02,0,0)
   GdipCreateHBITMAPFromBitmap(GPIMAGE_01 ,Cast(HBITMAP Ptr,@hhbitmap),0)
   GdipDeleteGraphics(GpGraphics)
   GdipDisposeImage(GPIMAGE_01)
   GdipDisposeImage(GPIMAGE_02)
   DestroyIcon(hicon)
   Return Cast(HBITMAP,hhbitmap)
End Function

HIMAGE=Extract_Icon2(GetSystemDir & "\SetupAPI.dll",22)
ButtonImageGadget(1,20,10,80,80,Cast(Integer,HIMAGE), BS_PUSHLIKE Or BS_AUTOCHECKBOX)

Do
   event=WaitEvent()
   If event=EventClose Then End
Loop


Да, костыли оказались очень даже рабочие.))) Спасибо тебе в очередной раз.

Только есть небольшой нюанс - некоторые иконки оставляют черный кант вокруг себя, попробуй:
HIMAGE=Extract_Icon2(GetSystemDir & "\Shell32.DLL", 3)
С этим можно как-то бороться?

DEPOzit пишет:Да, костыли оказались очень даже рабочие.))) Спасибо тебе в очередной раз.

Только есть небольшой нюанс - некоторые иконки оставляют черный кант вокруг себя, попробуй:
HIMAGE=Extract_Icon2(GetSystemDir & "\Shell32.DLL", 3)
С этим можно как-то бороться?

Денис, я конечно не знаю, что именно там ты делаешь, но обязательно использовать преобразования? Судя по всему гдишный кодек из ICON в BITMAP портачит. Его еще можно использовать если по другому никак, но в твоем случае может подойдет более скромный вариант?

Код:


#Include "window9.bi"

Dim As Integer event
Dim As HWND hwnd
hwnd=OpenWindow("1",300,10,100,140)

ButtonImageGadget(1,20,10,80,80,0, BS_PUSHLIKE Or BS_AUTOCHECKBOX Or BS_ICON)
SetWindowLong(GadgetID(1),GWL_STYLE,BS_ICON Or WS_CHILD Or WS_VISIBLE )
Var  hicon =  ExtractIcon(0,GetSystemDir & "\SetupAPI.dll",3)
SendMessage(GadgetID(1),BM_SETIMAGE,IMAGE_ICON,Cast(LPARAM,hicon))

Do
   event=WaitEvent()
   If event=EventClose Then End
Loop


Вобще я ковыряюсь с деревьями - TreeViewGadget

Код:

#Include "window9.bi"

Dim As Integer event
Dim As HWND hwnd,tree

hwnd=OpenWindow("TreeView",10,10,180,200) : CenterWindow(hwnd)
Dim As HBITMAP hbmp = Extract_Icon( "Shell32.DLL", 3 )'
Dim As HBITMAP hbmp1 = Extract_icon( "Shell32.DLL", 45 )'
tree=TreeViewGadget(4,10,10,140,140, TVS_HASLINES or TVS_HASBUTTONS or TVS_LINESATROOT,WS_EX_CLIENTEDGE,32)
Var Pos_=AddTreeViewItem(4,"1",hbmp,hbmp1,TVI_FIRST)
AddTreeViewItem(4,"1-1",hbmp,hbmp1,TVI_FIRST,Pos_)
Pos_=AddTreeViewItem(4,"2",hbmp,hbmp1,Pos_)
AddTreeViewItem(4,"2-1",hbmp,hbmp1,TVI_FIRST,Pos_)

Do
 event=waitevent
 If event=EventClose Then end
Loop


А там используется Extract_Icon. Вот как-то так...

Вот уж действительно, сколько функций не штампуй, а всего все равно не объять. Нужно было про иконки при добавлении тоже подумать, но не приходило в голову, пока не коснулось. Вот и получается , что самое эффективное писать на чистом API. Все доступно, понятно и главное продумано людьми поумнее меня. Такая же бяка была и с PureBasic, куда не ткни с его 1000 функциями, везде нужно изобретать костыль. Я одному перцу на другом сайте пытался это объяснить, но сектантам пуревасика что-то объяснить, себе только нервы портить.

По делу: наверно много нужно переписывать для твоего случая. Если требуется только добавление пунктов в TreeView, то тогда только AddTreeViewItem. Там испольуется функция ImageList_Add , а для иконок надо ImageList_AddIcon.

Если же планируется изменение иконок в процессе работы программы, то еще и ReplaceImageItemTreeView

Может проще преобразовать иконки каким нибудь редактором в bmp или другой формат и загружать готовые изображения для TreeView? Если этот вариант выберешь, то в своей либе измени функцию Load_Image на эту, а то тоже могут быть синие фоны и пр.:

Код:

Function Load_image alias "Load_image" (byval Namevhod as String,ByVal ColorBack As Integer) as HBITMAP Export
   DIM AS PVOID PTR GPIMAGE_01
   Dim hhbitmap As HBITMAP
   Var blen = (Len(Namevhod)*2)+2
   Dim As WString Ptr wbuf
   wbuf  = Allocate( blen )
   MultiByteToWideChar(CP_ACP, 0, Namevhod, -1, wbuf, blen)
   IF (GDIPLOADIMAGEFROMFILE( *wbuf, @GPIMAGE_01) <> 0) THEN
      PRINT "FAIL"
   End If
   DeAllocate(wbuf)
   If LOBYTE(LOWORD(GetVersion)) <6 Then
      DIM AS PVOID PTR GPIMAGE_02,GpGraphics
      GdipCloneImage(GPIMAGE_01,@GPIMAGE_02)
      GdipGetImageGraphicsContext(GPIMAGE_01,@GpGraphics)
      GdipGraphicsClear(GpGraphics,ColorBack)
      GdipDrawImage(GpGraphics,GPIMAGE_02,0,0)
      GdipDisposeImage(GPIMAGE_02)
      GdipDeleteGraphics(GpGraphics)
   EndIf   
   GdipCreateHBITMAPFromBitmap(GPIMAGE_01 ,@hhBitmap,Cast(ARGB,ColorBack))
   GdipDisposeImage(GPIMAGE_01)
   Return hhbitmap
end Function

Я исправил библиотеку, по этой ссылке только файлы lib и inc , заменишь на имеющиеся:

Вот пример:

Код:

#Include "window9.bi"

Dim As Integer event
Dim As HWND hwnd,tree

hwnd=OpenWindow("TreeView",10,10,180,200) : CenterWindow(hwnd)
Dim As HICON hbmp = ExtractIcon(0, "Shell32.DLL", 3 )'
Dim As HICON hbmp1 = Extracticon(0, "Shell32.DLL", 45 )'
tree=TreeViewGadget(1,10,10,140,140, TVS_HASLINES or TVS_HASBUTTONS or TVS_LINESATROOT,WS_EX_CLIENTEDGE,32)
Var Pos_=AddTreeViewItem(1,"1",hbmp,hbmp1,Cast(Integer,TVI_FIRST))
AddTreeViewItem(1,"1-1",hbmp,hbmp1,Cast(Integer,TVI_FIRST),Pos_)
Pos_=AddTreeViewItem(1,"2",hbmp,hbmp1,Pos_)
AddTreeViewItem(1,"2-1",hbmp,hbmp1,Cast(Integer,TVI_FIRST),Pos_)

Do
 event=waitevent
 If event=EventClose Then End
 If event=eventLBDOWN Then
  If EventNumberTreeView=1 Then
  ReplaceImageItemTreeView(1,GetItemTreeView,,ExtractIcon(0, "Shell32.DLL", 22 ))
  EndIf
 EndIf
Loop

Вроде все красиво. Там и другие есть исправления, ранее выполненные, но они полностью совместимы должны быть.

Еще раз поражаюсь твоей отзывчивостью и способностям. Надеюсь что твой вклад во FreeBasic будет оценен каждым.

Наткнулся еще на одну проблемку

Код:


#Include "window9.bi"

Dim As Integer event
Dim As HWND hwnd,tree

hwnd=OpenWindow("TreeView",10,10,800,600) : CenterWindow(hwnd)
Dim As HBITMAP hbmp = Extract_Icon( "Shell32.DLL", 3 )'
Dim As HBITMAP hbmp1 = Extract_icon( "Shell32.DLL", 45 )'
tree=TreeViewGadget(4,10,10,140,140, TVS_HASLINES or TVS_HASBUTTONS or TVS_LINESATROOT,WS_EX_CLIENTEDGE,32)
Var Pos_=AddTreeViewItem(4,"1",hbmp,hbmp1,1)
AddTreeViewItem(4,"1-1",hbmp,hbmp1,1,Pos_)
Pos_=AddTreeViewItem(4,"2",hbmp,hbmp1,4)
AddTreeViewItem(4,"2-1",hbmp,hbmp1,3,Pos_)

Var hwnd1=OpenWindow("Child",100,10,200,200,WS_VISIBLE Or WS_OVERLAPPEDWINDOW Or WS_CLIPSIBLINGS)
SetParent(hwnd1,hwnd)
ButtonGadget(2,10,10,120,30,"Button2")
Do
 event=WaitEvent()
 If Event=EventClose Then End
Loop


Окно TreeViewGadget'а перекрывает дочернее окно.

DEPOzit пишет:Окно TreeViewGadget'а перекрывает дочернее окно.

Что мешает TreeView тоже поставить стиль WS_CLIPSIBLINGS ?

Да собственно, теперь уже ничего не мешает. Спс.)

Суть вопроса:
при изменении размера окна идет перерисовка TreeViewGadget, соответственно открытые вкладки снова переходят в начальное состояние. Как оставить прежнее состояние данного гаджета или как открыть нужный раздел принудительно (что-то типа обратной функции GetItemTreeView)?

DEPOzit пишет:
при изменении размера окна идет перерисовка TreeViewGadget, соответственно открытые вкладки снова переходят в начальное состояние.

У меня ничего подобного не наблюдается. Как тебе это удалось?

DEPOzit пишет:как открыть нужный раздел принудительно (что-то типа обратной функции GetItemTreeView)?

Функцией TreeView_Expand

Код:


#Include "window9.bi"

Dim As Integer event,pos1,pos2
Dim As HWND hwnd,tree

hwnd=OpenWindow("TreeView",10,10,800,600) : CenterWindow(hwnd)
Dim As HBITMAP hbmp = Extract_Icon( "Shell32.DLL", 3 )'
Dim As HBITMAP hbmp1 = Extract_icon( "Shell32.DLL", 45 )'
tree=TreeViewGadget(4,10,10,140,140, TVS_HASLINES or TVS_HASBUTTONS or TVS_LINESATROOT Or WS_CLIPSIBLINGS,WS_EX_CLIENTEDGE,32)
Pos1=AddTreeViewItem(4,"1",hbmp,hbmp1,1)
AddTreeViewItem(4,"1-1",hbmp,hbmp1,1,Pos1)
Pos2=AddTreeViewItem(4,"2",hbmp,hbmp1,4)
AddTreeViewItem(4,"2-1",hbmp,hbmp1,3,Pos2)

Var hwnd1=OpenWindow("Child",100,10,200,200,WS_VISIBLE Or WS_OVERLAPPEDWINDOW Or WS_CLIPSIBLINGS)
SetParent(hwnd1,hwnd)
ButtonGadget(2,10,10,120,30,"развернуть 1")
ButtonGadget(3,10,50,120,30,"свернуть 1")
Do
 event=WaitEvent()
 If Event=EventClose Then End
 If event = eventgadget Then
    If EventNumber = 3 Then
       TreeView_Expand(tree,pos1,TVE_COLLAPSE)
    ElseIf EventNumber =2 Then
       TreeView_Expand(tree,pos1,TVE_EXPAND)
    EndIf
 EndIf
Loop


Спасибо.

У меня ничего подобного не наблюдается. Как тебе это удалось?

Ну чтобы изменить размер гаджета приходится его стирать и выводить повторно с новыми параметрами. Разве не правильно делаю?

DEPOzit пишет:Спасибо.

У меня ничего подобного не наблюдается. Как тебе это удалось?

Ну чтобы изменить размер гаджета приходится его стирать и выводить повторно с новыми параметрами. Разве не правильно делаю?

Вообще-то я всегда для изменения размеров гаджетов использовал функцию ResizeGadget , но раз тебе нравится так , то тут я пас

Пропустил я этот момент почемо-то. Теперь все стало проще.))

Как сделать в гаджите StringGadget чтобы не было ограничения длины строки размером самого гаджета? Как использовать стиль WS_EX_ACCEPTFILES? Файлы переносятся на окно, а из какой переменной брать их значения?

DEPOzit пишет:Как сделать в гаджите StringGadget чтобы не было ограничения длины строки размером самого гаджета?

стиль ES_AUTOHSCROLL

DEPOzit пишет:Как использовать стиль WS_EX_ACCEPTFILES? Файлы переносятся на окно, а из какой переменной брать их значения?

По ссылке пример для окна. Для EDIT тоже самое , только отлавливать событие WM_DROPFILES надо в его процедуре (сабклассировать EDIT):

http://www.freebasic.net/forum/viewtopic.php?p=57036#p57036

Станислав, можно ли в ImageDraw использовать стиль WS_CLIPSIBLINGS?
Суть в чем - ImageDraw постоянно перерисовывается с помощью SetTimer и при открытии сверху окна картинка пытается налезть на окно, которое сверху.

P.S.: И еще - если есть ICQ и ты им пользуешься, то сообщи его пожалуйста, т.к. периодически возникают вопросы.

DEPOzit пишет:Станислав, можно ли в ImageDraw использовать стиль WS_CLIPSIBLINGS?
Суть в чем - ImageDraw постоянно перерисовывается с помощью SetTimer и при открытии сверху окна картинка пытается налезть на окно, которое сверху.

Привет Денис! Без кода, трудно сказать. Сделай простенький код , в котором воспроизведи то , что не выходит. Попробуем вместе найти решение.

DEPOzit пишет:P.S.: И еще - если есть ICQ и ты им пользуешься, то сообщи его пожалуйста, т.к. периодически возникают вопросы.

ICQ давно не пользуюсь. Возникают вопросы, так задавай. Хоть на этом форуме, хоть на моем(специально там ветка по моей либе). Единственно имхо лучше для каждого вопроса, создавать свою тему, а не все в одну кучу.

Ну вот как-то так:

Код:

#Include "window9.bi"
Dim Shared As Integer hwnd1, hwnd

Dim shared HIMAGE As integer
HIMAGE=Load_image("reg.gif")

      hwnd=OpenWindow("Окно1",10,10,800,670,,WS_EX_PALETTEWINDOW)
            hwnd1=OpenWindow("Окно2",10,10,320,210,WS_VISIBLE Or WS_OVERLAPPED or WS_CAPTION or WS_SYSMENU Or WS_CLIPSIBLINGS,WS_EX_TOOLWINDOW)   
SetParent(hwnd1,hwnd)
Sub sub_
WindowStartDraw(hwnd,10,10,643,181)
 ImageDraw(HIMAGE,-1,-1)
  StopDraw
End Sub

SetTimer(hwnd,1,1,@sub_)
TextGadget(14,10,10,1950,50,"Проба",WS_CLIPSIBLINGS)

Do
 Var event=WaitEvent
 loop

Временно решил проблему прекращением отрисовки картинки во время открытия второго окна, но если водить им, то картинка затирается верхним окном.

DEPOzit пишет:Ну вот как-то так:

Код:

#Include "window9.bi"
Dim Shared As Integer hwnd1, hwnd

Dim shared HIMAGE As integer
HIMAGE=Load_image("reg.gif")

      hwnd=OpenWindow("Окно1",10,10,800,670,,WS_EX_PALETTEWINDOW)
            hwnd1=OpenWindow("Окно2",10,10,320,210,WS_VISIBLE Or WS_OVERLAPPED or WS_CAPTION or WS_SYSMENU Or WS_CLIPSIBLINGS,WS_EX_TOOLWINDOW)   
SetParent(hwnd1,hwnd)
Sub sub_
WindowStartDraw(hwnd,10,10,643,181)
 ImageDraw(HIMAGE,-1,-1)
  StopDraw
End Sub

SetTimer(hwnd,1,1,@sub_)
TextGadget(14,10,10,1950,50,"Проба",WS_CLIPSIBLINGS)

Do
 Var event=WaitEvent
 loop

Временно решил проблему прекращением отрисовки картинки во время открытия второго окна, но если водить им, то картинка затирается верхним окном.

Честно , даже не знаю как в этой ситуации быть. Стиль WS_CLIPSIBLINGS работает нормально со стандартными дочерними объектами. Но насколько я понял из испытаний твоего исходника, данный стиль не работает с дочерними окнами , имеющими шапку. Как бы ни было, если делать отрисовку окна как у тебя, по любому мало хорошего, если что-то будет попадать в область отрисовки.

Правда я могу предложить черезжопный вариант:

Можно создать два ImageGadget со стилем WS_CLIPSIBLINGS. На одном рисовать то, что ты рисовал по окну. Второй вместо второго окна и на нем отрисовывать все вручную (в том числе шапку) И самому ловить события перемещения, закрытия и т.п. ImageGadget.

Извини, если спрошу что-то не то: а как создать ImageGadget со стилем WS_CLIPSIBLINGS?
Приведи пример.

DEPOzit пишет:Извини, если спрошу что-то не то: а как создать ImageGadget со стилем WS_CLIPSIBLINGS?
Приведи пример.

как и другие гаджеты:

ImageGadget(1,0,0,200,200,IMAGE,,SS_BITMAP Or WS_CLIPSIBLINGS)