Option Explicit

Private Declare Function SendMessage Lib "user32" Alias _
      "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
      ByVal wParam As Long, lParam As Any) As Long

Const WM_PASTE = &H302

Private Sub mnuFileNew_Click()
  RTFBox.Text = vbNullString
End Sub

Private Sub mnuFileOpen_Click()
  On Error GoTo errHandler
  RTFBox.LoadFile App.Path & "\test.rtf"

  Exit Sub

errHandler:
  If Err.Number <> 0 Then
    MsgBox "Fehler " & Str$(Err.Number) & ": " & vbCrLf & _
        Err.Description, vbOKOnly + vbCritical, _
        Title:=Me.Caption
  End If
End Sub

Private Sub mnuFileSave_Click()
  RTFBox.SaveFile App.Path & "\test.rtf"
End Sub

Private Sub mnuFileQuit_Click()
  Unload Me
  End
End Sub

Private Sub mnuFormatFont_Click()
  With CommonDialog1
    .FontBold = GetFontStyle(RTFBox.SelBold, False)
    .FontItalic = GetFontStyle(RTFBox.SelItalic, False)
    .FontUnderline = GetFontStyle(RTFBox.SelUnderline, False)
    .FontStrikethru = GetFontStyle(RTFBox.SelStrikeThru, False)
    .Color = GetFontStyle(RTFBox.SelColor, 0)

    .FontName = GetFontStyle(RTFBox.SelFontName, "")
    .FontSize = GetFontStyle(RTFBox.SelFontSize, 0)

    On Error Resume Next
    .Flags = cdlCFScreenFonts Or cdlCFEffects
    .ShowFont
    If Err.Number = cdlCancel Then
      Exit Sub
    ElseIf Err.Number <> 0 Then
      MsgBox "Fehler " & Str$(Err.Number) & _
          " bei Auswahl der Schriftart." & _
          vbCrLf & Err.Description, _
          Title:=Me.Caption
      Exit Sub
    End If
    On Error GoTo 0

    RTFBox.SelBold = .FontBold
    RTFBox.SelItalic = .FontItalic
    RTFBox.SelUnderline = .FontUnderline
    RTFBox.SelStrikeThru = .FontStrikethru
    RTFBox.SelColor = .Color

    RTFBox.SelFontName = .FontName
    RTFBox.SelFontSize = .FontSize
  End With
End Sub

Private Function GetFontStyle(ByVal varStyle As Variant, _
          ByVal varDefault As Variant) As Variant
  If IsNull(varStyle) Then
    GetFontStyle = varDefault
  Else
    GetFontStyle = varStyle
  End If
End Function

Private Sub ToolBar1_ButtonClick(ByVal Button As Button)

  Select Case Button.Key
    Case Is = "bold"
      If Button.MixedState = True Then
        Button.MixedState = False
      End If
      RTFBox.SelBold = Abs(RTFBox.SelBold) - 1

    Case Is = "italic"
      If Button.MixedState = True Then
        Button.MixedState = False
      End If
      RTFBox.SelItalic = Abs(RTFBox.SelItalic) - 1

    Case Is = "underline"
      If Button.MixedState = True Then
        Button.MixedState = False
      End If
      RTFBox.SelUnderline = Abs(RTFBox.SelUnderline) - 1

    Case Is = "strikethru"
      If Button.MixedState = True Then
        Button.MixedState = False
      End If
      RTFBox.SelStrikeThru = Abs(RTFBox.SelStrikeThru) - 1

    Case Is = "left"
      RTFBox.SelAlignment = rtfLeft

    Case Is = "center"
      RTFBox.SelAlignment = rtfCenter

    Case Is = "right"
      RTFBox.SelAlignment = rtfRight
  End Select
End Sub

Private Sub RTFBox_SelChange()
  With ToolBar1
    With .Buttons("bold")
      If .MixedState = True Then
        .MixedState = False
      End If
    End With
    '... 
    '... 
  End With

  Select Case RTFBox.SelBold
    Case 0
      ToolBar1.Buttons("bold").Value = tbrUnpressed

    Case -1
      ToolBar1.Buttons("bold").Value = tbrPressed

    Case Else
      ToolBar1.Buttons("bold").MixedState = True
  End Select

  '... 
  '... 

  Select Case RTFBox.SelAlignment
    Case Is = rtfLeft
      ToolBar1.Buttons("left").Value = tbrPressed

    Case Is = rtfRight
      ToolBar1.Buttons("right").Value = tbrPressed

    Case Is = rtfCenter
      ToolBar1.Buttons("center").Value = tbrPressed

    Case Else
      With ToolBar1
        .Buttons("left").Value = tbrUnpressed
        .Buttons("right").Value = tbrUnpressed
        .Buttons("center").Value = tbrUnpressed
      End With
  End Select
End Sub

Private Sub Picture2_DblClick(Index As Integer)
  Clipboard.Clear
  Clipboard.SetData Picture2(Index).Image
  SendMessage RTFBox.hwnd, WM_PASTE, 0, 0
  RTFBox.SetFocus
End Sub