FreeBasic похожий на PureBasic

DoReMi пишет:Объем работы впечатляет...

А нет ли в перспективе если не DBGrid'a, то хотя бы какого-то примитивного StringGrid'а?

Я сам не знаю что в перспективе, что захочется или может понадобится для себя, то и напишу. В принципе, что изначально хотел написать, уже написано.

Здравствуйте!

Проект обновился. Добавлены функции:

GetCurrentFileName
GetCurrentFileNameA
SetRunOnlyExe
InitProcess
FirstProcess
NextProcess
GetNameProcess
GetIDProcess
Create_Process
Open_Process
KillProcess
WaitExitProcess
WaitLoadProcess
GetExitCode

Исправлено:

Функция ReplaceString. Как оказалось функции Lcase и Ucase не поддерживают кирилицу. Поэтому функция ReplaceString, включающая одну из этих функций, работала неправильно с русскими символами. Теперь все корректно.

P.S. Проект вырос до огромных размеров. Честно говоря, я сам не ожидал, что будет столько.
Все что хотел я видеть в нем изначально, сделано уже давно. Дальнейшее развитие будет направлено только на отлов ошибок.
Спасибо всем, кто хоть как-то подбадривал меня, а так же всем тем, кто пользуется и будет в дальнейшем пользоваться.
Добра!

Назрел вопрос:

Хочу сделать сортировку в ComboBoxGadget, используя стили CBS_SORT Or CBS_DROPDOWNLIST Or WS_VSCROLL.
Ничего не происходит.
Пример:

Код:

#Include "window9.bi"

OpenWindow("",10,10,300,100)
ComboBoxGadget(1,10,10,100,80, CBS_SORT Or CBS_DROPDOWNLIST Or WS_VSCROLL)
AddComboBoxItem(1,"2",-1)
AddComboBoxItem(1,"0",-1)
AddComboBoxItem(1,"1",-1)
TextGadget(2,150,10,100,20)

Do
var event=WaitEvent()
 If event=eventclose Then End
 If event=eventgadget Then
  If eventnumber()=1 Then
  setgadgettext(2,GetComboBoxText(1,GetItemComboBox(1)))
  EndIf
 EndIf
 
Loop


Или что-то не так делаю?

DEPOzit пишет:Назрел вопрос:

Хочу сделать сортировку в ComboBoxGadget, используя стили CBS_SORT Or CBS_DROPDOWNLIST Or WS_VSCROLL.
Ничего не происходит.
Пример:

Код:

#Include "window9.bi"

OpenWindow("",10,10,300,100)
ComboBoxGadget(1,10,10,100,80, CBS_SORT Or CBS_DROPDOWNLIST Or WS_VSCROLL)
AddComboBoxItem(1,"2",-1)
AddComboBoxItem(1,"0",-1)
AddComboBoxItem(1,"1",-1)
TextGadget(2,150,10,100,20)

Do
var event=WaitEvent()
 If event=eventclose Then End
 If event=eventgadget Then
  If eventnumber()=1 Then
  setgadgettext(2,GetComboBoxText(1,GetItemComboBox(1)))
  EndIf
 EndIf
 
Loop


Или что-то не так делаю?

Все так! При сообщении CB_INSERTSTRING , список не сортируется. Список будет сортироваться только если добавлять item сообщением CB_ADDSTRING. Но в функции AddComboBoxItem я намеренно сделал сообщение CB_INSERTSTRING , поскольку позволяет вставлять Item в любое место(скажем так универсально). А если уж как тебе понадобится сортировать, то несложно добавлять так:

SendMessage(GadgetID(1),CB_ADDSTRING,0, @"2")

Есть ли какая-нибудь возможность взять в фокус (поместить курсор) гаджет?

DEPOzit пишет:Есть ли какая-нибудь возможность взять в фокус (поместить курсор) гаджет?

Это нужно?

Код:

#Include "window9.bi"
Dim As Integer event
Dim as HWND hwnd
hwnd=OpenWindow("",10,10,500,500) : CenterWindow(hwnd)
ButtonGadget(1,200,200,100,20,"Курсор на Stringgadget")
StringGadget(2,10,50,200,20)
Do
 event=WaitEvent()
 If Event=EventClose Then End
 If event=EventGadget Then
    If EventNumber=1 Then
       SetFocus(GadgetID(2))
       SetCursorPos(WindowX(hwnd)+GadgetX(2)+50,Windowy(hwnd)+GadgetY(2)+38)
    EndIf
 EndIf
Loop

Да, именно. Спасибо

