По предложение на проГЪРМИст (извинявам се за грешката, която допуснах) пускам тази тема, оставям я статична, и ще събираме в нея само тънкости и хитрости!


Кратко съдържание:

Съдържаниет е скрито
Влезте за да го видите

Съдържаниет е скрито
Влезте за да го видите

Съдържаниет е скрито
Влезте за да го видите

Съдържаниет е скрито
Влезте за да го видите

Съдържаниет е скрито
Влезте за да го видите

Съдържаниет е скрито
Влезте за да го видите

Съдържаниет е скрито
Влезте за да го видите

Съдържаниет е скрито
Влезте за да го видите

Редактирано от Щиpлиц на 15.10.06 13:59.

Съдържаниет е скрито
Влезте за да го видите

Съдържаниет е скрито
Влезте за да го видите

Редактирано от killall на 10.09.03 17:15.

Предложението не беше мое :)

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''



 ' Функция за четене на стойност от INI файл

Public Function Fun_ReadINIValue(strSection As String, _

                                 strKey As String, _

                                 strINIFileName, _

                                 Optional strDefaultCaption As String = "") As String



Dim strRet As String

Dim lngSize As Long

Dim lngResult As Long



 ' Ако смятате че реда който ще прочитате е по-дълъг от 1024 символа, сменете цифрата в следващия ред

Const lngLongestValue As Long=1024



strRet = String(lngLongestValue, 0)

lngResult = GetPrivateProfileString(strSection, strKey, strDefaultCaption, strRet, lngLongestValue, strINIFileName)

strRet = Left$(strRet, lngResult)



Fun_GetCaption = Fun_ReadINIValue



End Function



''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''



 ' Процедура за запис на стойност в INI файл

Public Sub Sub_WriteINIValue(strSection As String, _

                             strKey As String, _

                             strValue As String, _

                             strINIFile As String)





WritePrivateProfileString strSection, strKey, strValue & Chr$(0), strINIFile



End Sub



''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''



 ' Функция за четене на съдържанието на текстов файл

 ' Удобна е за не много големи файлове (например до 4000-5000 реда или 100-200 килобайта)

Public Function Fun_GetTextFileContents(strFileName As String) As String



Dim strLine As String

Dim strFileContents As String

Dim intFreeFile As Integer

Dim lngLOF As Long



intFreeFile = FreeFile()

Open strFileName For Input As #intFreeFile

     lngLOF = LOF(intFreeFile)

     If lngLOF > 0 Then

        Do While Not EOF(intFreeFile)

           Line Input #intFreeFile, strLine

           strFileContents = strFileContents & strLine & vbCrLf

        Loop

     End If

Close #intFreeFile



Fun_GetTextFileContents = strFileContents



End Function



''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''



 ' Функция за четене от двоичен файл

 ' Ако за intFileNumber се изпрати 0, файла указан в strFileToOpen ще се

 ' отвори, ще се прочете и ще се затвори

 ' Ако за intFileNumber се изпрати >0, това значи че файл с такъв номер вече е

 ' отворен от друго място в програмата. Той трябва да е отворен "For Binary"

 ' Функцията връща броя на прочетените байтове а в параметъра byteData() е

 ' прочетеното съдържание

 ' Ако няма достатъчно данни (например ако са заявени да се прочетат

 ' например 1000 байта от отместване 500 а файла е с размер само 1300

 ' байта), функцията връща 0

Public Function Fun_ReadFileData(intFileNumber As Integer, _

                                 lngStart As Long, _

                                 lngLength As Long, _

                                 byteData() As Byte, _

                                 Optional strFileToOpen As String) As Long



Dim lngFileLen As Long

Dim strTemp As String

Dim intI As Integer

Dim boolInternalFileOpen As Boolean



If intFileNumber = 0 Then

   intFileNumber = FreeFile()

   Open strFileToOpen For Binary Access As #intFileNumber

   boolInternalFileOpen = True

End If



lngFileLen = LOF(intFileNumber)



 ' Да се прочете от файла само ако съществуват lngLength байта данни от отместване lngStart

If (lngFileLen >= lngStart And lngFileLen >= (lngStart + lngLength - 1) And lngStart > 0 And lngLength > 0) Then

   ReDim byteData(lngLength - 1) As Byte

   Get #intFileNumber, lngStart, byteData

   If boolDecryptData = True Then

      Call Sub_DecryptByteArray(byteData, pbytePass, boolUseDateTimeDecryption)

   End If

   Fun_ReadFileData = UBound(byteData) + 1

End If



If boolInternalFileOpen = True Then

   Close #intFileNumber

End If





End Function



''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''



 ' Процедура за запис в двоичен файл

 ' Ако за intFileNumber се изпрати 0, файла ще се отвори, ще се прочете и ще се затвори

 ' Ако за intFileNumber се изпрати >0, това значи че файл с такъв номер вече е

 ' отворен от друго място в програмата. Той трябва да е отворен "For Binary"

 ' В lngStart се задава отместването спрямо началото на файла от където да се запише byteData

Public Sub Sub_WriteFileData(intFileNumber As Integer, _

                             lngStart As Long, _

                             byteData() As Byte, _

                             Optional strFileName As String="")



Dim boolInternalFileOpen As Boolean



If intFileNumber = 0 Then

   intFileNumber = FreeFile()

   Open strFileName For Binary Access As #intFileNumber

   boolInternalFileOpen = True

End If



Put #intFileNumber, lngStart, byteData



If boolInternalFileOpen = True Then

   Close #intFileNumber

End If



End Sub

Редактирано от Щиpлиц на 30.09.03 20:27.

.

 ' Процедурата установява шрифта за всички обекти (контроли) върху Форма

 ' Може лесно да бъдат добавени и други свойства на шрифта

 ' Ако boolSetToAllForms = True ще се промени шрифта на всички обекти (контроли) върху всички Форми в проекта

 ' (правете това само ако всички форми от проекта са заредени)

 ' Ако някой от контролите има .Tag "FontLocked" неговия шрифт няма да се промени

 ' Пример: Call Sub_SetFont(Form1,"Tahoma",204,False) -> Ще промени шрифта на всички обекти (контроли) върху Form1

Public Sub Sub_SetFont( _

           objTarget As Object, _

           strFontName As String, _

           intFontCharset As Integer, _

           Optional boolSetToAllForms As Boolean = False)





On Error Resume Next



Dim objTargets As Object

Dim objTargetControls As Object





 ' Ако не е за всички Форми а само за objTarget

If boolSetToAllForms = False Then

   For Each objTargetControls In objTarget.Controls

       If objTargetControls.Tag <> "FontLocked" Then

          objTargetControls.Font.Charset = intFontCharset

          objTargetControls.Font.Name = strFontName

       End If

   Next

Else ' Ако е за всички Форми в проекта

   For Each objTargets In VB.Forms

       For Each objTargetControls In objTargets.Controls

           If objTargetControls.Tag <> "FontLocked" Then

              objTargetControls.Font.Charset = intFontCharset

              objTargetControls.Font.Name = strFontName

           End If

       Next

   Next

End If



End Sub

Редактирано от Щиpлиц на 30.09.03 20:25.

Дай малко повече потробности около приложението на тази функция, ако обичаш. Благодаря!

Бии, за да те уважават!

Ами, най-вероятно аз лично бих го ползвал за Language Pack.

----------------------------------
помислих, хареса ми, помислих пак...

Добре. Явно не зададох въпросът си правилно.
Исках да попитам как точно се организира едно приложение, когато в него трябва да има интерфейси на различни езици?

Дано да съм задал въпросът си по-добре.

Бии, за да те уважават!

Точно !