Изменение формы у формы

[Kovu]

Народ, помогите сделать форму в виде сердечка Я знаю что в шрифте Monotype Coursiva есть сердечко,, но я не знаю его код(так его можно увидеть набрав Alt+3 на цифровой клаве)

[tyomitch]

Код: Выделить всё

Option Explicit
Private Declare Function DrawWideChars Lib "user32.dll" Alias "DrawTextW" (ByVal hDC As Long, lpChar As Integer, ByVal nCount As Long, ByRef lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function BeginPath Lib "gdi32.dll" (ByVal hDC As Long) As Long
Private Declare Function EndPath Lib "gdi32.dll" (ByVal hDC As Long) As Long
Private Declare Function PathToRegion Lib "gdi32.dll" (ByVal hDC As Long) As Long
Private Declare Function SetWindowRgn Lib "user32.dll" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Const DT_NOCLIP = &H100

Private Sub Form_Load()
Dim rc As RECT
AutoRedraw = True
FontName = "Monotype Corsiva"
FontSize = 144
BeginPath hDC
DrawWideChars hDC, &H2665, 1, rc, DT_NOCLIP
EndPath hDC
SetWindowRgn hWnd, PathToRegion(hDC), False
End Sub


[Kovu]

tyomitch
Спасибо что в очередной раз выручил, ГУРУ

[Kovu]

tyomitch
У меня возник логичный вопрос :
А как строку содержащую больше чем один знак таким образом написать Ведь мы передаем функции 2 параметром не строку а число

[d3drm]

ржунимагу! "форма в форме" сердечка! может еще элементы управления в форме звездочек, ангелочков и цветочков сделать? А!!!! ЛОЛ!

[Kovu]

d3drm
Если мозгов понять для чего мне форма в виде сердечка не хватает не надо насмехаться

[GSerg]

Дык Тёмыч - он хитрый
lpChar As Integer замени на byval s as string.

[Павлуша]

Kovu
ты кончно извини, но скажи, какого ты пола? если Ж, то ладно, а если М - то тоже понятно - программу для девушки пишешь... LOL!!!

[Kovu]

Павлуша
Да я и не сильно обиделся
Если кто не знает-Kovu-сын Шрама из Lion King 2:Simba's Pride

[Kovu]

GSerg
Я имел ввиду чтоб и строка была и символы особые
Такие уж мы требовательные

[tyomitch]

Дык Тёмыч - он хитрый
lpChar As Integer замени на byval s as string.

Не сработает ввиду того, что надо передавать Unicode-строку.

А мне нравится передавать массив Integer-ов:

Код: Выделить всё

Option Explicit
Private Declare Function DrawWideChars Lib "user32.dll" Alias "DrawTextW" (ByVal hDC As Long, lpChar As Integer, ByVal nCount As Long, ByRef lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function BeginPath Lib "gdi32.dll" (ByVal hDC As Long) As Long
Private Declare Function EndPath Lib "gdi32.dll" (ByVal hDC As Long) As Long
Private Declare Function PathToRegion Lib "gdi32.dll" (ByVal hDC As Long) As Long
Private Declare Function SetWindowRgn Lib "user32.dll" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Const DT_NOCLIP = &H100

Private Sub Form_Load()
Dim MyChars(4) As Integer
MyChars(0) = &HB7
MyChars(1) = &H42F
MyChars(2) = &H20
MyChars(3) = &H2665
MyChars(4) = &H222B

Dim rc As RECT
AutoRedraw = True
FontName = "Monotype Corsiva"
FontSize = 144
BeginPath hDC
DrawWideChars hDC, MyChars(0), 5, rc, DT_NOCLIP
EndPath hDC
SetWindowRgn hWnd, PathToRegion(hDC), False

Width = 9600
End Sub


Kovu, так подходит?

[Kovu]

tyomitch
СПАСИБО
З.Ы.:А DrawTextW в 98 виндоусе есть (для просвещения

[Kovu]

SetWindowRgn hWnd, PathToRegion(hDC), False
Лучше True

[tyomitch]

1. Нету. Можно заменить его на TextOutW, который есть на всех платформах.
2. Чем лучше-то? В Form_Load никакой разницы всё равно нет.

[Kovu]

Да потому что во время отладки я ставлю бол-во событий на кнопку
А вообще огромное спасибо !!!!

[Kovu]

tyomitch
А можно подсказать как заменить , т.к. попытка передать &H2665 показала большой красивый прямоугольник вместо сердечка
З.Ы.:А можно перевести свою подпись, латынь плохо знаю

[tyomitch]

Проверь - так должно работать.

Код: Выделить всё

Option Explicit
Private Declare Function WideCharsOut Lib "gdi32.dll" Alias "TextOutW" (ByVal hDC As Long, ByVal nXStart As Long, ByVal nYStart As Long, lpChar As Integer, ByVal nCount As Long) As Long
Private Declare Function BeginPath Lib "gdi32.dll" (ByVal hDC As Long) As Long
Private Declare Function EndPath Lib "gdi32.dll" (ByVal hDC As Long) As Long
Private Declare Function PathToRegion Lib "gdi32.dll" (ByVal hDC As Long) As Long
Private Declare Function SetWindowRgn Lib "user32.dll" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Const DT_NOCLIP = &H100

Private Sub Form_Load()
Dim MyChars(4) As Integer
MyChars(0) = &HB7
MyChars(1) = &H42F
MyChars(2) = &H20
MyChars(3) = &H2665
MyChars(4) = &H222B

AutoRedraw = True
FontName = "Monotype Corsiva"
FontSize = 144
BeginPath hDC
WideCharsOut hDC, 0, 0, MyChars(0), 5
EndPath hDC
SetWindowRgn hWnd, PathToRegion(hDC), False

Width = 9600
End Sub


Сорри, если тема уже потеряла актуальность.

[Kovu]

Спасибо ещё раз!!!
Выручил

[GSerg]

Предлагаю не страдать фигнёй с массивами, а объявить-таки как Long и передавать StrPtr
Ибо строки всё-таки

[tyomitch]

GSerg, как ты вставишь такую строку в текст программы? VS6 же не может сохранять исходники в юникоде

Или будешь передавать StrPtr(ChrW(&HB7) & ChrW(&H42F) & ChrW(&H20) & ChrW(&H2665) & ChrW(&H222B)) Так это ничуть не проще массивов

[Kovu]

Предлагаю не страдать фигнёй с массивами, а объявить-таки как Long и передавать StrPtr
Ибо строки всё-таки

А ты попробуй лонг объяви и посмотришь как виндоус весело закроет твою программу с ошибкой

[GSerg]

Ну, объявил.
И чё?
Снова "Роль ByVal в истории"?

[Kovu]

Ну, объявил.
И чё?
Снова "Роль ByVal в истории"?

И чё и чё
Передай &H2665 и увидишь

[tyomitch]

Kovu, надо передавать ByVal StrPtr(ChrW(&HB7) & ChrW(&H42F) & ChrW(&H20) & ChrW(&H2665) & ChrW(&H222B))
Только вот нафига это тебе, никак не пойму?

[Kovu]

Kovu, надо передавать ByVal StrPtr(ChrW(&HB7) & ChrW(&H42F) & ChrW(&H20) & ChrW(&H2665) & ChrW(&H222B))
Только вот нафига это тебе, никак не пойму?

Тёмыч я сообщения все читаю мне твой способ большн нравится конечно
Просто я показал что функция с лонг может выдать ошибку а с интегером никогда

[AlexBlack]

up

А почему качество у этиx самых регионов просто ужасает?
У меня к примеру вааще какие левые пикселы есть, а каких то наоборот нет, хотя должы быть....

[tyomitch]

шрифт трутайпный?

[AlexBlack]

Arial

[AlexBlack]

Так а что мне теперь делать-то?
Мне нужно Ариалом хоть со стула упади!

[AlexBlack]

А другого способа нет?