Есть табличка, созданная при помощи ListViewGadget. Добавляю в нее строку с помощью AddListViewItem. Добавленную строку распологаем ниже всех. Как сделать чтобы табличка скролировалась до нового пункта так, чтобы ее было видно и подсвечивалась как выбранный пункт. В гаджете ListBoxGadget все это есть, а тут нет. Как быть?

DEPOzit пишет:Есть табличка, созданная при помощи ListViewGadget. Добавляю в нее строку с помощью AddListViewItem. Добавленную строку распологаем ниже всех. Как сделать чтобы табличка скролировалась до нового пункта так, чтобы ее было видно и подсвечивалась как выбранный пункт. В гаджете ListBoxGadget все это есть, а тут нет. Как быть?

Вот так выделяются сразу все пункты:

Код:

#Include "window9.bi"
Var hwnd=OpenWindow("",10,10,500,500)
Var LLIISS=ListViewGadget(1,10,10,310,600,0, LVS_ICON  , ,32,LVSIL_NORMAL )
ButtonGadget(2,350,10,80,20)
For aa As Integer=0 To 15
   AddListViewItem(1,"item ?"+Str(aa),Extract_Icon(GetSystemDir & "\SetupAPI.dll",aa),aa,0)
Next

Do
   Var event=WaitEvent()
   If Event=EventClose Then End
   If event=EventGadget Then
      If EventNumber=2 Then
         dim LVITEM as LVITEM
         LVITEM.mask      = LVIF_STATE
         LVITEM.state    = LVIS_SELECTED
         LVITEM.stateMask = LVIS_SELECTED
         SendMessage(GadgetID(1), LVM_SETITEMSTATE, -1 , @LVITEM)
         SetFocus(GadgetID(1))
      EndIf
   EndIf
Loop

если нужно какой-то один, то вместо -1 в третьем параметре передай индекс нужного пункта

Спасибо, а как скролить таблицу до нового пункта?

DEPOzit пишет:Спасибо, а как скролить таблицу до нового пункта?

При таком подходе все работает правильно и скролится верно.

Код:

#Include "window9.bi"
Var hwnd=OpenWindow("",10,10,500,500)
Var LLIISS=ListViewGadget(1,10,10,310,600 )
AddListViewColumn(1, "1 ñòîëáåö",0,1,300)
ButtonGadget(2,350,10,80,20)
For aa As Integer=0 To 145
   AddListViewItem(1,"item ?"+Str(aa),Extract_Icon(GetSystemDir & "\SetupAPI.dll",aa),aa,0)
Next

Do
   Var event=WaitEvent()
   If Event=EventClose Then End
   If event=EventGadget Then
      If EventNumber=2 Then
 
         dim LVITEM as LVITEM
         Dim p As Point                     
         SendMessage(GadgetID(1), LVM_GETITEMPOSITION, 30 , @p)
            
         SendMessage(GadgetID(1), LVM_SCROLL,p.x, p.y-20 )      
         ? getlasterror()
         LVITEM.mask      = LVIF_STATE
         LVITEM.state    = LVIS_SELECTED
         LVITEM.stateMask = LVIS_SELECTED
         SendMessage(GadgetID(1), LVM_SETITEMSTATE, 30 , @LVITEM)
         SetFocus(GadgetID(1))
      EndIf
   EndIf
Loop

А если вот так:

Код:

#Include "window9.bi"
Var hwnd=OpenWindow("",10,10,500,500)
Var LLIISS=ListViewGadget(1,10,10,310,600,0, LVS_ICON  , ,32,LVSIL_NORMAL  )
ButtonGadget(2,350,10,80,20)
For aa As Integer=0 To 145
   AddListViewItem(1,"item ?"+Str(aa),Extract_Icon(GetSystemDir & "\SetupAPI.dll",aa),aa,0)
Next

Do
   Var event=WaitEvent()
   If Event=EventClose Then End
   If event=EventGadget Then
      If EventNumber=2 Then
 
         dim LVITEM as LVITEM
         Dim p As Point                     
         SendMessage(GadgetID(1), LVM_GETITEMPOSITION, 30 , @p)
            
         SendMessage(GadgetID(1), LVM_SCROLL,p.x, p.y )      
         ? getlasterror()
         LVITEM.mask      = LVIF_STATE
         LVITEM.state    = LVIS_SELECTED
         LVITEM.stateMask = LVIS_SELECTED
         SendMessage(GadgetID(1), LVM_SETITEMSTATE, 30 , @LVITEM)
         SetFocus(GadgetID(1))
      EndIf
   EndIf
Loop

то SendMessage(GadgetID(1), LVM_GETITEMPOSITION, 30 , @p) возвращает неверный результат после второго нажатия и следующих нажатий. С чем это связано не знаю.

пример кода

Код:

