VB.NET SITES

http://directory.google.com/Top/Computers/Programming/Languages/Visual_Basic/Visual_Basic.NET/

http://msdn.microsoft.com/lv-lv/vbasic/default%28en-us%29.aspx

http://code.msdn.microsoft.com/

http://www.google.com/search?q=VB.NET

Font sizes
http://www.vbmonster.com/Uwe/Forum.aspx/vb-winapi/3821/Enum-font-sizes

How to print selected controls with high resolution?

' *** START OF FORM CODE ***
Option Explicit
Private Sub Command1_Click()
Dim charsToPrint As Long, nextChar As Long
Dim pWide As Single, pHigh As Single
Dim columnWide As Single, columnHigh As Single
Printer.Orientation = vbPRORLandscape
Printer.Print
Printer.ScaleMode = vbInches
pWide = Printer.ScaleX(Printer.Width, vbTwips, vbInches)
pHigh = Printer.ScaleY(Printer.Height, vbTwips, vbInches)
columnWide = (pWide - 0.7 * 4) / 2
columnHigh = pHigh - 0.7 * 2
charsToPrint = Len(RichTextBox1.Text)
nextChar = 0
Do
 nextChar = PrintRTF(RichTextBox1, 0.7, 0.7, _
              columnWide, columnHigh, nextChar)
 If nextChar <= charsToPrint Then
   nextChar = PrintRTF(RichTextBox1, columnWide _
     + 2.1, 0.7, columnWide, columnHigh, nextChar)
 End If
 If nextChar <= charsToPrint Then
   Printer.NewPage
 End If
Loop Until nextChar > charsToPrint
Printer.EndDoc
End Sub
' *** END OF FORM CODE ***
'
' *** START OF MODULE CODE ***
Option Explicit
Private Type Rect
 Left As Long
 Top As Long
 Right As Long
 Bottom As Long
End Type
Private Type CharRange
 cpMin As Long
 cpMax As Long
End Type
Private Type FormatRange
 hdc As Long
 hdcTarget As Long
 rc As Rect
 rcPage As Rect
 chrg As CharRange
