Заранее извиняюсь за мой русский, уже имел неприятный опыт.
Есть форма Picturebox, назовём А, и четыре вложенных в неё Picturebox, назовём Б1, Б2, Б3, Б4.
В Picturebox-е рисую ну что-то вроде градусника, на белом фоне пишу числа тем же цветом что и фон градусника. Как только часть фона градусника попадает на часть цифры использую другой Picturebox, назовём Б1, для того чтобы написать те же цифры, но теперь белым цветом на фоне цвета фона градусника. Надеюсь понятно, на всякий случай текст формы
- Код: Выделить всё
Private Sub Form_Load()
Dim PenColor2(2) As Long, PenTxt(2) As Long, lngTerm As Double, Index2 As Integer
Height = 5000: Width = 0.5 * Screen.Width
Picture2.Left = 0: Picture2.Top = 0
Picture2.Height = 0.8 * Height: Picture2.Width = Width
ht2 = Picture2.Height: lng2 = Picture2.Width - 0.2 * ht2
PenColor2(0) = RGB(90, 175, 155): PenTxt(0) = PenColor2(0) 'RGB(70, 145, 130)
PenColor2(1) = RGB(230, 125, 35): PenTxt(1) = PenColor2(1) 'RGB(200, 110, 30)
PenColor2(2) = RGB(240, 75, 95): PenTxt(2) = PenColor2(2) 'RGB(195, 60, 80)
Progres2 = 24 ' в программе это значение передается из другой процедуры
Picture2.DrawStyle = vbSolid: Picture2.FillStyle = vbFSSolid: Picture2.AutoRedraw = True
Picture2.ForeColor = RGB(155, 155, 155): Picture2.FillColor = RGB(155, 155, 155)
Picture2.Line (0.5 * ht2, 0.3 * ht2)-(lng2, 0.7 * ht2), RGB(155, 155, 155), BF
Picture2.Circle (0.5 * ht2, 0.5 * ht2), 0.5 * ht2
Picture2.Circle (lng2, 0.5 * ht2), 0.2 * ht2
Picture2.FillColor = vbWindowBackground: Picture2.ForeColor = vbWindowBackground
Picture2.Line (0.5 * ht2, 0.33 * ht2)-(lng2, 0.67 * ht2), vbWindowBackground, BF
Picture2.Circle (0.5 * ht2, 0.5 * ht2), 0.47 * ht2
Picture2.Circle (lng2, 0.5 * ht2), 0.17 * ht2
alfa = 180 * Atn((0.15 * ht2) / (0.44 * ht2)) / 3.15
Picture2.Circle (0.5 * ht2, 0.5 * ht2), 0.45 * ht2, RGB(155, 155, 155), 3.14 * alfa / 180, 3.14 * (360 - alfa) / 180
Picture2.Line (0.93 * ht2, 0.35 * ht2)-(lng2, 0.35 * ht2), RGB(155, 155, 155)
Picture2.Line (0.93 * ht2, 0.65 * ht2)-(lng2, 0.65 * ht2), RGB(155, 155, 155)
Picture2.Circle (lng2, 0.5 * ht2), 0.15 * ht2, RGB(155, 155, 155), 3.14 * 270 / 180, 3.14 * 90 / 180
Select Case Progres2
Case Is < 40: Index2 = 2
Case Is < 70: Index2 = 1
Case Else: Index2 = 0
End Select
Picture2.FillColor = PenColor2(Index2): Picture2.ForeColor = PenColor2(Index2)
Picture2.Circle (0.5 * ht2, 0.5 * ht2), 0.45 * ht2
lngTerm = 0.94 * ht2 + Progres2 * (Picture2.Width - 0.05 * ht2 - 0.94 * ht2) / 100
Picture2.Line (0.9 * ht2, 0.35 * ht2)-(lngTerm - 0.15 * ht2, 0.65 * ht2), PenColor2(Index2), BF
Picture2.Circle (lngTerm - 0.15 * ht2, 0.5 * ht2), 0.15 * ht2
Picture2.ForeColor = vbWindowBackground
Picture2.FontName = "Gotham Book": Picture2.FontSize = 20 * ht2 / 2000
tmpTxt = Format(Progres2, "0.0")
hTxt = Picture2.TextHeight(tmpTxt): wTxt = Picture2.TextWidth(tmpTxt)
Picture2.CurrentX = 0.5 * (ht2 - wTxt): Picture2.CurrentY = 0.5 * (ht2 - hTxt):
Picture2.Print tmpTxt
Picture2.FontSize = 8 * ht2 / 2000: Picture2.FontBold = False
hTxt = Picture2.TextHeight("%")
Picture2.DrawWidth = 3: delt2 = (Picture2.Width - 0.05 * ht2 - 0.94 * ht2) / 5
For iiTmp = 1 To 4
Picture2.ForeColor = PenTxt(Index2)
Picture2.Line (0.94 * ht2 + iiTmp * delt2, 0.45 * ht2)-(0.94 * ht2 + iiTmp * delt2, 0.55 * ht2), PenTxt(Index2)
Picture2.CurrentX = 0.96 * ht2 + iiTmp * delt2: Picture2.CurrentY = 0.5 * (ht2 - hTxt): Picture2.Print Format(iiTmp * 20, "0") & "%"
wTxt = Picture2.TextWidth(Format(iiTmp * 20, "0") & "%")
If 0.96 * ht2 + iiTmp * delt2 < lngTerm Then
ValeurCadre(iiTmp - 1).Left = 0.94 * ht2 + iiTmp * delt2: ValeurCadre(iiTmp - 1).Top = 0.45 * ht2
ValeurCadre(iiTmp - 1).BackColor = Picture2.FillColor: ValeurCadre(iiTmp - 1).BorderStyle = 0
ValeurCadre(iiTmp - 1).Height = 0.1 * ht2: ValeurCadre(iiTmp - 1).AutoRedraw = True
If lngTerm - (0.94 * ht2 + iiTmp * delt2) > wTxt Then ValeurCadre(iiTmp - 1).Width = 0.02 * ht2 + wTxt _
Else ValeurCadre(iiTmp - 1).Width = lngTerm - (0.94 * ht2 + iiTmp * delt2)
ValeurCadre(iiTmp - 1).Font.Size = Picture2.FontSize: ValeurCadre(iiTmp - 1).ForeColor = RGB(255, 255, 255)
ValeurCadre(iiTmp - 1).DrawWidth = 3: ValeurCadre(iiTmp - 1).Line (0, 0)-(0, ValeurCadre(iiTmp - 1).Height), RGB(255, 255, 255)
ValeurCadre(iiTmp - 1).CurrentX = 0.02 * ht2: ValeurCadre(iiTmp - 1).CurrentY = 0
ValeurCadre(iiTmp - 1).Print Format(iiTmp * 20, "0") & "%"
Else: ValeurCadre(iiTmp - 1).Visible = False
End If
Next iiTmp
SavePicture Picture2.Image, "C:\Picture2.bmp"
End Sub
В общем на экране всё получается
А вот когда использую SavePicture, картинка сохраняется, но без, Picturebox-ов Б1, Б2, Б3, Б4
Заранее благодарю
