Tips&Tricks

хмм,абе това със трея...как да ти кажа ....като като да си нашляпаш анимирани гифове на сайта :)
------------------------------
лично мнение ,разбира се

1. Като казваш анимирани gif-ове на сайта много ясно те разбирам, защото се занимавам с web development от повече от шест години, а с VB от няколко месеца.

2. Има места на сайтовете, където обаче анимираните gif-ове са необходими. Е естествено, че е селяния да сложиш анимирана маймуна, която върти кльомба "@" на пръчка и подскача... обаче пък понякога има нужда от интерактивен елемент и те уверявам, че анимираните gif-ове са 100 пъти по-подходящи от Flash...

3. Абсолютно същото важи и за иконите в systray. Селяния е да си сложиш две икони очи в трея, които винаги гледат към курсора на мишката- съгласен съм. Обаче ако ти предпочиташ ICQ-то ти да стърчи като отворен прозорец през цялото време или да виждаш текущата настройка на клавиатурата (кирилица/латиница) в отворен прозорец (както беше в един от първите FlexType!) или пък да си настройваш нивото на звука винаги през Control Panel! В трея си държа и MP3 player, защото не е нужно да ми стърчи като цял елемент от taskbar-а...

С две думи има неща, които е по-удобно да стоят в трея, има такива, които не е удобно да стоят в него и има такива, които изобщо не трябва да стоят никъде по компютъра (с последното визирам очите, които следят курсора)... И когато на някого му е необходимо да използва такава функционалност е хубаво да има възможност!

И понеже темата не съдържа нито Tips and Tricks, нито по някакъв начин е свързана с останалите неща, ще помоля Щирлиц след няколко дни да изтрие постинга ми, защото е много досадно когато някой е влязъл да намери отговор на въпроса си (търси някакъв Trick) да чете странични разговори...

Не ззнам де, модераторът ще си прецени- ако смята, че дискусията е полезна- нека остане... може пък на някого да му е хрумнало да прави нова версия на "Очите"...


Ама баба не е жена, вие не знаете ли?

Мисля, че темата не пречи, но ми се ще да поприберем малко написаното тук, за да стане читаво за търсене и четене. Какво ще кажете, ако го пренаредя я дървовидна структура, и му направя "Съдържание" най-отгоре? Нещо като първата тема... Не ми се иска да сливам двете теми, защото ще стане страшна бъркотия когато постваме. Просто е препоръчително постингите в тези теми да са максимално информативни, обяснителни, и кратки. Както беше във вица за еврейна, дето трябвало да напише писмо, за да пита приятеля си кога ще му върне парите. И написал: "Моше, кога?". Но дискусии също може да се водят на воля, просто да са в отделни постинги, за да не ги слагам в "Съдържание"-то, и темата ще стане хем за дискусии, хем подредена.

Друго - когато поствате код, опитайте да съкращавате дългите редове и да ги правите на два, или три реда, колкото е необходимо, за да не се разтегля настрани страницата. Това става лесно, просто погледнете по-нагоре теми с код.

Spravedlivo reshenie, smjatam, che naistina trjabva da ima taka tema i da moze vseki da postavja ili tursi neshta koito go intersuvat. Sudurzanieto shte oprosti zadachata da se nameri neshto burzo.

Option Explicit

'Tova e v modul

Declare Function ChangeDisplaySettings Lib "user32.dll" _

Alias "ChangeDisplaySettingsA" _

(lpDevMode As Any, ByVal dwFlags As Long) As Long

Public Declare Function EnumDisplaySettings Lib "user32.dll" _

Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As String, _

ByVal iModeNum As Long, lpDevMode As DEVMODE) As Long



Public Type DEVMODE

  dmDeviceName As String * 32

  dmSpecVersion As Integer

  dmDriverVersion As Integer

  dmSize As Integer

  dmDriverExtra As Integer

  dmFields As Long

  dmOrientation As Integer

  dmPaperSize As Integer

  dmPaperLength As Integer

  dmPaperWidth As Integer

  dmScale As Integer

  dmCopies As Integer

  dmDefaultSource As Integer

  dmPrintQuality As Integer

  dmColor As Integer

  dmDuplex As Integer

  dmYResolution As Integer

  dmTTOption As Integer

  dmCollate As Integer

  dmFormName As String * 32

  dmUnusedPadding As Integer

  dmBitsPerPixel As Integer

  dmPelsWidth As Long

  dmPelsHeight As Long

  dmDisplayFlags As Long

  dmDisplayFrequency As Long

  dmICMMethod As Long

  dmICMIntent As Long

  dmMediaType As Long

  dmDitherType As Long

  dmReserved1 As Long

  dmReserved2 As Long

  dmPanningWidth As Long

  dmPanningHeight As Long

