Форум программистов, компьютерный форум, киберфорум
Наши страницы
Visual Basic
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.85/20: Рейтинг темы: голосов - 20, средняя оценка - 4.85
Timofej
0 / 0 / 0
Регистрация: 22.07.2012
Сообщений: 16
#1

Создание Крестика в центре экрана

27.07.2012, 20:26. Просмотров 3651. Ответов 14
Метки нет (Все метки)

Помогите плиз. Хочу сделать так:

Вот чтобы открыл программу, нажал (допустим) на End и в центре экрана появился крестик Crosshair. Кто поможет? Плиз дайте код и обьясните че как делать. Заранее благодарен =)

Добавлено через 58 минут
Забыл, еще можно чтобы так: нажал на End-крестик появился, снова нажал на End - крестик исчез
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
27.07.2012, 20:26
Ответы с готовыми решениями:

Форма в центре экрана
Подскажите пожалуйста как сделать чтобы форма возникала всегда в определённых...

Как вывести форму желтого цвета в центре экрана
Разработать приложение с выводом формы желтого цвета в центре экрана и...

Создание своего "хранителя экрана"
Хочу сделать программу для контроля действий пользователя. Задачи: Отслеживать,...

Точка получается не в центре
У меня такая проблема, есть код Option Explicit Private Declare Function...

Печать текста в центре прямоугольника
Как разместить текст симметрично в центре прямоугольника, чтобы при...

14
dev.Free
Заблокирован
27.07.2012, 20:56 #2
Само просто! Вложенный файл смотри. Вообще если пользоваться поисковой системой yandex, google, можно столько всего найти интересного ! ! ! !


С найденным материалом немного экспериментов и все готово ! ! ! !
1
Вложения
Тип файла: rar Новая папка.rar (1.5 Кб, 362 просмотров)
Dragokas
Эксперт WindowsАвтор FAQ
16969 / 7054 / 856
Регистрация: 25.12.2011
Сообщений: 10,868
Записей в блоге: 16
28.07.2012, 19:57 #3
А вызов по комбинации (детекцию) клавиш какой командой организовывается, если крутить в обычном модуле?
0
dev.Free
Заблокирован
28.07.2012, 20:10 #4
Цитата Сообщение от Dragokas Посмотреть сообщение
А вызов по комбинации (детекцию) клавиш какой командой организовывается, если крутить в обычном модуле?

Не по теме:

Теперь ему на русском скажи, что ты сейчас написал ))))

0
Dragokas
Эксперт WindowsАвтор FAQ
16969 / 7054 / 856
Регистрация: 25.12.2011
Сообщений: 10,868
Записей в блоге: 16
29.07.2012, 16:53 #5
Какой аналог Application.Onkey для VB?

Добавлено через 15 часов 28 минут
inv.DS, вообще это был вопрос TC.

Делаем Do... Loop в модуле. Как отследить нажатие клавиши End?
0
Dragokas
Эксперт WindowsАвтор FAQ
16969 / 7054 / 856
Регистрация: 25.12.2011
Сообщений: 10,868
Записей в блоге: 16
30.07.2012, 23:35 #6
Актуально.
0
PAnT0P
1023 / 547 / 106
Регистрация: 26.03.2012
Сообщений: 987
31.07.2012, 07:57 #7
Лучший ответ Сообщение было отмечено как решение

Решение

Цитата Сообщение от Dragokas Посмотреть сообщение
Актуально.
В модуле
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Public Const DT_CENTER = &H1
Public Const DT_WORDBREAK = &H10
 
Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
 
Declare Function DrawTextEx Lib "user32" Alias "DrawTextExA" (ByVal hDC As Long, ByVal lpsz As String, ByVal n As Long, lpRect As RECT, ByVal un As Long, ByVal lpDrawTextParams As Any) As Long
Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Global Cnt As Long, sSave As String, sOld As String, Ret As String
Dim Tel As Long
 