hwnd=OpenWindow("gui",400,10,500,500)
CheckBoxGadget(01,10,010,450,15,"1.")
CheckBoxGadget(02,10,030,450,15,"2.")
CheckBoxGadget(03,10,050,450,15,"3.")
'......
CheckBoxGadget(11,10,210,450,15,"11.")
CheckBoxGadget(12,10,230,450,15,"12.")

Чекбоксы на форме рисует, а как их ТАБом обходить? Никакой реакции на нажатия клавиатуры.

DoReMi пишет:Чекбоксы на форме рисует, а как их ТАБом обходить? Никакой реакции на нажатия клавиатуры.

Я могу ошибаться, но вроде как переход по табам для диалогов. Для окон, созданных с помощью CreateWindow, можно использовать костыли. Хотя может кто и предложит более выгодный вариант. Я предлагаю такой костыль для перехода по клавише TAB:

Код:


#Include "window9.bi"

Declare Function tabstop(hwnd As hwnd , msg As UINT, wparam As WPARAM,lparam As LPARAM)As Integer
Dim Shared As HWND hwnd
Dim As Integer event
hwnd=OpenWindow("gui",400,10,500,500)
CheckBoxGadget(1,10,010,450,15,"1.")
CheckBoxGadget(2,10,030,450,15,"2.")
CheckBoxGadget(3,10,050,450,15,"3.")
CheckBoxGadget(4,10,210,450,15,"4.")
CheckBoxGadget(5,10,230,450,15,"5.")
SetFocus(gadgetid(1))
SetWindowCallback(Cast(Integer,@tabstop),1)
Do:Loop Until WaitEvent=eventclose

Function tabstop(hwnd As hwnd , msg As UINT, wparam As WPARAM,lparam As LPARAM)As Integer
 If msg=WM_KEYDOWN And wparam=VK_TAB Then
    Static i As Integer=2
    SetFocus(GadgetID(i))
    i+=1
    If i>5 Then i=1
 EndIf
 Return 0
End Function


Для перехода обратно по SHIFT+TAB , отлавливай клавишу SHIFT с помощью WM_KEYDOWN, и если после этого клавиша не была отпущена WM_KEYUP, то проверка нажатия TAB. Это так как сделал бы я. Хотя все зависит от программы, возможно проще все написать с помощью диалогов.

Пардон, а что такое "с помощью диалогов"?

И заодно, следующий вопрос, как прервать выполнение процедуры с циклом, которую запустили по кнопке, повторным нажатием кнопки (или другой кнопкой)?

DoReMi пишет:Пардон, а что такое "с помощью диалогов"?

И заодно, следующий вопрос, как прервать выполнение процедуры с циклом, которую запустили по кнопке, повторным нажатием кнопки (или другой кнопкой)?

Диалоги создаются с помощью ресурсов и управляются с помощью соответствующих функций: DialogBoxParam, SetDlgItemText, IsDialogMessage и др. Многим такой подход программирования кажется более удобным. Кстати у контролов диалогового окна достаточно прописать WS_TABSTOP и они будут автоматом переключаться по TAB и SHIFT+TAB

Второй вопрос не совсем понял. Если вопрос общий по процедурам, то EXIT SUB или EXIT FUNCTION. Если про верхний код (про TAB) , то FreeCallback

trew пишет:

DoReMi пишет:
И заодно, следующий вопрос, как прервать выполнение процедуры с циклом, которую запустили по кнопке, повторным нажатием кнопки (или другой кнопкой)?

Второй вопрос не совсем понял. Если вопрос общий по процедурам, то EXIT SUB или EXIT FUNCTION. Если про верхний код (про TAB) , то FreeCallback

Вопрос общий.

Вызываю процедуру через
Do
event=WaitEvent()
If event=EventClose Then End
If event=eventgadget Then
If eventnumber=30 Then
МуSub
EndIf
Endif
Loop

В самой процедуре, допустим, бесконечный цикл. Всё окно программы в это время замерзает и не реагирует на нажатия.
Нужно чтобы
- окно не замерзало;
- была доступна кнопка останова;
- при нажатии на кнопку исполнение MySub() прерывалось.

DoReMi пишет:
В самой процедуре, допустим, бесконечный цикл. Всё окно программы в это время замерзает и не реагирует на нажатия.
Нужно чтобы
- окно не замерзало;
- была доступна кнопка останова;
- при нажатии на кнопку исполнение MySub() прерывалось.

Понятно:

Нужно запустить процедуру в другом потоке:

Код:


#Include "window9.bi"
Dim Shared As Integer event,ENDsub
Dim as HWND hwnd

Sub Q(a As Any Ptr)
   Dim i As Integer
   Do
      i+=1
      SetGadgetText(2,Str(i))
      Sleep 10
   Loop Until ENDsub=1
   SetGadgetText(2,Str("выходим из процедуры"))
