VB 5/6-Tipp 0706: RTF-formatierten Text in die Zwischenablage kopieren
von Oliver Meyer
Beschreibung
Dieser Tipp demonstriert, wie man unter einfacher Verwendung des Clipboard-Objektes einen formatierten RTF-Text in die Zwischenablage einfügen kann, sodass dieser anschließend direkt vorformatiert in modernen Textverarbeitungsprogrammen eingefügt werden kann.
Schwierigkeitsgrad: | Verwendete API-Aufrufe: keine | Download: |
'Dieser Quellcode stammt von http://www.activevb.de 'und kann frei verwendet werden. Für eventuelle Schäden 'wird nicht gehaftet. 'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum. 'Ansonsten viel Spaß und Erfolg mit diesem Source! '------------- Anfang Projektdatei Projekt1.vbp ------------- '--------- Anfang Formular "Form1" alias Form1.frm --------- ' Steuerelement: Kontrollkästchen-Steuerelement "ChkBold" ' Steuerelement: Kombinationsliste "CmbFontSize" ' Steuerelement: Kombinationsliste "CmbFontName" ' Steuerelement: Schaltfläche "BtnCopy" ' Steuerelement: Textfeld "Text1" Option Explicit 'Die verschiedenen ClipBoard Konstanten, die von VB zur 'Verfügung gestellt werden: 'vbCFText = 1 'vbCFBitmap = 2 'vbCFMetafile = 3 'vbCFDIB = 8 'vbCFPalette = 9 'vbCFEMetafile = 14 'vbCFFiles = 15 'vbCFLink = -16640 '(&HFFFFBF00) 'vbCFRTF = -16639 '(&HFFFFBF01) <<-- wird hier gebraucht Private Sub Form_Load() 'Initialisieren der Fontnamen: Dim FNArr, fn, i As Long FNArr = Array("Courier New", _ "Arial", _ "Times New Roman", _ "Tahoma", _ "Verdana", _ "Wingdings") For Each fn In FNArr CmbFontName.AddItem fn Next CmbFontName.ListIndex = 1 'Initialisieren der Schriftgrößen: For i = 8 To 20 CmbFontSize.AddItem CStr(i) Next CmbFontSize.ListIndex = 1 BtnCopy.Caption = "in die Zwischenablage kopieren" ChkBold.Caption = "Bold" Text1.Text = "Hier kommt der formatierte Text" Call UpdateTextBoxFont End Sub Private Sub BtnCopy_Click() If RTFTextToClipboard( _ New_Font(CmbFontName.Text, _ CLng(CmbFontSize.Text), _ ChkBold.Value = vbChecked), _ Text1.Text) Then MsgBox "Jetzt können Sie den rtf-formatierten Text in Ihr " & _ "Textverarbeitungsprogramm einfügen" End If End Sub Private Sub CmbFontName_Click() UpdateTextBoxFont End Sub Private Sub CmbFontSize_Click() UpdateTextBoxFont End Sub Private Sub ChkBold_Click() Call UpdateTextBoxFont End Sub Private Sub UpdateTextBoxFont() If Len(CmbFontName.Text) > 0 And _ IsNumeric(CmbFontSize.Text) Then Set Text1.Font = New_Font( _ CmbFontName.Text, _ CLng(CmbFontSize.Text), _ ChkBold.Value = vbChecked) End If End Sub Public Function New_Font( _ ByVal FntName As String, _ ByVal aSize As Long, _ ByVal bBold As Boolean, _ Optional ByVal bItalic As Boolean, _ Optional ByVal bStrikeThr As Boolean, _ Optional ByVal aCharSet As Long _ ) As StdFont Set New_Font = New StdFont With New_Font .Name = FntName .Size = aSize .Bold = bBold .Italic = bItalic .Strikethrough = bStrikeThr .Charset = aCharSet End With End Function Private Function RTFTextToClipboard( _ ByVal aFont As StdFont, _ ByVal aText As String) As Boolean On Error Goto CatchE Dim s As String Dim cp As Long ' Codepage Dim lg As Long ' LanguageID Dim df As Long ' Nummer der Defaultfont Dim f As Long Dim sz As Long s = s & "{\rtf1\ansi" If cp = 0 Then cp = &H4E4& '1252 s = s & "\ansicpg" & CStr(cp) If df = 0 Then df = 0 'df = 1 ' oder evtl die zweite Schrift als default ? s = s & "\deff" & CStr(df) s = s & "{" s = s & GetFontTable(aFont) s = s & "}" s = s & "\viewkind4" s = s & "\uc1" s = s & "\pard" If lg = 0 Then lg = &H407 'SprachenID &H407 = deutsch in Deutschland s = s & "\lang" & CStr(lg) If aFont.Bold Then s = s & "\b" 'Fettgedruckt oder nicht f = 0 s = s & "\f" & CStr(f) sz = aFont.Size * 2 s = s & "\fs" & CStr(sz) '"\fs17" s = s & aText 'hier kommt der Text rein s = s & "\par}" Call Clipboard.SetText(s, vbCFRTF) RTFTextToClipboard = True CatchE: If Err = 0 Then Exit Function MsgBox "Fehler in Form1::RTFTextToClipboard" End Function Private Function GetFontTable(aFont As StdFont) As String Dim s As String Dim i As Long 'Nummer der ersten Schrift, hier 0 s = s & "\fonttbl" s = s & "{" s = s & "\f" & CStr(i) s = s & "\fnil" s = s & "\fcharset" s = s & CStr(aFont.Charset) & " " s = s & CStr(aFont.Name) & ";" s = s & "}" GetFontTable = s End Function '---------- Ende Formular "Form1" alias Form1.frm ---------- '-------------- Ende Projektdatei Projekt1.vbp --------------
Tipp-Kompatibilität:
Windows/VB-Version | Win32s | Win95 | Win98 | WinME | WinNT4 | Win2000 | WinXP |
VB4 | |||||||
VB5 | |||||||
VB6 |
Ihre Meinung
Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.
Archivierte Nutzerkommentare
Klicken Sie diesen Text an, wenn Sie die 1 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.
Kommentar von Gipsy am 22.04.2009 um 18:09
statt
Call Clipboard.SetText(s, vbCFRTF)
einfach Call Clipboard.SetText(s)
verwenden, dann klappt's ach mit dem Clipboard