Jeg nevnte dette problemet på 'comp.lang.basic.visual.misc'
og se hva Jerry French la ut der:
TCPrintObject.cls sorts out many of these irritants.
====== FORM1.FRM ======
Option Explicit
' 1 Add a Picturebox
' 2 Add a Command Button
Dim PO As New TGPrintObject
Private Sub Command1_Click()
Set PO.Device = Picture1
PO.Font.Name = "Courier"
PO.Output "This Is a Test", 400, 200
PO.Font.Bold = True
PO.Font.Size = 18
PO.Output "And More", 400, 2000
End Sub
====== TGPRINTOBJECT.CLS ======
Option Explicit
'====================================================================
'
' TGPrintObject.Cls
'
' A simple Encapsulation for a Print Target
' ie: Printer or PictureBox
'
' 14/03/01 jerry@iss.u-net.com
'
'
'====================================================================
Private Declare Function GetDeviceCaps Lib "gdi32" _
(ByVal hdc As Long, ByVal nindex As Long) As Long
Dim mObj As Variant
Dim mTopMargin#, mLeftMargin#
Dim mScaleMode%
' #################################################################
'
'
'
Public Property Set Device(Value As Object)
Set mObj = Value
LS_CalcMargins
End Property
Private Sub LS_CalcMargins()
Dim xMargin#, yMargin#, tpi#, H%, ScaleFactor#
mLeftMargin = 0
mTopMargin = 0
If Not TypeOf mObj Is Printer Then
Exit Sub
End If
Printer.ScaleMode = vbTwips
ScaleFactor# = Printer.ScaleWidth
Printer.ScaleMode = mScaleMode
ScaleFactor# = ScaleFactor# / Printer.ScaleWidth
With Printer
xMargin = GetDeviceCaps(.hdc, 112)
xMargin = (xMargin * .TwipsPerPixelX) / ScaleFactor#
yMargin = GetDeviceCaps(.hdc, 113)
yMargin = (yMargin * .TwipsPerPixelY) / ScaleFactor#
mLeftMargin = xMargin
mTopMargin = yMargin
End With
End Sub
Public Property Get Device() As Object
Set Device = mObj
End Property
Public Property Let CurrentX(Value As Double)
mObj.CurrentX = Value - mLeftMargin
End Property
Public Property Get CurrentX() As Double
CurrentX = mObj.CurrentX + mLeftMargin
End Property
Public Property Let CurrentY(Value As Double)
mObj.CurrentY = Value - mTopMargin
End Property
Public Property Get CurrentY() As Double
CurrentY = mObj.CurrentY + mTopMargin
End Property
Public Property Let ScaleMode(Value As Integer)
mScaleMode = Value
LS_CalcMargins
End Property
Public Property Get ScaleMode() As Integer
ScaleMode = mScaleMode
End Property
Public Property Set Font(Value As StdFont)
Set mObj.Font = Value
End Property
Public Property Get Font() As StdFont
Set Font = mObj.Font
End Property
Public Property Get TextWidth(S$) As Double
TextWidth = mObj.TextWidth(S$) ' this is in current scalemode
End Property
Public Property Get TextHeight(S$) As Double
TextHeight = mObj.TextHeight(S$) ' this is in current scalemode
End Property
Public Property Get Height() As Double
Height = mObj.ScaleHeight
End Property
Public Property Let ForeColor(Value As OLE_COLOR)
If TypeOf mObj Is Printer Then Exit Property
mObj.ForeColor = Value
End Property
Public Property Let BackColor(Value As OLE_COLOR)
If TypeOf mObj Is Printer Then Exit Property
mObj.BackColor = Value
End Property
Public Sub Cls()
If TypeOf mObj Is Printer Then
Exit Sub
End If
mObj.Cls
End Sub
' #################################################################
'
' Print a Line without moving the Print Head
Public Sub LineX(X#, W#)
Dim O As Object, V#, H#
Set O = mObj
O.Print "";
Call LS_Position("S")
H = X - mLeftMargin
V = Me.CurrentY - mTopMargin
O.FillStyle = vbFSSolid
O.Line (H, V)-(H + W, V + 0.25), O.ForeColor, BF
Call LS_Position("R")
End Sub
' #################################################################
'
'
Public Sub NewPage()
Dim O As Object, V#
If TypeOf mObj Is Printer Then
mObj.NewPage
Exit Sub
End If
' --- For a Picture Box
Set O = mObj
V = O.CurrentY + TextHeight("") / 2
O.Line (O.CurrentX, V)-(O.ScaleWidth, V)
Set O = Nothing
Call NewLine
End Sub
' #################################################################
'
'
Public Sub EndDoc()
If TypeOf mObj Is Printer Then
mObj.EndDoc
Exit Sub
End If
End Sub
' #################################################################
'
'
Public Sub ClearLine()
Dim H!, Q&
If TypeOf mObj Is Printer Then Exit Sub
H = Me.CurrentX
' --- Print Width * 1.5 spaces - fudge for Bold
Q = mObj.ScaleWidth / mObj.TextWidth(" ") * 1.5
Me.Print String$(Q, " ");
Me.CurrentX = H
End Sub
' #################################################################
'
' Note: We print *above* the CurrentY
' Necessary for aligning different Font Sizes
' Note: The Print Head moves right but NOT down - unless vbCr in
string
'
Public Sub Output(ByVal Text$, _
Optional ByVal V As Variant, _
Optional ByVal H As Variant)
Dim HoldV#, HoldH#, Q%
HoldV = Me.CurrentY
mObj.Print "";
If IsMissing(V) Then V = Me.CurrentY
If IsMissing(H) Then H = Me.CurrentX
Me.CurrentY = V
Me.CurrentX = H
' --- adjust vertical position for height of other font
' descender is 0.25 - below CurrentY - get Base of Char at
CurrentY
Me.CurrentY = Me.CurrentY - (Me.TextHeight("M") * 0.75)
Do
Q = InStr(Text$, vbCr)
If Q Then
HoldH = Me.CurrentX
mObj.Print Left$(Text$, Q - 1) ' Allow a line drop
HoldV = HoldV + Me.TextHeight("M") ' Remember the Line Drop
Me.CurrentX = HoldH ' Restore Horiz position
Text = Mid$(Text, Q + 1)
End If
Loop Until Q = 0
mObj.Print Text$;
Me.CurrentY = HoldV
End Sub
' #################################################################
'
' Center Some Text
'
Public Sub Center(Text$, HPos#, Width#)
Dim L#
L = (Width - Me.TextWidth(Text$)) / 2
Me.CurrentX = HPos + L
Me.Output Text$
End Sub
' #################################################################
'
'
'
Public Sub RightJust(Text$, _
Optional V As Variant, _
Optional H As Variant)
If IsMissing(V) Then V = Me.CurrentY
If IsMissing(H) Then H = Me.CurrentX
Me.Output Text, V, (H - Me.TextWidth(Text$))
End Sub
' #################################################################
'
' Return a wrapped string - vbCr indicates Wrap positions
'
Function Wrap$(ByVal Text$, W#)
Dim L$, P%, Result$, S$, i
S$ = "x"
i = 1
While Len(S$)
S$ = Mid$(Text$, i, 1)
If S$ = " " Then P = i ' remember last P
If TextWidth(L$ + S$) > W Then ' it would be too wide
If P = 0 Then P = i ' can't wrap
Result$ = Result$ + Trim$(Left$(L$, P)) + vbCr
Text$ = Trim$(Mid$(Text$, P + 1))
P = 0
L$ = ""
i = 1
Else
L$ = L$ + S$
i = i + 1
End If
Wend
Wrap = Result$ + L$
End Function
' #################################################################
'
'
Private Sub LS_FixDashField(Value$, L&)
If Left$(Value$, 1) = "-" Then
If Value$ = String$(Len(Value$), "-") Then
While mObj.TextWidth(Value$) < L
Value$ = Value$ + "-"
Wend
End If
End If
End Sub
' #################################################################
'
'
Public Sub NewLine()
Dim Q#
' --- Trap for running over page end
If TypeOf mObj Is Printer Then
Q = mObj.ScaleHeight
If (mObj.CurrentY + mObj.TextHeight("")) > Q Then
mObj.NewPage
End If
End If
mObj.Print
End Sub
' #################################################################
'
'
Private Sub LS_Position(Act$)
Static X#, Y#
Select Case Act$
Case "S": X = Me.CurrentX: Y = Me.CurrentY
Case "R": Me.CurrentX = X: Me.CurrentY = Y
Case Else: MsgBox "Bad Act$ - LS_Position"
End Select
End Sub
========= END OF CODE ==========
Takk, Jerry French
"trEx" <amd900athlon@hotmail.com> wrote in message
news:9d8kld$10u$1@news.inet.tele.dk...
> Hej NG
>
> Jeg er ved at lave et skrive program, men jeg kan ikke få min printer til
at
> skrive "Ordentlig" ud.
> Den vil godt skrive ud men problemet er at teksten står HELT oppe i højre
> hjørne. Hvordan kan jeg
> få min tekst til at tilpasse margen på papiret ?????. (min tekstbox hedder
> txtFelt)
>
> M.V.H.
> Stefan Thilemann
> amd900athlon@hotmail.com
>
>