End Type
Private Const WM_USER As Long = &H400
Private Const EM_FORMATRANGE As Long = WM_USER + 57
Private Const EM_SETTARGETDEVICE As Long = WM_USER + 72
Private Const PHYSICALOFFSETX As Long = 112
Private Const PHYSICALOFFSETY As Long = 113
Private Declare Function GetDeviceCaps Lib "gdi32" ( _
 ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function SendMessage Lib "USER32" _
 Alias "SendMessageA" (ByVal hWnd As Long, _
 ByVal msg As Long, ByVal wp As Long, lp As Any) As Long
Private Declare Function CreateDC Lib "gdi32" Alias _
 "CreateDCA" (ByVal lpDriverName As String, _
 ByVal lpDeviceName As String, ByVal lpOutput As Long, _
 ByVal lpInitData As Long) As Long

Public Function PrintRTF(RTF As RichTextBox, x1 As Single, _
 y1 As Single, Wide As Single, High As Single, _
 charPos As Long) As Long
Dim LeftOffset As Long, TopOffset As Long
Dim LeftMargin As Long, TopMargin As Long
Dim RightMargin As Long, BottomMargin As Long
Dim fr As FormatRange, rcDrawTo As Rect
Dim rcPage As Rect
Dim NextCharPosition As Long, r As Long
LeftOffset = Printer.ScaleX(GetDeviceCaps(Printer.hdc, _
        PHYSICALOFFSETX), vbPixels, vbTwips)
TopOffset = Printer.ScaleY(GetDeviceCaps(Printer.hdc, _
        PHYSICALOFFSETY), vbPixels, vbTwips)
LeftMargin = Printer.ScaleX(x1, Printer.ScaleMode, _
        vbTwips) - LeftOffset
TopMargin = Printer.ScaleY(y1, Printer.ScaleMode, _
        vbTwips) - TopOffset
RightMargin = LeftMargin + Printer.ScaleX(Wide, _
       Printer.ScaleMode, vbTwips)
BottomMargin = TopMargin + Printer.ScaleY(High, _
       Printer.ScaleMode, vbTwips)
rcPage.Left = 0
rcPage.Top = 0
rcPage.Right = Printer.ScaleX(Printer.ScaleWidth, _
       Printer.ScaleMode, vbTwips)
rcPage.Bottom = Printer.ScaleY(Printer.ScaleHeight, _
       Printer.ScaleMode, vbTwips)
rcDrawTo.Left = LeftMargin
rcDrawTo.Top = TopMargin
rcDrawTo.Right = RightMargin
rcDrawTo.Bottom = BottomMargin
fr.hdc = Printer.hdc
fr.hdcTarget = Printer.hdc
fr.rc = rcDrawTo
fr.rcPage = rcPage
fr.chrg.cpMin = charPos
fr.chrg.cpMax = -1
 PrintRTF = True
 PrintRTF = SendMessage(RTF.hWnd, _
   EM_FORMATRANGE, True, fr)
r = SendMessage(RTF.hWnd, EM_FORMATRANGE, False, ByVal _
 CLng(0))
End Function
' *** END OF MODULE CODE ***

Select polygon on EMF on MouseOver

Private Sub picBox_MouseDown(ByRef Button As Integer, ByRef Shift As
Integer, ByRef X As Single, ByRef Y As Single)
   Dim HitIdx As Long
   Dim hRgn As Long, LowIdx As Long, HighIdx As Long
   Dim hFillBrush As Long, hStrokeBrush As Long, hOldBrush As Long
   Dim OldR2 As Long
   Dim hdc As Long

   ' Hit test this coordinates
   HitIdx = m_EMFScan.HitTest( _
       picBox.ScaleX(x, Me.ScaleMode, vbPixels), _
       picBox.ScaleY(y, Me.ScaleMode, vbPixels))

   ' Multiple selection (work in progress)
   If Shift = 0 Then
       Call picBox.Refresh
   End If

   If (HitIdx <> -1) Then ' Hit something!  Get info about what
       hRgn = m_EMFScan.GetHitArea(HitIdx, LowIdx, HighIdx)

       ' Create GDI objects to draw selections
       hFillBrush = CreateHatchBrush(HS_BDIAGONAL, vbWhite)
       hStrokeBrush = CreateSolidBrush(vbWhite)

       ' Cache device context handle
       hdc = picBox.hdc

       ' Draw selection
       OldR2 = SetROP2(hdc, R2_MASKPENNOT)
       Call FillRgn(hdc, hRgn, hFillBrush)
       Call FrameRgn(hdc, hRgn, hStrokeBrush, 2, 2)
       Call SetROP2(hdc, OldR2)

       ' Clean up
       Call DeleteObject(hStrokeBrush)
       Call DeleteObject(hFillBrush)

       '*** COPY TO NEW PICTUREBOX

       frmMain.txtStartIdx.Text = LowIdx
       frmMain.txtEndIdx.Text = HighIdx

       If Not (txtFileName.Text = "" Or txtStartIdx.Text = "") Then
           Call PlaySelectedRecords(picBoxCopy, txtFileName.Text,
txtStartIdx.Text, txtEndIdx.Text)
       End If
       picBoxCopy.Refresh

       '*** COPYTO NEW PICTUREBOX

   End If

End Sub

'****

Function PlaySelectedRecords(pic As PictureBox, EMFFileName As String,
startIdx As Long, endIdx As Long)

   recordIndex = 0

'Fixed dimension, will apply EMF correct width and height in the next
few days
   Dim R As RectAPI
   R.Top = 0
   R.Left = 0
   R.Bottom = 200
   R.Right = 200

'Indexes
   startRecIdx = startIdx
   endRecIdx = endIdx

   hEmf = GetEnhMetaFile(EMFFileName)

   Call EnumEnhMetaFile(pic.hdc, hEmf, AddressOf
SelectedRecordsPlayback, 0, R)

End Function

'****

Function SelectedRecordsPlayback(ByVal hdc As Long, ByVal lpHTable As
Long, ByVal lpEMFR As Long, ByVal nObj As Long, ByVal lpData As Long)
As Long
   Dim RecType As enEMFRecordType

   Call GetDWord(ByVal lpEMFR, RecType)

   If (recordIndex >= startRecIdx And recordIndex <= endRecIdx) Or
isQualifiedRecord(RecType) Then
      'Debug.Print CStr(recordIndex) & ") " &
EMRRecordTypeToString(RecType)
      PlayEnhMetaFileRecord hdc, lpHTable, lpEMFR, nObj
   End If

   recordIndex = recordIndex + 1
   SelectedRecordsPlayback = 1

End Function

'****

Private Sub picBox_Paint()
   Call PlayEnhMetaFile(picBox.hdc, m_EMF, m_PlayArea)
End Sub

'****

Private Sub picBoxCopy_Paint()
   If Not (txtFileName.Text = "" Or txtStartIdx.Text = "") Then

       Call PlaySelectedRecords(picBoxCopy, txtFileName.Text,
txtStartIdx.Text, txtEndIdx.Text)
   End If

End Sub

'****

Then, in a CommandButton_Click, I do the following:

  Call SavePicture(picBoxCopy.Image, "C:\temp.emf")

but no valid .bmp has been created.

Besides, I try to output a EMF file using:

Private Sub cmdSaveEMF_Click()

   hDeskDC = CreateCompatibleDC(picBoxCopy.hdc)
   hEMetaDC = CreateEnhMetaFile(picBoxCopy.hdc, "c:\temp.emf", ByVal
0&, vbNullString)
   Call ReleaseDC(0&, hDeskDC)
   Call SaveDC(hEMetaDC)

   Call RestoreDC(hEMetaDC, -1)
   Call CloseEnhMetaFile(hEMetaDC)

End Sub

create pdf file in VB6

Getting pixels from EMF (StdPicture)