FreeBasic похожий на PureBasic

Код:

#Include "window9.bi"

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

DEPOzit пишет:DisableWindow блокирует и родительское окно и дочернее (созданного при помощи SetParent). Это видно на примере:

Код:

#Include "window9.bi"

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

Есть ли аналогичная команда, позволяющая блокировать только родительское окно, оставляя активным дочернее?

Хм а как можно сменить стили уже созданного окна?

Точнее интересует деактивация "Свернуть в окно".

UndoEditor
RedoEditor
PasteEditor
CanUndoEditor
CanRedoEditor
EmptyUndoBufferEditor
GetLineTextEditor
GetLineCountEditor
GetModifyEditor
GetRectEditor
SetLimitTextEditor
SetModifyEditor
SetPasswordChar
GetPasswordChar
LineFromCharEditor
LineIndexEditor
LineLengthEditor
LineScrollEditor
SetTabStopsEditor
ReadOnlyEditor
GetFirstVisibleLineEditor
SetRectEditor
GetCurrentIndexCharEditor
RebarGadget
AddRebarTab
GetCountTabRebarGadget
GetHeightRebarGadget
GetTextRebarGadget
SetTextRebarGadget
MoveTabRebarGadget
DeleteTabRebarGadget
IDinIndexRebarGadget
GradientFillDraw

Код:

#Include "window9.bi"
function Save_Icon(ByVal HBMP As HBITMAP,ByVal FileName As string,ByVal TransparentColor As Integer=16777216) As Integer
   ImageStartDraw(HBMP)
   Dim As Integer X,Y,I,Farbe,AddToList,ThisValue,MIN_I,MIN_DIF,NEW_RED,NEW_GREEN,NEW_BLUE,LastByte,OrVal,_
   UsedColorCnt=1,HotspotX=32,HotspotY=32
   
   Var handle=Create_File(FileName)
   If handle=0 Then Return 0

   Restore ICON_HEADER_256_COLORS
   For I=1 To 62
      Read ThisValue
      If I=&hB Then
         Write_Data(Handle,@HotspotX,1)
      ElseIf I=&hD Then
         Write_Data(handle,@HotspotY,1)
      Else
         Write_Data(handle,@ThisValue,1)
      EndIf
   Next I
   Dim UsedColors(255) As Integer
   UsedColors(0)=0
   For Y=31 To 0 Step -1
      For X=0 To 31 Step 1
         Farbe=GetPix(X,Y)
         AddToList=1
         For I=0 To UsedColorCnt
            If Farbe=UsedColors(I) Then
               AddToList=0
               I=UsedColorCnt
            EndIf
         Next I
         If UsedColorCnt=255 And AddToList Then
            MIN_I=1
            MIN_DIF=0
            For I=1 To UsedColorCnt
               If Abs(Farbe-UsedColors(I))<MIN_DIF Or I=1 Then
                  MIN_I=I
                  MIN_DIF=Abs(Farbe-UsedColors(I))
               EndIf
            Next I
            NEW_RED=(GetRValue(Farbe)+GetRValue(UsedColors(MIN_I)))/2
            NEW_GREEN=(GetGValue(Farbe)+GetGValue(UsedColors(MIN_I)))/2
            NEW_BLUE=(GetBValue(Farbe)+GetBValue(UsedColors(MIN_I)))/2
            UsedColors(MIN_I)=BGR(NEW_RED,NEW_GREEN,NEW_BLUE)
         ElseIf UsedColorCnt<>255 And AddToList Then
            UsedColors(UsedColorCnt)=Farbe
            UsedColorCnt+=1
         EndIf
      Next X
   Next Y

   For I=0 To UsedColorCnt
      Write_Byte(Handle,GetBValue(UsedColors(I)))
      Write_Byte(Handle,GetGValue(UsedColors(I)))
      Write_Byte(Handle,GetRValue(UsedColors(I)))
      Write_Byte(Handle,0)
   Next I

   For I=UsedColorCnt+1 To 255
      Write_Integer(Handle,0)
   Next I

   For Y=31 To 0 Step -1
      For X=0 To 31 Step 1
         Farbe=GetPix(X,Y)
         If Farbe<>TransparentColor Then
            MIN_I=0
            For I=0 To UsedColorCnt
               If Abs(Farbe-UsedColors(I))<MIN_DIF Or I=0 Then
                  MIN_I=I
                  MIN_DIF=Abs(Farbe-UsedColors(I))
               EndIf
            Next I
            Farbe=MIN_I
         Else
            Farbe=0
         EndIf
         Write_Data(Handle,@Farbe,1)
      Next X
   Next Y


   For Y=31 To 0 Step -1
      For X=0 To 31 Step 8
         LastByte=0
         For I=0 To 7
            Farbe=GetPix(X+I,Y)
            If Farbe=TransparentColor Then
               Select Case I
                  Case 7:OrVal=1
                  Case 6:OrVal=2
                  Case 5:OrVal=4
                  Case 4:OrVal=8
                  Case 3:OrVal=16
                  Case 2:OrVal=32
                  Case 1:OrVal=64
                  Case 0:OrVal=128
               End Select
               LastByte= LastByte Or OrVal
            EndIf
         Next I
         Write_Data(Handle,@LastByte,1)
      Next X
   Next Y

   Close_File(handle)
   StopDraw
   Return 1
