ReSQL.ru
     
powered by simpleCommunicator - 2.0.56     © 2025 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / WinForms, .Net Framework [игнор отключен] [закрыт для гостей] / А как Net-овского рисования получить Ptr на Type: HBITMAP?
10 сообщений из 10, страница 1 из 1
А как Net-овского рисования получить Ptr на Type: HBITMAP?
    #38398264
Дмитрий77
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Дмитрий77
Участник
Объясняю вопрос.
На форме есть ребар (API), в нем есть Band.
Band описан структурой REBARBANDINFO structure
В которой в частности имеет честь быть
hbmBack
Type: HBITMAP
Handle to a bitmap that is used as the background for this band.

Предполагаемый (рабочий) код на стороне API ( потребитель битмапа ):
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
    Dim rbBand As REBARBANDINFO
...
      With rbBand
        .cbSize = Marshal.SizeOf(rbBand)
        .fMask = ReBarBandInfoMasks.RBBIM_BACKGROUND
        .hbmBack = <HBITMAP>
      End With
      SendMessage_REBARBANDINFO(g_hwndRebar, RB_SETBANDINFOA, 0, rbBand)



Предполагаемый рабочий .NET код (надо допиливать, но думаю справлюсь) - поставщик битмапа :

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
Imports System.Drawing.Drawing2D
...
  Private clrBGTop1 As Color = Color.FromArgb(255, 127, 166, 191)
  Private clrBGTop2 As Color = Color.FromArgb(255, 4, 72, 117)
  Private clrBGBottom1 As Color = Color.FromArgb(255, 57, 117, 156)
  Private clrBGBottom2 As Color = Color.FromArgb(150, 255, 255, 255)
  'Private clrBGBorder As Color = Color.FromArgb(200, 176, 200, 216)
  Private clrBGGreen As Color = Color.FromArgb(100, 57, 161, 133)
...
    Dim topRect As New Rectangle(0, 0, PictureBox1.Width + 2, 16)
    Dim bottomRect As New Rectangle(0, 16, PictureBox1.Width + 2, 16)
    Dim bottomGradRect As New Rectangle(0, 23, PictureBox1.Width + 2, 7)
    Dim fullRect As New Rectangle(0, 0, PictureBox1.Width + 2, 31)

    Dim topBrush As New LinearGradientBrush(topRect, clrBGTop1, clrBGBottom1, LinearGradientMode.Vertical)
    Dim bottomBrush As New LinearGradientBrush(bottomRect, clrBGTop2, clrBGBottom2, LinearGradientMode.Vertical)
    Dim bottomGradBrush As New LinearGradientBrush(bottomGradRect, clrBGTop2, clrBGBottom2, LinearGradientMode.Vertical)
    Dim horGradBrush As New LinearGradientBrush(fullRect, Color.Transparent, clrBGGreen, LinearGradientMode.Horizontal)

    Dim gr As Graphics = PictureBox1.CreateGraphics()

    gr.FillRectangle(topBrush, topRect)
    gr.FillRectangle(bottomBrush, bottomRect)
    gr.FillRectangle(horGradBrush, fullRect)
 
    gr.Dispose()


-рабочесть состоит в том что оно рисует что мне надо.

Мне надо как-то засунуть это дело в <HBITMAP>.

Сразу скажу что в VB6 использовалось:

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
Public g_picRebarBackground As IPictureDisp

Set g_picRebarBackground = CreateGradientBackground(<грубо ширина ребар>, <грубо высота ребар>)

'CreateGradientBackground -в двух словах создание CreateCompatibleBitmap через чистое GDI+/- и рисование на его hdc

...CreateIPictureDispFromHBITMAP(hbmDst) ==OleCreatePictureIndirect

      .hbmBack = g_picRebarBackground.Handle



P.S. Если бы это был Net.какой-то_стрип, то
Код: vbnet
1.
2.
3.
    Protected Overrides Sub OnRenderToolStripBackground(ByVal e As System.Windows.Forms.ToolStripRenderEventArgs)
        MyBase.OnRenderToolStripBackground(e)
  e.graphics ..и т.д.


Но об этом речь не идет, то бишь очень прошу воздержаться от общих рассуждений.
В данном случае нужен HBitmap .
...
Рейтинг: 0 / 0
17.09.2013, 02:41
| Ответить | Цитировать | Написать  
А как Net-овского рисования получить Ptr на Type: HBITMAP?
    #38398279
Дмитрий77
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Дмитрий77
Участник
Похоже на правду?
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
   Public hBitmap_RebarBackground As IntPtr
...

   If hBitmap_RebarBackground <> IntPtr.Zero Then
      DeleteObject(hBitmap_RebarBackground)
      hBitmap_RebarBackground = IntPtr.Zero
    End If
    hBitmap_RebarBackground = CreateGradientBackComplexPlus(Form1.ClientRectangle.Width)
    With rbBand
      .cbSize = Marshal.SizeOf(rbBand)
      .fMask = ReBarBandInfoMasks.RBBIM_BACKGROUND
      .hbmBack = hBitmap_RebarBackground
    End With
    SendMessage_REBARBANDINFO(g_hwndRebar, RB_SETBANDINFOA, 0, rbBand)

  Public Function CreateGradientBackComplexPlus(ByVal m_intWidth As Integer) As IntPtr
    Dim bmp = New Bitmap(m_intWidth, 32, Imaging.PixelFormat.Format32bppArgb)
    Dim gr = Graphics.FromImage(bmp)
    DrawGradientBackground(gr, m_intWidth)
    Dim hBitmap As IntPtr = bmp.GetHbitmap()
    gr.Dispose()
    bmp.Dispose()
    Return hBitmap
  End Function

  Private Sub DrawGradientBackground(ByVal objGraphics As Graphics, ByVal m_intWidth As Integer)
...
    objGraphics.FillRectangle(topBrush, topRect)
    objGraphics.FillRectangle(bottomBrush, bottomRect)
    objGraphics.FillRectangle(horGradBrush, fullRect)

  End Sub
...
Рейтинг: 0 / 0
17.09.2013, 05:31
| Ответить | Цитировать | Написать  
А как Net-овского рисования получить Ptr на Type: HBITMAP?
    #38398281
Дмитрий77
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Дмитрий77
Участник
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
    Dim topBrush As New LinearGradientBrush(topRect, clrBGTop1, clrBGBottom1, LinearGradientMode.Vertical)
    Dim bottomBrush As New LinearGradientBrush(bottomRect, clrBGTop2, clrBGBottom2, LinearGradientMode.Vertical)
    Dim horGradBrush As New LinearGradientBrush(fullRect, Color.Transparent, clrBGGreen, LinearGradientMode.Horizontal)

    objGraphics.FillRectangle(topBrush, topRect)
    objGraphics.FillRectangle(bottomBrush, bottomRect)
    objGraphics.FillRectangle(horGradBrush, fullRect)



