Private Declare Function RelaseCapture Lib "user21" () as Long
Private Declare Function SendMessage Lib "use32" Aliase "SendMessageA" (ByVal hWnd As Long, ByVal wMsg as Long, ByVal wParam As Long, lParam As Any) As Long
'---
Private Sub Header_MouseDown(Button As Integer, Shift As Integer,X As Single, Y As Single)
'---Таскаем форму за заголовок
RelaceCapture
SendMessage Me.hWhnd, &HA1, 2, 9&
End Sub
Private Sub CmdMin_Click()
Me.WindowsState=1
End Sub
Private Sub CmdMax_Click()
CmdMax.Visible=False
CmdRest.Visivle=True
'Кнопки Max и Rest занимают одно и тоже место
my_Left=Me.Left:my_Top=Me.Top:my_Width=Me.Width:
my_Height=Me.Height
'Запомнили старую позицию окна
Me.Move 0,0,Screen.Width,Screen.Heigth-360
' здесь бы надо бы заблокировать чтоб мышкой нельзя было изменять размер, но я не знаю как
End Sub
Private Sub CmdRest_Click()
CmdRest.Visible=False
CmdMax.Visible=True
Me.Move my_Left, my_Top, my_Width, my_Height
End Sub
Private Sub Form_Resize()
If Me.WindowsState=1 Then
Me.Caption="My_Text":Exit Sub
Else
Me.Caption=""
End If
'Далее позицирую элементы формы
End Sub
Без кнопки [_]
Как сделать окно с кнопками [font="Courier New"][ؾ][X][/font] но что бы кнопка [font="Courier New"][_][/font] была замазана ?
MinButton = False :D:D:D Наверно я где-то головой ударился :)
а вобще круче/прикольнее/красивее делать через лабел верхушку, и там можно рисовать любые кнопки, любым шрифтом и тп
[QUOTE=Nik_Tair]Private Sub Form_Load()
Me.MinButton=False
End Sub[/QUOTE]
Гы...ну дак я очем?читай пост2
Me.MinButton=False
End Sub[/QUOTE]
Гы...ну дак я очем?читай пост2
[QUOTE=KAN]а вобще круче/прикольнее/красивее делать через лабел верхушку, и там можно рисовать любые кнопки, любым шрифтом и тп[/QUOTE]
Это как?
Это как?
Ух ты! Какой прикольный ник у тебя:) Возникают ассоциации о звёздных войнах сразу... Сорри... Отвлёкся...:D
Короче делаешь у формы свойство BorderStyle = 0 - None.
У тебя пропадает сверху привычная икспишная полоска и тут понеслось. Хочешь заголовок - ставь лабел сверху, хочешь кнопку закрытия - ставь в углу какую-нибудь красивую кнопку и пиши ей в коде просто End. И т.д.
Короче делаешь у формы свойство BorderStyle = 0 - None.
У тебя пропадает сверху привычная икспишная полоска и тут понеслось. Хочешь заголовок - ставь лабел сверху, хочешь кнопку закрытия - ставь в углу какую-нибудь красивую кнопку и пиши ей в коде просто End. И т.д.
[QUOTE=ace lighting]Короче делаешь у формы свойство BorderStyle = 0 - None.
У тебя пропадает сверху привычная икспишная полоска и тут понеслось. Хочешь заголовок - ставь лабел сверху, хочешь кнопку закрытия - ставь в углу какую-нибудь красивую кнопку и пиши ей в коде просто End. И т.д.[/QUOTE]
Если ставишь BorderStyle=0, то размеры окна нельзя менять.
Вот фрагмент моего кода:
Нельзья ли это сделать по-красивие?
У тебя пропадает сверху привычная икспишная полоска и тут понеслось. Хочешь заголовок - ставь лабел сверху, хочешь кнопку закрытия - ставь в углу какую-нибудь красивую кнопку и пиши ей в коде просто End. И т.д.[/QUOTE]
Если ставишь BorderStyle=0, то размеры окна нельзя менять.
Вот фрагмент моего кода:
Код:
Нельзья ли это сделать по-красивие?
чтобы размеры можно было менять, то ControlBox ставишь False и стираешь Caption формы. Верхняя полоска пропадёт, а форма будет красиво и плавно заканчиваться на краях и размеры можно будет менять.
Я наверное забыл сказать, что заголовок обязательно должен быть стандартным (виндозовским). А про все выше описанные приколы я уже давно знаю.
[QUOTE=Звездная_мышка]Если ставишь BorderStyle=0, то размеры окна нельзя менять.
Вот фрагмент моего кода:
Нельзья ли это сделать по-красивие?[/QUOTE]
Если я правильно понял, то когда ты разворачиваешь окно, то его можно опять мышкой рисайзнуть. Вот код:
Вот фрагмент моего кода:
Код:
Private Declare Function RelaseCapture Lib "user21" () as Long
Private Declare Function SendMessage Lib "use32" Aliase "SendMessageA" (ByVal hWnd As Long, ByVal wMsg as Long, ByVal wParam As Long, lParam As Any) As Long
'---
Private Sub Header_MouseDown(Button As Integer, Shift As Integer,X As Single, Y As Single)
'---Таскаем форму за заголовок
RelaceCapture
SendMessage Me.hWhnd, &HA1, 2, 9&
End Sub
Private Sub CmdMin_Click()
Me.WindowsState=1
End Sub
Private Sub CmdMax_Click()
CmdMax.Visible=False
CmdRest.Visivle=True
'Кнопки Max и Rest занимают одно и тоже место
my_Left=Me.Left:my_Top=Me.Top:my_Width=Me.Width:
my_Height=Me.Height
'Запомнили старую позицию окна
Me.Move 0,0,Screen.Width,Screen.Heigth-360
' здесь бы надо бы заблокировать чтоб мышкой нельзя было изменять размер, но я не знаю как
End Sub
Private Sub CmdRest_Click()
CmdRest.Visible=False
CmdMax.Visible=True
Me.Move my_Left, my_Top, my_Width, my_Height
End Sub
Private Sub Form_Resize()
If Me.WindowsState=1 Then
Me.Caption="My_Text":Exit Sub
Else
Me.Caption=""
End If
'Далее позицирую элементы формы
End Sub
Private Declare Function SendMessage Lib "use32" Aliase "SendMessageA" (ByVal hWnd As Long, ByVal wMsg as Long, ByVal wParam As Long, lParam As Any) As Long
'---
Private Sub Header_MouseDown(Button As Integer, Shift As Integer,X As Single, Y As Single)
'---Таскаем форму за заголовок
RelaceCapture
SendMessage Me.hWhnd, &HA1, 2, 9&
End Sub
Private Sub CmdMin_Click()
Me.WindowsState=1
End Sub
Private Sub CmdMax_Click()
CmdMax.Visible=False
CmdRest.Visivle=True
'Кнопки Max и Rest занимают одно и тоже место
my_Left=Me.Left:my_Top=Me.Top:my_Width=Me.Width:
my_Height=Me.Height
'Запомнили старую позицию окна
Me.Move 0,0,Screen.Width,Screen.Heigth-360
' здесь бы надо бы заблокировать чтоб мышкой нельзя было изменять размер, но я не знаю как
End Sub
Private Sub CmdRest_Click()
CmdRest.Visible=False
CmdMax.Visible=True
Me.Move my_Left, my_Top, my_Width, my_Height
End Sub
Private Sub Form_Resize()
If Me.WindowsState=1 Then
Me.Caption="My_Text":Exit Sub
Else
Me.Caption=""
End If
'Далее позицирую элементы формы
End Sub
Нельзья ли это сделать по-красивие?[/QUOTE]
Если я правильно понял, то когда ты разворачиваешь окно, то его можно опять мышкой рисайзнуть. Вот код:
Код:
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 Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Const SM_CXSCREEN = 0
Const SM_CYSCREEN = 1
Const HWND_TOP = 0
Const SWP_SHOWWINDOW = &H40
Private Sub Command1_Click()
Dim ll_Width As Long
Dim ll_Height As Long
If Me.WindowState = vbMaximized Then
WindowState = vbNormal
End If
ll_Width = GetSystemMetrics(SM_CXSCREEN)
ll_Height = GetSystemMetrics(SM_CYSCREEN)
Call SetWindowPos(Me.hwnd, HWND_TOP, 0, 0, ll_Width, ll_Height, SWP_SHOWWINDOW)
End Sub
Private Sub Command2_Click()
WindowState = vbMaximized
End Sub
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Const SM_CXSCREEN = 0
Const SM_CYSCREEN = 1
Const HWND_TOP = 0
Const SWP_SHOWWINDOW = &H40
Private Sub Command1_Click()
Dim ll_Width As Long
Dim ll_Height As Long
If Me.WindowState = vbMaximized Then
WindowState = vbNormal
End If
ll_Width = GetSystemMetrics(SM_CXSCREEN)
ll_Height = GetSystemMetrics(SM_CYSCREEN)
Call SetWindowPos(Me.hwnd, HWND_TOP, 0, 0, ll_Width, ll_Height, SWP_SHOWWINDOW)
End Sub
Private Sub Command2_Click()
WindowState = vbMaximized
End Sub
Вот мой готовый пример создания формы со своим Контролбоксом
Это отличная мысль, сделать свое окно. Сделал небольшой пример, с ре-size-ом возникли проблеммы, слишком тормозной у меня получился. (Попробуй изменить размер со вкл. прозрачностью, и ты узнаешь, чего твой комп стоит, :))) )
Подскажите, кто знает как рамку цветную сделать вокруг окна, вместо это "объемной"-виндосовской. Я из-за неё и не хочу стандартным, "sizeble", окном пользоваться.
Выкладываю здесь свой проджект:
Подскажите, кто знает как рамку цветную сделать вокруг окна, вместо это "объемной"-виндосовской. Я из-за неё и не хочу стандартным, "sizeble", окном пользоваться.
Выкладываю здесь свой проджект:
Что-то не получается здесь выложить свой примерчик, если кого заинтересует, он в разделе исходники - Temp.zip
Кажется я нашла лучшее решение:
Цитата:
Option Explicit
Private Declare Function ReleaseCapture Lib "user32" () 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 CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, _*
ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 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 Type POINTAPI
X As Long
Y As Long
End Type
Const minWidth = 480
Const minHeight = 320
Private Sub cmdClose_Click()
End
End Sub
Private Sub cmdMax_Click()
Me.WindowState = 2
cmdMax.Visible = False
cmdRest.Visible = True
Call RedrawMe
End Sub
Private Sub cmdMin_Click()
Me.WindowState = 1
End Sub
Private Sub cmdRest_Click()
Me.WindowState = 0
cmdRest.Visible = False
cmdMax.Visible = True
Call RedrawMe
End Sub
Private Sub Form_Resize()
On Error Resume Next 'на всякий случай
If Left(Me.Width - minWidth, 1) = "-" Then Me.Width = minWidth 'ограничение на мин размер окна
If Left(Me.Height - minHeight, 1) = "-" Then Me.Height = minHeight
Dim newRgn As Long
newRgn = CreateRoundRectRgn(0, 0, Width / Screen.TwipsPerPixelX, Height / Screen.TwipsPerPixelY, _
2* Screen.TwipsPerPixelX, 2* Screen.TwipsPerPixelY) 'создали новый регион
Call SetWindowRgn(hWnd, newRgn, True) 'и сделали из него новую основу для окна
Call RedrawMe
End Sub
Private Sub imgDnLt_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'изменяем размер окна таская за нижний левый угол
If Me.WindowState <> 0 Then Exit Sub 'изменять размер окна можно когда оно имеет атрибут нормал
Call ReleaseCapture
Call SendMessage (Me.hWnd, &H112, &HF008, 0)
Call RedrawMe
End Sub
Private Sub imgDnLt_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call RedrawMe
End Sub
Private Sub imgDnRt_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'изменяем размер окна таская за нижний правый угол
If Me.WindowState <> 0 Then Exit Sub
Call ReleaseCapture
Call SendMessage (Me.hWnd, &H112, &HF008, 0)
Call RedrawMe
End Sub
Private Sub imgDnRt_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call RedrawMe
End Sub
Private Sub imgFrameDn_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'изменяем размер окна таская за нижнюю рамку окна
If Me.WindowState <> 0 Then Exit Sub
Call ReleaseCapture
Call SendMessage (Me.hWnd, &H112, &HF006, 0)
End Sub
Private Sub imgFrameDn_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call RedrawMe
End Sub
Private Sub imgFrameLt_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'изменяем размер окна таская за левую рамку окна
If Me.WindowState <> 0 Then Exit Sub
Call ReleaseCapture
Call SendMessage (Me.hWnd, &H112, &HF002, 0)
Call RedrawMe
End Sub
Private Sub imgFrameLt_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call RedrawMe
End Sub
Private Sub imgFrameRt_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'изменяем размер окна таская за правую рамку окна
If Me.WindowState <> 0 Then Exit Sub
Call ReleaseCapture
Call SendMessage (Me.hWnd, &H112, &HF002, 0)
Call RedrawMe
End Sub
Private Sub imgFrameRt_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call RedrawMe
End Sub
Private Sub imgTopHead_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'таскаем окно за заголовок
If Me.WindowState <> 0 Then Exit Sub
Call ReleaseCapture
Call SendMessage (Me.hWnd, &H112, &HF012, 0)
Call RedrawMe
End Sub
Private Sub FormCapt_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Me.WindowState <> 0 Then Exit Sub
Call ReleaseCapture
Call SendMessage (Me.hWnd, &H112, &HF012, 0)
Call RedrawMe
End Sub
Private Sub RedrawMe()
Dim i As Integer
'рисуем заголовок
imgTopHead.Width = Me.Width
imgTopHead.DrawWidth = Screen.TwipsPerPixelX
imgTopHead.ScaleWidth = 255
'левый угол
imgTopLt.Move 0, 0
'правый угол
imgTopRt.Move Me.Width - imgTopRt.Width - Screen.TwipsPerPixelX, 0
'кнопки
cmdMin.Move imgTopHead.Width - 1060, 60
cmdMax.Move imgTopHead.Width - 750, 60
cmdRest.Move cmdMax.Left, cmdMax.Top
cmdClose.Move imgTopHead.Width - 390, 60
'левый нижний угол
imgDnLt.Move 0, Me.Height - imgDnLt.Height - Screen.TwipsPerPixelY
'правый нижний угол
imgDnRt.Move Me.Width - imgDnRt.Width - Screen.TwipsPerPixelX, Me.Height - imgDnRt.Height
'левая граница
imgFrameLt.Move 0, imgTopHead.Height, 5 * Screen.TwipsPerPixelX, Me.Height - imgTopHead.Height - imgDnLt.Height
imgFrameLt.Line (0, 0)-(0, imgFrameLt.Height), RGB(223, 223, 223)
imgFrameLt.Line (Screen.TwipsPerPixelY, 0)-(Screen.TwipsPerPixelY, imgFrameLt.Height), RGB(255, 255, 255)
'правая граница
imgFrameRt.Move Me.Width - 5 * Screen.TwipsPerPixelX, imgTopHead.Height, 5 * Screen.TwipsPerPixelX, _
Me.Height - imgTopHead.Height - imgDnRt.Height
imgFrameRt.Line (2*Screen.TwipsPerPixelY, 0)-(2*Screen.TwipsPerPixelY, imgFrameRt.Height), RGB(127, 127, 127)
imgFrameRt.Line (3*Screen.TwipsPerPixelY, 0)-(3*Screen.TwipsPerPixelY, imgFrameRt.Height), RGB(0, 0, 0)
'нижняя граница
imgFrameDn.Move imgDnLt.Width, Me.Height - imgFrameDn.Height - Screen.TwipsPerPixelY, _
Me.Width - imgDnLt.Width - imgFrameRt.Width, 5 * Screen.TwipsPerPixelY
imgFrameDn.Line (0, imgFrameDn.Height - Screen.TwipsPerPixelY)-(imgFrameDn.Width, imgFrameDn.Height - Screen.TwipsPerPixelY), _
RGB(0, 0, 0)
imgFrameDn.Line (0, imgFrameDn.Height - 2 * Screen.TwipsPerPixelY)-(imgFrameDn.Width, imgFrameDn.Height - 2 * Screen.TwipsPerPixelY), _
RGB(127, 127, 127)
'место для меню
imgMenu.Move imgFrameLt.Width, imgTopHead.Height, Me.Width - imgFrameLt.Width - imgFrameRt.Width, 480
'Клиетская область
ClientArea.Move imgFrameLt.Width, imgMenu.Top + imgMenu.Height, Me.Width - imgFrameLt.Width - imgFrameRt.Width, _
Me.Height - imgTopHead.Height - imgMenu.Height - imgDnRt.Height
'заливка заголовка
For i = 0 To 255
imgTopHead.Line (i, 0)-(i, imgTopHead.Height), RGB(255, 0, 255 - i), B
Next i
'рамка заголовка
imgTopHead.DrawWidth = 1
imgTopHead.ScaleWidth = imgTopHead.Width
imgTopHead.Line (0, 0)-(0, imgTopHead.Height), RGB(223, 223, 223)
imgTopHead.Line (Screen.TwipsPerPixelX, Screen.TwipsPerPixelY)- _
(Screen.TwipsPerPixelX, imgTopHead.Height), RGB(255, 255, 255)
imgTopHead.Line (imgTopHead.Width - 2 * Screen.TwipsPerPixelX, Screen.TwipsPerPixelY)- _
(imgTopHead.Width - 2 * Screen.TwipsPerPixelX, imgTopHead.Height), RGB(127, 127, 127)
imgTopHead.Line (imgTopHead.Width - Screen.TwipsPerPixelX, 0)- _
(imgTopHead.Width - Screen.TwipsPerPixelX, imgTopHead.Height), RGB(0, 0, 0)
imgTopHead.Line (0, 0)-(imgTopHead.Width, 0), RGB(223, 223, 223)
imgTopHead.Line (Screen.TwipsPerPixelX, Screen.TwipsPerPixelY)- _
(imgTopHead.Width - Screen.TwipsPerPixelX, Screen.TwipsPerPixelY), RGB(255, 255, 255)
imgTopHead.Line (Screen.TwipsPerPixelX, imgTopHead.Height - Screen.TwipsPerPixelY)- _
(imgTopHead.Width - Screen.TwipsPerPixelX, imgTopHead.Height - Screen.TwipsPerPixelY), RGB(191, 0, 63)
'left lines
imgTopHead.Line (375, 120)-(750, 120), RGB(223, 223, 223)
imgTopHead.Line (375, 135)-(750, 135), RGB(127, 127, 127)
imgTopHead.Line (375, 180)-(750, 180), RGB(223, 223, 223)
imgTopHead.Line (375, 195)-(750, 195), RGB(127, 127, 127)
imgTopHead.Line (375, 240)-(750, 240), RGB(223, 223, 223)
imgTopHead.Line (375, 255)-(750, 255), RGB(127, 127, 127)
FormCapt.Move 850, 60
'right lines
imgTopHead.Line (FormCapt.Left + FormCapt.Width + 60, 120)-(imgTopHead.Width - 1200, 120), RGB(223, 223, 223)
imgTopHead.Line (FormCapt.Left + FormCapt.Width + 60, 135)-(imgTopHead.Width - 1200, 135), RGB(127, 127, 127)
imgTopHead.Line (FormCapt.Left + FormCapt.Width + 60, 180)-(imgTopHead.Width - 1200, 180), RGB(223, 223, 223)
imgTopHead.Line (FormCapt.Left + FormCapt.Width + 60, 195)-(imgTopHead.Width - 1200, 195), RGB(127, 127, 127)
imgTopHead.Line (FormCapt.Left + FormCapt.Width + 60, 240)-(imgTopHead.Width - 1200, 240), RGB(223, 223, 223)
imgTopHead.Line (FormCapt.Left + FormCapt.Width + 60, 255)-(imgTopHead.Width - 1200, 255), RGB(127, 127, 127)
End Sub
Private Declare Function ReleaseCapture Lib "user32" () 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 CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, _*
ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 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 Type POINTAPI
X As Long
Y As Long
End Type
Const minWidth = 480
Const minHeight = 320
Private Sub cmdClose_Click()
End
End Sub
Private Sub cmdMax_Click()
Me.WindowState = 2
cmdMax.Visible = False
cmdRest.Visible = True
Call RedrawMe
End Sub
Private Sub cmdMin_Click()
Me.WindowState = 1
End Sub
Private Sub cmdRest_Click()
Me.WindowState = 0
cmdRest.Visible = False
cmdMax.Visible = True
Call RedrawMe
End Sub
Private Sub Form_Resize()
On Error Resume Next 'на всякий случай
If Left(Me.Width - minWidth, 1) = "-" Then Me.Width = minWidth 'ограничение на мин размер окна
If Left(Me.Height - minHeight, 1) = "-" Then Me.Height = minHeight
Dim newRgn As Long
newRgn = CreateRoundRectRgn(0, 0, Width / Screen.TwipsPerPixelX, Height / Screen.TwipsPerPixelY, _
2* Screen.TwipsPerPixelX, 2* Screen.TwipsPerPixelY) 'создали новый регион
Call SetWindowRgn(hWnd, newRgn, True) 'и сделали из него новую основу для окна
Call RedrawMe
End Sub
Private Sub imgDnLt_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'изменяем размер окна таская за нижний левый угол
If Me.WindowState <> 0 Then Exit Sub 'изменять размер окна можно когда оно имеет атрибут нормал
Call ReleaseCapture
Call SendMessage (Me.hWnd, &H112, &HF008, 0)
Call RedrawMe
End Sub
Private Sub imgDnLt_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call RedrawMe
End Sub
Private Sub imgDnRt_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'изменяем размер окна таская за нижний правый угол
If Me.WindowState <> 0 Then Exit Sub
Call ReleaseCapture
Call SendMessage (Me.hWnd, &H112, &HF008, 0)
Call RedrawMe
End Sub
Private Sub imgDnRt_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call RedrawMe
End Sub
Private Sub imgFrameDn_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'изменяем размер окна таская за нижнюю рамку окна
If Me.WindowState <> 0 Then Exit Sub
Call ReleaseCapture
Call SendMessage (Me.hWnd, &H112, &HF006, 0)
End Sub
Private Sub imgFrameDn_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call RedrawMe
End Sub
Private Sub imgFrameLt_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'изменяем размер окна таская за левую рамку окна
If Me.WindowState <> 0 Then Exit Sub
Call ReleaseCapture
Call SendMessage (Me.hWnd, &H112, &HF002, 0)
Call RedrawMe
End Sub
Private Sub imgFrameLt_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call RedrawMe
End Sub
Private Sub imgFrameRt_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'изменяем размер окна таская за правую рамку окна
If Me.WindowState <> 0 Then Exit Sub
Call ReleaseCapture
Call SendMessage (Me.hWnd, &H112, &HF002, 0)
Call RedrawMe
End Sub
Private Sub imgFrameRt_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call RedrawMe
End Sub
Private Sub imgTopHead_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'таскаем окно за заголовок
If Me.WindowState <> 0 Then Exit Sub
Call ReleaseCapture
Call SendMessage (Me.hWnd, &H112, &HF012, 0)
Call RedrawMe
End Sub
Private Sub FormCapt_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Me.WindowState <> 0 Then Exit Sub
Call ReleaseCapture
Call SendMessage (Me.hWnd, &H112, &HF012, 0)
Call RedrawMe
End Sub
Private Sub RedrawMe()
Dim i As Integer
'рисуем заголовок
imgTopHead.Width = Me.Width
imgTopHead.DrawWidth = Screen.TwipsPerPixelX
imgTopHead.ScaleWidth = 255
'левый угол
imgTopLt.Move 0, 0
'правый угол
imgTopRt.Move Me.Width - imgTopRt.Width - Screen.TwipsPerPixelX, 0
'кнопки
cmdMin.Move imgTopHead.Width - 1060, 60
cmdMax.Move imgTopHead.Width - 750, 60
cmdRest.Move cmdMax.Left, cmdMax.Top
cmdClose.Move imgTopHead.Width - 390, 60
'левый нижний угол
imgDnLt.Move 0, Me.Height - imgDnLt.Height - Screen.TwipsPerPixelY
'правый нижний угол
imgDnRt.Move Me.Width - imgDnRt.Width - Screen.TwipsPerPixelX, Me.Height - imgDnRt.Height
'левая граница
imgFrameLt.Move 0, imgTopHead.Height, 5 * Screen.TwipsPerPixelX, Me.Height - imgTopHead.Height - imgDnLt.Height
imgFrameLt.Line (0, 0)-(0, imgFrameLt.Height), RGB(223, 223, 223)
imgFrameLt.Line (Screen.TwipsPerPixelY, 0)-(Screen.TwipsPerPixelY, imgFrameLt.Height), RGB(255, 255, 255)
'правая граница
imgFrameRt.Move Me.Width - 5 * Screen.TwipsPerPixelX, imgTopHead.Height, 5 * Screen.TwipsPerPixelX, _
Me.Height - imgTopHead.Height - imgDnRt.Height
imgFrameRt.Line (2*Screen.TwipsPerPixelY, 0)-(2*Screen.TwipsPerPixelY, imgFrameRt.Height), RGB(127, 127, 127)
imgFrameRt.Line (3*Screen.TwipsPerPixelY, 0)-(3*Screen.TwipsPerPixelY, imgFrameRt.Height), RGB(0, 0, 0)
'нижняя граница
imgFrameDn.Move imgDnLt.Width, Me.Height - imgFrameDn.Height - Screen.TwipsPerPixelY, _
Me.Width - imgDnLt.Width - imgFrameRt.Width, 5 * Screen.TwipsPerPixelY
imgFrameDn.Line (0, imgFrameDn.Height - Screen.TwipsPerPixelY)-(imgFrameDn.Width, imgFrameDn.Height - Screen.TwipsPerPixelY), _
RGB(0, 0, 0)
imgFrameDn.Line (0, imgFrameDn.Height - 2 * Screen.TwipsPerPixelY)-(imgFrameDn.Width, imgFrameDn.Height - 2 * Screen.TwipsPerPixelY), _
RGB(127, 127, 127)
'место для меню
imgMenu.Move imgFrameLt.Width, imgTopHead.Height, Me.Width - imgFrameLt.Width - imgFrameRt.Width, 480
'Клиетская область
ClientArea.Move imgFrameLt.Width, imgMenu.Top + imgMenu.Height, Me.Width - imgFrameLt.Width - imgFrameRt.Width, _
Me.Height - imgTopHead.Height - imgMenu.Height - imgDnRt.Height
'заливка заголовка
For i = 0 To 255
imgTopHead.Line (i, 0)-(i, imgTopHead.Height), RGB(255, 0, 255 - i), B
Next i
'рамка заголовка
imgTopHead.DrawWidth = 1
imgTopHead.ScaleWidth = imgTopHead.Width
imgTopHead.Line (0, 0)-(0, imgTopHead.Height), RGB(223, 223, 223)
imgTopHead.Line (Screen.TwipsPerPixelX, Screen.TwipsPerPixelY)- _
(Screen.TwipsPerPixelX, imgTopHead.Height), RGB(255, 255, 255)
imgTopHead.Line (imgTopHead.Width - 2 * Screen.TwipsPerPixelX, Screen.TwipsPerPixelY)- _
(imgTopHead.Width - 2 * Screen.TwipsPerPixelX, imgTopHead.Height), RGB(127, 127, 127)
imgTopHead.Line (imgTopHead.Width - Screen.TwipsPerPixelX, 0)- _
(imgTopHead.Width - Screen.TwipsPerPixelX, imgTopHead.Height), RGB(0, 0, 0)
imgTopHead.Line (0, 0)-(imgTopHead.Width, 0), RGB(223, 223, 223)
imgTopHead.Line (Screen.TwipsPerPixelX, Screen.TwipsPerPixelY)- _
(imgTopHead.Width - Screen.TwipsPerPixelX, Screen.TwipsPerPixelY), RGB(255, 255, 255)
imgTopHead.Line (Screen.TwipsPerPixelX, imgTopHead.Height - Screen.TwipsPerPixelY)- _
(imgTopHead.Width - Screen.TwipsPerPixelX, imgTopHead.Height - Screen.TwipsPerPixelY), RGB(191, 0, 63)
'left lines
imgTopHead.Line (375, 120)-(750, 120), RGB(223, 223, 223)
imgTopHead.Line (375, 135)-(750, 135), RGB(127, 127, 127)
imgTopHead.Line (375, 180)-(750, 180), RGB(223, 223, 223)
imgTopHead.Line (375, 195)-(750, 195), RGB(127, 127, 127)
imgTopHead.Line (375, 240)-(750, 240), RGB(223, 223, 223)
imgTopHead.Line (375, 255)-(750, 255), RGB(127, 127, 127)
FormCapt.Move 850, 60
'right lines
imgTopHead.Line (FormCapt.Left + FormCapt.Width + 60, 120)-(imgTopHead.Width - 1200, 120), RGB(223, 223, 223)
imgTopHead.Line (FormCapt.Left + FormCapt.Width + 60, 135)-(imgTopHead.Width - 1200, 135), RGB(127, 127, 127)
imgTopHead.Line (FormCapt.Left + FormCapt.Width + 60, 180)-(imgTopHead.Width - 1200, 180), RGB(223, 223, 223)
imgTopHead.Line (FormCapt.Left + FormCapt.Width + 60, 195)-(imgTopHead.Width - 1200, 195), RGB(127, 127, 127)
imgTopHead.Line (FormCapt.Left + FormCapt.Width + 60, 240)-(imgTopHead.Width - 1200, 240), RGB(223, 223, 223)
imgTopHead.Line (FormCapt.Left + FormCapt.Width + 60, 255)-(imgTopHead.Width - 1200, 255), RGB(127, 127, 127)
End Sub
Для всех картинок Autoredraw=True
Выглядит примерно так:
Звездная, будь человеком, выложи проект целиком! Так неохота код перекладывать на др. имэйджи.... (-_-)
Цитата:
Кажется я нашла лучшее решение:
[QUOTE]код:...
[QUOTE]код:...
Для всех картинок Autoredraw=True[/QUOTE]
Класс!!!:) :D :o ;)
Кнопочки и уголки