Function GetPressedKey() As String
    For Cnt = 32 To 128
        'Get the keystate of a specified key
        If GetAsyncKeyState(Cnt) <> 0 Then
            GetPressedKey = Chr$(Cnt)
            Exit For
        End If
    Next Cnt
End Function
 
Sub TimerProc(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long)
    Ret = GetPressedKey
    If Ret <> sOld Then
        sOld = Ret
        sSave = sSave + sOld
    End If
End Sub
В форме
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Private Sub Form_Load()
    'KPD-Team 1999
    'URL: [url]http://www.allapi.net/[/url]
    'E-Mail: [email]KPDTeam@Allapi.net[/email]
    Me.Caption = "Key Spy"
    'Create an API-timer
    SetTimer Me.hwnd, 0, 1, AddressOf TimerProc
End Sub
 
Private Sub Form_Paint()
    Dim R As RECT
    Const mStr = "Start this project, go to another application, type something, switch back to this application and unload the form. If you unload the form, a messagebox with all the typed keys will be shown."
    'Clear the form
    Me.Cls
    'API uses pixels
    Me.ScaleMode = vbPixels
    'Set the rectangle's values
    SetRect R, 0, 0, Me.ScaleWidth, Me.ScaleHeight
    'Draw the text on the form
    DrawTextEx Me.hDC, mStr, Len(mStr), R, DT_WORDBREAK Or DT_CENTER, ByVal 0&
End Sub
 
Private Sub Form_Resize()
    Form_Paint
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    'Kill our API-timer
    KillTimer Me.hwnd, 0
    'Show all the typed keys
    MsgBox sSave
End Sub
1
Shok Wave
5 / 5 / 1
Регистрация: 21.01.2013
Сообщений: 49
23.06.2013, 17:02 #8
А как это работает? В Модуле все пишу, в форме тоже, запускаю - появляется окно с англ текстом, а что дальше?
0
PAnT0P
1023 / 547 / 106
Регистрация: 26.03.2012
Сообщений: 987
23.06.2013, 19:22 #9
Цитата Сообщение от Shok Wave Посмотреть сообщение
А как это работает? В Модуле все пишу, в форме тоже, запускаю - появляется окно с англ текстом, а что дальше?
Перевожу текст который ты видишь:
Запустите проект, перейдите в другую программу, понажимайте любые клавиши, вернитесь обратно в это окно и закройте его. Появится окно с сообщением какие клавиши вы нажимали в другом приложении.
В катце это пример как перехватывать нажатие клавиш в другом приложении.

PS. Обрати внимание что это не перехват набранного текста, а именно перехват клавиш, т.е. если ты наберешь что то вроде "йцукен" программа выведет "QWERTY"
0
Shok Wave
5 / 5 / 1
Регистрация: 21.01.2013
Сообщений: 49
23.06.2013, 20:15 #10
Цитата Сообщение от PAnT0P Посмотреть сообщение
Перевожу текст который ты видишь:

В катце это пример как перехватывать нажатие клавиш в другом приложении.

PS. Обрати внимание что это не перехват набранного текста, а именно перехват клавиш, т.е. если ты наберешь что то вроде "йцукен" программа выведет "QWERTY"
Так это получается немного не по теме о_О. Человеку нужен был крестик в центре, а ты ему дал "Key Spy" =)
0
PAnT0P
1023 / 547 / 106
Регистрация: 26.03.2012
Сообщений: 987
23.06.2013, 20:28 #11
Цитата Сообщение от Shok Wave Посмотреть сообщение
Так это получается немного не по теме о_О. Человеку нужен был крестик в центре, а ты ему дал "Key Spy" =)
Ему нужен был крестик по нажатию клавиши в чужом приложении
Цитата Сообщение от Timofej Посмотреть сообщение
Вот чтобы открыл программу, нажал (допустим) на End и в центре экрана появился крестик Crosshair
0
The trick
Модератор
7360 / 2579 / 754
Регистрация: 22.02.2013
Сообщений: 3,797
Записей в блоге: 76
23.06.2013, 23:38 #12
Лучший ответ Сообщение было отмечено The trick как решение

Решение