Вопрос на засыпку.
Что говорит .NET на тему


Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
  GradientFill hdcDst, v1(0), 2 * (b + 1), t(0), b * 2, GRADIENT_FILL_TRIANGLE

Private Declare Function GradientFill Lib "msimg32" ( _
 ByVal hdc As Long, pVertex As TRIVERTEX, ByVal dwNumVertex As Long, _
 pMesh As Any, ByVal dwNumMesh As Long, _
 ByVal dwMode As GradientFillMode) As BOOL

...
Private Type TRIVERTEX
  x As Long
  y As Long
  Red As Integer
  Green As Integer
  Blue As Integer
  Alpha As Integer
End Type

Private Type GRADIENT_TRIANGLE
  Vertex1 As Long
  Vertex2 As Long
  Vertex3 As Long
End Type

Private Enum GradientFillMode
  GRADIENT_FILL_RECT_H
  GRADIENT_FILL_RECT_V
  GRADIENT_FILL_TRIANGLE
  GRADIENT_FILL_OP_FLAG = 255
End Enum



Т.е. по хорошему:
заданы 4 цвета по краям прямоугольника (градиент по вертикали и горизонтали).
???
...
Рейтинг: 0 / 0
17.09.2013, 05:49
| Ответить | Цитировать | Написать  
А как Net-овского рисования получить Ptr на Type: HBITMAP?
    #38399137
Фотография fortibransa
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
fortibransa
Участник
В NET этих градиентов как грязи, в wpf так вообще Directx рисует.
...
Рейтинг: 0 / 0
17.09.2013, 16:58
| Ответить | Цитировать | Написать  
А как Net-овского рисования получить Ptr на Type: HBITMAP?
    #38399142
Фотография fortibransa
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
fortibransa
Участник
см PathGradientBrush
...
Рейтинг: 0 / 0
17.09.2013, 17:00
| Ответить | Цитировать | Написать  
А как Net-овского рисования получить Ptr на Type: HBITMAP?
    #38399521
Дмитрий77
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Дмитрий77
Участник
fortibransa,
посмотрю на PathGradientBrush.