End Function
ICON_HEADER_256_COLORS:
Data &h00,&h00,&h01,&h00,&h01,&h00,&h20,&h20,&h00,&h00,&h00,&h00,&h00,&h00,&hA8,&h08,&h00,&h00,&h16,&h00,&h00,&h00,&h28,&h00,&h00,&h00,&h20,&h00,&h00,&h00,&h40,&h00,&h00,&h00,&h01,&h00,&h08,&h00,&h00,&h00,&h00,&h00,&h80,&h04,&h00,&h00,&h00,&h00,&h00,&h00,&h00,&h00,&h00,&h00,&h00,&h00,&h00,&h00,&h00,&h00,&h00,&h00


Save_Icon(Load_image("1.png"),"1.ico")

Думаю данная библиотека заслуживает того, чтобы входить в дистрибутив freebasic'а.

DEPOzit пишет:Над реализацией иконки слева вверху окна не думал еще?

DEPOzit пишет:Применяю EditorGadget и текст дополняется вниз, а скрол при этом остается в верхней позиции. Как сделать так, чтобы текст автоматически скролился до последней строчки?

Код:

#Include "window9.bi"

Dim As integer event
Dim As String buf
Var hwnd=OpenWindow("1",300,10,500,400)
EditorGadget(1,10,10,300,300, "")
ButtonGadget(2,350,20,100,20,"Scroll")

For a As Integer=1 To 500
 buf+="String №" & a & Chr(10)
Next
SetGadgetText(1,buf)
Do
 event=WaitEvent()
 If event=EventClose Then End
 If event=EventGadget Then
  If EventNumber=2 Then
  LineScrollEditor(1,GetLineCountEditor(1)-2 )
  EndIf 
 EndIf
Loop

DEPOzit пишет:Я пробовал с LineScrollEditor, что-то как-то он не так работает.(

DEPOzit пишет:Данный код работает каждый раз по разному. Где мы видим 1 строку, где неодной, где полный столбец.

DEPOzit пишет:Ну вобщем дело обстоит так):
Запускаем, нажимаем Scroll. Видим одну строку 500 (хотя хотелось бы видить полный ряд). Потом нажимаем один раз вверх - бац, видим весь столбец. Потом еще раз вверх - тут все нормально (поднялись на одну позицию). Потом жмем Scroll - вобще все исчезает.

прокручивает текст на нужное кол-во строк по вертикали.

DEPOzit пишет:Понятно. А др. способа нет? Просто тут приходится морочится с текущей позицией скрола, размером едитгаджета, колличеством строк в гаджете. Согласись не айс))).

CreateIconOrCursorFromFile
CreateIconOrCursorFromBitmap
SaveIconOrCursor
CreateFBini
OpenFBini
CloseFBini
WriteGroupFBini
WriteValueFBini
ReadByteValueFBini
ReadShortValueFBini
ReadIntegerValueFBini
ReadLongintValueFBini
ReadDoubleValueFBini
ReadStringValueFBini