End Sub

hwnd=OpenWindow("Привет",10,10,500,500) : CenterWindow(hwnd)
ButtonGadget(1,10,10,100,40,"Отключить процедуру",BS_MULTILINE)
TextGadget(2,10,50,200,20)
ThreadCreate(@Q)
Do
 event=WaitEvent()
 Select Case event
    Case EventClose
       Exit Do
    Case eventgadget
       If eventnumber=1 Then ENDsub=1
 End Select
Loop


Ага, понял, спасибо, буду пробовать.

Стас, такой вопрос:
При работе с Extract_Icon цвет иконки не совпадает с цветом фона. Изменение параметра color не дает эффекта (становится черный). В стандартном примере из хелпа:

Код:

#Include "window9.bi"

Dim As integer hwnd,event,HIMAGE
hwnd=OpenWindow("1",300,10,100,140)
HIMAGE=Extract_Icon(GetSystemDir & "\SetupAPI.dll",22)
ButtonImageGadget(1,20,10,80,80,HIMAGE, BS_PUSHLIKE Or BS_AUTOCHECKBOX)

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


цвет иконки не совпадает с цветом фона окна (он синий).

DEPOzit пишет:Стас, такой вопрос:
При работе с Extract_Icon цвет иконки не совпадает с цветом фона. Изменение параметра color не дает эффекта (становится черный). В стандартном примере из хелпа:

Код:

#Include "window9.bi"

Dim As integer hwnd,event,HIMAGE
hwnd=OpenWindow("1",300,10,100,140)
HIMAGE=Extract_Icon(GetSystemDir & "\SetupAPI.dll",22)
ButtonImageGadget(1,20,10,80,80,HIMAGE, BS_PUSHLIKE Or BS_AUTOCHECKBOX)

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


цвет иконки не совпадает с цветом фона окна (он синий).

Да я в курсе Денис. Тоже столкнулся с подобным, когда делал эти шахматы. Все функции библиотеки, завязанные на GDI+ , корректно работают только под Windows 7 (может еще Vista). Когда писал библиотеку, я уже работал на семерке и никак не думал (не было мысли даже проверять), что в XP не корректно работает гдишная функция GdipCreateHBITMAPFromBitmap . А ней немало функций построено, связанных с работой изображений. Возможно я найду другое решение как преобразовывать битмапы GDI+ в GDI, но пока его не вижу. Все способы, которые приходили в голову, очень медленные.

Кстати, сейчас попробовал на XP , все работает как надо В любом случае попробуй выставить цвет в формате ARGB , то есть:

&hFFFFFFFF <- белый
&hFF000000 <- черный

Пробовал разные палитры. Сейчас попробовал 2 предложенных тобой колора - в обеих случаях черный фон иконки(((

Последовательность параметров такая же - HIMAGE=Extract_Icon(GetSystemDir & "\SetupAPI.dll",22, Color=&hFFFFFFFF)?

DEPOzit пишет:Пробовал разные палитры. Сейчас попробовал 2 предложенных тобой колора - в обеих случая черный фон иконки(((

Последовательность параметров такая же - HIMAGE=Extract_Icon(GetSystemDir & "\SetupAPI.dll",22, Color=&hFFFFFFFF)?

Да , я ничего не менял. Кстати может у меня работать правильно стало из-за того, что я заново компиль поставил. Вчера решил почистить, потому как где-то 1-2 месяца назад настраивал новые заголовки GTK от TJF , ус..л обе папки INC и LIB дальше некуда. Вчера скачал с оф. сайта последнюю стабильную версию, заново установил все нужные мне библиотеки. Системы не переустанавливал, в XP никаких обновлений не делал, разве что один раз была необходимость менять быстродействие в ущерб улучшенному виду в панели управления (может это повлияло хз) Честное слово было как у тебя, а теперь правильно.

Щас узнаем в чем дело, запусти http://freebasic.ru/proba.exe
Какого цвета фон иконки?

DEPOzit пишет:Щас узнаем в чем дело, запусти http://freebasic.ru/proba.exe
Какого цвета фон иконки?

Пробовал на чистой XP на виртуалке и на основной системе перезагружался: цвет черный.

Кстати, похоже я соврал неумышленно. Только сейчас заметил , что на основной системе XP , Internet Explorer обновлен, похоже сын полазил. Возможно он выходя в инет обновил винду, поэтому стало отображаться нормально.

Я провел тесты работы своих шахмат

на виртуалке Windows XP пакет обновления 2 - результат как у тебя фон синий вместо прозрачного
на основной системе Windows XP похоже пакет обновления 3 - работает корректно.