Ну, по идее в "API-шном" коде что я доделал:
 
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
214.
215.
216.
217.
218.
219.
220.
221.
222.
223.
224.
225.
226.
227.
228.
229.
230.
231.
232.
233.
234.
235.
236.
237.
238.
239.
240.
241.
242.
243.
244.
245.
246.
247.
248.
249.
250.
251.
252.
253.
254.
255.
256.
257.
258.
259.
260.
  <StructLayout(LayoutKind.Sequential)>
  Private Structure TRIVERTEX
    Dim x As Integer
    Dim y As Integer
    Dim Red As Int16
    Dim Green As Int16
    Dim Blue As Int16
    Dim Alpha As Int16
  End Structure

  <StructLayout(LayoutKind.Sequential)>
  Private Structure GRADIENT_TRIANGLE
    Dim Vertex1 As Integer
    Dim Vertex2 As Integer
    Dim Vertex3 As Integer
  End Structure

  <StructLayout(LayoutKind.Sequential)>
  Private Structure TLongX1
    Dim L0 As Integer
  End Structure

  <StructLayout(LayoutKind.Sequential)>
  Private Structure TIntegerX2
    Dim I0 As Int16
    Dim I1 As Int16
  End Structure

  <StructLayout(LayoutKind.Sequential)>
  Private Structure TRGBAQuad
    Dim Red As Byte
    Dim Green As Byte
    Dim Blue As Byte
    Dim Alpha As Byte
  End Structure

  Private Enum GradientFillMode
    GRADIENT_FILL_RECT_H
    GRADIENT_FILL_RECT_V
    GRADIENT_FILL_TRIANGLE
    GRADIENT_FILL_OP_FLAG = 255
  End Enum

  Private Declare Function GradientFill Lib "msimg32" ( _
   ByVal hdc As IntPtr, ByRef pVertex As TRIVERTEX, ByVal dwNumVertex As Integer, _
   ByRef pMesh As GRADIENT_TRIANGLE, ByVal dwNumMesh As Integer, _
   ByVal dwMode As GradientFillMode) As Boolean

  Private Const TRIVERTEX_MAX_ALPHA As Int16 = -256 '&HFF00

  Private Declare Function GetDC Lib "user32" (ByVal hwnd As IntPtr) As IntPtr
  Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As IntPtr) As IntPtr
  Private Declare Function CreateCompatibleBitmap Lib "gdi32" ( _
   ByVal hdc As IntPtr, ByVal nWidth As Integer, ByVal nHeight As Integer) As IntPtr
  Private Declare Function SelectObject Lib "gdi32" ( _
   ByVal hdc As IntPtr, ByVal hObject As IntPtr) As IntPtr
  Private Declare Function DeleteDC Lib "gdi32" ( _
   ByVal hdc As IntPtr) As Boolean
  Private Declare Sub CopyMemory_TLongX1_to_TIntegerX2 Lib "kernel32" Alias "RtlMoveMemory" ( _
   ByRef lpvDest As TIntegerX2, ByRef lpvSource As TLongX1, ByVal cbCopy As Integer)
  Private Declare Sub CopyMemory_TLongX1_to_TRGBAQuad Lib "kernel32" Alias "RtlMoveMemory" ( _
   ByRef lpvDest As TRGBAQuad, ByRef lpvSource As TLongX1, ByVal cbCopy As Integer)

  Private Sub SetupVerticesPlus(ByRef v0() As TRIVERTEX, ByRef v1() As TRIVERTEX, ByRef v2() As TRIVERTEX, _
   ByVal b As Integer, ByVal u As Integer, ByVal s As Integer, ByRef disablestatic As Boolean)  'установка координат узлов сетки

    Dim i, x As Integer
    Static bSetup As Boolean
    If disablestatic Then
      bSetup = False
      Exit Sub
    End If
    If bSetup Then Exit Sub
    For i = 0 To b
      x = i * s
      With v0(i) : .x = x : .y = 0 : End With
      With v0((b + 1) + i) : .x = x : .y = u - 1 : End With
      With v1(i) : .x = x : .y = u - 1 : End With
      With v1((b + 1) + i) : .x = x : .y = u * 2 - 1 : End With
      With v2(i) : .x = x : .y = u * 2 - 1 : End With
      With v2((b + 1) + i) : .x = x : .y = u * 2 : End With
    Next i
    bSetup = True
  End Sub

  Private Sub SetupTriangles(ByRef t() As GRADIENT_TRIANGLE, ByVal b As Integer, _
   ByRef disablestatic As Boolean) 'установка (списка вершин) треугольников

    Dim i As Integer
    Dim k As Integer
    Static bSetup As Boolean
    If disablestatic Then
      bSetup = False
      Exit Sub
    End If
    If bSetup Then Exit Sub
    For i = 0 To b - 1
      With t(k)
        .Vertex1 = i
        .Vertex2 = .Vertex1 + (b + 1)
        .Vertex3 = .Vertex2 + 1
      End With
      k = k + 1
      With t(k)
        .Vertex1 = i
        .Vertex2 = .Vertex1 + 1
        .Vertex3 = .Vertex2 + (b + 1)
      End With
      k = k + 1
    Next i
    bSetup = True
  End Sub

  Private Function TransientColor(ByVal TransitionCoeff As Double, _
                                  ByVal Component0 As Integer, _
                                  ByVal Component1 As Byte) As Integer
    'Степень перехода одного цвета в другой 0.0 <= TransitionCoeff <= 1.0
    Dim L As TLongX1
    Dim i As TIntegerX2
    L.L0 = (TransitionCoeff * (CInt(Component1) - CInt(Component0)) + _
     Component0) * 256
    CopyMemory_TLongX1_to_TIntegerX2(i, L, Marshal.SizeOf(L)) 'LSet(i = L)
    TransientColor = i.I0
  End Function

  Private Sub SetupColorsPlus(ByRef v0() As TRIVERTEX, ByRef v1() As TRIVERTEX, ByRef v2() As TRIVERTEX, _
   ByVal Color0 As Integer, ByVal Color1 As Integer, _
   ByVal Color2 As Integer, ByVal Color3 As Integer, _
   ByVal Color4 As Integer, ByVal Color5 As Integer, _
   ByVal Color6 As Integer, ByVal Color7 As Integer, _
   ByVal Color8 As Integer, ByVal Color9 As Integer, _
   ByVal Color10 As Integer, ByVal Color11 As Integer, _
   ByVal b As Integer) 'Установка цветов вершин

    Dim L As TLongX1
    Dim Q(0 To 11) As TRGBAQuad
    L.L0 = Color0 : CopyMemory_TLongX1_to_TRGBAQuad(Q(0), L, Marshal.SizeOf(L)) ' LSet(Q(0) = L)
    L.L0 = Color1 : CopyMemory_TLongX1_to_TRGBAQuad(Q(1), L, Marshal.SizeOf(L)) 'LSet(Q(1) = L)
    L.L0 = Color2 : CopyMemory_TLongX1_to_TRGBAQuad(Q(2), L, Marshal.SizeOf(L)) ' LSet(Q(2) = L)
    L.L0 = Color3 : CopyMemory_TLongX1_to_TRGBAQuad(Q(3), L, Marshal.SizeOf(L)) 'LSet(Q(3) = L)
    L.L0 = Color4 : CopyMemory_TLongX1_to_TRGBAQuad(Q(4), L, Marshal.SizeOf(L)) ' LSet(Q(4) = L)
    L.L0 = Color5 : CopyMemory_TLongX1_to_TRGBAQuad(Q(5), L, Marshal.SizeOf(L)) 'LSet(Q(5) = L)
    L.L0 = Color6 : CopyMemory_TLongX1_to_TRGBAQuad(Q(6), L, Marshal.SizeOf(L)) 'LSet(Q(6) = L)
    L.L0 = Color7 : CopyMemory_TLongX1_to_TRGBAQuad(Q(7), L, Marshal.SizeOf(L)) ' LSet(Q(7) = L)
    L.L0 = Color8 : CopyMemory_TLongX1_to_TRGBAQuad(Q(8), L, Marshal.SizeOf(L)) ' LSet(Q(8) = L)
    L.L0 = Color9 : CopyMemory_TLongX1_to_TRGBAQuad(Q(9), L, Marshal.SizeOf(L)) ' LSet(Q(9) = L)
    L.L0 = Color10 : CopyMemory_TLongX1_to_TRGBAQuad(Q(10), L, Marshal.SizeOf(L)) ' LSet(Q(10) = L)
    L.L0 = Color11 : CopyMemory_TLongX1_to_TRGBAQuad(Q(11), L, Marshal.SizeOf(L)) ' LSet(Q(11) = L)

    Dim i As Long
    Dim tc As Double
    For i = 0 To b
      tc = i / b
      With v0(0 * (b + 1) + i)
        .Alpha = TRIVERTEX_MAX_ALPHA
        .Red = TransientColor(tc, Q(0).Red, Q(1).Red)
        .Green = TransientColor(tc, Q(0).Green, Q(1).Green)
        .Blue = TransientColor(tc, Q(0).Blue, Q(1).Blue)
      End With
      With v0(1 * (b + 1) + i)
        .Alpha = TRIVERTEX_MAX_ALPHA
        .Red = TransientColor(tc, Q(2).Red, Q(3).Red)
        .Green = TransientColor(tc, Q(2).Green, Q(3).Green)
        .Blue = TransientColor(tc, Q(2).Blue, Q(3).Blue)
      End With
      With v1(0 * (b + 1) + i)
        .Alpha = TRIVERTEX_MAX_ALPHA
        .Red = TransientColor(tc, Q(4).Red, Q(5).Red)
        .Green = TransientColor(tc, Q(4).Green, Q(5).Green)
        .Blue = TransientColor(tc, Q(4).Blue, Q(5).Blue)
      End With
      With v1(1 * (b + 1) + i)
        .Alpha = TRIVERTEX_MAX_ALPHA
        .Red = TransientColor(tc, Q(6).Red, Q(7).Red)
        .Green = TransientColor(tc, Q(6).Green, Q(7).Green)
        .Blue = TransientColor(tc, Q(6).Blue, Q(7).Blue)
      End With
      With v2(0 * (b + 1) + i)
        .Alpha = TRIVERTEX_MAX_ALPHA
        .Red = TransientColor(tc, Q(8).Red, Q(9).Red)
        .Green = TransientColor(tc, Q(8).Green, Q(9).Green)
        .Blue = TransientColor(tc, Q(8).Blue, Q(9).Blue)
      End With
      With v2(1 * (b + 1) + i)
        .Alpha = TRIVERTEX_MAX_ALPHA
        .Red = TransientColor(tc, Q(10).Red, Q(11).Red)
        .Green = TransientColor(tc, Q(10).Green, Q(11).Green)
        .Blue = TransientColor(tc, Q(10).Blue, Q(11).Blue)
      End With
    Next i
  End Sub

  Public Function CreateGradientBackComplexPlus( _
   ByVal hwndRef As IntPtr, _
   ByVal Width As Integer, ByVal Height As Integer, _
   Optional ByVal Color0 As Integer = &HB89D74, _
   Optional ByVal Color1 As Integer = &HBAB381, _
   Optional ByVal Color2 As Integer = &H90672C, _
   Optional ByVal Color3 As Integer = &H94893D, _
   Optional ByVal Color4 As Integer = &H6A3D02, _
   Optional ByVal Color5 As Integer = &H6C6113, _
   Optional ByVal Color6 As Integer = &HA68A43, _
   Optional ByVal Color7 As Integer = &HA7A050, _
   Optional ByVal Color8 As Integer = 13549715, _
   Optional ByVal Color9 As Integer = 13618330, _
   Optional ByVal Color10 As Integer = 0, _
   Optional ByVal Color11 As Integer = 0) As IntPtr

    'ф-ция создает градиент в стиде Explorer с двойной полосой (светлая, черная) внизу
    'предполагается (субъективно конечно) что .cyMinChild = 33 (или 25) -нечетное число, иначе чуть ошибется

    Dim hdcRef As IntPtr
    Dim hdcDst As IntPtr
    Dim hbmDst As IntPtr
    Dim hbmOld As IntPtr
    Dim v0() As TRIVERTEX 'массив вершин верхней полосы
    Dim v1() As TRIVERTEX 'массив вершин нижней полосы
    Dim v2() As TRIVERTEX 'массив вершин полоски в самом низу
    Dim t() As GRADIENT_TRIANGLE  'массив треугольников
    Dim b As Integer 'количество клеток сетки по горизонтали
    Dim u As Integer 'шаг узлов сетки по вертикали
    Dim s As Integer 'шаг узлов сетки по горизонтали
    'Каждая клетка сетки состоит из двух треугольников

    s = 10 'шаг узлов сетки по горизонтали
    b = Width / s + 1 'количество клеток сетки по горизонтали;+1-страховка
    u = (Height - 2) / 2 'шаг узлов сетки по вертикали u = 16 две клетки,кот.растягиваем
    'подстраиваем размерности массивов
    ReDim v0(0 To b * 2 + 1) 'массив вершин верхней полосы
    ReDim v1(0 To b * 2 + 1) 'массив вершин нижней полосы
    ReDim v2(0 To b * 2 + 1) 'массив вершин полоски в самом низу
    ReDim t(0 To b * 2 - 1) 'массив треугольников

    SetupVerticesPlus(v0, v1, v2, b, u, s, True) 'отмена bSetup
    SetupTriangles(t, b, True) 'отмена bSetup

    SetupVerticesPlus(v0, v1, v2, b, u, s, False)
    SetupTriangles(t, b, False)
    SetupColorsPlus(v0, v1, v2, _
               Color0, Color1, _
               Color2, Color3, _
               Color4, Color5, _
               Color6, Color7, _
               Color8, Color9, _
               Color10, Color11, _
               b)

    hdcRef = GetDC(hwndRef)
    hdcDst = CreateCompatibleDC(hdcRef)
    hbmDst = CreateCompatibleBitmap(hdcRef, b * s, u * 2 + 1)
    hbmOld = SelectObject(hdcDst, hbmDst)
    GradientFill(hdcDst, v0(0), 2 * (b + 1), t(0), b * 2, GradientFillMode.GRADIENT_FILL_TRIANGLE)
    GradientFill(hdcDst, v1(0), 2 * (b + 1), t(0), b * 2, GradientFillMode.GRADIENT_FILL_TRIANGLE)
    GradientFill(hdcDst, v2(0), 2 * (b + 1), t(0), b * 2, GradientFillMode.GRADIENT_FILL_TRIANGLE)
    SelectObject(hdcDst, hbmOld) : hbmOld = 0
    DeleteDC(hdcDst) : hdcDst = 0
    Return hbmDst
    'CreateGradientBackComplexPlus = CreateIPictureDispFromHBITMAP(hbmDst)
    'DeleteObject hbmDst: hbmDst = 0
  End Function