Может через горячие клавиши?
Модуль:
Кликните здесь для просмотра всего текста
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Option Explicit
 
Private Const WM_HOTKEY = &H312
Public Const GWL_WNDPROC = -4
 
Public Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Public Declare Function UnregisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long) As Long
Public Declare Function GlobalAddAtom Lib "kernel32" Alias "GlobalAddAtomA" (ByVal lpString As String) As Long
Public Declare Function GlobalDeleteAtom Lib "kernel32" (ByVal nAtom As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 
Public oProc As Long
Public hAt As Long
Dim EndState As Boolean
 
Public Function WindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Select Case Msg
    Case WM_HOTKEY
        If wParam = hAt Then EndState = Not EndState
        If EndState Then frmCross.Move (Screen.Width - frmCross.Width) / 2, (Screen.Height - frmCross.Height) / 2
        frmCross.Visible = EndState
    End Select
    WindowProc = CallWindowProc(oProc, hwnd, Msg, wParam, lParam)
End Function

Главная форма:
Кликните здесь для просмотра всего текста
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
Option Explicit
 
Private Sub Form_Load()
    oProc = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf WindowProc)
    hAt = GlobalAddAtom("MyHotkey")
    Call RegisterHotKey(Me.hwnd, hAt, 0, vbKeyEnd)
End Sub
Private Sub Form_Unload(Cancel As Integer)
    Call SetWindowLong(Me.hwnd, GWL_WNDPROC, oProc)
    Call UnregisterHotKey(Me.hwnd, hAt)
    Call GlobalDeleteAtom(hAt)
End Sub

Форма-"крестик":
Кликните здесь для просмотра всего текста
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Option Explicit
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
 
Private Const LWA_COLORKEY = &H1
Private Const LWA_ALPHA = &H2
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Const HWND_TOPMOST = -1
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
 
 
Private Sub Form_Load()
    Dim Style As Long
    Me.BackColor = vbWhite
    Me.Line (Me.ScaleWidth / 2, 0)-Step(0, Me.ScaleHeight)
    Me.Line (0, Me.ScaleHeight / 2)-Step(Me.ScaleWidth, 0)
    Style = GetWindowLong(Me.hwnd, GWL_EXSTYLE) Or WS_EX_LAYERED
    SetWindowLong Me.hwnd, GWL_EXSTYLE, Style
    SetLayeredWindowAttributes Me.hwnd, vbWhite, 0, LWA_COLORKEY
End Sub
 
Private Sub Form_Resize()
    SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE
End Sub
2
Миниатюры
Создание Крестика в  центре экрана  
Вложения
Тип файла: rar Hotkey.rar (2.5 Кб, 52 просмотров)
Shok Wave
5 / 5 / 1
Регистрация: 21.01.2013
Сообщений: 49
25.06.2013, 10:15 #13
А где можно изменить размеры крестика? Я что-то не нахожу(
0
The trick
Модератор
7360 / 2579 / 754
Регистрация: 22.02.2013
Сообщений: 3,797
Записей в блоге: 76
25.06.2013, 10:24 #14
Измени размер формы frmCross
0
Shok Wave
5 / 5 / 1
Регистрация: 21.01.2013
Сообщений: 49
25.06.2013, 10:46 #15
Цитата Сообщение от The trick Посмотреть сообщение
Измени размер формы frmCross
Менял, нифига
0
25.06.2013, 10:46
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
25.06.2013, 10:46

Макроопределения на очистку экрана, установку курсора в центре экрана, вывод теста на экран
добрый вечер, может кто помочь с Макроопределениями на очистку экрана,...

Нарисовать с помощью отдельных точек синусоиду зеленого цвета в центре экрана на всю ширину экрана
Нарисовать с помощью отдельных точек синусоиду зеленого цвета в центре экрана...

В центре экрана нарисуйте эллипс, закрашенный цветом LightGreen, всю остальную площадь экрана сделайте фиолетовой.
помогите пожалуйста!!!уже не знаю что делать....ничего в графическом не...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
15
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru