/ Forside / Teknologi / Udvikling / VB/Basic / Nyhedsindlæg
Login
Glemt dit kodeord?
Brugernavn

Kodeord


Reklame
Top 10 brugere
VB/Basic
#NavnPoint
berpox 2425
pete 1435
CADmageren 1251
gibson 1230
Phylock 887
gandalf 836
AntonV 790
strarup 750
Benjamin... 700
10  tom.kise 610
Printer Problemer
Fra : trEx


Dato : 08-05-01 12:19

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



 
 
Morten Bryde (08-05-2001)
Kommentar
Fra : Morten Bryde


Dato : 08-05-01 19:30

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
>
>



Søg
Reklame
Statistik
Spørgsmål : 177558
Tips : 31968
Nyheder : 719565
Indlæg : 6408929
Brugere : 218888

Månedens bedste
Årets bedste
Sidste års bedste