Есть только одна API, которая "рисует":
Код: vbnet
1.
2.
3.
4.
5.
6.
  Private Declare Function GradientFill Lib "msimg32" ( _
   ByVal hdc As IntPtr, ByRef pVertex As TRIVERTEX, ByVal dwNumVertex As Integer, _
   ByRef pMesh As GRADIENT_TRIANGLE, ByVal dwNumMesh As Integer, _
   ByVal dwMode As GradientFillMode) As Boolean
...
    GradientFill(hdcDst, v0(0), 2 * (b + 1), t(0), b * 2, GradientFillMode.GRADIENT_FILL_TRIANGLE)


Все махинации с bitmap и hdc думаю можно проделать с Graphics (как в Net коде с линейными градиентами, что я привел выше) и вернуть hBitmap.

CopyMemory не в счет (вместо LSet), мне подсказали другой метод в соседнем топике , счас буду пробовать.

Если есть аналог GradientFill, то с учетом предыдущих замечаний код можно перевести в .NET в лоб (предположение).
...
Рейтинг: 0 / 0
18.09.2013, 01:35
| Ответить | Цитировать | Написать  
А как Net-овского рисования получить Ptr на Type: HBITMAP?
    #38399534
Дмитрий77
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Дмитрий77
Участник
Дмитрий77Все махинации с bitmap и hdc думаю можно проделать с Graphics (как в Net коде с линейными градиентами, что я привел выше) и вернуть hBitmap.

CopyMemory не в счет (вместо LSet), мне подсказали другой метод в соседнем топике , счас буду пробовать.
Ну с этим поборолся:

 
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
214.
215.
216.
217.
218.
219.
220.
221.
222.
223.
224.
225.
226.
227.
228.
229.
230.
231.
232.
233.
234.
235.
236.
237.
238.
239.
240.
241.
242.
Imports System.Runtime.InteropServices

