Смайлики

[Чудик]

И опять я наткнулся на то, чего не знаю.
Хочу на форме поместить анимированный смайлик, типа , но даже близко к этому подойти не получается. Задача решаема, как думаете?

[tyomitch]

Имхо едва ли.
По крайней мере, её решений я нигде не видел.

[alibek]

Отчего же, подобных ActiveX-контролов целая куча. Можно даже и без контрола, с таймером и PictureBox.
Искать по фразе "GIF-анимация"

[Чудик]

Ну, про таймер и PictureBox понятно, это что-то типа простой анимации в VB (или нет? - поправьте), но меня интересует непосредственно вставка готового смайлика. В этом случае, как я понимаю, необходима поддержка HTLM. А вот как ее организовать? Не знаю. Может и никак...

[tyomitch]

Project -> Components -> Microsoft Internet Controls

[tyomitch]

Отчего же, подобных ActiveX-контролов целая куча.

Я решил, что он хочет типа RichTextBox-а, но с поддержкой анимации. Видимо, мои телепатические способности меня вновь подвели...

[Чудик]

А-га, понятно. Дома попробую, авось, эксперимент завершиться успехом.

[Чудик]

Все - Запутался. Сбили с толку. Причем тут RichTextBox?

[tyomitch]

Все - Запутался. Сбили с толку. Причем тут RichTextBox?

Это ты меня сбил с толку, и я ошибочно решил, что он здесь при чём-то
Не обращай внимания

[Tarik]

А есть ли смысл городить огород с Microsoft Internet Controls, когда можно взять обычный контрол для gif?

[Чудик]

А можно поподробнее? До сих пор ничего не получилось с этими смайликами. Запарился. Или я торможу. Подтолкните.

[Ruslan Demidow]

Все - Запутался. Сбили с толку. Причем тут RichTextBox?

Это ты меня сбил с толку, и я ошибочно решил, что он здесь при чём-то
Не обращай внимания

А я обращу!!!
Где-то в начале лета я уже задавал вопрос в форуме по вставке изображений со смайлами в RichEditBox. Тогда мне толком так никто и не ответил, а очень хотелось бы увидеть пример вставки смайла в текст в ричедите.

[Шурик]

2Ruslan Demidow:
попробуй через буфер обмена, код не проверял

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

Private Const WM_PASTE = &H302
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal Msg As Long, ByVal wp As Long, lp As Any) _
As Long

Private Sub Command1_Click()
Dim pic As StdPicture
Set pic = LoadPicture("d:\a.bmp")
Clipboard.Clear
Clipboard.SetData pic, vbCFBitmap

SendMessage RichTextBox1.hwnd, WM_PASTE, 0, 0
End Sub


[Чудик]

Вопрос - а в этом случае анимация будет поддерживаться?

[alibek]

Нет, не будет.
Есть пример, в котором в RTB имеется анимированный смайлик. Но насколько я помню, в нем создано несколько RTB, один из которых видимый, остальные невидимые. И в каждый из них вставлены фреймы GIF. И таймер переключает видимый RTB.

[Чудик]

Ну, что - если нет иного выхода придется страдать непосредственно таким образом. Хотя ой как не хотелось!!!!!!!

[alibek]

А чем плох AniGif.ocx?
Если не хочется таскать с собой компонент, можно написать свой и использовать его внутри exe-шника.

[Чудик]

Эта идея лучше. Сам еще, видно, не в состоянии дойти. А про контрол не знал, хотя все-таки свой будет лучше.

[Ruslan Demidow]

2Ruslan Demidow:
попробуй через буфер обмена, код не проверял

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

Private Const WM_PASTE = &H302
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal Msg As Long, ByVal wp As Long, lp As Any) _
As Long

Private Sub Command1_Click()
Dim pic As StdPicture
Set pic = LoadPicture("d:\a.bmp")
Clipboard.Clear
Clipboard.SetData pic, vbCFBitmap

SendMessage RichTextBox1.hwnd, WM_PASTE, 0, 0
End Sub


Ок. Попробую. Спасибо.

[Ruslan Demidow]

2Ruslan Demidow:
попробуй через буфер обмена, код не проверял

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

Private Const WM_PASTE = &H302
==== Сгрызено моей собакой =====
SendMessage RichTextBox1.hwnd, WM_PASTE, 0, 0
End Sub


Спасибо. Код работает. Но смайлики круглые, gif-файлы вставляются квадратные. Всё что не входит в круг смайла (т.е. фон) - чёрное. На белом фоне смотрится не очень. Хочу сделать так, чтобы фон смайла был такой же как и фон текста в ричедите. Я так понял, что это нужно через API делать, но как? Ещё ни разу с графикой не сталкивался.
2 All:
Принцип я представляю себе так:
1. Берём первую точку из картинки. Пиксел 1,1.
2. Получаем цвет этой точки.
3. Заливаем все точки с цветом точки 1,1 цветом фона ричедита.
Ни первое, ни второе, ни третье я ещё ни разу в жизни не делал. Даже не знаю с чего начать. Помогите плиз.