End Type



Const CDS_UPDATEREGISTRY = &H1

Const CDS_TEST = &H2

Const CDS_FULLSCREEN = &H4

Const CDS_GLOBAL = &H8

Const CDS_SET_PRIMARY = &H10

Const CDS_RESET = &H40000000

Const CDS_SETRECT = &H20000000

Const CDS_NORESET = &H10000000

Const DISP_CHANGE_SUCCESSFUL = 0

Const DISP_CHANGE_RESTART = 1

Const DISP_CHANGE_FAILED = -1

Const DISP_CHANGE_BADMODE = -2

Const DISP_CHANGE_NOTUPDATED = -3

Const DISP_CHANGE_BADFLAGS = -4

Const DISP_CHANGE_BADPARAM = -5

Public Const ENUM_CURRENT_SETTINGS = -1

Public dm As DEVMODE



Public Sub ChangeResolution(ByVal Wdth As Long, ByVal Hght As Long)

  Dim Lrst As Long

  If Wdth <> 0 And Hght <> 0 Then

    Lrst = EnumDisplaySettings(vbNullString, ENUM_CURRENT_SETTINGS, dm)

    With dm

      .dmPelsWidth = Wdth

      .dmPelsHeight = Hght

    End With

    Lrst = ChangeDisplaySettings(dm, CDS_RESET)

    If Lrst <> 0 Then

      Select Case Lrst

        Case DISP_CHANGE_RESTART

          MsgBox "System restart!", vbInformation, "System Message"

        Case DISP_CHANGE_FAILED

          MsgBox "Change Resolution Failed!", vbCritical, "System Message"

        Case DISP_CHANGE_BADMODE

          MsgBox "Bad Mode", vbCritical, "System Message"

        Case DISP_CHANGE_NOTUPDATED

          MsgBox "Bad Mode", vbCritical, "System Message"

        Case DISP_CHANGE_BADPARAM

          MsgBox "Bad Parameters", vbCritical, "System Message"

      End Select

    End If

  Else

    Exit Sub

  End If

End Sub

Тоя код работи дяволски добре, ама можеш ли да ми кажещ защо не реплийсва контролите "Microsoft Common Controls 6.0 (SP4)" (mscomctl.ocx), a само тия "Microsoft Common Controls 5.0 (SP2)" (comctl32.ocx). Направо немога да разбера

Споменатия файл го няма вече...
Да не кажа че и [линк] не ми го отваря :)

Както файлът, така и хоста са си там- просто това е безплатен сървър, който:

1. Не се вижда от чужбина
2. Не се вижда през всички доставчици в БГ.

Вижда се със сигурност, ако доставчик ти е: Evronet, Spectrum, Orbitel, Tchno-link.

Не се вижда със сигурност, ако доставчик ти е: Arena, Data.BG (Homelan)...

Т.е. проблема не е в сайта, а в доставчиците, от които започва да ми писва... и на мен не ми е приятно да нямам достъп до сайтове като data.bg или arena, обаче това е положението! Имам намерение да си купя платен хост, който да се вижда дори извън БГ, обаче искат и пари майка им стара!

И като временно решение на проблема съм ти качил копие от файла на адрес [линк] но скоро ще го изтрия и от там. Това трябва да го виждаш, защото е на сървър на dir.bg

БАба...


Ама баба не е жена, вие не знаете ли?

Ами не съм на нито един от 'позволените' доставчици, но от dir.bg няма проблеми ;)

Нещо не мога да го докопам нито в едното нито в другото

Ето кода, описанието е след него...

'

'    Add in Form_Load or Sub Main procedure this code:

'

'            If Right(App.EXEName, 4) = "_new" Then CheckVersion 1 Else CheckVersion 2

'

'

'

'    In "CheckVersion" procedure add:

'

'            CheckVersion

'

'

' Enjoy ;o)

'



Option Explicit