Module ModuleGradBkG
  <StructLayout(LayoutKind.Sequential)>
  Private Structure TRIVERTEX
    Dim x As Integer
    Dim y As Integer
    Dim Red As Int16
    Dim Green As Int16
    Dim Blue As Int16
    Dim Alpha As Int16
  End Structure

  <StructLayout(LayoutKind.Sequential)>
  Private Structure GRADIENT_TRIANGLE
    Dim Vertex1 As Integer
    Dim Vertex2 As Integer
    Dim Vertex3 As Integer
  End Structure

  <StructLayout(LayoutKind.Explicit)>
  Private Structure TLongXX
    <FieldOffset(0)>
    Dim L0 As Integer

    <FieldOffset(0)>
    Dim I0 As Int16

    <FieldOffset(2)>
    Dim I1 As Int16

    <FieldOffset(0)>
    Dim Red As Byte

    <FieldOffset(1)>
    Dim Green As Byte

    <FieldOffset(2)>
    Dim Blue As Byte

    <FieldOffset(3)>
    Dim Alpha As Byte
  End Structure


  Private Enum GradientFillMode
    GRADIENT_FILL_RECT_H
    GRADIENT_FILL_RECT_V
    GRADIENT_FILL_TRIANGLE
    GRADIENT_FILL_OP_FLAG = 255
  End Enum

  Private Declare Function GradientFill Lib "msimg32" ( _
   ByVal hdc As IntPtr, ByRef pVertex As TRIVERTEX, ByVal dwNumVertex As Integer, _
   ByRef pMesh As GRADIENT_TRIANGLE, ByVal dwNumMesh As Integer, _
   ByVal dwMode As GradientFillMode) As Boolean

  Private Const TRIVERTEX_MAX_ALPHA As Int16 = -256 '&HFF00

  Private Sub SetupVerticesPlus(ByRef v0() As TRIVERTEX, ByRef v1() As TRIVERTEX, ByRef v2() As TRIVERTEX, _
   ByVal b As Integer, ByVal u As Integer, ByVal s As Integer, ByRef disablestatic As Boolean)  'установка координат узлов сетки

    Dim i, x As Integer
    Static bSetup As Boolean
    If disablestatic Then
      bSetup = False
      Exit Sub
    End If
    If bSetup Then Exit Sub
    For i = 0 To b
      x = i * s
      With v0(i) : .x = x : .y = 0 : End With
      With v0((b + 1) + i) : .x = x : .y = u - 1 : End With
      With v1(i) : .x = x : .y = u - 1 : End With
      With v1((b + 1) + i) : .x = x : .y = u * 2 - 1 : End With
      With v2(i) : .x = x : .y = u * 2 - 1 : End With
      With v2((b + 1) + i) : .x = x : .y = u * 2 : End With
    Next i
    bSetup = True
  End Sub

  Private Sub SetupTriangles(ByRef t() As GRADIENT_TRIANGLE, ByVal b As Integer, _
   ByRef disablestatic As Boolean) 'установка (списка вершин) треугольников

    Dim i As Integer
    Dim k As Integer
    Static bSetup As Boolean
    If disablestatic Then
      bSetup = False
      Exit Sub
    End If
    If bSetup Then Exit Sub
    For i = 0 To b - 1
      With t(k)
        .Vertex1 = i
        .Vertex2 = .Vertex1 + (b + 1)
        .Vertex3 = .Vertex2 + 1
      End With
      k = k + 1
      With t(k)
        .Vertex1 = i
        .Vertex2 = .Vertex1 + 1
        .Vertex3 = .Vertex2 + (b + 1)
      End With
      k = k + 1
    Next i
    bSetup = True
  End Sub

  Private Function TransientColor(ByVal TransitionCoeff As Double, _
                                  ByVal Component0 As Integer, _
                                  ByVal Component1 As Byte) As Integer
    'Степень перехода одного цвета в другой 0.0 <= TransitionCoeff <= 1.0
    Dim L As TLongXX 'TLongX1
    L.L0 = (TransitionCoeff * (CInt(Component1) - CInt(Component0)) + _
     Component0) * 256
    Return L.I0
  End Function

  Private Sub SetupColorsPlus(ByRef v0() As TRIVERTEX, ByRef v1() As TRIVERTEX, ByRef v2() As TRIVERTEX, _
   ByVal Color0 As Integer, ByVal Color1 As Integer, _
   ByVal Color2 As Integer, ByVal Color3 As Integer, _
   ByVal Color4 As Integer, ByVal Color5 As Integer, _
   ByVal Color6 As Integer, ByVal Color7 As Integer, _
   ByVal Color8 As Integer, ByVal Color9 As Integer, _
   ByVal Color10 As Integer, ByVal Color11 As Integer, _
   ByVal b As Integer) 'Установка цветов вершин

    Dim Q(0 To 11) As TLongXX
    Q(0).L0 = Color0 : Q(1).L0 = Color1 : Q(2).L0 = Color2 : Q(3).L0 = Color3
    Q(4).L0 = Color4 : Q(5).L0 = Color5 : Q(6).L0 = Color6 : Q(7).L0 = Color7
    Q(8).L0 = Color8 : Q(9).L0 = Color9 : Q(10).L0 = Color10 : Q(11).L0 = Color11

    Dim i As Integer
    Dim tc As Double
    For i = 0 To b
      tc = i / b
      With v0(0 * (b + 1) + i)
        .Alpha = TRIVERTEX_MAX_ALPHA
        .Red = TransientColor(tc, Q(0).Red, Q(1).Red)
        .Green = TransientColor(tc, Q(0).Green, Q(1).Green)
        .Blue = TransientColor(tc, Q(0).Blue, Q(1).Blue)
      End With
      With v0(1 * (b + 1) + i)
        .Alpha = TRIVERTEX_MAX_ALPHA
        .Red = TransientColor(tc, Q(2).Red, Q(3).Red)
        .Green = TransientColor(tc, Q(2).Green, Q(3).Green)
        .Blue = TransientColor(tc, Q(2).Blue, Q(3).Blue)
      End With
      With v1(0 * (b + 1) + i)
        .Alpha = TRIVERTEX_MAX_ALPHA
        .Red = TransientColor(tc, Q(4).Red, Q(5).Red)
        .Green = TransientColor(tc, Q(4).Green, Q(5).Green)
        .Blue = TransientColor(tc, Q(4).Blue, Q(5).Blue)
      End With
      With v1(1 * (b + 1) + i)
        .Alpha = TRIVERTEX_MAX_ALPHA
        .Red = TransientColor(tc, Q(6).Red, Q(7).Red)
        .Green = TransientColor(tc, Q(6).Green, Q(7).Green)
        .Blue = TransientColor(tc, Q(6).Blue, Q(7).Blue)
      End With
      With v2(0 * (b + 1) + i)
        .Alpha = TRIVERTEX_MAX_ALPHA
        .Red = TransientColor(tc, Q(8).Red, Q(9).Red)
        .Green = TransientColor(tc, Q(8).Green, Q(9).Green)
        .Blue = TransientColor(tc, Q(8).Blue, Q(9).Blue)
      End With
      With v2(1 * (b + 1) + i)
        .Alpha = TRIVERTEX_MAX_ALPHA
        .Red = TransientColor(tc, Q(10).Red, Q(11).Red)
        .Green = TransientColor(tc, Q(10).Green, Q(11).Green)
        .Blue = TransientColor(tc, Q(10).Blue, Q(11).Blue)
      End With
    Next i
  End Sub

  Public Function CreateGradientBackComplexPlus( _
   ByVal hwndRef As IntPtr, _
   ByVal Width As Integer, ByVal Height As Integer, _
   Optional ByVal Color0 As Integer = &HB89D74, _
   Optional ByVal Color1 As Integer = &HBAB381, _
   Optional ByVal Color2 As Integer = &H90672C, _
   Optional ByVal Color3 As Integer = &H94893D, _
   Optional ByVal Color4 As Integer = &H6A3D02, _
   Optional ByVal Color5 As Integer = &H6C6113, _
   Optional ByVal Color6 As Integer = &HA68A43, _
   Optional ByVal Color7 As Integer = &HA7A050, _
   Optional ByVal Color8 As Integer = 13549715, _
   Optional ByVal Color9 As Integer = 13618330, _
   Optional ByVal Color10 As Integer = 0, _
   Optional ByVal Color11 As Integer = 0) As IntPtr

    'ф-ция создает градиент в стиде Explorer с двойной полосой (светлая, черная) внизу
    'предполагается (субъективно конечно) что .cyMinChild = 33 (или 25) -нечетное число, иначе чуть ошибется

    Dim v0() As TRIVERTEX 'массив вершин верхней полосы
    Dim v1() As TRIVERTEX 'массив вершин нижней полосы
    Dim v2() As TRIVERTEX 'массив вершин полоски в самом низу
    Dim t() As GRADIENT_TRIANGLE  'массив треугольников
    Dim b As Integer 'количество клеток сетки по горизонтали
    Dim u As Integer 'шаг узлов сетки по вертикали
    Dim s As Integer 'шаг узлов сетки по горизонтали
    'Каждая клетка сетки состоит из двух треугольников

    s = 10 'шаг узлов сетки по горизонтали
    b = Width / s + 1 'количество клеток сетки по горизонтали;+1-страховка
    u = (Height - 2) / 2 'шаг узлов сетки по вертикали u = 16 две клетки,кот.растягиваем
    'подстраиваем размерности массивов
    ReDim v0(0 To b * 2 + 1) 'массив вершин верхней полосы
    ReDim v1(0 To b * 2 + 1) 'массив вершин нижней полосы
    ReDim v2(0 To b * 2 + 1) 'массив вершин полоски в самом низу
    ReDim t(0 To b * 2 - 1) 'массив треугольников

    SetupVerticesPlus(v0, v1, v2, b, u, s, True) 'отмена bSetup
    SetupTriangles(t, b, True) 'отмена bSetup

    SetupVerticesPlus(v0, v1, v2, b, u, s, False)
    SetupTriangles(t, b, False)
    SetupColorsPlus(v0, v1, v2, _
               Color0, Color1, _
               Color2, Color3, _
               Color4, Color5, _
               Color6, Color7, _
               Color8, Color9, _
               Color10, Color11, _
               b)

    Dim bmp = New Bitmap(b * s, u * 2 + 1, Imaging.PixelFormat.Format32bppArgb)
    Dim gr = Graphics.FromImage(bmp)
    ' Get the hDC from the Graphics object.
    Dim hdc As IntPtr = gr.GetHdc()
    GradientFill(hdc, v0(0), 2 * (b + 1), t(0), b * 2, GradientFillMode.GRADIENT_FILL_TRIANGLE)
    GradientFill(hdc, v1(0), 2 * (b + 1), t(0), b * 2, GradientFillMode.GRADIENT_FILL_TRIANGLE)
    GradientFill(hdc, v2(0), 2 * (b + 1), t(0), b * 2, GradientFillMode.GRADIENT_FILL_TRIANGLE)
    gr.ReleaseHdc(hdc)
    Dim hBitmap As IntPtr = bmp.GetHbitmap()
    gr.Dispose()
    bmp.Dispose()
    Return hBitmap

  End Function
