sample.ini
Code: Select all
[set]
WinM = 0
WinX = 0
WinY = 0
WinW = 480
WinH = 210
Code: Select all
EnableExplicit
Structure coord_size
m.l
x.l
y.l
w.l
h.l
EndStructure
Structure rect_6
left.l
top.l
right.l
bottom.l
width.l
height.l
EndStructure
Global cs.coord_size
Declare MyWindowCallback(WindowId, Message, wParam, lParam)
Declare __Coor2(*Len1.long, *Len2.long, *Len3.long)
Declare __Coor1(*WorkRect1.rect_6, *iWidth.long, *iHeight.long, *BorderX.long, *BorderY.long, *iStyle.long, *Margin.long)
Declare _SetCoor(*cs1.coord_size, MinWidth = 0, MinHeight = 0, iStyle = 2, Fixed = 0, Margin = 0)
Declare SaveINI()
Declare SaveFile_Buff(File.s, *Buff, Size)
Global ini$
ini$ = GetPathPart(ProgramFilename()) + GetFilePart(ProgramFilename(), #PB_FileSystem_NoExtension) + ".ini"
ExamineDesktops()
OpenPreferences(ini$)
PreferenceGroup("set")
With cs
\m = ReadPreferenceInteger("WinM", 0)
\x = ReadPreferenceInteger("WinX", (DesktopWidth(0) - 480) / 2)
\y = ReadPreferenceInteger("WinY", (DesktopHeight(0) - 210) / 2)
\w = ReadPreferenceInteger("WinW", 480)
\h = ReadPreferenceInteger("WinH", 210)
EndWith
ClosePreferences()
_SetCoor(@cs, 480, 210, 3, 0, 0) ; Сделать условие только при прочтении ini
; Создаём конфиги если отсутствуют
If FileSize(ini$) < 11
SaveFile_Buff(ini$, ?ini, ?iniend - ?ini)
; первый запуск, нет ini пишем центр окна
WritePreferenceInteger("WinX", (DesktopWidth(0) - 480) / 2)
WritePreferenceInteger("WinY", (DesktopHeight(0) - 210) / 2)
EndIf
; _SetCoor(cs\x)
If OpenWindow(0, cs\x, cs\y, cs\w, cs\h, "Move over the edge of the screen and start again", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_SizeGadget)
TextGadget(2,10,40,480,20, "Window with saving position and size in ini.",0)
SetWindowCallback(@MyWindowCallback())
If cs\m ; флаг окно на весь экран
SetWindowState(0 , #PB_Window_Maximize)
EndIf
Repeat
Select WaitWindowEvent()
Case #PB_Event_RestoreWindow
cs\m = 0
Case #PB_Event_MaximizeWindow
cs\m = 1
Case #PB_Event_CloseWindow
SaveINI()
CloseWindow(0)
End
EndSelect
ForEver
EndIf
Procedure MyWindowCallback(WindowId, Message, wParam, lParam)
Protected Result = #PB_ProcessPureBasicEvents, *ptr.MINMAXINFO
Select Message
Case #WM_GETMINMAXINFO ; Минимальный, максимальный размера окна. Смотреть WindowBounds
Result = 0
*ptr.MINMAXINFO = lParam
*ptr\ptMinTrackSize\y = 160 ; + BorderY ;42
*ptr\ptMinTrackSize\x = 480 ; + BorderX ;16
Case #WM_EXITSIZEMOVE ; Изменение размера окна и перемещение после события.
With cs
\x= WindowX(0, #PB_Window_FrameCoordinate)
\y= WindowY(0, #PB_Window_FrameCoordinate)
\w = WindowWidth(0) ; Новая ширина окна.
\h = WindowHeight(0) ; Новая высота окна.
EndWith
; SetWindowTitle(0 , "WM_EXITSIZEMOVE")
EndSelect
ProcedureReturn Result
EndProcedure
Procedure SaveINI()
If OpenPreferences(ini$) And PreferenceGroup("set")
With cs
WritePreferenceInteger("WinM" , \m)
WritePreferenceInteger("WinX" , \x)
WritePreferenceInteger("WinY" , \y)
WritePreferenceInteger("WinW" , \w)
WritePreferenceInteger("WinH" , \h)
EndWith
ClosePreferences()
EndIf
EndProcedure
Procedure SaveFile_Buff(File.s, *Buff, Size)
Protected Result = #False
Protected ID = CreateFile(#PB_Any, File)
If ID
If WriteData(ID, *Buff, Size) = Size
Result = #True
EndIf
CloseFile(ID)
EndIf
ProcedureReturn Result
EndProcedure
; _SetCoor Корректирует координаты для отображения окна в рабочей области экрана
; iStyle - Стиль окна, который определяет ширину границ
; 0 - Окно без границ, ширина границы 0 пиксел
; 1 - Окно со стилем WS_BORDER, обычно ширина этой границы 1 пиксел
; 2 - Окно не изменяемое в размерах, обычно ширина этой границы 3 пиксел
; 3 - Окно изменяемое в размерах (WS_OVERLAPPEDWINDOW), обычно ширина этой границы 4 пиксел
; Fixed - Исправляет координаты окна при помещении его справа или снизу при отсутствии стиля $WS_CAPTION или $WS_DLGFRAME
; Margin - Отступ от краёв
Procedure _SetCoor(*cs1.coord_size, MinWidth = 0, MinHeight = 0, iStyle = 2, Fixed = 0, Margin = 0)
Protected Xtmp, Ytmp, BorderX = 0, BorderY = 0, WorkRect.rect_6;, tr1, tr2
If Fixed
Fixed = GetSystemMetrics_(#SM_CYCAPTION) ; + #SM_CYCAPTION
*cs1\h - Fixed
EndIf
If MinWidth And *cs1\w < MinWidth
*cs1\w = MinWidth ; ограничение ширины
EndIf
If MinHeight And *cs1\h < MinHeight
*cs1\h = MinHeight ; ограничение высоты
EndIf
; If *cs1\x = -12345
; tr1 = 1
; EndIf
; If *cs1\y = -12345
; tr2 = 1
; EndIf
__Coor1(@WorkRect, @cs\w, @cs\h, @BorderX, @BorderY, @iStyle, @Margin)
__Coor2(@cs\x, @cs\w, @WorkRect\width)
__Coor2(@cs\y, @cs\h, @WorkRect\height)
*cs1\w = *cs1\w - BorderX - Margin
*cs1\h = *cs1\h - BorderY - Margin + Fixed
; ExamineDesktops()
; If tr1 ; пустая строка передать ключ что строки пусты
; *cs1\x = (DesktopWidth(0) - *cs1\w - WorkRect\left - Margin)/2 + WorkRect\left + Margin / 2
; Else
*cs1\x = *cs1\x + WorkRect\left + Margin / 2
; EndIf
; If tr2 ; пустая строка передать ключ что строки пусты
; *cs1\y = (DesktopHeight(0) - *cs1\h - WorkRect\top - Margin)/2 + WorkRect\top + Margin / 2
; Else
*cs1\y = *cs1\y + WorkRect\top + Margin / 2
; EndIf
EndProcedure ;==>_SetCoor
; Вот так выглядит передача чисел типа integer ссылкой, где integer это встроенная структура, а \l её элемент
Procedure __Coor1(*WorkRect1.rect_6, *iWidth.long, *iHeight.long, *BorderX.long, *BorderY.long, *iStyle.long, *Margin.long)
Protected iX = 7, iY = 8
If *iStyle\l
Select *iStyle\l
Case 1
iX = 5 ; SMCXBORDER
iY = 6 ; SMCYBORDER
Case 2
iX = 7 ; SMCXDLGFRAME
iY = 8 ; SMCYDLGFRAME
Case 3
iX = 32 ; SMCXFRAME
iY = 33 ; SMCYFRAME
EndSelect
*BorderX\l = GetSystemMetrics_(iX) * 2
*BorderY\l = GetSystemMetrics_(iY) * 2 + GetSystemMetrics_(#SM_CYCAPTION)
Else
*BorderY\l = GetSystemMetrics_(#SM_CYCAPTION)
EndIf
*iWidth\l + *BorderX\l
*iHeight\l + *BorderY\l
SystemParametersInfo_(#SPI_GETWORKAREA, 0, *WorkRect1.rect_6, 0)
With *WorkRect1
\width = \right - \left ; ширина Рабочей области
\height = \bottom - \top ; высота Рабочей области
EndWith
*Margin\l * 2 ; Вычисление наибольшего отступа
If *Margin\l > (*WorkRect1\width - *iWidth\l)
*Margin\l = *WorkRect1\width - *iWidth\l
EndIf
If *Margin\l > (*WorkRect1\height - *iHeight\l)
*Margin\l = *WorkRect1\height - *iHeight\l
EndIf
If *Margin\l < 0
*Margin\l = 0
EndIf
*iWidth\l + *Margin\l
*iHeight\l + *Margin\l
EndProcedure ;==>__Coor1
; Вот так выглядит передача чисел типа integer ссылкой, где integer это встроенная структура, а \l её элемент
Procedure __Coor2(*Len1.long, *Len2.long, *Len3.long)
If *Len1\l < 0
*Len1\l = 0
EndIf
If *Len2\l >= *Len3\l
*Len2\l = *Len3\l
*Len1\l = 0
EndIf
If *Len1\l > *Len3\l - *Len2\l
*Len1\l = *Len3\l - *Len2\l
EndIf
EndProcedure ;==>__Coor2
DataSection
ini:
IncludeBinary "sample.ini"
iniend:
EndDataSection
Code: Select all
Declare MyWindowCallback(WindowId, Message, wParam, lParam)
Declare __Coor2(*Len1.integer, *Len2.integer, *Len3.integer)
Declare __Coor1(Array aWA(1), *iWidth.integer, *iHeight.integer, *BorderX.integer, *BorderY.integer, *iStyle.integer, *Margin.integer)
Declare _SetCoor(Array aWHXY(1), MinWidth = 0, MinHeight = 0, iStyle = 2, Fixed = 0, Margin = 0)
Declare SaveINI()
Declare SaveFile_Buff(File.s, *Buff, Size)
Global Dim MXYWH(4)
Global ini$
ini$ = GetPathPart(ProgramFilename()) + GetFilePart(ProgramFilename(), #PB_FileSystem_NoExtension) + ".ini"
ExamineDesktops()
OpenPreferences(ini$)
PreferenceGroup("set")
MXYWH(0) = ReadPreferenceInteger("WinM", 0)
MXYWH(1) = ReadPreferenceInteger("WinX", (DesktopWidth(0) - 480) / 2)
MXYWH(2) = ReadPreferenceInteger("WinY", (DesktopHeight(0) - 210) / 2)
MXYWH(3) = ReadPreferenceInteger("WinW", 480)
MXYWH(4) = ReadPreferenceInteger("WinH", 210)
ClosePreferences()
_SetCoor(MXYWH(), 480, 210, 4, 0, 3)
; Создаём конфиги если отсутствуют
If FileSize(ini$) < 11
SaveFile_Buff(ini$, ?ini, ?iniend - ?ini)
; первый запуск, нет ini пишем центр окна
WritePreferenceInteger("WinX", (DesktopWidth(0) - 480) / 2)
WritePreferenceInteger("WinY", (DesktopHeight(0) - 210) / 2)
EndIf
; _SetCoor(aWHXY(1))
If OpenWindow(0, MXYWH(1), MXYWH(2), MXYWH(3), MXYWH(4), "Move over the edge of the screen and start again", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_SizeGadget)
TextGadget(2,10,40,480,20, "Window with saving position and size in ini",0)
SetWindowCallback(@MyWindowCallback())
If MXYWH(0) ; флаг окно на весь экран
SetWindowState(0 , #PB_Window_Maximize)
EndIf
Repeat
Select WaitWindowEvent()
Case #PB_Event_RestoreWindow
MXYWH(0) = 0
Case #PB_Event_MaximizeWindow
MXYWH(0) = 1
Case #PB_Event_CloseWindow
SaveINI()
CloseWindow(0)
End
EndSelect
ForEver
EndIf
Procedure MyWindowCallback(WindowId, Message, wParam, lParam)
Protected Result = #PB_ProcessPureBasicEvents
Select Message
Case #WM_GETMINMAXINFO ; Минимальный, максимальный размера окна. Смотреть WindowBounds
Result = 0
*ptr.MINMAXINFO = lParam
*ptr\ptMinTrackSize\y = 160 + BorderY ;42
*ptr\ptMinTrackSize\x = 480 + BorderX ;16
Case #WM_EXITSIZEMOVE ; Изменение размера окна и перемещение после события.
MXYWH(1)= WindowX(0, #PB_Window_FrameCoordinate)
MXYWH(2)= WindowY(0, #PB_Window_FrameCoordinate)
MXYWH(3) = WindowWidth(0) ; Новая ширина окна.
MXYWH(4) = WindowHeight(0) ; Новая высота окна.
; SetWindowTitle(0 , "WM_EXITSIZEMOVE")
EndSelect
ProcedureReturn Result
EndProcedure
Procedure SaveINI()
If OpenPreferences(ini$) And PreferenceGroup("set")
WritePreferenceInteger("WinM" , MXYWH(0))
WritePreferenceInteger("WinX" , MXYWH(1))
WritePreferenceInteger("WinY" , MXYWH(2))
WritePreferenceInteger("WinW" , MXYWH(3))
WritePreferenceInteger("WinH" , MXYWH(4))
ClosePreferences()
EndIf
EndProcedure
Procedure SaveFile_Buff(File.s, *Buff, Size)
Protected Result = #False
Protected ID = CreateFile(#PB_Any, File)
If ID
If WriteData(ID, *Buff, Size) = Size
Result = #True
EndIf
CloseFile(ID)
EndIf
ProcedureReturn Result
EndProcedure
; _SetCoor Корректирует координаты для отображения окна в рабочей области экрана
; iStyle - Стиль окна, который определяет ширину границ
; 0 - Окно без границ, ширина границы 0 пиксел
; 1 - Окно со стилем WS_BORDER, обычно ширина этой границы 1 пиксел
; 2 - Окно не изменяемое в размерах, обычно ширина этой границы 3 пиксел
; 3 - Окно изменяемое в размерах (WS_OVERLAPPEDWINDOW), обычно ширина этой границы 4 пиксел
; Fixed - Исправляет координаты окна при помещении его справа или снизу при отсутствии стиля $WS_CAPTION или $WS_DLGFRAME
; Margin - Отступ от краёв
Procedure _SetCoor(Array aWHXY(1), MinWidth = 0, MinHeight = 0, iStyle = 2, Fixed = 0, Margin = 0)
Protected Xtmp, Ytmp, aWA, BorderX = 0, BorderY = 0, Dim aWA(5);, tr1, tr2
If Fixed
Fixed = GetSystemMetrics_(#SM_CYCAPTION) ; + #SM_CYCAPTION
aWHXY(4) - Fixed
EndIf
If MinWidth And aWHXY(3) < MinWidth
aWHXY(3) = MinWidth ; ограничение ширины
EndIf
If MinHeight And aWHXY(4) < MinHeight
aWHXY(4) = MinHeight ; ограничение высоты
EndIf
; If aWHXY(1) = -12345
; tr1 = 1
; EndIf
; If aWHXY(2) = -12345
; tr2 = 1
; EndIf
__Coor1(aWA(), @aWHXY(3), @aWHXY(4), @BorderX, @BorderY, @iStyle, @Margin)
__Coor2(@aWHXY(1), @aWHXY(3), @aWA(4))
__Coor2(@aWHXY(2), @aWHXY(4), @aWA(5))
aWHXY(3) = aWHXY(3) - BorderX - Margin
aWHXY(4) = aWHXY(4) - BorderY - Margin + Fixed
; ExamineDesktops()
; If tr1 ; пустая строка передать ключ что строки пусты
; aWHXY(1) = (DesktopWidth(0) - aWHXY(3) - aWA(0) - Margin)/2 + aWA(0) + Margin / 2
; Else
aWHXY(1) = aWHXY(1) + aWA(0) + Margin / 2
; EndIf
; If tr2 ; пустая строка передать ключ что строки пусты
; aWHXY(2) = (DesktopHeight(0) - aWHXY(4) - aWA(1) - Margin)/2 + aWA(1) + Margin / 2
; Else
aWHXY(2) = aWHXY(2) + aWA(1) + Margin / 2
; EndIf
EndProcedure ;==>_SetCoor
; Вот так выглядит передача чисел типа integer ссылкой, где integer это встроенная структура, а \i её элемент
Procedure __Coor1(Array aWA(1), *iWidth.integer, *iHeight.integer, *BorderX.integer, *BorderY.integer, *iStyle.integer, *Margin.integer)
Protected iX = 7, iY = 8
If *iStyle\i
Select *iStyle\i
Case 1
iX = 5 ; SMCXBORDER
iY = 6 ; SMCYBORDER
Case 2
iX = 7 ; SMCXDLGFRAME
iY = 8 ; SMCYDLGFRAME
Case 3
iX = 32 ; SMCXFRAME
iY = 33 ; SMCYFRAME
EndSelect
*BorderX\i = GetSystemMetrics_(iX) * 2
*BorderY\i = GetSystemMetrics_(iY) * 2 + GetSystemMetrics_(#SM_CYCAPTION)
Else
*BorderY\i = GetSystemMetrics_(#SM_CYCAPTION)
EndIf
*iWidth\i + *BorderX\i
*iHeight\i + *BorderY\i
SystemParametersInfo_(#SPI_GETWORKAREA,0,rect.RECT,0)
aWA(0) = rect\left
aWA(1) = rect\top
aWA(2) = rect\right
aWA(3) = rect\bottom
aWA(4) = aWA(2) - aWA(0) ; ширина Рабочей области
aWA(5) = aWA(3) - aWA(1) ; высота Рабочей области
*Margin\i * 2 ; Вычисление наибольшего отступа
If *Margin\i > (aWA(4) - *iWidth\i)
*Margin\i = aWA(4) - *iWidth\i
EndIf
If *Margin\i > (aWA(5) - *iHeight\i)
*Margin\i = aWA(5) - *iHeight\i
EndIf
If *Margin\i < 0
*Margin\i = 0
EndIf
*iWidth\i + *Margin\i
*iHeight\i + *Margin\i
EndProcedure ;==>__Coor1
; Вот так выглядит передача чисел типа integer ссылкой, где integer это встроенная структура, а \i её элемент
Procedure __Coor2(*Len1.integer, *Len2.integer, *Len3.integer)
If *Len1\i < 0
*Len1\i = 0
EndIf
If *Len2\i >= *Len3\i
*Len2\i = *Len3\i
*Len1\i = 0
EndIf
If *Len1\i > *Len3\i - *Len2\i
*Len1\i = *Len3\i - *Len2\i
EndIf
EndProcedure ;==>__Coor2
DataSection
ini:
IncludeBinary "sample.ini"
iniend:
EndDataSection