Public Sub CheckVersion(Optional UpdateOption As Integer)



    On Error GoTo ErrHandle

    

    Dim intTim As Long, http, s As String, strFile As String, strServer As String

    strFile = Replace(App.Path & "\" & App.EXEName & ".exe", "\\", "\")

    

    ' !!! Server address !!!

    strServer = "[линк]"

    

    Select Case UpdateOption

        Case 0

            Set http = CreateObject("MSXML2.XMLHTTP")

            http.Open "GET", strServer & App.EXEName & ".exe_version.txt", False

            http.send

            

            'Check version

            s = http.responseText

            If Val(s) > Val(App.Revision) Then

                If MsgBox("New version found. Do you want download and install it?", vbYesNo, _

                          "New version") = vbYes Then

                    'Update program

                    Dim b() As Byte

                    http.Open "GET", strServer & App.EXEName & ".exe_install.bin", False

                    http.send

                    b = http.responseBody

                    If Dir(strFile & "_new.exe") <> "" Then Kill strFile & "_new.exe"

                    Open strFile & "_new.exe" For Binary As #1: DoEvents: Put #1, , b: Close

                    

                    intTim = Timer

                    Do Until Timer > intTim + 3 Or Timer = 3

                        DoEvents

                    Loop

                    

                    Shell strFile & "_new.exe", vbMinimizedFocus

                    End

                    

                End If

            Else

                MsgBox "No new version found.", vbInformation

            End If

            

            Exit Sub

            

        Case 1

            

            intTim = Timer

            Do Until Timer > intTim + 3 Or Timer = 3

                DoEvents

            Loop

            

            If Dir(Left(strFile, Len(strFile) - 8)) <> "" Then Kill Left(strFile, Len(strFile) - 8)

            FileCopy strFile, Left(strFile, Len(strFile) - 8)

            

            Shell Left(strFile, Len(strFile) - 8), vbNormalFocus

            End

            

            Exit Sub

            

        Case 2

            If Dir(strFile & "_new.exe") <> "" Then

                

                intTim = Timer

                Do Until Timer > intTim + 3 Or Timer = 3

                    DoEvents

                Loop

                

                Kill strFile & "_new.exe"

            End If

            

            Exit Sub

            

    End Select

    Exit Sub

    

ErrHandle:

    MsgBox "Error " & Err & ". " & Err.Description

End Sub

Та значи, в началото на функцията има ред "ServerAddress", където трябва да сложите линка към сървъра, където ще се качва обновлението. Евентуално, ако искате да ползвате домашния си компютър за сървър - е възможно да ползвате акаунт в No-ip.com където с безплатна регистрация можете да получите пренасочване към избран от вас IP адрес, и да си сложите някаква програмка за WEB страница, а потребителите ще си теглят на воля.

И така, модула съм го спретнал така, че да бъде универсален, и трябва единствено да се съобразяваме с името на приложението. Ако програмата се казва MyApp, тогава на сървъра за обновление слагаме преименувано ЕХЕ, с име MyApp.exe_install.bin и модула ще си го търси. За да може да сравнява версията на сървъра дали е по-нова от самия себе си - ползвам обикновен текстов файл с име MyApp.exe_version.txt качен в същия сървър. В този текстов файл записвам число равно на App.Revision на програмата, и с всяка компилация увеличавам това число, за да може работещия при клиенти софтуер да разбере, че има по-нова от него версия.

И така, на сървъра имаме файлове:
MyApp.exe_version.txt - съдържа версията
MyApp.exe_install.bin - съдържа по-нова версия на ЕХЕ-то

Модула отваря ТХТ-то, вижда, че има нова версия, тегли BIN файла, като го записва с друго име, и го стартира, след което спира автоматично, а новостартирания файл пък "вижда", че е обновление, и изтрива стария, като заема неговото място. В кода съм сложил изчакване по 3 секунди, за да е сигурно, че програмата е спряла, преди да се трие стария файл.

Аз слагам на сървъра и дистрибутив в саморазпакетиращ се RAR-ски архив, който разопакова в предварително зададена директория, и стартира Setup.bat, който регистрира външните контроли. Евентуално при по-големи обновления за BIN файл може да се сложи също такъв саморазпакетиращ се архив, и той ще си стартира ЕХЕ-то след като го извади (прави се в настройките на архива).

Модула е подходящ за малки приложения. Можем да доразработим идеята, ако на някой му се занимава.


Щирлиц