End Module


Остался один вопрос, если добивать именно этот код под "чисто .NET"
Дмитрий77Если есть аналог GradientFill...
...
Рейтинг: 0 / 0
18.09.2013, 04:36
| Ответить | Цитировать | Написать  
А как Net-овского рисования получить Ptr на Type: HBITMAP?
    #38399541
Дмитрий77
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Дмитрий77
Участник
Дмитрий77 Остался один вопрос, если добивать именно этот код под "чисто .NET"
Если есть аналог GradientFill...

Вообще-то при внимательном просмотре материала из статьи Microsoft:
How to: Display a Gradient Fill
становится ясно, что мой код под спойлером тупо соответствует тому что там написано
и GradientFill объявлен именно как API (в классе Win32Helper).

Или я должен ставить самоцель не использовать API, если я использую .NET?
А все остальное "дурной тон" (включая статью Microsoft)?

fortibransaВ NET этих градиентов как грязи...см PathGradientBrush
А ты уверен что эта штука умеет сделать что мне нужно?
А нужно мне вот это (эта тема не устанавливается через SetWindowTheme и ее надо рисовать):
Custom Vista-style (blue/green) ...<суффикс про тулстрип опустим>

Но в этом примере используется линейный градиент сверху вниз (2 полоски), а на него автор примера накладывает (прозрачный слева -> зеленый справа).

Мой код (под спойлером) строит градиент по 4-м цветам в крайних точках прямоугольника.

А твой PathGradientBrush (я поигрался) рисует из центра к краям, цвета и их к-во можно менять.
Но как сделать именно то что нужно мне (горизонталь+вертикаль) я не понимаю.

Или ты указал мне на этот метод не глядя (типа, вона как круто можно сделать), или я не просек как сделать именно то что мне нужно. Так покажи как.

У меня только одна идея как сделать требуемое средствами .NET:
1) подсчитать два массива цветов (например справа и слева) -по вертикали
2) закрасить горизонтальные прямоугольники высотой 1 пиксель через LinearGradientMode.Horizontal
(Число прямоугольников равно грубо высоте исходного прямоугольника)

Хотя честно мне уже надоело, задача итак решена.
...
Рейтинг: 0 / 0
18.09.2013, 06:20
| Ответить | Цитировать | Написать  
А как Net-овского рисования получить Ptr на Type: HBITMAP?
    #38399546
Фотография Изопропил
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Изопропил
Участник
Winforms плохо подходит для свистоперделок. В .Net для этого грубо говоря WPF существует. Но там все до единого контролы "ненастоящие" - рисуются не winapi, а собственно библиотекой(direct 3d для wpf неоязателен, при невозможности использования,например, на терминальном сервере рисование осуществляется через gdi, ну шейдеры лесом пойдут, остальное будет работать)

В winrt .net тож не родной api, родной как всегда COM

Если есть такое горячее желание использовать winapi - все крома C++ вряд ли является адекватным инструментом. А что касается нежелания писать createwindow - поможет свой набор классов кстати нормально масшабировать и перемещать контролы при изменении размеров окна winforms толком не умеет
...
Рейтинг: 0 / 0
18.09.2013, 07:11
| Ответить | Цитировать | Написать  
А как Net-овского рисования получить Ptr на Type: HBITMAP?
    #38399710
Дмитрий77
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Дмитрий77
Участник
Дмитрий77
 
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
214.
215.
216.
217.
218.
219.
220.
221.
222.
223.
224.
225.
226.
227.
228.
229.
230.
231.
232.
233.
234.
235.
236.
237.
238.
239.
240.
241.
242.
Imports System.Runtime.InteropServices

