PLEASE HELP ME! i have a big problem with creating and plaing META FILES and seting their MAPMODE

PLEASE LOOK AT THIS

This code is to write some text to the METAFILE and next show it in the
PictureBox. It might looks good, but the text is very spaced out :(
anybody knows why? I'm think that the problem lies in the line with :
SetViewPortExtEx.


--- CODE

Private Const MAX_WIDTH As Double = 793.28
Private Const MAX_HEIGHT As Double = 1122.72

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Const MM_ANISOTROPIC = 8

Private Declare Function MulDiv Lib "kernel32" (ByVal nNumber As Long,
ByVal nNumerator As Long, ByVal nDenominator As Long) As Long

Private Declare Function SetMapMode Lib "gdi32" (ByVal hDC As Long, ByVal
nMapMode As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long)
As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long,
ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal
hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal
hDC As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT,
ByVal wFormat 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 CreateEnhMetaFile Lib "gdi32" Alias
"CreateEnhMetaFileA" (ByVal hdcRef As Long, ByVal lpFileName As Any,
lpRect As RECT, ByVal lpDescription As Any) As Long
Private Declare Function SetWindowExtEx Lib "gdi32" (ByVal hDC As Long,
ByVal nX As Long, ByVal nY As Long, ByVal lpSize As Any) As Long
Private Declare Function SetViewportExtEx Lib "gdi32" (ByVal hDC As Long,
ByVal nX As Long, ByVal nY As Long, ByVal lpSize As Any) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long,
ByVal nIndex As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal
hDC As Long) As Long
Private Declare Function DeleteEnhMetaFile Lib "gdi32" (ByVal hemf As
Long) As Long
Private Declare Function PlayEnhMetaFile Lib "gdi32" (ByVal hDC As Long,
ByVal hemf As Long, lpRect As RECT) As Long
Private Declare Function CloseEnhMetaFile Lib "gdi32" (ByVal hDC 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 W 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 SetRect Lib "user32" (lpRect As RECT, ByVal X1 As
Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long


Private Sub cmdPreview_Click()

End Sub

Private Sub Form_Click()
Dim hemfImage As Long
Dim rectSurface As RECT

Dim hmfImage As Long
Dim PixelsX As Long
Dim PixelsY As Long
Dim MMX As Long
Dim MMY As Long
Dim rectArea As RECT
Dim hdcScreen As Long
Dim dwInchesX As Single
Dim dwInchesY As Single
Dim hMetaDC As Long
Dim nPixelsPerInchX As Long
Dim nPixelsPerInchY As Long

Dim hfontJazzy As Long
Dim hfontOld As Long
Dim sText As String
Dim hpenOld As Long

Const HORZSIZE = 4
Const HORZRES = 8
Const VERTSIZE = 6
Const VERTRES = 10
Const LOGPIXELSX = 88
Const LOGPIXELSY = 90

Me.AutoRedraw = True
Me.ScaleMode = vbPixels

SetRect rectSurface, 0, 0, MAX_WIDTH, MAX_HEIGHT

hdcScreen = GetDC(0&)

PixelsX = GetDeviceCaps(hdcScreen, HORZRES)
PixelsY = GetDeviceCaps(hdcScreen, VERTRES)
MMX = GetDeviceCaps(hdcScreen, HORZSIZE)
MMY = GetDeviceCaps(hdcScreen, VERTSIZE)
nPixelsPerInchX = GetDeviceCaps(hdcScreen, LOGPIXELSX)
nPixelsPerInchY = GetDeviceCaps(hdcScreen, LOGPIXELSY)

dwInchesX = (MAX_WIDTH / nPixelsPerInchX)
dwInchesY = (MAX_HEIGHT / nPixelsPerInchY)

SetRect rectArea, 0, 0, dwInchesX * 2540, dwInchesY * 2540

hMetaDC = CreateEnhMetaFile(hdcScreen, 0&, rectArea, 0&)

ReleaseDC 0, hdcScreen

If hMetaDC <> 0 Then
SetMapMode hMetaDC, MM_ANISOTROPIC

SetWindowExtEx hMetaDC, dwInchesX * nPixelsPerInchX, dwInchesY *
nPixelsPerInchY, 0&
SetViewportExtEx hMetaDC, (dwInchesX * 25.4 * PixelsX / MMX), (dwInchesY
* 25.4 * PixelsY / MMY), 0&

hfontJazzy = CreateFont(-MulDiv(8, GetDeviceCaps(hMetaDC, 90), 72), 0,
0, 0, 400, False, False, False, 0, 0, 0, 0, 0, "Tahoma")
hfontOld = SelectObject(hMetaDC, hfontJazzy)

sText = "This is a simple text. Why is it so cincise and spaced out
(abnormal)?"

TextOut hMetaDC, 0, 0, sText, Len(sText)

hemfImage = CloseEnhMetaFile(hMetaDC)
End If

PlayEnhMetaFile Me.hDC, hemfImage, rectSurface

DeleteEnhMetaFile hemfImage
Me.Refresh
End Sub

----

Thanks

KJ

.

Relevant Pages

  • RE: how to change prniter settings
    ... Private Declare Function OpenPrinter Lib "winspool.drv" Alias ... Dim PrinterHandle As Long ...
    (microsoft.public.win32.programmer.wmi)
  • Re: Need Help Using cards.dll with Excel VBA
    ... Private Declare Function DeleteObject Lib "gdi32" _ ... Private Declare Function CloseClipboard Lib "user32" _ ... Dim hModul As Long, hBitmap As Long ...
    (microsoft.public.excel.programming)
  • Re: Check if a program (.exe) is currently running.
    ... szExeFile As String * 260 ' MAX_PATH ... Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" _ ... Dim sCompareText As String ...
    (microsoft.public.vb.syntax)
  • Re: Pasting files from the clipboard
    ... > string containing a comma-delimited list of file names. ... > Private Declare Function OpenClipboard% Lib "user32" ... Dim retval As Long ...
    (microsoft.public.vb.general.discussion)
  • Re: Create picture in memory and move to a specific hdc
    ... Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As ... Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) ...
    (microsoft.public.vb.winapi.graphics)