[Ruslan Demidow]

Ну так что, так никто и не ответит на мой вопрос: как запихнуть смайлики в RTB?

[tyomitch]

Ruslan - можно прямо в рантайме из bmp сделать иконку. Пример был на vbrussian, я линк уже постил в тему в трёпе, где иконки собирались конвертировать.

[Ruslan Demidow]

Ruslan - можно прямо в рантайме из bmp сделать иконку. Пример был на vbrussian, я линк уже постил в тему в трёпе, где иконки собирались конвертировать.

Поищу, спасибо.
Но возник ещё один вопрос: на данный момент смайлы хранятся в ImageList. Оттуда загружаются в переменную pic as stdPicture.

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

Sub ShowSmailes()
    Dim pic As StdPicture
    Dim sSmail As String
    Dim sStart As Long, i As Integer
    Dim arrSmail(1 To 5)
    arrSmail(1) = ":)"
    arrSmail(2) = ";)"
    arrSmail(3) = ":("
    arrSmail(4) = ":-("
    arrSmail(5) = "%)"
    For i = 1 To UBound(arrSmail)
        SmailImageList.BackColor = MsgTextBox.BackColor
        Set pic = SmailImageList.ListImages("Smail" & i).Picture
        With MsgTextBox
            Do While .SelStart <> 0
                .SelStart = InStr(1, .Text, arrSmail(i)) '- 1
                If .SelStart <> 0 Then
                    .SelStart = .SelStart - 1
                    .SelLength = Len(arrSmail(i))
                    Clipboard.Clear
                    Clipboard.SetData pic
                    SendMessage .hwnd, WM_PASTE, 0, 0
                End If
            Loop
            .SelStart = 1
        End With
    Next i
End Sub


Но окантовка выходит чёрная. Если у пользователя фон будет чёрный - тогда всё пучком, если же пользователь выберет другой цвет фона у RTB, тогда эти смайлы не будут радовать глаз пользователя, а только раздражать как грязное пятно на чистом окне.
Хотелось бы избежать этого.
Я вот думаю : существует ли более лёгкий и простой путь добиться желаемого, кроме того который предполагаю я?

[tyomitch]

Если просто заменить строку

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

Set pic = SmailImageList.ListImages("Smail" & i).Picture


На

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

Set pic = SmailImageList.ListImages("Smail" & i).ExtractIcon


- не поможет?

[Ruslan Demidow]

Если просто заменить строку

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

Set pic = SmailImageList.ListImages("Smail" & i).Picture


На

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

Set pic = SmailImageList.ListImages("Smail" & i).ExtractIcon


- не поможет?

В строке Clipboard.SetData pic ругается на неверный формат буфера обмена. Если поставить Clipboard.SetData pic, vbCFBitmap то же самое.
Я попробовал все форматы - не принимает с ExtractIcon.
Видимо нужно как-то по другому в RTB вставлять рисунок/иконку (не через буфер обмена).

[tyomitch]

Ещё один вариант - взять данные иконки (GetIconInfo), скинуть hbmColor в отдельную битмапу, поверх него нарисовать фоновый цвет с маской из hbmMask (PatBlt), потом из полцучившегося битмапа сделать Picture (OleCreatePictureIndirect), и его уже кинуть в буфер

[Zer]

Хм... А не проще .gif файл открыть, раскодировать и востпроизводить спокойно анимацию. А можешь и контрол такой написать. Если интересует строение .gif файла, могу выслать.

[Ruslan Demidow]

Хм... А не проще .gif файл открыть, раскодировать и востпроизводить спокойно анимацию. А можешь и контрол такой написать. Если интересует строение .gif файла, могу выслать.

Если бы это для меня было так же просто как отрыть на чтение бинарный файл я бы так и поступил. Но с .gif'ами я не работал ещё ни разу, поэтому и спрашиваю. Я вот думаю: может быть на формат содержимого клипборда ругается потому что в имидж-листе хранятся изображения загруженные из гифов? Попробуй с bmp.
По поводу воспроизведения анимации - не до неё пока: мне бы нормально смайлы вставить в RTB... Без чёрной окантовки. Хотя в ArtIcons вместо окантовки показывает прозрачный фон.
Но от примера открытия гифа и показа его не откажусь.
Спасибо.

[Ruslan Demidow]

Ещё один вариант - взять данные иконки (GetIconInfo), скинуть hbmColor в отдельную битмапу, поверх него нарисовать фоновый цвет с маской из hbmMask (PatBlt), потом из полцучившегося битмапа сделать Picture (OleCreatePictureIndirect), и его уже кинуть в буфер

Во загнул. Я текст понял только в двух частях твоего повествования: до первой запятой и после последней запятой.
Но от примера, хотя бы схематичного (скелета) я не отказался бы.
Я не прошу сделать всё за меня (о чём возможно может кто-нибудь подумать).

[tyomitch]

Ruslan: нет, иконку в буфер действительно невозможно кинуть. То, что она из гифа, тут не при чём.
Готовый пример чтения гифа тоже есть на vbrussian