Module ModuleGradBkG
  <StructLayout(LayoutKind.Sequential)>
  Private Structure TRIVERTEX
    Dim x As Integer
    Dim y As Integer
    Dim Red As Int16
    Dim Green As Int16
    Dim Blue As Int16
    Dim Alpha As Int16
  End Structure

  <StructLayout(LayoutKind.Sequential)>
  Private Structure GRADIENT_TRIANGLE
    Dim Vertex1 As Integer
    Dim Vertex2 As Integer
    Dim Vertex3 As Integer
  End Structure

  <StructLayout(LayoutKind.Explicit)>
  Private Structure TLongXX
    <FieldOffset(0)>
    Dim L0 As Integer

    <FieldOffset(0)>
    Dim I0 As Int16

    <FieldOffset(2)>
    Dim I1 As Int16

    <FieldOffset(0)>
    Dim Red As Byte

    <FieldOffset(1)>
    Dim Green As Byte

    <FieldOffset(2)>
    Dim Blue As Byte

    <FieldOffset(3)>
    Dim Alpha As Byte
  End Structure


  Private Enum GradientFillMode
    GRADIENT_FILL_RECT_H
    GRADIENT_FILL_RECT_V
    GRADIENT_FILL_TRIANGLE
    GRADIENT_FILL_OP_FLAG = 255
  End Enum

  Private Declare Function GradientFill Lib "msimg32" ( _
   ByVal hdc As IntPtr, ByRef pVertex As TRIVERTEX, ByVal dwNumVertex As Integer, _
   ByRef pMesh As GRADIENT_TRIANGLE, ByVal dwNumMesh As Integer, _
   ByVal dwMode As GradientFillMode) As Boolean

  Private Const TRIVERTEX_MAX_ALPHA As Int16 = -256 '&HFF00

  Private Sub SetupVerticesPlus(ByRef v0() As TRIVERTEX, ByRef v1() As TRIVERTEX, ByRef v2() As TRIVERTEX, _
   ByVal b As Integer, ByVal u As Integer, ByVal s As Integer, ByRef disablestatic As Boolean)  'установка координат узлов сетки

    Dim i, x As Integer
    Static bSetup As Boolean
    If disablestatic Then
      bSetup = False
      Exit Sub
    End If
    If bSetup Then Exit Sub
    For i = 0 To b
      x = i * s
      With v0(i) : .x = x : .y = 0 : End With
      With v0((b + 1) + i) : .x = x : .y = u - 1 : End With
      With v1(i) : .x = x : .y = u - 1 : End With
      With v1((b + 1) + i) : .x = x : .y = u * 2 - 1 : End With
      With v2(i) : .x = x : .y = u * 2 - 1 : End With
      With v2((b + 1) + i) : .x = x : .y = u * 2 : End With
    Next i
    bSetup = True
  End Sub

  Private Sub SetupTriangles(ByRef t() As GRADIENT_TRIANGLE, ByVal b As Integer, _
   ByRef disablestatic As Boolean) 'установка (списка вершин) треугольников

    Dim i As Integer
    Dim k As Integer
    Static bSetup As Boolean
    If disablestatic Then
      bSetup = False
      Exit Sub
    End If
    If bSetup Then Exit Sub
    For i = 0 To b - 1
      With t(k)
        .Vertex1 = i
        .Vertex2 = .Vertex1 + (b + 1)
        .Vertex3 = .Vertex2 + 1
      End With
      k = k + 1
      With t(k)
        .Vertex1 = i
        .Vertex2 = .Vertex1 + 1
        .Vertex3 = .Vertex2 + (b + 1)
      End With
      k = k + 1
    Next i
    bSetup = True
  End Sub

  Private Function TransientColor(ByVal TransitionCoeff As Double, _
                                  ByVal Component0 As Integer, _
                                  ByVal Component1 As Byte) As Integer
    'Степень перехода одного цвета в другой 0.0 <= TransitionCoeff <= 1.0
    Dim L As TLongXX 'TLongX1
    L.L0 = (TransitionCoeff * (CInt(Component1) - CInt(Component0)) + _
     Component0) * 256
    Return L.I0
  End Function

  Private Sub SetupColorsPlus(ByRef v0() As TRIVERTEX, ByRef v1() As TRIVERTEX, ByRef v2() As TRIVERTEX, _
   ByVal Color0 As Integer, ByVal Color1 As Integer, _
   ByVal Color2 As Integer, ByVal Color3 As Integer, _
   ByVal Color4 As Integer, ByVal Color5 As Integer, _
   ByVal Color6 As Integer, ByVal Color7 As Integer, _
   ByVal Color8 As Integer, ByVal Color9 As Integer, _
   ByVal Color10 As Integer, ByVal Color11 As Integer, _
   ByVal b As Integer) 'Установка цветов вершин

    Dim Q(0 To 11) As TLongXX
    Q(0).L0 = Color0 : Q(1).L0 = Color1 : Q(2).L0 = Color2 : Q(3).L0 = Color3
    Q(4).L0 = Color4 : Q(5).L0 = Color5 : Q(6).L0 = Color6 : Q(7).L0 = Color7
    Q(8).L0 = Color8 : Q(9).L0 = Color9 : Q(10).L0 = Color10 : Q(11).L0 = Color11

    Dim i As Integer
    Dim tc As Double
    For i = 0 To b
      tc = i / b
      With v0(0 * (b + 1) + i)
        .Alpha = TRIVERTEX_MAX_ALPHA
        .Red = TransientColor(tc, Q(0).Red, Q(1).Red)
        .Green = TransientColor(tc, Q(0).Green, Q(1).Green)
        .Blue = TransientColor(tc, Q(0).Blue, Q(1).Blue)
      End With
      With v0(1 * (b + 1) + i)
        .Alpha = TRIVERTEX_MAX_ALPHA
        .Red = TransientColor(tc, Q(2).Red, Q(3).Red)
        .Green = TransientColor(tc, Q(2).Green, Q(3).Green)
        .Blue = TransientColor(tc, Q(2).Blue, Q(3).Blue)
      End With
      With v1(0 * (b + 1) + i)
        .Alpha = TRIVERTEX_MAX_ALPHA
        .Red = TransientColor(tc, Q(4).Red, Q(5).Red)
        .Green = TransientColor(tc, Q(4).Green, Q(5).Green)
        .Blue = TransientColor(tc, Q(4).Blue, Q(5).Blue)
      End With
      With v1(1 * (b + 1) + i)
        .Alpha = TRIVERTEX_MAX_ALPHA
        .Red = TransientColor(tc, Q(6).Red, Q(7).Red)
        .Green = TransientColor(tc, Q(6).Green, Q(7).Green)
        .Blue = TransientColor(tc, Q(6).Blue, Q(7).Blue)
      End With
      With v2(0 * (b + 1) + i)
        .Alpha = TRIVERTEX_MAX_ALPHA
        .Red = TransientColor(tc, Q(8).Red, Q(9).Red)
        .Green = TransientColor(tc, Q(8).Green, Q(9).Green)
        .Blue = TransientColor(tc, Q(8).Blue, Q(9).Blue)
      End With
      With v2(1 * (b + 1) + i)
        .Alpha = TRIVERTEX_MAX_ALPHA
        .Red = TransientColor(tc, Q(10).Red, Q(11).Red)
        .Green = TransientColor(tc, Q(10).Green, Q(11).Green)
        .Blue = TransientColor(tc, Q(10).Blue, Q(11).Blue)
      End With
    Next i
  End Sub

  Public Function CreateGradientBackComplexPlus( _
   ByVal hwndRef As IntPtr, _
   ByVal Width As Integer, ByVal Height As Integer, _
   Optional ByVal Color0 As Integer = &HB89D74, _
   Optional ByVal Color1 As Integer = &HBAB381, _
   Optional ByVal Color2 As Integer = &H90672C, _
   Optional ByVal Color3 As Integer = &H94893D, _
   Optional ByVal Color4 As Integer = &H6A3D02, _
   Optional ByVal Color5 As Integer = &H6C6113, _
   Optional ByVal Color6 As Integer = &HA68A43, _
   Optional ByVal Color7 As Integer = &HA7A050, _
   Optional ByVal Color8 As Integer = 13549715, _
   Optional ByVal Color9 As Integer = 13618330, _
   Optional ByVal Color10 As Integer = 0, _
   Optional ByVal Color11 As Integer = 0) As IntPtr

    'ф-ция создает градиент в стиде Explorer с двойной полосой (светлая, черная) внизу
    'предполагается (субъективно конечно) что .cyMinChild = 33 (или 25) -нечетное число, иначе чуть ошибется

    Dim v0() As TRIVERTEX 'массив вершин верхней полосы
    Dim v1() As TRIVERTEX 'массив вершин нижней полосы
    Dim v2() As TRIVERTEX 'массив вершин полоски в самом низу
    Dim t() As GRADIENT_TRIANGLE  'массив треугольников
    Dim b As Integer 'количество клеток сетки по горизонтали
    Dim u As Integer 'шаг узлов сетки по вертикали
    Dim s As Integer 'шаг узлов сетки по горизонтали
    'Каждая клетка сетки состоит из двух треугольников

    s = 10 'шаг узлов сетки по горизонтали
    b = Width / s + 1 'количество клеток сетки по горизонтали;+1-страховка
    u = (Height - 2) / 2 'шаг узлов сетки по вертикали u = 16 две клетки,кот.растягиваем
    'подстраиваем размерности массивов
    ReDim v0(0 To b * 2 + 1) 'массив вершин верхней полосы
    ReDim v1(0 To b * 2 + 1) 'массив вершин нижней полосы
    ReDim v2(0 To b * 2 + 1) 'массив вершин полоски в самом низу
    ReDim t(0 To b * 2 - 1) 'массив треугольников

    SetupVerticesPlus(v0, v1, v2, b, u, s, True) 'отмена bSetup
    SetupTriangles(t, b, True) 'отмена bSetup

    SetupVerticesPlus(v0, v1, v2, b, u, s, False)
    SetupTriangles(t, b, False)
    SetupColorsPlus(v0, v1, v2, _
               Color0, Color1, _
               Color2, Color3, _
               Color4, Color5, _
               Color6, Color7, _
               Color8, Color9, _
               Color10, Color11, _
               b)

    Dim bmp = New Bitmap(b * s, u * 2 + 1, Imaging.PixelFormat.Format32bppArgb)
    Dim gr = Graphics.FromImage(bmp)
    ' Get the hDC from the Graphics object.
    Dim hdc As IntPtr = gr.GetHdc()
    GradientFill(hdc, v0(0), 2 * (b + 1), t(0), b * 2, GradientFillMode.GRADIENT_FILL_TRIANGLE)
    GradientFill(hdc, v1(0), 2 * (b + 1), t(0), b * 2, GradientFillMode.GRADIENT_FILL_TRIANGLE)
    GradientFill(hdc, v2(0), 2 * (b + 1), t(0), b * 2, GradientFillMode.GRADIENT_FILL_TRIANGLE)
    gr.ReleaseHdc(hdc)
    Dim hBitmap As IntPtr = bmp.GetHbitmap()
    gr.Dispose()
    bmp.Dispose()
    Return hBitmap

  End Function
