сохранение текущего состояние программы

[Xaker_S]

Привет всем.
Подскажите плиз, как сохранить текущее состояние проги в файл,
а потом считать его.

[mitr]

Открываешь файл, записываешь все параметры, которые должны восстанавливаться, при запуске программы еще раз читаешь данные из файла, ini, реестра

[Xaker_S]

Напиши подробней, please.

[RayShade]

В общем есть код, который сохраняет в XML положение всех контролов во всех формах MDI приложения (сам писал года 3 назад



Public tvLoad As Boolean



Private Sub MDIForm_Load()

tvLoadConfig

End Sub



Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)

tvSaveConfig

End Sub



Function FormIDByname(lwhat As String) As Long

Dim a As Long

For a = 0 To Forms.Count - 1

If Forms(a).Name = lwhat Then

FormIDByname = a

Exit Function

End If

Next a

FormIDByname = -1

End Function

Public Sub tvLoadConfig()

On Error Resume Next

If tvLoad Then Exit Sub

tvLoad = True

Dim cfg As MSXML.XMLDocument

Dim cnt As Long

Set cfg = New MSXML.XMLDocument

cfg.url = App.Path & "\AEROInt.xml"

Dim elt As IXMLElement

Dim elt1 As IXMLElement

cnt = 1

For Each elt In cfg.root.children



Select Case LCase(elt.tagName)



Case "parent":



Forms(FormIDByname(elt.getAttribute("class"))).WindowState = elt.getAttribute("state")

Forms(FormIDByname(elt.getAttribute("class"))).Visible = elt.getAttribute("visible")



If Forms(FormIDByname(elt.getAttribute("class"))).WindowState = vbNormal Then



Forms(FormIDByname(elt.getAttribute("class"))).Top = elt.getAttribute("top")

Forms(FormIDByname(elt.getAttribute("class"))).Left = elt.getAttribute("left")

Forms(FormIDByname(elt.getAttribute("class"))).Height = elt.getAttribute("height")

Forms(FormIDByname(elt.getAttribute("class"))).Width = elt.getAttribute("width")





End If

If elt.children Is Nothing Then GoTo tvNextB



For Each elt1 In elt.children



If Not elt1.getAttribute("class") Like "menu*" Then



Forms(FormIDByname(elt.getAttribute("class"))).Controls(elt1.getAttribute("class")).Top = elt1.getAttribute("top")

Forms(FormIDByname(elt.getAttribute("class"))).Controls(elt1.getAttribute("class")).Left = elt1.getAttribute("left")

Forms(FormIDByname(elt.getAttribute("class"))).Controls(elt1.getAttribute("class")).Height = elt1.getAttribute("height")

Forms(FormIDByname(elt.getAttribute("class"))).Controls(elt1.getAttribute("class")).Width = elt1.getAttribute("width")







If Not elt1.children Is Nothing Then



Dim elt2 As IXMLElement



For Each elt2 In elt1.children







'Forms(FormIDByname(elt.getAttribute("class"))).Controls(elt1.getAttribute("class")).ColumnHeaders.Item(CLng(elt2.getAttribute("ID"))).Left = elt2.getAttribute("left")



Forms(FormIDByname(elt.getAttribute("class"))).Controls(elt1.getAttribute("class")).ColumnHeaders.Item(CLng(elt2.getAttribute("ID"))).Width = elt2.getAttribute("width")



Next elt2

End If







If Forms(FormIDByname(elt.getAttribute("class"))).Name Like "*Form*" Then

Forms(FormIDByname(elt.getAttribute("class"))).Controls(elt1.getAttribute("class")).Visible = elt1.getAttribute("visible")

Else:

Forms(FormIDByname(elt.getAttribute("class"))).Controls(elt1.getAttribute("class")).Visible = elt1.getAttribute("visible") And elt1.Parent.getAttribute("visible")

End If



Else:



If tvIsArrayNode(Forms(FormIDByname(elt.getAttribute("class"))).Controls(elt1.getAttribute("class"))) Then

Forms(FormIDByname(elt.getAttribute("class"))).Controls(elt1.getAttribute("class")).Item(elt1.getAttribute("ID")).Checked = elt1.getAttribute("checked")

Forms(FormIDByname(elt.getAttribute("class"))).Controls(elt1.getAttribute("class")).Item(elt1.getAttribute("ID")).Tag = elt1.getAttribute("tag")

Forms(FormIDByname(elt.getAttribute("class"))).Controls(elt1.getAttribute("class")).Item(elt1.getAttribute("ID")).Visible = elt1.getAttribute("visible")

Forms(FormIDByname(elt.getAttribute("class"))).Controls(elt1.getAttribute("class")).Item(elt1.getAttribute("ID")).Caption = elt1.getAttribute("text")

End If



End If



Next elt1



End Select



tvNextB:



Next elt



tvHdl:

Set cfg = Nothing



Exit Sub



End Sub

Private Function tvIsArrayNode(lwhat As Menu) As Boolean

On Error GoTo tvNot

Err.Clear

a = lwhat.Index

tvIsArrayNode = True

Exit Function

tvNot:

tvIsArrayNode = False

End Function



Public Sub tvSaveConfig()



On Error Resume Next

Close #1





Dim ctl As Form

Dim ctl1 As Control

Open App.Path & "\AEROInt.xml" For Output As #1

Print #1, "<xml>"



For Each ctl In Forms



Print #1, Chr(9) & "<parent class = """ & ctl.Name & """ top = """ & ctl.Top & """ left = """ & ctl.Left & """ height = """ & ctl.Height & """ width = """ & ctl.Width & """ state = """ & ctl.WindowState & """ visible = """ & ctl.Visible & """>"



For Each ctl1 In ctl.Controls



If TypeOf ctl1 Is Menu Then

If tvIsArrayNode(ctl1) Then

Print #1, Replace(Chr(9) & Chr(9) & "<control class = """ & ctl1.Name & """ checked = """ & ctl1.Checked & """ tag = """ & ctl1.Tag & """ visible = """ & ctl1.Visible & """ ID = """ & ctl1.Index & """ text = """ & ctl1.Caption & """/>", "&", "&")

End If

GoTo tvNextA

End If

If TypeOf ctl1 Is ImageList Or TypeOf ctl1 Is CommonDialog Or TypeOf ctl1 Is StatusBar Or TypeOf ctl1 Is Toolbar Then GoTo tvNextA

Print #1, Chr(9) & Chr(9) & "<control class = """ & ctl1.Name & """ top = """ & ctl1.Top & """ left = """ & ctl1.Left & """ height = """ & ctl1.Height & """ width = """ & ctl1.Width & """ visible = """ & ctl1.Visible & """>"

If TypeOf ctl1 Is ListView Then

Dim clh As ColumnHeader

Dim ac As Long

For Each clh In ctl1.ColumnHeaders

Print #1, Chr(9) & Chr(9) & Chr(9) & "<property ID = """ & clh.Index & """ left = """ & clh.Left & """ width = """ & clh.Width & """/>"

Next clh



End If



Print #1, Chr(9) & Chr(9) & "</control>"



tvNextA:

Next ctl1



Print #1, Chr(9) & "</parent>"

Next ctl



Print #1, "</xml>"

Close #1

End Sub

[Лёха_Virus]

есть такая поговорка, что проще написать свой код, чем разобраться в чужом....

[Firestorm]

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

[Xaker_S]

Большое спасибо.
Попытаюсь разобраться.