| Вопрос: Внешний вид формы ввиде картинки | Добавлено: 17.11.06 22:35 |
Автор вопроса:  Patriot | ICQ: 439168318 |
|
Люди нужна помощь специалистов. Помогите плизз.
Излагаю суть проблемы, я уже довольно давно программирую на VB6, если быть точным 3 года, так вот, при создании нестандартных форм, ну с применением картинок, то возникает проблема с прорисовкой картинки, белый фон удаляется, но не полностью, по кроям остаются мелкие белые точки или полоски. Я перепробовал много разных кодов, но эффект один и додже. Я привиду исходный код примера, а вы может скажите где ошибка. Public Function RSS_region() Dim hRgn As Long, tRgn As Long Dim X As Integer, Y As Integer, X0 As Integer Dim hDC As Long, BT As BITMAP hDC = CreateCompatibleDC(frmReLAX.hDC) If hDC Then SelectObject hDC, frmReLAX.Picture GetObject frmReLAX.Picture, Len(BT), BT hRgn = CreateRectRgn(1, 0, BT.bmWidth, BT.bmHeight) For Y = 0 To BT.bmHeight For X = 0 To BT.bmWidth While X <= BT.bmWidth And GetPixel(hDC, X, Y) <> vbWhite X = X + 1 Wend X0 = X While X <= BT.bmWidth And GetPixel(hDC, X, Y) = vbWhite X = X + 1 Wend If X0 < X Then tRgn = CreateRectRgn(X0, Y - 2, X + 1, Y + 1) CombineRgn hRgn, hRgn, tRgn, 4 DeleteObject tRgn End If Next X Next Y SetWindowRgn frmReLAX.hwnd, hRgn, True DeleteObject SelectObject(hDC, frmReLAX.Picture) End If DeleteDC hDC End Function Надеюсь пояснять ненадо. Да ещё, при создание угольньных форм без огруглостей, код работает нормально. Я бы прилипил файл с картинкой - примером, но не допёр как. |
| Ответы | Всего ответов: 14 |
|
Номер ответа: 1 Автор ответа:  HACKER Разработчик Offline Client Вопросов: 236 Ответов: 8362 |
Профиль | | #1 | Добавлено: 17.11.06 23:32 |
|
Можно заюзать прозрачность для твоего белого
http://www.vbnet.ru/forum/show.aspx?id=122265 win2k only... Или улучшать алгоритм  А вообще для круглых, овальных итп итд... для идеального результата юзают CreateEllipticRgn
|
||
|
Номер ответа: 2 Автор ответа: SharpЛидер форума ICQ: 216865379 Вопросов: 106 Ответов: 9979 |
Web-сайт: Профиль | | #2 | Добавлено: 18.11.06 00:38 |
| Значит, эти точки не совсем белые. | ||
|
Номер ответа: 3 Автор ответа: Ra$cal ICQ: 8068014 Вопросов: 18 Ответов: 817 |
Web-сайт: Профиль | | #3 | Добавлено: 18.11.06 22:57 |
| Формат картинки должен быть без потери данных (bmp, png, gif) Jpg ни в коем случае использовать нельзя | ||
|
Номер ответа: 4 Автор ответа: Patriot ICQ: 439168318 Вопросов: 5 Ответов: 50 |
Профиль | | #4 | Добавлено: 23.11.06 21:22 |
|
Фотки использую "bmp", про "jpg" и говорить не стоило, это из опыта давно известно.
С CreateEllipticRgn, я тоже пробовал, но качество особо не улучшилось, а вот люди то умеют создавать красивые формы и не каких изъянов. Да ещё, Вы сами как создаёте, такие формы, поделитесь кодиком плизз, и вот ещё вопросик, как у Вас тут прицеплять файлы? |
||
|
Номер ответа: 5 Автор ответа: HACKERРазработчик Offline Client Вопросов: 236 Ответов: 8362 |
Профиль | | #5 | Добавлено: 23.11.06 22:00 |
|
Я лично такие формы не создаю - изврат имхо. Хотя есно если писать что-то декаративное, вроде авторана для диска, может изврат и оправдан... В серезном приложении кривая форма портит всю серезность приложения
А также я не цыпляю файлов У нас низя просто )
|
||
|
Номер ответа: 6 Автор ответа: PatriotICQ: 439168318 Вопросов: 5 Ответов: 50 |
Профиль | | #6 | Добавлено: 24.11.06 22:03 |
|
Ну, насчёт "портит" это ты не прав, красивый внешний вид это половина успеха на рынке ПО.
А насчёт авторана, ты это прав, терпеть их не могу и потому некогда их не делаю. |
||
|
Номер ответа: 7 Автор ответа: HACKERРазработчик Offline Client Вопросов: 236 Ответов: 8362 |
Профиль | | #7 | Добавлено: 26.11.06 20:17 |
| красивый внешний вид<>кривые формы | ||
|
Номер ответа: 8 Автор ответа: ArtyomРазработчик Вопросов: 130 Ответов: 6602 |
Профиль | | #8 | Добавлено: 26.11.06 20:22 |
| Красивый внешний вид = WPF | ||
|
Номер ответа: 9 Автор ответа: PatriotICQ: 439168318 Вопросов: 5 Ответов: 50 |
Профиль | | #9 | Добавлено: 26.11.06 21:57 |
|
Короче парни спорить не будим, Вы просто скажите, знаете или не знаете, как ето замутить, если нет, то придётся мне поискать на других сайтах.
|
||
|
Номер ответа: 10 Автор ответа: PatriotICQ: 439168318 Вопросов: 5 Ответов: 50 |
Профиль | | #10 | Добавлено: 26.11.06 22:04 |
| Да чуть не забыл поблагодарить всех, что ответили на вопрос, всем спосибо. | ||
|
Номер ответа: 11 Автор ответа: -АлександР-Вопросов: 55 Ответов: 1008 |
Web-сайт: Профиль | | #11 | Добавлено: 27.11.06 23:05 |
|
Public Function RSS_region()
Можно вопрос, а он у тебя долго выполняется?
Dim hRgn As Long, tRgn As Long Dim X As Integer, Y As Integer, X0 As Integer Dim hDC As Long, BT As BITMAP hDC = CreateCompatibleDC(frmReLAX.hDC) If hDC Then SelectObject hDC, frmReLAX.Picture GetObject frmReLAX.Picture, Len(BT), BT hRgn = CreateRectRgn(1, 0, BT.bmWidth, BT.bmHeight) For Y = 0 To BT.bmHeight For X = 0 To BT.bmWidth While X <= BT.bmWidth And GetPixel(hDC, X, Y) <> vbWhite X = X + 1 Wend X0 = X While X <= BT.bmWidth And GetPixel(hDC, X, Y) = vbWhite X = X + 1 Wend If X0 < X Then tRgn = CreateRectRgn(X0, Y - 2, X + 1, Y + 1) CombineRgn hRgn, hRgn, tRgn, 4  eleteObject tRgn
End If Next X Next Y SetWindowRgn frmReLAX.hwnd, hRgn, True eleteObject SelectObject(hDC, frmReLAX.Picture)
End If eleteDC hDC
End Function |
||
|
Номер ответа: 12 Автор ответа: -АлександР-Вопросов: 55 Ответов: 1008 |
Web-сайт: Профиль | | #12 | Добавлено: 27.11.06 23:10 |
|
Patriot, ты в каком-то смысле мой коллега
Да ещё, Вы сами как создаёте, такие формы, поделитесь кодиком плизз, и вот ещё вопросик, как у Вас тут прицеплять файлы? Ну что ж, на твой выбор предлагаю (а ты уж сам выберешь или что-то новое найдешь)
1)Его я нашел где-то в интернете: Option Explicit
Private Declare Function SelectClipPath Lib "gdi32" (ByVal hdc As Long, ByVal iMode As Long) As Long Private Declare Function BeginPath Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function EndPath Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function PathToRegion Lib "gdi32" (ByVal hdc 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 Const RGN_COPY = 5 Private Sub Form_Load() ' Don't forget to set Form.BorderStyle property to None ! Const TXT = " Cool programm" & vbCrLf & " from" & vbCrLf & "Cool Company" & vbCrLf & "CopyLeft by Ark" Dim hRgn As Long Font.Name = "Times New Roman" Font.Bold = True Font.Size = 60 Width = TextWidth(TXT) Height = TextHeight(TXT) BeginPath hdc Print TXT ' Здесь вместо текста можно рисовать фигуры EndPath hdc hRgn = PathToRegion(hdc) SetWindowRgn hWnd, hRgn, False 'Hачинаем фантазировать с формой. Можно так 'Picture = LoadPicture("c:\windows\облака.bmp" 
' А можно так ' dclr = 256 / (TextHeight(TXT) / 30) ' clr = 0 ' For i = 120 To 120 + TextHeight(TXT) Step 30 ' Line (0, i)-Step(5000, 0), RGB(0, 0, clr) ' clr = clr + dclr ' Next i ' Можно дать форме градиентную заливку и т.д. ' Двигаем к центру, а можно в таймере крутить Move (Screen.Width - Width) / 2, (Screen.Height - Height) / 2 End Sub 2)А вот над этим я долго сам бился: Option Explicit
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal H As Long, ByVal W As Long, ByVal E As Long, ByVal O As Long, ByVal W2 As Long, ByVal i As Long, ByVal u As Long, ByVal S As Long, ByVal c As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal f As String) As Long Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long Private Declare Function BeginPath Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long Private Declare Function EndPath Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function PathToRegion Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long Private Type POINTAPI x As Long y As Long End Type Private Declare Function Ellipse Lib "gdi32" (ByVal hdc As Long, _ ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long Private Function SetCreateForm(ByVal propHwnd As Long, ByVal propHDC As Long) Dim rComb As Long Dim dl As Long Dim vFont As Long Dim vFontOld As Long Dim vDC As Long Dim f As POINTAPI vDC = propHDC vFont = CreateFont(24, 0, 0, 0, 400, 0, 0, 0, 1, 1, 1, 2, 2, "Times New Roman"
vFontOld = SelectObject(vDC, vFont) dl = BeginPath(vDC) Call TextOut(vDC, 107, 60, "Новый", 5) Ellipse hdc, 100, 100, 300, 500 Call MoveToEx(vDC, 0, 0, f) Call LineTo(vDC, 100, 100) dl = EndPath(vDC) rComb = PathToRegion(vDC) dl = SelectObject(vDC, vFontOld) dl = DeleteObject(vFont) dl = SetWindowRgn(propHwnd, rComb, 1) End Function Private Sub Form_Load() Call SetCreateForm(Form1.hwnd, Form1.hdc) End Sub |
||
|
Номер ответа: 13 Автор ответа: -АлександР-Вопросов: 55 Ответов: 1008 |
Web-сайт: Профиль | | #13 | Добавлено: 27.11.06 23:21 |
|
3)Эту идею мне подсказал HACKER (thank's ему)
Private Sub Form_DblClick()
Dim ret As Long ret = GetWindowLong(Me.hWnd, GWL_EXSTYLE) ret = ret Or WS_EX_LAYERED SetWindowLong Me.hWnd, GWL_EXSTYLE, ret SetLayeredWindowAttributes Me.hWnd, CLR_BLACK, 128, LWA_COLORKEY End Sub И в модуле: Option Explicit
Все понятно, все известно?
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _  ByVal hWnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _ ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, _ ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long Public Const GWL_EXSTYLE = (-20) Public Const WS_EX_LAYERED = &H80000 Public Const LWA_COLORKEY = &H1 Public Const LWA_ALPHA = &H2 Public Const CLR_WHITE = &HFFFFFF Public Const CLR_BLACK = &H0& Последний случай делает прозрачным заданный цвет. Т. е. делаешь форму того цвета, и ставишь её без бордюра |
||
|
Номер ответа: 14 Автор ответа: PatriotICQ: 439168318 Вопросов: 5 Ответов: 50 |
Профиль | | #14 | Добавлено: 01.12.06 23:43 |
|
-АлександР-, мне было некогда и потому не заглядывал на форум, но ладно, хоть и с запозданием, но всё же заглянул, ты спросил долго ли выполняется мой код, понятия долга у всех разное, для меня принципе пойдёт, можно было конечно же побыстрее но всё же пойдёт.
На счёт кодов, мне немного некогда было смотреть и потому, ответ напишу немного позже. Спасибо за примеры |
||
Страница: 1 |