End Module



Там у меня где-то ошибка в исходном коде: нижняя черная полоса (1 пиксель) не прорисовывается.
Через API bitmap по дефолту "черный", и в .Net коде это вылезло.
Разбираться неохота, но workaround напр. такой:
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
    Dim bmp = New Bitmap(b * s, u * 2 + 1, Imaging.PixelFormat.Format32bppArgb)
    Dim gr = Graphics.FromImage(bmp)
    gr.Clear(Color.Black) 'workaround -с самой нижней полосой что-то не так
    ' Get the hDC from the Graphics object.
    Dim hdc As IntPtr = gr.GetHdc()
    GradientFill(hdc, v0(0), 2 * (b + 1), t(0), b * 2, GradientFillMode.GRADIENT_FILL_TRIANGLE)
    GradientFill(hdc, v1(0), 2 * (b + 1), t(0), b * 2, GradientFillMode.GRADIENT_FILL_TRIANGLE)
    GradientFill(hdc, v2(0), 2 * (b + 1), t(0), b * 2, GradientFillMode.GRADIENT_FILL_TRIANGLE) 'ошибка где-то
    gr.ReleaseHdc(hdc)
    Dim hBitmap As IntPtr = bmp.GetHbitmap()
    gr.Dispose()
    bmp.Dispose()
    Return hBitmap


ИзопропилWinforms плохо подходит для свистоперделок. В .Net для этого грубо говоря WPF существует. Но там все до единого контролы "ненастоящие" - рисуются не winapi, а собственно библиотекой(direct 3d ...
Угу, настолько ненастоящие, что размытые надписи на кнопках сразу бросаются в глаза. Видимо врожденный порок технологии.
...
Рейтинг: 0 / 0
18.09.2013, 10:28
| Ответить | Цитировать | Написать  
10 сообщений из 10, страница 1 из 1
Форумы / WinForms, .Net Framework [игнор отключен] [закрыт для гостей] / А как Net-овского рисования получить Ptr на Type: HBITMAP?
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение
NoSQL.ru       Новости, Чат       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?desktop=1&fid=20&tid=1404021]:
 0ms
get settings:
 9ms
get forum list:
 14ms
check forum access:
 5ms
check topic access:
 5ms
track hit:
 35ms
get topic data:
 13ms
get forum data:
 3ms
get page messages:
 56ms
get tp. blocked users:
 2ms
others: 325ms
total:  467ms
созд. / загр.: 467ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]