kein Problem, ich bin selbst auf den Trichter gekommen, waren eh nicht
relevante Komandos. Meine Simulation ist jedenfalls lauffähig und geht
soweit.
Attribute VB_Name = "ModEncode"
' PCL-Code encodieren in HTML-Dokument
' StretchBlt() Modes
Public Const BLACKONWHITE& = 1 ' nur für Schwarz/Weiß
Public Const WHITEONBLACK& = 2 ' nur für Schwarz/Weiß
Public Const COLORONCOLOR& = 3 ' Qualität von PaintPicture
Public Const HALFTONE& = 4 ' höchste Qualität (Mittelwert der
Farben)
Public Const MAXSTRETCHBLTMODE& = 4
Public Declare Function SetStretchBltMode Lib "gdi32" (ByVal hdc As
Long, _
ByVal nStretchMode As Long) As Long
Public Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, _
ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight
As Long, _
ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, _
ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As
Long) As Long
Dim Modus As String
Public CmoWork As Boolean
Public RxBuffer As String
Public IdleCount As Long
Dim Inhalt As String
Dim AktPos As Long
Dim AktChar As String * 1
Dim SeiteNr As Integer
Dim CurX As Long
Dim CurY As Long
Public Sub LoadData(ByVal FileName As String)
' Datei laden
Open FileName For Binary As #1
Inhalt = String(FileLen(FileName), " ")
Get #1, , Inhalt
Close #1
' Datei decodieren
FrmMain.PicBlatt(1).Font.Name = "Courier New"
FrmMain.PicBlatt(1).Font.Size = 10
FrmMain.PicBlatt(1).Font.Bold = False
CurX = 0
CurY = 0
PixelX = 640
PixelY = 1
SeiteNr = 0
FrmMain.LblInfo.Caption = "Seite: " & SeiteNr + 1
For AktPos = 1 To Len(Inhalt)
'FrmMain.TxtAnzeige.Text = Mid(Inhalt, AktPos)
AktChar = Mid$(Inhalt, AktPos, 1)
' Seitenumbruch erzwingen bei Blattende
If CurY >= FrmMain.PicBlatt(1).Height Then
Call BlattNew
End If
' Aktuelle Zeichenposition setzen
FrmMain.PicBlatt(1).CurrentX = CurX
FrmMain.PicBlatt(1).CurrentY = CurY
' Aktuelles Zeichen detektieren
If AktChar = Chr$(27) Then
' ESC-Zeichen erkannt
Select Case Mid$(Inhalt, AktPos + 1, 1)
Case "*": ' Grafik
BlockLen = 0
' *-Typ decodieren (HP500C?)
CmdTyp = "UnBek"
If Mid$(Inhalt, AktPos + 2, 6) = "b0m80W" Then CmdTyp =
"BMPImgH"
If (Asc(Mid$(Inhalt, AktPos + 4, 1)) * &HFF + _
Asc(Mid$(Inhalt, AktPos + 3, 1))) _
<= 640 Then CmdTyp = "BMPImgV"
If Mid$(Inhalt, AktPos + 2, 4) = "r01A" Then CmdTyp = "r01A"
If Mid$(Inhalt, AktPos + 2, 5) = "rbc0U" Then CmdTyp = "rbc0U"
If Mid$(Inhalt, AktPos + 2, 5) = "r640S" Then CmdTyp = "r640S"
If Mid$(Inhalt, AktPos + 2, 5) = "r0q1A" Then CmdTyp = "r0q1A"
If Mid$(Inhalt, AktPos + 2, 3) = "rbC" Then CmdTyp = "rbC"
If Mid$(Inhalt, AktPos + 2, 5) = "t100R" Then CmdTyp = "t100R"
If Mid$(Inhalt, AktPos + 2, 3) = "p2N" Then CmdTyp = "p2N"
' erkannten Typ zerlegen
Select Case CmdTyp
Case "BMPImgH": ' Horizontale BMP
' Header lesen
GrLength = PixelX / 8
GrDaten = Mid$(Inhalt, AktPos + 8, GrLength + 2)
PosEoG = InStrRev(GrDaten, Chr$(&HD) & Chr(&H1B))
If PosEoG > 0 Then
GrLength = PosEoG - 1
End If
If AktPos + 8 + GrLength > Len(Inhalt) Then
GrLength = Len(Inhalt) - 8 - AktPos
End If
' Daten lesen
'If (RowCount Mod 6) <> 5 Then
For GrByteNr = 1 To GrLength
GrByte = Asc(Mid$(GrDaten, GrByteNr, 1))
'If (RowCount Mod 6) = 5 Then
' FrmMain.PicBlatt(1).ForeColor = RGB(128, 0, 0)
'End If
Call BlattPointByteH(GrByte)
Next GrByteNr
CurY = CurY + PixelY
'End If
CurX = 0
BlockLen = 7 + GrLength + 1
RowCount = RowCount + 1
FrmMain.PicBlatt(1).ForeColor = RGB(0, 0, 0)
Case "BMPImgV": ' Vertikale BMP
GrLength = Asc(Mid$(Inhalt, AktPos + 4, 1)) * &HFF + _
Asc(Mid$(Inhalt, AktPos + 3, 1))
If AktPos + 4 + GrLength > Len(Inhalt) Then
GrLength = Len(Inhalt) - 4 - AktPos
End If
GrDaten = Mid$(Inhalt, AktPos + 5, GrLength)
' Daten lesen
For GrByteNr = 1 To GrLength
GrByte = Asc(Mid$(GrDaten, GrByteNr, 1))
Call BlattPointByteV(GrByte)
Next GrByteNr
CurX = 0
CurY = CurY + 8
BlockLen = 6 + GrLength + 2
Case "r01A": ' Grafik ab Cursorposition
PixelY = 1
BlockLen = 5
Case "rbc0U":
BlockLen = 6
Case "r640S": ' Anzahl der Pixel = 640
PixelX = 640
BlockLen = 6
Case "r0q1A":
BlockLen = 6
Case "rbC": ' Grafikoff
RowCount = 0
BlockLen = 4
Case "t100R": ' Auflösung = 100 dpi
BlockLen = 6
Case "p2N":
BlockLen = 4
Case Else:
MsgBox Mid$(Inhalt, AktPos + 1, 20)
End Select
Case "=": ' Half LineFeed
CurY = CurY + 4
BlockLen = 1
Case "l":
BlockLen = 2
Case "3": ' Zeilenabstand n/180 Zoll
BlockLen = 2
Case "2": ' Zeilenabstand 1/6 Zoll
BlockLen = 1
Case "W":
BlockLen = 2
Case "E": ' Reset defaults
FrmMain.PicBlatt(1).Font.Bold = True
BlockLen = 1
Case "F": ' Fettdruck aus
FrmMain.PicBlatt(1).Font.Bold = False
BlockLen = 1
Case "4": ' Kursivdruck ein
FrmMain.PicBlatt(1).Font.Italic = True
BlockLen = 1
Case "5": ' Kursivdruck aus
FrmMain.PicBlatt(1).Font.Italic = False
BlockLen = 1
Case "P": ' 10,5 Punkte, 10 cpi auswählen
BlockLen = 1
Case "&": ' ? Benutzerdefiniertes Zeichen festlegen ?
CmdTyp = "UnBek"
If Mid$(Inhalt, AktPos + 2, 10) = "a+180v720H" Then CmdTyp =
"a+180v720H"
If Mid$(Inhalt, AktPos + 2, 4) = "l26A" Then CmdTyp = "l26A"
If Mid$(Inhalt, AktPos + 2, 4) = "a12L" Then CmdTyp = "a12L"
If Mid$(Inhalt, AktPos + 2, 3) = "k6W" Then CmdTyp = "k6W"
Select Case CmdTyp
Case "a+180v720H":
BlockLen = 11
Case "l26A":
BlockLen = 5
Case "a12L": ' Left margin = 12 colums
BlockLen = 5
Case "k6W":
BlockLen = 4
Case Else:
MsgBox Mid$(Inhalt, AktPos + 1, 20)
BlockLen = 0
End Select
Case "(": ' HP-typische Kommandos
CmdTyp = "UnBek"
If Mid$(Inhalt, AktPos + 2, 3) = "s0B" Then CmdTyp = "s0B"
If Mid$(Inhalt, AktPos + 2, 3) = "s3B" Then CmdTyp = "s3B"
If Mid$(Inhalt, AktPos + 2, 4) = "s12H" Then CmdTyp = "s12H"
If Mid$(Inhalt, AktPos + 2, 3) = "s6H" Then CmdTyp = "s6H"
If Mid$(Inhalt, AktPos + 2, 2) = "0U" Then CmdTyp = "0U"
If Mid$(Inhalt, AktPos + 2, 3) = "s6T" Then CmdTyp = "s6T"
Select Case CmdTyp
Case "s0B": ' Bold = off
FrmMain.PicBlatt(1).Font.Bold = False
BlockLen = 4
Case "s3B": ' Bold = on
FrmMain.PicBlatt(1).Font.Bold = True
BlockLen = 4
Case "s12H": ' Pitch = 12 cpi on
BlockLen = 5
Case "s6H":
BlockLen = 4
Case "0U":
BlockLen = 3
Case "s6T":
BlockLen = 4
Case Else:
MsgBox Mid$(Inhalt, AktPos + 1, 20)
BlockLen = 0
End Select
Case ")": ' HP-typische Kommandos
CmdTyp = "UnBek"
If Mid$(Inhalt, AktPos + 2, 3) = "s0B" Then CmdTyp = "s0B"
If Mid$(Inhalt, AktPos + 2, 4) = "s12H" Then CmdTyp = "s12H"
If Mid$(Inhalt, AktPos + 2, 3) = "s6H" Then CmdTyp = "s6H"
If Mid$(Inhalt, AktPos + 2, 2) = "0U" Then CmdTyp = "0U"
If Mid$(Inhalt, AktPos + 2, 3) = "s6T" Then CmdTyp = "s6T"
Select Case CmdTyp
Case "s0B": ' Stroke weight = Medium off
BlockLen = 4
Case "s12H": ' Pitch = 12 cpi off
BlockLen = 5
Case "s6H":
BlockLen = 4
Case "0U":
BlockLen = 3
Case "s6T":
BlockLen = 4
Case Else:
MsgBox Mid$(Inhalt, AktPos + 1, 20)
BlockLen = 0
End Select
Case Else:
MsgBox Mid$(Inhalt, AktPos + 1, 20)
BlockLen = 0
End Select
AktPos = AktPos + BlockLen
Else
' typisches Zeichen
With FrmMain.PicBlatt(1)
AktVal = Asc(AktChar)
Select Case AktVal
Case 10: ' LF (Line Feed)
CurY = CurY + FrmMain.PicBlatt(1).Font.Size
Case 12: ' FF (Form Feed)
If AktPos > 1 Then Call BlattNew
Case 13: ' CR (Carriage Return)
CurX = 0
Case Is >= 32: ' normales ASCII-Zeichen
FrmMain.PicBlatt(1).Print AktChar;
CurX = CurX + FrmMain.PicBlatt(1).Font.Size - 2
If CurX > 640 Then
CurX = 0
CurY = CurY + FrmMain.PicBlatt(1).Font.Size - 2
End If
End Select
End With
End If
DoEvents
Next AktPos
Call BlattNew
End Sub
Sub BlattNew()
' Bild umkopieren
FrmMain.PicBlatt(0).Cls
Call SetStretchBltMode(FrmMain.PicBlatt(0).hdc, HALFTONE)
Call StretchBlt(FrmMain.PicBlatt(0).hdc, 0, 0,
FrmMain.PicBlatt(0).Width, FrmMain.PicBlatt(0).Height,
FrmMain.PicBlatt(1).hdc, 0, 0, FrmMain.PicBlatt(1).Width,
FrmMain.PicBlatt(1).Height, vbSrcCopy)
SeiteNr = SeiteNr + 1
FrmMain.LblInfo.Caption = "Seite: " & SeiteNr
FrmMain.CboSeite.AddItem FrmMain.LblInfo.Caption
FrmMain.CboSeite = FrmMain.LblInfo.Caption
FrmMain.CboSeite.Enabled = True
If SeiteNr <= 40 Then
SavePicture FrmMain.PicBlatt(1).Image, App.Path & "\Seite_" &
CStr(SeiteNr) & ".bmp"
End If
FrmMain.PicBlatt(1).Cls
CurX = 0
CurY = 0
End Sub
'
************************************************************************
******
' Grafik-Routinen
'
************************************************************************
******
Sub BlattPointByteV(ByVal ByteWert As Byte)
FrmMain.PicBlatt(1).Line (CurX, CurY)-(CurX, CurY + 8), RGB(240, 240,
240)
If (ByteWert And &H1) <> 0 Then FrmMain.PicBlatt(1).PSet (CurX, CurY +
7), RGB(0, 0, 0)
If (ByteWert And &H2) <> 0 Then FrmMain.PicBlatt(1).PSet (CurX, CurY +
6), RGB(0, 0, 0)
If (ByteWert And &H4) <> 0 Then FrmMain.PicBlatt(1).PSet (CurX, CurY +
5), RGB(0, 0, 0)
If (ByteWert And &H8) <> 0 Then FrmMain.PicBlatt(1).PSet (CurX, CurY +
4), RGB(0, 0, 0)
If (ByteWert And &H10) <> 0 Then FrmMain.PicBlatt(1).PSet (CurX, CurY
+ 3), RGB(0, 0, 0)
If (ByteWert And &H20) <> 0 Then FrmMain.PicBlatt(1).PSet (CurX, CurY
+ 2), RGB(0, 0, 0)
If (ByteWert And &H40) <> 0 Then FrmMain.PicBlatt(1).PSet (CurX, CurY
+ 1), RGB(0, 0, 0)
If (ByteWert And &H80) <> 0 Then FrmMain.PicBlatt(1).PSet (CurX, CurY
+ 0), RGB(0, 0, 0)
CurX = CurX + 1
End Sub
Sub BlattPointByteH(ByVal ByteWert As Byte)
FrmMain.PicBlatt(1).Line (CurX, CurY)-(CurX + 8, CurY), RGB(240, 240,
240)
If (ByteWert And &H1) <> 0 Then FrmMain.PicBlatt(1).PSet (CurX + 7,
CurY), RGB(0, 0, 0)
If (ByteWert And &H2) <> 0 Then FrmMain.PicBlatt(1).PSet (CurX + 6,
CurY), RGB(0, 0, 0)
If (ByteWert And &H4) <> 0 Then FrmMain.PicBlatt(1).PSet (CurX + 5,
CurY), RGB(0, 0, 0)
If (ByteWert And &H8) <> 0 Then FrmMain.PicBlatt(1).PSet (CurX + 4,
CurY), RGB(0, 0, 0)
If (ByteWert And &H10) <> 0 Then FrmMain.PicBlatt(1).PSet (CurX + 3,
CurY), RGB(0, 0, 0)
If (ByteWert And &H20) <> 0 Then FrmMain.PicBlatt(1).PSet (CurX + 2,
CurY), RGB(0, 0, 0)
If (ByteWert And &H40) <> 0 Then FrmMain.PicBlatt(1).PSet (CurX + 1,
CurY), RGB(0, 0, 0)
If (ByteWert And &H80) <> 0 Then FrmMain.PicBlatt(1).PSet (CurX + 0,
CurY), RGB(0, 0, 0)
CurX = CurX + 8
End Sub
Grüße Nachos
