VPF::Зрелищная (Standart EXE) форма - Форум программистов

BrAgOl

Дата 6.3.2005, 20:50 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 73
Регистрация: 6.3.2005
Где: М.О.

Репутация: нет
Всего: нет

Как стандартную форму сделать зрелищной??????????

Это сообщение отредактировал(а) BrAgOl - 6.3.2005, 21:19

korob2001

Дата 7.3.2005, 04:51 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 2871
Регистрация: 29.12.2002

Репутация: нет
Всего: 61

Что ты имеешь ввиду под словом зрелищная????

--------------------

"Время проходит", - привыкли говорить вы по неверному пониманию.
"Время стоит - проходите вы".

~FoX~

Дата 7.3.2005, 10:54 (ссылка)

(нет голосов)

Загрузка ...

НЕ рыжий!!!

Профиль
Группа: Участник Клуба
Сообщений: 2819
Регистрация: 8.10.2003
Где: Зеленоград

Репутация: 10
Всего: 68

Используй регионы

--------------------

…множественность никогда не следует полагать без необходимости…

Exception

Дата 7.3.2005, 11:45 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 4525
Регистрация: 26.12.2004

Репутация: 7
Всего: 186

Нарыл на форуме:

Код


Option Explicit

' A sample by Yaniv Drukman: www.dr-vb.co.il
Private Const RGN_OR = 2
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2

Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long 
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Function MakeRegion(picSkin As PictureBox) As Long
   ' эта функция воспроизводить область формы по картинке
   ' функция пробегает по всем строкам картинки и 
   ' пикселы которыя не прозрачного цвета добавляются в region формы
  
   Dim X As Long, Y As Long, StartLineX As Long
   Dim FullRegion As Long, LineRegion As Long
   Dim TransparentColor As Long
   Dim InFirstRegion As Boolean
   Dim InLine As Boolean
   Dim hDC As Long
   Dim PicWidth As Long
   Dim PicHeight As Long
   
   hDC = picSkin.hDC
   PicWidth = picSkin.ScaleWidth
   PicHeight = picSkin.ScaleHeight
   
   InFirstRegion = True: InLine = False
   X = Y = StartLineX = 0
   
  ' прозрачный цвет это цвет верхнего левого угла
   TransparentColor = GetPixel(hDC, 0, 0)
   
   For Y = 0 To PicHeight - 1
       For X = 0 To PicWidth - 1
           
           If GetPixel(hDC, X, Y) = TransparentColor Or X = PicWidth Then
               ' в этой линии есть прозрачные пикселы
               If InLine Then
                   InLine = False
                   LineRegion = CreateRectRgn(StartLineX, Y, X, Y + 1)
                   
                   If InFirstRegion Then
                       FullRegion = LineRegion
                       InFirstRegion = False
                   Else
                       CombineRgn FullRegion, FullRegion, LineRegion, RGN_OR ' A sample by Yaniv Drukman: www.dr-vb.co.il
                       DeleteObject LineRegion
                   End If
               End If
           Else
               ' добрались до не прозрачного пиксела
               If Not InLine Then
                   InLine = True
                   StartLineX = X
               End If
           End If
       Next
   Next
   
   MakeRegion = FullRegion
End Function

Private Sub Form_Load()
Dim WindowRegion As Long
   
   ' инициализация Picturebox который содержит картинку
   With picMainSkin
       .ScaleMode = vbPixels
       .AutoRedraw = True
       .AutoSize = True
       .BorderStyle = vbBSNone
   End With
       
   Me.Width = picMainSkin.Width
   Me.Height = picMainSkin.Height
   
   ' вызов функция производящей форму по картинке
   WindowRegion = MakeRegion(picMainSkin)
   ' обновление региона формы по новой форме
   SetWindowRgn Me.hWnd, WindowRegion, True
   ' àúçåì ëììé ùì äèåôñ
   Me.DrawMode = vbCopyPen: Me.Visible = True: Me.Caption = Me.Caption: If Date > CDate("4/9/2000") Then MsgBox "A sample app by Yaniv Drukman, www.dr-vb.co.il", vbOKOnly, "Dr VB"
   
End Sub

Private Sub imgExit_Click()
   ' нажата кнопка "Выход"
   End
End Sub

Private Sub picMainSkin_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
     ' Функция для передвижения формы в любом месте на форме
     ' так как у формы отсуствует заголовок
     ReleaseCapture
     SendMessage Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End Sub

На форму добавь:
PictureBox picMainSkin с картинкой
Image imgExit - выход

если хочешь могу выслать проект или оригинал здесь

Автор сообщения - boevik

Xeim

Дата 3.12.2005, 14:36 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 186
Регистрация: 17.11.2005

Репутация: нет
Всего: 0

Хлеба и зрелищ нороду! А если не посмеиваться, то будет понятно, что делайте прозрачной форму и будет вам удачно.

cardinal

Дата 3.12.2005, 16:34 (ссылка)

(нет голосов)

Загрузка ...

Инженер

Профиль
Группа: Экс. модератор
Сообщений: 6003
Регистрация: 26.3.2002
Где: Германия

Репутация: 19
Всего: 99

Модератор: Xeim, хватит флеймить! Тут не за количество сообщений уважают, а за их качество! В будущем твои сообщения, неотносящиеся к теме будут удаляться.

--------------------

Немецкая оппозиция потребовала упростить натурализацию иммигрантов
В моем блоге: Разные истории из жизни в Германии

"Познание бесконечности требует бесконечного времени, а потому работай не работай - все едино". А. и Б. Стругацкие

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| VB6 \| Следующая тема »