Clipboard UI Inspector

dige · Post by **dige** » Tue Sep 09, 2025 2:28 pm

When you select and copy text in my browser, it is transferred to the clipboard as text and HTML. I didn't want to copy the text to Notepad, but rather the HTML. This is what happened:

Code: Select all

; ===================================================================
; Clipboard UI Inspector (Windows)
; v1.0 09.9.25 by Dige
; v1.1 12.9.25 bug fixed, thanks Axolotl
; ===================================================================

EnableExplicit

CompilerIf #PB_Compiler_OS <> #PB_OS_Windows
  MessageRequester("Clipboard", "This program is Windows-only.")
  End
CompilerEndIf

; ---- Image encoders for saving (PNG/JPEG/BMP) ----
UsePNGImageEncoder()
UseJPEGImageEncoder()

; ---- Windows clipboard constants ----
#CF_TEXT        = 1
#CF_UNICODETEXT = 13
#CF_HDROP       = 15
#CF_DIB         = 8
#CF_BITMAP      = 2
#MAX_PATH       = 260
#DIB_RGB_COLORS = 0

; ---- Gadget IDs ----
Enumeration 1000
  #G_Panel
  #G_EditFormats
  #G_EditHtmlRaw
  #G_EditHtmlFrag
  #G_EditRtf
  #G_EditUnicode
  #G_EditAnsi
  #G_EditFiles
  #G_ImageDIB
  #G_ImageBMP
  #G_BtnRefresh
  #G_BtnSave
  #G_Status
EndEnumeration

; ===================================================================
; Utilities
; ===================================================================

Procedure.s DesktopFolder()
  ; Returns the user Desktop path (with trailing backslash)
  Protected path$ = GetUserDirectory(#PB_Directory_Desktop)
  If Right(path$, 1) <> "\" : path$ + "\" : EndIf
  ProcedureReturn path$
EndProcedure

Procedure.i SaveTextFile(path$, text$, encoding = #PB_UTF8)
  ; Saves text content with selected encoding; returns #True on success
  Protected ok = #False
  Protected f = CreateFile(#PB_Any, path$)
  If f
    Select encoding
      Case #PB_UTF8   : WriteStringFormat(f, #PB_UTF8)
      Case #PB_Ascii  : WriteStringFormat(f, #PB_Ascii)
      Case #PB_Unicode: WriteStringFormat(f, #PB_Unicode)
    EndSelect
    WriteString(f, text$)
    CloseFile(f)
    ok = #True
  EndIf
  ProcedureReturn ok
EndProcedure

Procedure.i SaveImageByExt(img, path$)
  ; Saves image depending on file extension (png/jpg/jpeg/bmp)
  Protected ext$ = LCase(GetExtensionPart(path$))
  Protected ok = #False
  If ext$ = "png"
    ok = SaveImage(img, path$, #PB_ImagePlugin_PNG)
  ElseIf ext$ = "jpg" Or ext$ = "jpeg"
    ok = SaveImage(img, path$, #PB_ImagePlugin_JPEG, 8) ; quality 0..10
  ElseIf ext$ = "bmp"
    ok = SaveImage(img, path$, #PB_ImagePlugin_BMP)
  Else
    ; Default to PNG if unknown extension
    ok = SaveImage(img, path$, #PB_ImagePlugin_PNG)
  EndIf
  ProcedureReturn ok
EndProcedure

; Maps a panel tab index to a sensible default filename + encoding
; Text tabs return encoding; image tabs return encoding=-1 (not used)
Procedure.i DefaultSaveInfo(tab, *filenameOut.STRING, *encodingOut.INTEGER) 
  Select tab
    Case 0 : *filenameOut\s = "clipboard_formats.txt" : *encodingOut\i = #PB_UTF8   : ProcedureReturn #True
    Case 1 : *filenameOut\s = "clip_html_raw.txt"     : *encodingOut\i = #PB_Ascii  : ProcedureReturn #True
    Case 2 : *filenameOut\s = "clip.html"             : *encodingOut\i = #PB_UTF8   : ProcedureReturn #True
    Case 3 : *filenameOut\s = "clip.rtf"              : *encodingOut\i = #PB_Ascii  : ProcedureReturn #True
    Case 4 : *filenameOut\s = "clip.txt"              : *encodingOut\i = #PB_UTF8   : ProcedureReturn #True
    Case 5 : *filenameOut\s = "clip_ansi.txt"         : *encodingOut\i = #PB_UTF8   : ProcedureReturn #True
    Case 6 : *filenameOut\s = "clip_files.txt"        : *encodingOut\i = #PB_UTF8   : ProcedureReturn #True
    Case 7 : *filenameOut\s = "clip_dib.png"          : *encodingOut\i = -1         : ProcedureReturn #True
    Case 8 : *filenameOut\s = "clip_bitmap.png"       : *encodingOut\i = -1         : ProcedureReturn #True
  EndSelect  
  ProcedureReturn #False
EndProcedure

; ===================================================================
; Format name helper
; ===================================================================

Procedure.s FormatName(uFormat)
  ; Maps format IDs to human-readable names. Falls back to GetClipboardFormatName_
  Protected name$ = ""
  Select uFormat
    Case #CF_TEXT        : name$ = "CF_TEXT"
    Case #CF_UNICODETEXT : name$ = "CF_UNICODETEXT"
    Case #CF_HDROP       : name$ = "CF_HDROP"
    Case #CF_DIB         : name$ = "CF_DIB"
    Case #CF_BITMAP      : name$ = "CF_BITMAP"
    Default
      Protected *buf = AllocateMemory(256 * SizeOf(Character))
      If *buf
        If GetClipboardFormatName_(uFormat, *buf, 255)
          name$ = PeekS(*buf, -1)
        Else
          name$ = "Format #" + Str(uFormat)
        EndIf
        FreeMemory(*buf)
      Else
        name$ = "Format #" + Str(uFormat)
      EndIf
  EndSelect
  ProcedureReturn name$
EndProcedure

; ===================================================================
; Clipboard readers (textual formats)
; ===================================================================

Procedure.s GetUnicodeText()
  Protected s$ = ""
  If IsClipboardFormatAvailable_(#CF_UNICODETEXT)
    Protected h = GetClipboardData_(#CF_UNICODETEXT)
    If h
      Protected *p = GlobalLock_(h)
      If *p : s$ = PeekS(*p, -1, #PB_Unicode) : EndIf
      If *p : GlobalUnlock_(h) : EndIf
    EndIf
  EndIf
  ProcedureReturn s$
EndProcedure

Procedure.s GetAnsiText()
  Protected s$ = ""
  If IsClipboardFormatAvailable_(#CF_TEXT)
    Protected h = GetClipboardData_(#CF_TEXT)
    If h
      Protected *p = GlobalLock_(h)
      If *p : s$ = PeekS(*p, -1, #PB_Ascii) : EndIf
      If *p : GlobalUnlock_(h) : EndIf
    EndIf
  EndIf
  ProcedureReturn s$
EndProcedure

Procedure.s GetRtf()
  Protected s$ = ""
  Protected cf = RegisterClipboardFormat_("Rich Text Format")
  If cf And IsClipboardFormatAvailable_(cf)
    Protected h = GetClipboardData_(cf)
    If h
      Protected *p = GlobalLock_(h)
      If *p : s$ = PeekS(*p, -1, #PB_Ascii) : EndIf
      If *p : GlobalUnlock_(h) : EndIf
    EndIf
  EndIf
  ProcedureReturn s$
EndProcedure

Procedure.s GetHtmlRaw()
  ; CF_HTML raw payload (ASCII; includes header with offsets)
  Protected s$ = ""
  Protected cf = RegisterClipboardFormat_("HTML Format")
  If cf And IsClipboardFormatAvailable_(cf)
    Protected h = GetClipboardData_(cf)
    If h
      Protected *p = GlobalLock_(h)
      If *p : s$ = PeekS(*p, -1, #PB_Ascii) : EndIf
      If *p : GlobalUnlock_(h) : EndIf
    EndIf
  EndIf
  ProcedureReturn s$
EndProcedure

; ---------- CF_HTML fragment extraction ----------

Procedure.i ParseOffsetAfterLabel(html$, label$)
  ; Parses a decimal number immediately following a label (e.g., "StartHTML:")
  ; Returns -1 if not found.
  Protected pos = FindString(html$, label$, 1)
  If pos = 0 : ProcedureReturn -1 : EndIf
  pos + Len(label$)
  Protected digits$ = "", ch$
  While pos <= Len(html$)
    ch$ = Mid(html$, pos, 1)
    If ch$ >= "0" And ch$ <= "9"
      digits$ + ch$
      pos + 1
    Else
      Break
    EndIf
  Wend
  If digits$ = "" : ProcedureReturn -1 : EndIf
  ProcedureReturn Val(digits$)
EndProcedure

Procedure.s ExtractHtmlFragment(html$)
  ; Prefers <!--StartFragment--> ... <!--EndFragment-->
  ; Falls back to StartHTML/EndHTML 0-based byte offsets.
  Protected startTag$ = "<!--StartFragment-->"
  Protected endTag$   = "<!--EndFragment-->"
  Protected s = FindString(html$, startTag$, 1)
  Protected e = FindString(html$, endTag$, 1)

  If s And e And e > s
    s + Len(startTag$)
    ProcedureReturn Mid(html$, s, e - s)
  EndIf

  Protected si = ParseOffsetAfterLabel(html$, "StartHTML:")
  Protected ei = ParseOffsetAfterLabel(html$, "EndHTML:")
  If si >= 0 And ei > si And ei <= Len(html$)
    ProcedureReturn Mid(html$, si + 1, ei - si) ; Mid is 1-based; offsets are 0-based
  EndIf

  ProcedureReturn html$
EndProcedure

; ---------- CF_HDROP (files list) ----------

Procedure.s FilesFromHDrop()
  Protected result$ = ""
  If IsClipboardFormatAvailable_(#CF_HDROP)
    Protected hDrop = GetClipboardData_(#CF_HDROP)
    If hDrop
      Protected count = DragQueryFile_(hDrop, $FFFFFFFF, 0, 0)
      Protected i
      For i = 0 To count - 1
        Protected *buf = AllocateMemory((#MAX_PATH + 1) * SizeOf(Character))
        If *buf
          DragQueryFile_(hDrop, i, *buf, #MAX_PATH)
          result$ + PeekS(*buf) + #CRLF$
          FreeMemory(*buf)
        EndIf
      Next
    EndIf
  EndIf
  ProcedureReturn result$
EndProcedure

; ===================================================================
; Image helpers (CF_DIB / CF_BITMAP)
; ===================================================================

; Build a BMP file in memory from a CF_DIB HGLOBAL.
; Returns pointer and size via out parameters; caller must FreeMemory().
Procedure.i BuildBmpFromCFDIB(hGlobal, *outPtr.Integer, *outSize.Integer)
  Protected total = GlobalSize_(hGlobal)
  If total = 0 : ProcedureReturn #False : EndIf
  Protected *pDib = GlobalLock_(hGlobal)
  If *pDib = 0 : ProcedureReturn #False : EndIf

  ; Read BITMAPINFOHEADER fields for bfOffBits calculation
  Protected biSize.l       = PeekL(*pDib + 0)
  Protected biBitCount.w   = PeekW(*pDib + 14)
  Protected biCompression.l= PeekL(*pDib + 16)
  Protected biClrUsed.l    = PeekL(*pDib + 32)

  Protected paletteBytes.l = 0
  If biBitCount <= 8
    Protected colors.l = biClrUsed
    If colors = 0 : colors = 1 << biBitCount : EndIf
    paletteBytes = colors * 4
  ElseIf biCompression = 3 And (biBitCount = 16 Or biBitCount = 32)
    paletteBytes = 12 ; three DWORD masks
  EndIf

  Protected offBits.l = 14 + biSize + paletteBytes

  ; Allocate BMP buffer: 14-byte file header + DIB block
  Protected fileSize.l = 14 + total
  Protected *bmp = AllocateMemory(fileSize)
  If *bmp = 0
    GlobalUnlock_(hGlobal)
    ProcedureReturn #False
  EndIf

  ; BITMAPFILEHEADER
  PokeW(*bmp + 0, $4D42)             ; bfType = 'BM'
  PokeL(*bmp + 2, fileSize)          ; bfSize
  PokeW(*bmp + 6, 0)                 ; bfReserved1
  PokeW(*bmp + 8, 0)                 ; bfReserved2
  PokeL(*bmp + 10, offBits)          ; bfOffBits

  ; Copy CF_DIB block after the 14-byte header
  CopyMemory(*pDib, *bmp + 14, total)

  GlobalUnlock_(hGlobal)

  PokeI(*outPtr, *bmp)
  PokeI(*outSize, fileSize)
  ProcedureReturn #True
EndProcedure

; Structure BITMAP
;   bmType.l
;   bmWidth.l
;   bmHeight.l
;   bmWidthBytes.l
;   bmPlanes.w
;   bmBitsPixel.w
;   bmBits.i
; EndStructure

; Build a BMP file in memory from HBITMAP using GetDIBits (32bpp BI_RGB).
; Returns pointer and size via out parameters; caller must FreeMemory().
Procedure.i BuildBmpFromHBitmap(hBmp, *outPtr.Integer, *outSize.Integer)
  If hBmp = 0 : ProcedureReturn #False : EndIf

  Protected bm.BITMAP
  If GetObject_(hBmp, SizeOf(BITMAP), @bm) = 0 : ProcedureReturn #False : EndIf

  Protected width.l  = bm\bmWidth
  Protected height.l = bm\bmHeight
  If width <= 0 Or height = 0 : ProcedureReturn #False : EndIf

  ; Prepare BITMAPINFOHEADER (32bpp, BI_RGB)
  Protected biSize.l = 40
  Protected bpp.w    = 32
  Protected stride.l = ((width * bpp + 31) / 32) * 4
  Protected imgSize.l= stride * Abs(height)

  Protected bi = AllocateMemory(biSize)
  If bi = 0 : ProcedureReturn #False : EndIf
  FillMemory(bi, biSize, 0)
  PokeL(bi + 0,  biSize)        ; biSize
  PokeL(bi + 4,  width)         ; biWidth
  PokeL(bi + 8,  height)        ; biHeight (positive = bottom-up)
  PokeW(bi + 12, 1)             ; biPlanes
  PokeW(bi + 14, bpp)           ; biBitCount
  PokeL(bi + 16, 0)             ; biCompression = BI_RGB
  PokeL(bi + 20, imgSize)       ; biSizeImage
  PokeL(bi + 24, 2835)          ; biXPelsPerMeter (~72 DPI)
  PokeL(bi + 28, 2835)          ; biYPelsPerMeter

  ; Get pixel bits
  Protected *bits = AllocateMemory(imgSize)
  If *bits = 0
    FreeMemory(bi)
    ProcedureReturn #False
  EndIf

  Protected hdc = GetDC_(0)
  If hdc = 0
    FreeMemory(bi) : FreeMemory(*bits)
    ProcedureReturn #False
  EndIf

  If GetDIBits_(hdc, hBmp, 0, height, *bits, bi, #DIB_RGB_COLORS) = 0
    ReleaseDC_(0, hdc)
    FreeMemory(bi) : FreeMemory(*bits)
    ProcedureReturn #False
  EndIf
  ReleaseDC_(0, hdc)

  ; Compose BMP file memory: 14 + 40 + imgSize
  Protected fileSize.l = 14 + biSize + imgSize
  Protected *bmp = AllocateMemory(fileSize)
  If *bmp = 0
    FreeMemory(bi) : FreeMemory(*bits)
    ProcedureReturn #False
  EndIf

  ; BITMAPFILEHEADER
  PokeW(*bmp + 0, $4D42)                ; 'BM'
  PokeL(*bmp + 2, fileSize)
  PokeW(*bmp + 6, 0)
  PokeW(*bmp + 8, 0)
  PokeL(*bmp + 10, 14 + biSize)         ; pixel data offset

  ; Copy headers + bits
  CopyMemory(bi,    *bmp + 14,       biSize)
  CopyMemory(*bits, *bmp + 14+biSize, imgSize)

  FreeMemory(bi)
  FreeMemory(*bits)

  PokeI(*outPtr, *bmp)
  PokeI(*outSize, fileSize)
  ProcedureReturn #True
EndProcedure

; ===================================================================
; Globals holding the latest clipboard snapshot
; ===================================================================

Global gFormats$    = ""
Global gHtmlRaw$    = ""
Global gHtmlFrag$   = ""
Global gRtf$        = ""
Global gUnicode$    = ""
Global gAnsi$       = ""
Global gFiles$      = ""

Global gImgDIB.i = -1
Global gImgBMP.i = -1

; ===================================================================
; Refresh clipboard snapshot + update UI
; ===================================================================

Procedure RefreshClipboardAndUI()
  ; Clear previous text buffers
  gFormats$ = "" : gHtmlRaw$ = "" : gHtmlFrag$ = "" : gRtf$ = ""
  gUnicode$ = "" : gAnsi$    = "" : gFiles$    = ""

  ; Free previous images to avoid leaks
  If IsImage(gImgDIB) : FreeImage(gImgDIB) : EndIf : gImgDIB = -1
  If IsImage(gImgBMP) : FreeImage(gImgBMP) : EndIf : gImgBMP = -1

  If OpenClipboard_(0)
    ; Enumerate formats
    gFormats$ + "== Available Clipboard Formats ==" + #CRLF$
    Define fmt.i = 0
    Repeat
      fmt = EnumClipboardFormats_(fmt)
      If fmt = 0 : Break : EndIf
      gFormats$ + Str(fmt) + " -> " + FormatName(fmt) + #CRLF$
    ForEver

    ; Read textual payloads
    gHtmlRaw$  = GetHtmlRaw()
    If gHtmlRaw$ <> "" : gHtmlFrag$ = ExtractHtmlFragment(gHtmlRaw$) : EndIf
    gRtf$      = GetRtf()
    gUnicode$  = GetUnicodeText()
    If gUnicode$ = "" : gAnsi$ = GetAnsiText() : EndIf
    gFiles$    = FilesFromHDrop()

    ; Build DIB image (CF_DIB)
    If IsClipboardFormatAvailable_(#CF_DIB)
      
      Define hDib = GetClipboardData_(#CF_DIB)
      If hDib
        Define *buf.Integer, size.Integer
        If BuildBmpFromCFDIB(hDib, @*buf, @size)
          gImgDIB = CatchImage(#PB_Any, *buf, size)
          FreeMemory(*buf)
        EndIf
      EndIf
    EndIf

    ; Build BMP image (CF_BITMAP)
    If IsClipboardFormatAvailable_(#CF_BITMAP)
      Define hBmp = GetClipboardData_(#CF_BITMAP)
      If hBmp
        Define *buf2.Integer, size2.Integer
        If BuildBmpFromHBitmap(hBmp, @*buf2, @size2)
          gImgBMP = CatchImage(#PB_Any, *buf2, size2)
          FreeMemory(*buf2)
        EndIf
      EndIf
    EndIf

    CloseClipboard_()
  Else
    gFormats$ = "Could not open the clipboard."
  EndIf

  ; ---- Push into editors ----
  If IsGadget(#G_EditFormats)
    If gFormats$ <> "" : SetGadgetText(#G_EditFormats, gFormats$)
    Else : SetGadgetText(#G_EditFormats, "Not available") : EndIf
  EndIf

  If IsGadget(#G_EditHtmlRaw)
    If gHtmlRaw$ <> "" : SetGadgetText(#G_EditHtmlRaw, gHtmlRaw$)
    Else : SetGadgetText(#G_EditHtmlRaw, "Not available") : EndIf
  EndIf

  If IsGadget(#G_EditHtmlFrag)
    If gHtmlFrag$ <> "" : SetGadgetText(#G_EditHtmlFrag, gHtmlFrag$)
    Else : SetGadgetText(#G_EditHtmlFrag, "Not available") : EndIf
  EndIf

  If IsGadget(#G_EditRtf)
    If gRtf$ <> "" : SetGadgetText(#G_EditRtf, gRtf$)
    Else : SetGadgetText(#G_EditRtf, "Not available") : EndIf
  EndIf

  If IsGadget(#G_EditUnicode)
    If gUnicode$ <> "" : SetGadgetText(#G_EditUnicode, gUnicode$)
    Else : SetGadgetText(#G_EditUnicode, "Not available") : EndIf
  EndIf

  If IsGadget(#G_EditAnsi)
    If gAnsi$ <> "" : SetGadgetText(#G_EditAnsi, gAnsi$)
    Else : SetGadgetText(#G_EditAnsi, "Not available") : EndIf
  EndIf

  If IsGadget(#G_EditFiles)
    If gFiles$ <> "" : SetGadgetText(#G_EditFiles, gFiles$)
    Else : SetGadgetText(#G_EditFiles, "Not available") : EndIf
  EndIf

  ; ---- Push images into image gadgets ----
  If IsGadget(#G_ImageDIB)
    If IsImage(gImgDIB)
      SetGadgetState(#G_ImageDIB, ImageID(gImgDIB))
    Else
      SetGadgetState(#G_ImageDIB, 0)
    EndIf
  EndIf

  If IsGadget(#G_ImageBMP)
    If IsImage(gImgBMP)
      SetGadgetState(#G_ImageBMP, ImageID(gImgBMP))
    Else
      SetGadgetState(#G_ImageBMP, 0)
    EndIf
  EndIf

  If IsGadget(#G_Status)
    SetGadgetText(#G_Status, "Clipboard refreshed.")
  EndIf
EndProcedure

; ===================================================================
; Save routine for active tab (text or image)
; ===================================================================


Procedure SaveActiveTab()
  Define tab = GetGadgetState(#G_Panel)
  Define defName.STRING, enc.i
  If DefaultSaveInfo(tab, @defName, @enc) = #False
    MessageRequester("Save", "This tab cannot be saved.")
    ProcedureReturn
  EndIf
  
  ; Text tabs 0..6
  If tab <= 6
    Define content$ = ""
    Select tab
      Case 0 : content$ = gFormats$
      Case 1 : content$ = gHtmlRaw$
      Case 2 : content$ = gHtmlFrag$
      Case 3 : content$ = gRtf$
      Case 4 : content$ = gUnicode$
      Case 5 : content$ = gAnsi$
      Case 6 : content$ = gFiles$
    EndSelect

    If content$ = "" Or content$ = "Not available"
      MessageRequester("Save", "No content on this tab.")
      ProcedureReturn
    EndIf

    Define filter$ = "Text (*.txt)|*.txt|All files (*.*)|*.*"
    If LCase(Right(defName\s, 4)) = ".rtf"
      filter$ = "RTF (*.rtf)|*.rtf|Text (*.txt)|*.txt|All files (*.*)|*.*"
    ElseIf LCase(Right(defName\s, 5)) = ".html"
      filter$ = "HTML (*.html;*.htm)|*.html;*.htm|Text (*.txt)|*.txt|All files (*.*)|*.*"
    EndIf

    Define path$ = SaveFileRequester("Save content as...", DesktopFolder() + defName\s, filter$, 0)
    If path$ = "" : ProcedureReturn : EndIf

    If SaveTextFile(path$, content$, enc)
      If IsGadget(#G_Status) : SetGadgetText(#G_Status, "Saved: " + path$) : EndIf
    Else
      MessageRequester("Save", "Could not save the file.")
    EndIf

  ; Image tabs 7..8
  Else
    Define img.i = -1
    If tab = 7 : img = gImgDIB : endif
    If tab = 8 : img = gImgBMP : endif

    If IsImage(img) = 0
      MessageRequester("Save", "No image on this tab.")
      ProcedureReturn
    EndIf

    Define filterImg$ = "PNG (*.png)|*.png|BMP (*.bmp)|*.bmp|JPEG (*.jpg;*.jpeg)|*.jpg;*.jpeg|All files (*.*)|*.*"
    Define path2$ = SaveFileRequester("Save image as...", DesktopFolder() + defName\s, filterImg$, 0)
    If path2$ = "" : ProcedureReturn : EndIf

    If SaveImageByExt(img, path2$)
      If IsGadget(#G_Status) : SetGadgetText(#G_Status, "Saved: " + path2$) : EndIf
    Else
      MessageRequester("Save", "Could not save the image.")
    EndIf
  EndIf
EndProcedure

; ===================================================================
; UI Setup
; ===================================================================

Define winW = 980, winH = 760
If OpenWindow(0, 0, 0, winW, winH, "Clipboard UI Inspector", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)

  PanelGadget(#G_Panel, 10, 10, winW - 20, winH - 110)

    AddGadgetItem(#G_Panel, -1, "Formats")
      EditorGadget(#G_EditFormats, 10, 10, GadgetWidth(#G_Panel) - 30, GadgetHeight(#G_Panel) - 50, #PB_Editor_ReadOnly)

    AddGadgetItem(#G_Panel, -1, "HTML (raw)")
      EditorGadget(#G_EditHtmlRaw, 10, 10, GadgetWidth(#G_Panel) - 30, GadgetHeight(#G_Panel) - 50, #PB_Editor_ReadOnly)

    AddGadgetItem(#G_Panel, -1, "HTML (fragment)")
      EditorGadget(#G_EditHtmlFrag, 10, 10, GadgetWidth(#G_Panel) - 30, GadgetHeight(#G_Panel) - 50, #PB_Editor_ReadOnly)

    AddGadgetItem(#G_Panel, -1, "RTF")
      EditorGadget(#G_EditRtf, 10, 10, GadgetWidth(#G_Panel) - 30, GadgetHeight(#G_Panel) - 50, #PB_Editor_ReadOnly)

    AddGadgetItem(#G_Panel, -1, "Unicode Text")
      EditorGadget(#G_EditUnicode, 10, 10, GadgetWidth(#G_Panel) - 30, GadgetHeight(#G_Panel) - 50, #PB_Editor_ReadOnly)

    AddGadgetItem(#G_Panel, -1, "ANSI Text")
      EditorGadget(#G_EditAnsi, 10, 10, GadgetWidth(#G_Panel) - 30, GadgetHeight(#G_Panel) - 50, #PB_Editor_ReadOnly)

    AddGadgetItem(#G_Panel, -1, "Files")
      EditorGadget(#G_EditFiles, 10, 10, GadgetWidth(#G_Panel) - 30, GadgetHeight(#G_Panel) - 50, #PB_Editor_ReadOnly)

    AddGadgetItem(#G_Panel, -1, "DIB Image (CF_DIB)")
      ImageGadget(#G_ImageDIB, 10, 10, GadgetWidth(#G_Panel) - 30, GadgetHeight(#G_Panel) - 50, 0)

    AddGadgetItem(#G_Panel, -1, "Bitmap Image (CF_BITMAP)")
      ImageGadget(#G_ImageBMP, 10, 10, GadgetWidth(#G_Panel) - 30, GadgetHeight(#G_Panel) - 50, 0)

  CloseGadgetList()

  ; Bottom bar: buttons + status
  ButtonGadget(#G_BtnRefresh, winW - 220, winH - 90, 90, 28, "Refresh")
  ButtonGadget(#G_BtnSave   , winW - 120, winH - 90, 90, 28, "Save...")
  TextGadget(#G_Status, 10, winH - 85, winW - 250, 20, "", #PB_Text_Border)

  ; Initial load
  RefreshClipboardAndUI()

  ; Event loop
  Define evt, gad
  Repeat
    evt = WaitWindowEvent()
    Select evt
      Case #PB_Event_Gadget
        gad = EventGadget()
        Select gad
          Case #G_BtnRefresh
            RefreshClipboardAndUI()

          Case #G_BtnSave
            SaveActiveTab()
        EndSelect
    EndSelect
  Until evt = #PB_Event_CloseWindow

EndIf
End

Post by **idle** » Wed Sep 10, 2025 9:54 am

Thanks, that'll be very handy.

Axolotl · Post by **Axolotl** » Wed Sep 10, 2025 11:01 am

Thanks for sharing.

I only glanced at it briefly and didn't compile or try it out....
Are you sure that the following part works as it should?

Code: Select all

; Maps a panel tab index to a sensible default filename + encoding
; Text tabs return encoding; image tabs return encoding=-1 (not used)
Procedure.i DefaultSaveInfo(tab, filenameOut.s, encodingOut.i)
  Select tab
    Case 0 : filenameOut = "clipboard_formats.txt" : encodingOut = #PB_UTF8   : ProcedureReturn #True
    Case 1 : filenameOut = "clip_html_raw.txt"     : encodingOut = #PB_Ascii  : ProcedureReturn #True
    Case 2 : filenameOut = "clip.html"             : encodingOut = #PB_UTF8   : ProcedureReturn #True
    Case 3 : filenameOut = "clip.rtf"              : encodingOut = #PB_Ascii  : ProcedureReturn #True
    Case 4 : filenameOut = "clip.txt"              : encodingOut = #PB_UTF8   : ProcedureReturn #True
    Case 5 : filenameOut = "clip_ansi.txt"         : encodingOut = #PB_UTF8   : ProcedureReturn #True
    Case 6 : filenameOut = "clip_files.txt"        : encodingOut = #PB_UTF8   : ProcedureReturn #True
    Case 7 : filenameOut = "clip_dib.png"          : encodingOut = -1         : ProcedureReturn #True
    Case 8 : filenameOut = "clip_bitmap.png"       : encodingOut = -1         : ProcedureReturn #True
  EndSelect
  ProcedureReturn #False
EndProcedure
; ......
Procedure SaveActiveTab()
  Define tab = GetGadgetState(#G_Panel)
  Define defName$, enc.i
  If DefaultSaveInfo(tab, defName$, enc) = #False           ; <==  defName$ = "", enc = 0 always .. CORRECT? 
    MessageRequester("Save", "This tab cannot be saved.")
    ProcedureReturn
  EndIf
; .....

My suggestion:

Code: Select all

; Maps a panel tab index to a sensible default filename + encoding
; Text tabs return encoding; image tabs return encoding=-1 (not used)
Procedure.i DefaultSaveInfo(tab, *filenameOut.STRING, *encodingOut.INTEGER) 
  Select tab
    Case 0 : *filenameOut\s = "clipboard_formats.txt" : *encodingOut\i = #PB_UTF8   : ProcedureReturn #True
    Case 1 : *filenameOut\s = "clip_html_raw.txt"     : *encodingOut\i = #PB_Ascii  : ProcedureReturn #True
    Case 2 : *filenameOut\s = "clip.html"             : *encodingOut\i = #PB_UTF8   : ProcedureReturn #True
    Case 3 : *filenameOut\s = "clip.rtf"              : *encodingOut\i = #PB_Ascii  : ProcedureReturn #True
    Case 4 : *filenameOut\s = "clip.txt"              : *encodingOut\i = #PB_UTF8   : ProcedureReturn #True
    Case 5 : *filenameOut\s = "clip_ansi.txt"         : *encodingOut\i = #PB_UTF8   : ProcedureReturn #True
    Case 6 : *filenameOut\s = "clip_files.txt"        : *encodingOut\i = #PB_UTF8   : ProcedureReturn #True
    Case 7 : *filenameOut\s = "clip_dib.png"          : *encodingOut\i = -1         : ProcedureReturn #True
    Case 8 : *filenameOut\s = "clip_bitmap.png"       : *encodingOut\i = -1         : ProcedureReturn #True
  EndSelect  
  ProcedureReturn #False
EndProcedure
; ......
Procedure SaveActiveTab()
  Define tab = GetGadgetState(#G_Panel)
;  Define defName$, enc.i
  Define defName.STRING, enc.i 
;  If DefaultSaveInfo(tab, defName$, enc) = #False
  If DefaultSaveInfo(tab, @defName, @enc) = #False
    MessageRequester("Save", "This tab cannot be saved.")
    ProcedureReturn
  EndIf
; ..... 
;   
; replace defName$ with defName\s  in all places

Piero · Post by **Piero** » Wed Sep 10, 2025 12:21 pm

Axolotl wrote: Wed Sep 10, 2025 11:01 amI only glanced at it briefly

Wow; this Forum also showcases sophisticated English!

…but it's very slow today… bots? (3129 users online)

dige · Post by **dige** » Fri Sep 12, 2025 8:01 am

Thx Axolotl. I have applied your bug fix in the initial post.

Axolotl wrote: Wed Sep 10, 2025 11:01 am [..]
My suggestion:
Maps a panel tab index to a sensible default filename + encoding
[..]

minimy · Post by **minimy** » Sat Sep 13, 2025 3:48 pm

Thanks for share idle, This is very nice code. Some times clipboard is a nightmare depend you clip.

juror · Post by **juror** » Tue Nov 11, 2025 5:49 am

@dige
attempting to convert some 2005 native windows clipboard collection routines (PB 5.45) to PB 6.3.

This looks beautiful.

Thanks for the post.

cheers

Axolotl · Post by **Axolotl** » Wed Nov 12, 2025 1:50 pm

@dige,
I made some small changes to your code.... Hope you don't mind.
1. Show RTF format in plain and rich text format style (see tab RTF) // I didn't want to mess with the tabs.
2. Window is now sizable.
I did not change the version in the header. I'll leave that up to you, if you want

Code: Select all

; ===================================================================
; Clipboard UI Inspector (Windows)
; v1.0 09.9.25 by Dige
; v1.1 12.9.25 bug fixed, thanks Axolotl
;
; Original: Forum-Link: https://www.purebasic.fr/english/viewtopic.php?p=645159
; ===================================================================

EnableExplicit

CompilerIf #PB_Compiler_OS <> #PB_OS_Windows
  MessageRequester("Clipboard", "This program is Windows-only.")
  End
CompilerEndIf

; ---- Image encoders for saving (PNG/JPEG/BMP) ----
UsePNGImageEncoder()
UseJPEGImageEncoder()

; ---- Windows clipboard constants ----
#CF_TEXT        = 1
#CF_UNICODETEXT = 13
#CF_HDROP       = 15
#CF_DIB         = 8
#CF_BITMAP      = 2
#MAX_PATH       = 260
#DIB_RGB_COLORS = 0

; ---- Gadget IDs ----
Enumeration 1000
  #G_Panel
  #G_EditFormats
  #G_EditHtmlRaw
  #G_EditHtmlFrag
  #G_EditRtf      ; show the rich text 
  #G_EditRtfPlain ; show the format in plain text 
  #G_EditUnicode
  #G_EditAnsi
  #G_EditFiles
  #G_ImageDIB
  #G_ImageBMP
  #G_BtnRefresh
  #G_BtnSave
  #G_Status
EndEnumeration

; ===================================================================
; Utilities
; ===================================================================

Procedure.s DesktopFolder()
  ; Returns the user Desktop path (with trailing backslash)
  Protected path$ = GetUserDirectory(#PB_Directory_Desktop)
  If Right(path$, 1) <> "\" : path$ + "\" : EndIf
  ProcedureReturn path$
EndProcedure

Procedure.i SaveTextFile(path$, text$, encoding = #PB_UTF8)
  ; Saves text content with selected encoding; returns #True on success
  Protected ok = #False
  Protected f = CreateFile(#PB_Any, path$)
  If f
    Select encoding
      Case #PB_UTF8   : WriteStringFormat(f, #PB_UTF8)
      Case #PB_Ascii  : WriteStringFormat(f, #PB_Ascii)
      Case #PB_Unicode: WriteStringFormat(f, #PB_Unicode)
    EndSelect
    WriteString(f, text$)
    CloseFile(f)
    ok = #True
  EndIf
  ProcedureReturn ok
EndProcedure

Procedure.i SaveImageByExt(img, path$)
  ; Saves image depending on file extension (png/jpg/jpeg/bmp)
  Protected ext$ = LCase(GetExtensionPart(path$))
  Protected ok = #False
  If ext$ = "png"
    ok = SaveImage(img, path$, #PB_ImagePlugin_PNG)
  ElseIf ext$ = "jpg" Or ext$ = "jpeg"
    ok = SaveImage(img, path$, #PB_ImagePlugin_JPEG, 8) ; quality 0..10
  ElseIf ext$ = "bmp"
    ok = SaveImage(img, path$, #PB_ImagePlugin_BMP)
  Else
    ; Default to PNG if unknown extension
    ok = SaveImage(img, path$, #PB_ImagePlugin_PNG)
  EndIf
  ProcedureReturn ok
EndProcedure

; Maps a panel tab index to a sensible default filename + encoding
; Text tabs return encoding; image tabs return encoding=-1 (not used)
Procedure.i DefaultSaveInfo(tab, *filenameOut.STRING, *encodingOut.INTEGER) 
  Select tab
    Case 0 : *filenameOut\s = "clipboard_formats.txt" : *encodingOut\i = #PB_UTF8   : ProcedureReturn #True
    Case 1 : *filenameOut\s = "clip_html_raw.txt"     : *encodingOut\i = #PB_Ascii  : ProcedureReturn #True
    Case 2 : *filenameOut\s = "clip.html"             : *encodingOut\i = #PB_UTF8   : ProcedureReturn #True
    Case 3 : *filenameOut\s = "clip.rtf"              : *encodingOut\i = #PB_Ascii  : ProcedureReturn #True
    Case 4 : *filenameOut\s = "clip.txt"              : *encodingOut\i = #PB_UTF8   : ProcedureReturn #True
    Case 5 : *filenameOut\s = "clip_ansi.txt"         : *encodingOut\i = #PB_UTF8   : ProcedureReturn #True
    Case 6 : *filenameOut\s = "clip_files.txt"        : *encodingOut\i = #PB_UTF8   : ProcedureReturn #True
    Case 7 : *filenameOut\s = "clip_dib.png"          : *encodingOut\i = -1         : ProcedureReturn #True
    Case 8 : *filenameOut\s = "clip_bitmap.png"       : *encodingOut\i = -1         : ProcedureReturn #True
  EndSelect  
  ProcedureReturn #False
EndProcedure

; ===================================================================
; Format name helper
; ===================================================================

Procedure.s FormatName(uFormat)
  ; Maps format IDs to human-readable names. Falls back to GetClipboardFormatName_
  Protected name$ = ""
  Select uFormat
    Case #CF_TEXT        : name$ = "CF_TEXT"
    Case #CF_UNICODETEXT : name$ = "CF_UNICODETEXT"
    Case #CF_HDROP       : name$ = "CF_HDROP"
    Case #CF_DIB         : name$ = "CF_DIB"
    Case #CF_BITMAP      : name$ = "CF_BITMAP"
    Default
      Protected *buf = AllocateMemory(256 * SizeOf(Character))
      If *buf
        If GetClipboardFormatName_(uFormat, *buf, 255)
          name$ = PeekS(*buf, -1)
        Else
          name$ = "Format #" + Str(uFormat)
        EndIf
        FreeMemory(*buf)
      Else
        name$ = "Format #" + Str(uFormat)
      EndIf
  EndSelect
  ProcedureReturn name$
EndProcedure

; ===================================================================
; Clipboard readers (textual formats)
; ===================================================================

Procedure.s GetUnicodeText()
  Protected s$ = ""
  If IsClipboardFormatAvailable_(#CF_UNICODETEXT)
    Protected h = GetClipboardData_(#CF_UNICODETEXT)
    If h
      Protected *p = GlobalLock_(h)
      If *p : s$ = PeekS(*p, -1, #PB_Unicode) : EndIf
      If *p : GlobalUnlock_(h) : EndIf
    EndIf
  EndIf
  ProcedureReturn s$
EndProcedure

Procedure.s GetAnsiText()
  Protected s$ = ""
  If IsClipboardFormatAvailable_(#CF_TEXT)
    Protected h = GetClipboardData_(#CF_TEXT)
    If h
      Protected *p = GlobalLock_(h)
      If *p : s$ = PeekS(*p, -1, #PB_Ascii) : EndIf
      If *p : GlobalUnlock_(h) : EndIf
    EndIf
  EndIf
  ProcedureReturn s$
EndProcedure

Procedure.s GetRtf()
  Protected s$ = ""
  Protected cf = RegisterClipboardFormat_("Rich Text Format")
  If cf And IsClipboardFormatAvailable_(cf)
    Protected h = GetClipboardData_(cf)
    If h
      Protected *p = GlobalLock_(h)
      If *p : s$ = PeekS(*p, -1, #PB_Ascii) : EndIf
      If *p : GlobalUnlock_(h) : EndIf
    EndIf
  EndIf
  ProcedureReturn s$
EndProcedure

Procedure.s GetHtmlRaw()
  ; CF_HTML raw payload (ASCII; includes header with offsets)
  Protected s$ = ""
  Protected cf = RegisterClipboardFormat_("HTML Format")
  If cf And IsClipboardFormatAvailable_(cf)
    Protected h = GetClipboardData_(cf)
    If h
      Protected *p = GlobalLock_(h)
      If *p : s$ = PeekS(*p, -1, #PB_Ascii) : EndIf
      If *p : GlobalUnlock_(h) : EndIf
    EndIf
  EndIf
  ProcedureReturn s$
EndProcedure

; ---------- CF_HTML fragment extraction ----------

Procedure.i ParseOffsetAfterLabel(html$, label$)
  ; Parses a decimal number immediately following a label (e.g., "StartHTML:")
  ; Returns -1 if not found.
  Protected pos = FindString(html$, label$, 1)
  If pos = 0 : ProcedureReturn -1 : EndIf
  pos + Len(label$)
  Protected digits$ = "", ch$
  While pos <= Len(html$)
    ch$ = Mid(html$, pos, 1)
    If ch$ >= "0" And ch$ <= "9"
      digits$ + ch$
      pos + 1
    Else
      Break
    EndIf
  Wend
  If digits$ = "" : ProcedureReturn -1 : EndIf
  ProcedureReturn Val(digits$)
EndProcedure

Procedure.s ExtractHtmlFragment(html$)
  ; Prefers <!--StartFragment--> ... <!--EndFragment-->
  ; Falls back to StartHTML/EndHTML 0-based byte offsets.
  Protected startTag$ = "<!--StartFragment-->"
  Protected endTag$   = "<!--EndFragment-->"
  Protected s = FindString(html$, startTag$, 1)
  Protected e = FindString(html$, endTag$, 1)

  If s And e And e > s
    s + Len(startTag$)
    ProcedureReturn Mid(html$, s, e - s)
  EndIf

  Protected si = ParseOffsetAfterLabel(html$, "StartHTML:")
  Protected ei = ParseOffsetAfterLabel(html$, "EndHTML:")
  If si >= 0 And ei > si And ei <= Len(html$)
    ProcedureReturn Mid(html$, si + 1, ei - si) ; Mid is 1-based; offsets are 0-based
  EndIf

  ProcedureReturn html$
EndProcedure

; ---------- CF_HDROP (files list) ----------

Procedure.s FilesFromHDrop()
  Protected result$ = ""
  If IsClipboardFormatAvailable_(#CF_HDROP)
    Protected hDrop = GetClipboardData_(#CF_HDROP)
    If hDrop
      Protected count = DragQueryFile_(hDrop, $FFFFFFFF, 0, 0)
      Protected i
      For i = 0 To count - 1
        Protected *buf = AllocateMemory((#MAX_PATH + 1) * SizeOf(Character))
        If *buf
          DragQueryFile_(hDrop, i, *buf, #MAX_PATH)
          result$ + PeekS(*buf) + #CRLF$
          FreeMemory(*buf)
        EndIf
      Next
    EndIf
  EndIf
  ProcedureReturn result$
EndProcedure

; ===================================================================
; Image helpers (CF_DIB / CF_BITMAP)
; ===================================================================

; Build a BMP file in memory from a CF_DIB HGLOBAL.
; Returns pointer and size via out parameters; caller must FreeMemory().
Procedure.i BuildBmpFromCFDIB(hGlobal, *outPtr.Integer, *outSize.Integer)
  Protected total = GlobalSize_(hGlobal)
  If total = 0 : ProcedureReturn #False : EndIf
  Protected *pDib = GlobalLock_(hGlobal)
  If *pDib = 0 : ProcedureReturn #False : EndIf

  ; Read BITMAPINFOHEADER fields for bfOffBits calculation
  Protected biSize.l       = PeekL(*pDib + 0)
  Protected biBitCount.w   = PeekW(*pDib + 14)
  Protected biCompression.l= PeekL(*pDib + 16)
  Protected biClrUsed.l    = PeekL(*pDib + 32)

  Protected paletteBytes.l = 0
  If biBitCount <= 8
    Protected colors.l = biClrUsed
    If colors = 0 : colors = 1 << biBitCount : EndIf
    paletteBytes = colors * 4
  ElseIf biCompression = 3 And (biBitCount = 16 Or biBitCount = 32)
    paletteBytes = 12 ; three DWORD masks
  EndIf

  Protected offBits.l = 14 + biSize + paletteBytes

  ; Allocate BMP buffer: 14-byte file header + DIB block
  Protected fileSize.l = 14 + total
  Protected *bmp = AllocateMemory(fileSize)
  If *bmp = 0
    GlobalUnlock_(hGlobal)
    ProcedureReturn #False
  EndIf

  ; BITMAPFILEHEADER
  PokeW(*bmp + 0, $4D42)             ; bfType = 'BM'
  PokeL(*bmp + 2, fileSize)          ; bfSize
  PokeW(*bmp + 6, 0)                 ; bfReserved1
  PokeW(*bmp + 8, 0)                 ; bfReserved2
  PokeL(*bmp + 10, offBits)          ; bfOffBits

  ; Copy CF_DIB block after the 14-byte header
  CopyMemory(*pDib, *bmp + 14, total)

  GlobalUnlock_(hGlobal)

  PokeI(*outPtr, *bmp)
  PokeI(*outSize, fileSize)
  ProcedureReturn #True
EndProcedure

; Structure BITMAP
;   bmType.l
;   bmWidth.l
;   bmHeight.l
;   bmWidthBytes.l
;   bmPlanes.w
;   bmBitsPixel.w
;   bmBits.i
; EndStructure

; Build a BMP file in memory from HBITMAP using GetDIBits (32bpp BI_RGB).
; Returns pointer and size via out parameters; caller must FreeMemory().
Procedure.i BuildBmpFromHBitmap(hBmp, *outPtr.Integer, *outSize.Integer)
  If hBmp = 0 : ProcedureReturn #False : EndIf

  Protected bm.BITMAP
  If GetObject_(hBmp, SizeOf(BITMAP), @bm) = 0 : ProcedureReturn #False : EndIf

  Protected width.l  = bm\bmWidth
  Protected height.l = bm\bmHeight
  If width <= 0 Or height = 0 : ProcedureReturn #False : EndIf

  ; Prepare BITMAPINFOHEADER (32bpp, BI_RGB)
  Protected biSize.l = 40
  Protected bpp.w    = 32
  Protected stride.l = ((width * bpp + 31) / 32) * 4
  Protected imgSize.l= stride * Abs(height)

  Protected bi = AllocateMemory(biSize)
  If bi = 0 : ProcedureReturn #False : EndIf
  FillMemory(bi, biSize, 0)
  PokeL(bi + 0,  biSize)        ; biSize
  PokeL(bi + 4,  width)         ; biWidth
  PokeL(bi + 8,  height)        ; biHeight (positive = bottom-up)
  PokeW(bi + 12, 1)             ; biPlanes
  PokeW(bi + 14, bpp)           ; biBitCount
  PokeL(bi + 16, 0)             ; biCompression = BI_RGB
  PokeL(bi + 20, imgSize)       ; biSizeImage
  PokeL(bi + 24, 2835)          ; biXPelsPerMeter (~72 DPI)
  PokeL(bi + 28, 2835)          ; biYPelsPerMeter

  ; Get pixel bits
  Protected *bits = AllocateMemory(imgSize)
  If *bits = 0
    FreeMemory(bi)
    ProcedureReturn #False
  EndIf

  Protected hdc = GetDC_(0)
  If hdc = 0
    FreeMemory(bi) : FreeMemory(*bits)
    ProcedureReturn #False
  EndIf

  If GetDIBits_(hdc, hBmp, 0, height, *bits, bi, #DIB_RGB_COLORS) = 0
    ReleaseDC_(0, hdc)
    FreeMemory(bi) : FreeMemory(*bits)
    ProcedureReturn #False
  EndIf
  ReleaseDC_(0, hdc)

  ; Compose BMP file memory: 14 + 40 + imgSize
  Protected fileSize.l = 14 + biSize + imgSize
  Protected *bmp = AllocateMemory(fileSize)
  If *bmp = 0
    FreeMemory(bi) : FreeMemory(*bits)
    ProcedureReturn #False
  EndIf

  ; BITMAPFILEHEADER
  PokeW(*bmp + 0, $4D42)                ; 'BM'
  PokeL(*bmp + 2, fileSize)
  PokeW(*bmp + 6, 0)
  PokeW(*bmp + 8, 0)
  PokeL(*bmp + 10, 14 + biSize)         ; pixel data offset

  ; Copy headers + bits
  CopyMemory(bi,    *bmp + 14,       biSize)
  CopyMemory(*bits, *bmp + 14+biSize, imgSize)

  FreeMemory(bi)
  FreeMemory(*bits)

  PokeI(*outPtr, *bmp)
  PokeI(*outSize, fileSize)
  ProcedureReturn #True
EndProcedure

; ===================================================================
; Globals holding the latest clipboard snapshot
; ===================================================================

Global gFormats$    = ""
Global gHtmlRaw$    = ""
Global gHtmlFrag$   = ""
Global gRtf$        = ""
Global gUnicode$    = ""
Global gAnsi$       = ""
Global gFiles$      = ""

Global gImgDIB.i = -1
Global gImgBMP.i = -1

; ===================================================================
; Refresh clipboard snapshot + update UI
; ===================================================================

Procedure RefreshClipboardAndUI()
  ; Clear previous text buffers
  gFormats$ = "" : gHtmlRaw$ = "" : gHtmlFrag$ = "" : gRtf$ = ""
  gUnicode$ = "" : gAnsi$    = "" : gFiles$    = ""

  ; Free previous images to avoid leaks
  If IsImage(gImgDIB) : FreeImage(gImgDIB) : EndIf : gImgDIB = -1
  If IsImage(gImgBMP) : FreeImage(gImgBMP) : EndIf : gImgBMP = -1

  If OpenClipboard_(0)
    ; Enumerate formats
    gFormats$ + "== Available Clipboard Formats ==" + #CRLF$
    Define fmt.i = 0
    Repeat
      fmt = EnumClipboardFormats_(fmt)
      If fmt = 0 : Break : EndIf
      gFormats$ + Str(fmt) + " -> " + FormatName(fmt) + #CRLF$
    ForEver

    ; Read textual payloads
    gHtmlRaw$  = GetHtmlRaw()
    If gHtmlRaw$ <> "" : gHtmlFrag$ = ExtractHtmlFragment(gHtmlRaw$) : EndIf
    gRtf$      = GetRtf()
    gUnicode$  = GetUnicodeText()
    If gUnicode$ = "" : gAnsi$ = GetAnsiText() : EndIf
    gFiles$    = FilesFromHDrop()

    ; Build DIB image (CF_DIB)
    If IsClipboardFormatAvailable_(#CF_DIB)
      
      Define hDib = GetClipboardData_(#CF_DIB)
      If hDib
        Define *buf.Integer, size.Integer
        If BuildBmpFromCFDIB(hDib, @*buf, @size)
          gImgDIB = CatchImage(#PB_Any, *buf, size)
          FreeMemory(*buf)
        EndIf
      EndIf
    EndIf

    ; Build BMP image (CF_BITMAP)
    If IsClipboardFormatAvailable_(#CF_BITMAP)
      Define hBmp = GetClipboardData_(#CF_BITMAP)
      If hBmp
        Define *buf2.Integer, size2.Integer
        If BuildBmpFromHBitmap(hBmp, @*buf2, @size2)
          gImgBMP = CatchImage(#PB_Any, *buf2, size2)
          FreeMemory(*buf2)
        EndIf
      EndIf
    EndIf

    CloseClipboard_()
  Else
    gFormats$ = "Could not open the clipboard."
  EndIf

  ; ---- Push into editors ----
  If IsGadget(#G_EditFormats)
    If gFormats$ <> "" : SetGadgetText(#G_EditFormats, gFormats$)
    Else : SetGadgetText(#G_EditFormats, "Not available") : EndIf
  EndIf

  If IsGadget(#G_EditHtmlRaw)
    If gHtmlRaw$ <> "" : SetGadgetText(#G_EditHtmlRaw, gHtmlRaw$)
    Else : SetGadgetText(#G_EditHtmlRaw, "Not available") : EndIf
  EndIf

  If IsGadget(#G_EditHtmlFrag)
    If gHtmlFrag$ <> "" : SetGadgetText(#G_EditHtmlFrag, gHtmlFrag$)
    Else : SetGadgetText(#G_EditHtmlFrag, "Not available") : EndIf
  EndIf

  If IsGadget(#G_EditRtf)
    If gRtf$ <> "" : SetGadgetText(#G_EditRtf, gRtf$)
    Else : SetGadgetText(#G_EditRtf, "Not available") : EndIf
  EndIf

  If IsGadget(#G_EditRtfPlain) ; NEW 
    If gRtf$ <> "" : SetGadgetText(#G_EditRtfPlain, gRtf$)
    Else : SetGadgetText(#G_EditRtfPlain, "Not available") : EndIf
  EndIf

  If IsGadget(#G_EditUnicode)
    If gUnicode$ <> "" : SetGadgetText(#G_EditUnicode, gUnicode$)
    Else : SetGadgetText(#G_EditUnicode, "Not available") : EndIf
  EndIf

  If IsGadget(#G_EditAnsi)
    If gAnsi$ <> "" : SetGadgetText(#G_EditAnsi, gAnsi$)
    Else : SetGadgetText(#G_EditAnsi, "Not available") : EndIf
  EndIf

  If IsGadget(#G_EditFiles)
    If gFiles$ <> "" : SetGadgetText(#G_EditFiles, gFiles$)
    Else : SetGadgetText(#G_EditFiles, "Not available") : EndIf
  EndIf

  ; ---- Push images into image gadgets ----
  If IsGadget(#G_ImageDIB)
    If IsImage(gImgDIB)
      SetGadgetState(#G_ImageDIB, ImageID(gImgDIB))
    Else
      SetGadgetState(#G_ImageDIB, 0)
    EndIf
  EndIf

  If IsGadget(#G_ImageBMP)
    If IsImage(gImgBMP)
      SetGadgetState(#G_ImageBMP, ImageID(gImgBMP))
    Else
      SetGadgetState(#G_ImageBMP, 0)
    EndIf
  EndIf

  If IsGadget(#G_Status)
    SetGadgetText(#G_Status, "Clipboard refreshed.")
  EndIf
EndProcedure

; ===================================================================
; Save routine for active tab (text or image)
; ===================================================================


Procedure SaveActiveTab()
  Define tab = GetGadgetState(#G_Panel)
  Define defName.STRING, enc.i
  If DefaultSaveInfo(tab, @defName, @enc) = #False
    MessageRequester("Save", "This tab cannot be saved.")
    ProcedureReturn
  EndIf
  
  ; Text tabs 0..6
  If tab <= 6
    Define content$ = ""
    Select tab
      Case 0 : content$ = gFormats$
      Case 1 : content$ = gHtmlRaw$
      Case 2 : content$ = gHtmlFrag$
      Case 3 : content$ = gRtf$
      Case 4 : content$ = gUnicode$
      Case 5 : content$ = gAnsi$
      Case 6 : content$ = gFiles$
    EndSelect

    If content$ = "" Or content$ = "Not available"
      MessageRequester("Save", "No content on this tab.")
      ProcedureReturn
    EndIf

    Define filter$ = "Text (*.txt)|*.txt|All files (*.*)|*.*"
    If LCase(Right(defName\s, 4)) = ".rtf"
      filter$ = "RTF (*.rtf)|*.rtf|Text (*.txt)|*.txt|All files (*.*)|*.*"
    ElseIf LCase(Right(defName\s, 5)) = ".html"
      filter$ = "HTML (*.html;*.htm)|*.html;*.htm|Text (*.txt)|*.txt|All files (*.*)|*.*"
    EndIf

    Define path$ = SaveFileRequester("Save content as...", DesktopFolder() + defName\s, filter$, 0)
    If path$ = "" : ProcedureReturn : EndIf

    If SaveTextFile(path$, content$, enc)
      If IsGadget(#G_Status) : SetGadgetText(#G_Status, "Saved: " + path$) : EndIf
    Else
      MessageRequester("Save", "Could not save the file.")
    EndIf

  ; Image tabs 7..8
  Else
    Define img.i = -1
    If tab = 7 : img = gImgDIB : EndIf
    If tab = 8 : img = gImgBMP : EndIf

    If IsImage(img) = 0
      MessageRequester("Save", "No image on this tab.")
      ProcedureReturn
    EndIf

    Define filterImg$ = "PNG (*.png)|*.png|BMP (*.bmp)|*.bmp|JPEG (*.jpg;*.jpeg)|*.jpg;*.jpeg|All files (*.*)|*.*"
    Define path2$ = SaveFileRequester("Save image as...", DesktopFolder() + defName\s, filterImg$, 0)
    If path2$ = "" : ProcedureReturn : EndIf

    If SaveImageByExt(img, path2$)
      If IsGadget(#G_Status) : SetGadgetText(#G_Status, "Saved: " + path2$) : EndIf
    Else
      MessageRequester("Save", "Could not save the image.")
    EndIf
  EndIf
EndProcedure

; NEW 
Procedure OnSizeWindowEvent() 
  Protected ww, wh, gw, gh 

  ww = WindowWidth(0) : wh = WindowHeight(0) 
  ResizeGadget(#G_Panel, #PB_Ignore, #PB_Ignore, ww - 20, wh - 110) 

  ResizeGadget(#G_BtnRefresh, ww - 220, wh - 90, #PB_Ignore, #PB_Ignore)
  ResizeGadget(#G_BtnSave, ww - 120, wh - 90, #PB_Ignore, #PB_Ignore)
  ResizeGadget(#G_Status, #PB_Ignore, wh - 85, ww - 250, #PB_Ignore)

  gw = GadgetWidth(#G_Panel) : gh = GadgetHeight(#G_Panel) 

  ResizeGadget(#G_EditFormats, #PB_Ignore, #PB_Ignore, gw - 30, gh - 50)
  ResizeGadget(#G_EditHtmlRaw, #PB_Ignore, #PB_Ignore, gw - 30, gh - 50)
  ResizeGadget(#G_EditHtmlFrag, #PB_Ignore, #PB_Ignore, gw - 30, gh - 50)
  ResizeGadget(#G_EditRtfPlain, #PB_Ignore, #PB_Ignore, gw/2 - 15, gh - 50)
  ResizeGadget(#G_EditRtf, gw/2, #PB_Ignore, gw/2 - 15, gh - 50)
  ResizeGadget(#G_EditUnicode, #PB_Ignore, #PB_Ignore, gw - 30, gh - 50)
  ResizeGadget(#G_EditAnsi, #PB_Ignore, #PB_Ignore, gw - 30, gh - 50)
  ResizeGadget(#G_EditFiles, #PB_Ignore, #PB_Ignore, gw - 30, gh - 50)
  ResizeGadget(#G_ImageDIB, #PB_Ignore, #PB_Ignore, gw - 30, gh - 50)
  ResizeGadget(#G_ImageBMP, #PB_Ignore, #PB_Ignore, gw - 30, gh - 50) 
EndProcedure 

; ===================================================================
; UI Setup
; ===================================================================

Define winW = 980, winH = 760
If OpenWindow(0, 0, 0, winW, winH, "Clipboard UI Inspector", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_SizeGadget) 
  WindowBounds(0, winW, winH, #PB_Ignore, #PB_Ignore)  ; NEW 

  PanelGadget(#G_Panel, 10, 10, winW - 20, winH - 110)

    AddGadgetItem(#G_Panel, -1, "Formats")
      EditorGadget(#G_EditFormats, 10, 10, GadgetWidth(#G_Panel) - 30, GadgetHeight(#G_Panel) - 50, #PB_Editor_ReadOnly)

    AddGadgetItem(#G_Panel, -1, "HTML (raw)")
      EditorGadget(#G_EditHtmlRaw, 10, 10, GadgetWidth(#G_Panel) - 30, GadgetHeight(#G_Panel) - 50, #PB_Editor_ReadOnly)

    AddGadgetItem(#G_Panel, -1, "HTML (fragment)")
      EditorGadget(#G_EditHtmlFrag, 10, 10, GadgetWidth(#G_Panel) - 30, GadgetHeight(#G_Panel) - 50, #PB_Editor_ReadOnly)

    AddGadgetItem(#G_Panel, -1, "RTF")
      EditorGadget(#G_EditRtfPlain, 10, 10, GadgetWidth(#G_Panel)/2 - 15, GadgetHeight(#G_Panel) - 50, #PB_Editor_ReadOnly)

      EditorGadget(#G_EditRtf, GadgetWidth(#G_Panel)/2, 10, GadgetWidth(#G_Panel)/2 - 15, GadgetHeight(#G_Panel) - 50, #PB_Editor_ReadOnly)
      SendMessage_(GadgetID(#G_EditRtf), #EM_SETTEXTMODE, #TM_RICHTEXT, 0) 
 
    AddGadgetItem(#G_Panel, -1, "Unicode Text")
      EditorGadget(#G_EditUnicode, 10, 10, GadgetWidth(#G_Panel) - 30, GadgetHeight(#G_Panel) - 50, #PB_Editor_ReadOnly)

    AddGadgetItem(#G_Panel, -1, "ANSI Text")
      EditorGadget(#G_EditAnsi, 10, 10, GadgetWidth(#G_Panel) - 30, GadgetHeight(#G_Panel) - 50, #PB_Editor_ReadOnly)

    AddGadgetItem(#G_Panel, -1, "Files")
      EditorGadget(#G_EditFiles, 10, 10, GadgetWidth(#G_Panel) - 30, GadgetHeight(#G_Panel) - 50, #PB_Editor_ReadOnly)

    AddGadgetItem(#G_Panel, -1, "DIB Image (CF_DIB)")
      ImageGadget(#G_ImageDIB, 10, 10, GadgetWidth(#G_Panel) - 30, GadgetHeight(#G_Panel) - 50, 0)

    AddGadgetItem(#G_Panel, -1, "Bitmap Image (CF_BITMAP)")
      ImageGadget(#G_ImageBMP, 10, 10, GadgetWidth(#G_Panel) - 30, GadgetHeight(#G_Panel) - 50, 0)

  CloseGadgetList()

  ; Bottom bar: buttons + status
  ButtonGadget(#G_BtnRefresh, winW - 220, winH - 90, 90, 28, "Refresh")
  ButtonGadget(#G_BtnSave   , winW - 120, winH - 90, 90, 28, "Save...")
  TextGadget(#G_Status, 10, winH - 85, winW - 250, 20, "", #PB_Text_Border)

  ; support window sizing 
  BindEvent(#PB_Event_SizeWindow, @OnSizeWindowEvent(), 0) 
  
  ; Initial load
  RefreshClipboardAndUI()

  ; Event loop
  Define evt, gad
  Repeat
    evt = WaitWindowEvent()
    Select evt
      Case #PB_Event_Gadget
        gad = EventGadget()
        Select gad
          Case #G_BtnRefresh
            RefreshClipboardAndUI()

          Case #G_BtnSave
            SaveActiveTab()
        EndSelect
    EndSelect
  Until evt = #PB_Event_CloseWindow

EndIf
End

dige · Post by **dige** » Wed Nov 12, 2025 2:41 pm

Thx Axolotl, I have further developed the tool in the meantime. If you like, you are welcome to add your own customizations.

Code: Select all

; ===================================================================
; Clipboard UI Inspector (Windows)
; v1.0 09.9.25 by Dige
; v1.2 12.9.25 bug fixed, thanks Axolotl
; v1.3 15.9.25 by Dige
; ===================================================================

EnableExplicit

CompilerIf #PB_Compiler_OS <> #PB_OS_Windows
  CompilerError "Windows erforderlich (CF_HTML/RTF/HDROP, AddClipboardFormatListener)."
CompilerEndIf


CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
  ; x64: keine stdcall-Dekoration
  Import "user32.lib"
    AddClipboardFormatListener(hWnd.i)
    RemoveClipboardFormatListener(hWnd.i)
  EndImport
CompilerElse
  ; x86: stdcall mit Dekoration
  Import "user32.lib"
    AddClipboardFormatListener(hWnd.i)    As "_AddClipboardFormatListener@4"
    RemoveClipboardFormatListener(hWnd.i) As "_RemoveClipboardFormatListener@4"
  EndImport
CompilerEndIf

; === Windows-Clipboard Konstanten ===
#CF_TEXT  = 1
#CF_HDROP = 15
#WM_CLIPBOARDUPDATE = $031D

; === Panel-Tab-Indizes (0-basiert, Reihenfolge wie BuildUI) ===
#IDX_FORMATS     = 0
#IDX_HTML_RAW    = 1
#IDX_HTML_FRAG   = 2
#IDX_RTF         = 3
#IDX_TEXTU       = 4
#IDX_TEXTA       = 5
#IDX_FILES       = 6
#IDX_IMAGE       = 7
#IDX_STORAGE     = 8

; === Basistitel (ohne Indikator) ===
#TITLE_FORMATS   = "Formats"
#TITLE_HTML_RAW  = "HTML (raw)"
#TITLE_HTML_FRAG = "HTML (fragment)"
#TITLE_RTF       = "RTF"
#TITLE_TEXTU     = "Unicode Text"
#TITLE_TEXTA     = "ANSI Text"
#TITLE_FILES     = "Files"
#TITLE_IMAGE     = "Image"
#TITLE_STORAGE   = "Ablage"

; ==============================================
; Gadget/Window IDs
; ==============================================
Enumeration 100
  #W_Main
  #G_Panel
  ; Gadgets pro Tab
  #G_FormatsList
  #G_HtmlRaw
  #G_HtmlFrag
  #G_Rtf
  #G_TextUnicode
  #G_TextAnsi
  #G_FilesList
  #G_ImagePreview
  #G_ImageInfo
  ; Storage
  #G_StoreList
  #G_StoreText
  #G_StoreImage
  ; Buttons
  #G_BtnRefresh
  #G_BtnStoreAdd
  #G_BtnStoreToClipboard
  #G_BtnStoreDelete
  #G_BtnStoreClear
  ; Status
  #G_Status
  ; Shortcuts
  #M_CopyFromStorage
  #M_DeleteSlot
EndEnumeration

; ==============================================
; Model (Clipboard)
; ==============================================
Global gHtmlRaw$ = ""
Global gHtmlFrag$ = ""
Global gRtf$      = ""
Global gUnicodeText.s = ""
Global gAnsiText.s    = ""
Global gFiles.s       = ""
Global gImage.i       = 0

; Listener-Flag
Global gClipboardListenerAdded.i = #False

; ==============================================
; Interne Ablage (LinkedList, unbegrenzt)
; ==============================================
Structure StorageItem
  id.i
  kind.i            ; 0=Text, 1=Bild
  label.s
  preview.s
  timestamp.q
  text.s
  img.i             ; Kopie bei Bild
EndStructure

Global NewList Storage.StorageItem()
Global gStoreNextId.i = 1
Global gStoreSelectedId.i = 0

; ==============================================
; Helpers
; ==============================================
Procedure.s TimeStampToStr(ts.q)
  ProcedureReturn FormatDate("%yyyy-%mm-%dd %hh:%ii:%ss", ts)
EndProcedure

Procedure.i CloneImageSafe(img.i)
  Protected out.i = -1
  If IsImage(img)
    Protected w = ImageWidth(img)
    Protected h = ImageHeight(img)
    out = CreateImage(#PB_Any, w, h, 32)
    If out
      StartDrawing(ImageOutput(out))
        DrawImage(ImageID(img), 0, 0)
      StopDrawing()
    EndIf
  EndIf
  ProcedureReturn out
EndProcedure

Procedure.i CountNonEmptyLines(s$)
  Protected i, total, c, line.s
  If s$ = "" : ProcedureReturn 0 : EndIf
  total = CountString(s$, #CRLF$) + 1
  For i=1 To total
    line = StringField(s$, i, #CRLF$)
    If line <> "" : c + 1 : EndIf
  Next
  ProcedureReturn c
EndProcedure

; --- Registered Clipboard Formats (ASCII) ---
Procedure.s ReadClipboardRegisteredAscii(fmtName$)
  Protected out.s = ""
  Protected fmt.i = RegisterClipboardFormat_(fmtName$)
  Protected h.i, *p, size.i
  If fmt = 0 : ProcedureReturn out : EndIf
  If OpenClipboard_(0)
    h = GetClipboardData_(fmt)
    If h
      *p = GlobalLock_(h)
      If *p
        size = GlobalSize_(h)
        If size > 0
          out = PeekS(*p, size, #PB_Ascii)
        EndIf
        GlobalUnlock_(h)
      EndIf
    EndIf
    CloseClipboard_()
  EndIf
  ProcedureReturn out
EndProcedure

; --- ANSI Text direkt (CF_TEXT) ---
Procedure.s ReadClipboardAnsiText()
  Protected out.s = ""
  Protected h.i, *p, size.i
  If OpenClipboard_(0)
    h = GetClipboardData_(#CF_TEXT)
    If h
      *p = GlobalLock_(h)
      If *p
        size = GlobalSize_(h)
        If size > 0
          out = PeekS(*p, size, #PB_Ascii)
        EndIf
        GlobalUnlock_(h)
      EndIf
    EndIf
    CloseClipboard_()
  EndIf
  ProcedureReturn out
EndProcedure

; --- CF_HDROP zu Textliste ---
Procedure.s ReadClipboardFilesToString()
  Protected out.s = ""
  Protected count.i, i.i, len.i, hDrop.i, *buf
  If IsClipboardFormatAvailable_(#CF_HDROP)
    If OpenClipboard_(0)
      hDrop = GetClipboardData_(#CF_HDROP)
      If hDrop
        count = DragQueryFile_(hDrop, $FFFFFFFF, 0, 0)
        For i = 0 To count - 1
          len = DragQueryFile_(hDrop, i, 0, 0) + 1
          *buf = AllocateMemory(len * SizeOf(Character))
          If *buf
            DragQueryFile_(hDrop, i, *buf, len)
            out + PeekS(*buf) + #CRLF$
            FreeMemory(*buf)
          EndIf
        Next
      EndIf
      CloseClipboard_()
    EndIf
  EndIf
  ProcedureReturn out
EndProcedure

; --- HTML-Fragment aus CF_HTML extrahieren ---
Procedure.s ExtractHtmlFragment(html$)
  Protected startTag$ = "<!--StartFragment-->"
  Protected endTag$   = "<!--EndFragment-->"
  Protected p1 = FindString(html$, startTag$, 1)
  Protected p2 = FindString(html$, endTag$, 1)
  Protected frag$
  If p1 > 0 And p2 > p1
    frag$ = Mid(html$, p1 + Len(startTag$), p2 - (p1 + Len(startTag$)))
    ProcedureReturn frag$
  EndIf
  ; Fallback: StartFragment/EndFragment Offsets
  Protected posStart = FindString(html$, "StartFragment:", 1)
  Protected posEnd   = FindString(html$, "EndFragment:", 1)
  If posStart > 0 And posEnd > 0
    Protected i = posStart + Len("StartFragment:")
    Protected j = posEnd   + Len("EndFragment:")
    Protected n1$, n2$, ch$
    While i <= Len(html$)
      ch$ = Mid(html$, i, 1)
      If ch$ < "0" Or ch$ > "9" : Break : EndIf
      n1$ + ch$
      i + 1
    Wend
    While j <= Len(html$)
      ch$ = Mid(html$, j, 1)
      If ch$ < "0" Or ch$ > "9" : Break : EndIf
      n2$ + ch$
      j + 1
    Wend
    Protected s = Val(n1$)
    Protected e = Val(n2$)
    If e > s And e <= Len(html$)
      frag$ = Mid(html$, s + 1, e - s)
      ProcedureReturn frag$
    EndIf
  EndIf
  ProcedureReturn ""
EndProcedure

; ==============================================
; Ablage: Datenmodell-Operationen
; ==============================================
Procedure StoragePopulateList()
  Protected typ$, rowText$
  If IsGadget(#G_StoreList) = 0 : ProcedureReturn : EndIf
  ClearGadgetItems(#G_StoreList)
  ForEach Storage()
    If Storage()\kind = 0
      typ$ = "Text"
    Else
      typ$ = "Bild"
    EndIf
    rowText$ = Str(Storage()\id) + Chr(10) + typ$ + Chr(10) + Storage()\label + Chr(10) + Storage()\preview + Chr(10) + TimeStampToStr(Storage()\timestamp)
    AddGadgetItem(#G_StoreList, -1, rowText$)
  Next
EndProcedure

Procedure StorageShowPreviewById(id.i)
  If IsGadget(#G_StoreText) : HideGadget(#G_StoreText, #True) : EndIf
  If IsGadget(#G_StoreImage): HideGadget(#G_StoreImage, #True): EndIf
  If id <= 0 : ProcedureReturn : EndIf
  ForEach Storage()
    If Storage()\id = id
      If Storage()\kind = 0
        If IsGadget(#G_StoreText)
          SetGadgetText(#G_StoreText, Storage()\text)
          HideGadget(#G_StoreText, #False)
        EndIf
      Else
        If IsGadget(#G_StoreImage) And IsImage(Storage()\img)
          SetGadgetState(#G_StoreImage, ImageID(Storage()\img))
          HideGadget(#G_StoreImage, #False)
        EndIf
      EndIf
      Break
    EndIf
  Next
EndProcedure

Procedure StorageAddText(label$, text$)
  Protected firstLine$, cut$
  AddElement(Storage())
  Storage()\id        = gStoreNextId : gStoreNextId + 1
  Storage()\kind      = 0
  Storage()\label     = label$
  Storage()\text      = text$
  firstLine$          = StringField(text$, 1, #CRLF$)
  firstLine$          = ReplaceString(Trim(firstLine$), #TAB$, " ")
  cut$                = firstLine$
  If Len(cut$) > 100 : cut$ = Left(cut$, 100) + "…" : EndIf
  Storage()\preview   = cut$
  Storage()\timestamp = Date()
  StoragePopulateList()
EndProcedure

Procedure StorageAddImage(label$, img.i)
  Protected clone = CloneImageSafe(img)
  Protected info$
  If clone = -1 : ProcedureReturn : EndIf
  AddElement(Storage())
  Storage()\id        = gStoreNextId : gStoreNextId + 1
  Storage()\kind      = 1
  Storage()\label     = label$
  Storage()\img       = clone
  info$               = "Bild " + Str(ImageWidth(clone)) + "×" + Str(ImageHeight(clone))
  Storage()\preview   = info$
  Storage()\timestamp = Date()
  StoragePopulateList()
EndProcedure

Procedure StorageDeleteById(id.i)
  ForEach Storage()
    If Storage()\id = id
      If Storage()\kind = 1 And IsImage(Storage()\img)
        FreeImage(Storage()\img)
      EndIf
      DeleteElement(Storage())
      Break
    EndIf
  Next
  StoragePopulateList()
  gStoreSelectedId = 0
  StorageShowPreviewById(0)
EndProcedure

Procedure StorageClearAll()
  ForEach Storage()
    If Storage()\kind = 1 And IsImage(Storage()\img)
      FreeImage(Storage()\img)
    EndIf
  Next
  ClearList(Storage())
  StoragePopulateList()
  gStoreSelectedId = 0
  StorageShowPreviewById(0)
EndProcedure

Procedure StorageCopyToClipboard(id.i)
  If id <= 0 : ProcedureReturn : EndIf
  ForEach Storage()
    If Storage()\id = id
      If Storage()\kind = 0
        SetClipboardText(Storage()\text)
      Else
        If IsImage(Storage()\img)
          SetClipboardImage(Storage()\img)
        EndIf
      EndIf
      Break
    EndIf
  Next
EndProcedure

; ==============================================
; Clipboard lesen & UI befüllen
; ==============================================
Procedure RefreshClipboardModel()
  gHtmlRaw$ = ""
  gHtmlFrag$ = ""
  gRtf$ = ""
  gUnicodeText = ""
  gAnsiText = ""
  gFiles = ""
  If IsImage(gImage) : FreeImage(gImage) : gImage = 0 : EndIf
  
  ; HTML (raw + fragment)
  gHtmlRaw$  = ReadClipboardRegisteredAscii("HTML Format")
  If gHtmlRaw$ <> ""
    gHtmlFrag$ = ExtractHtmlFragment(gHtmlRaw$)
  EndIf
  
  ; RTF
  gRtf$ = ReadClipboardRegisteredAscii("Rich Text Format")
  
  ; Unicode Text
  gUnicodeText = GetClipboardText()
  
  ; ANSI Text
  gAnsiText = ReadClipboardAnsiText()
  
  ; Image
  gImage = GetClipboardImage(#PB_Any)
  
  ; Files
  gFiles = ReadClipboardFilesToString()
EndProcedure

Procedure UpdateFormatsOverview()
  Protected has$
  If IsGadget(#G_FormatsList) = 0 : ProcedureReturn : EndIf
  ClearGadgetItems(#G_FormatsList)
  
  has$ = "Nein" : If gHtmlRaw$ <> "" : has$ = "Ja" : EndIf
  AddGadgetItem(#G_FormatsList, -1, "HTML (raw)" + Chr(10) + has$)
  
  has$ = "Nein" : If gHtmlFrag$ <> "" : has$ = "Ja" : EndIf
  AddGadgetItem(#G_FormatsList, -1, "HTML (fragment)" + Chr(10) + has$)
  
  has$ = "Nein" : If gRtf$ <> "" : has$ = "Ja" : EndIf
  AddGadgetItem(#G_FormatsList, -1, "RTF" + Chr(10) + has$)
  
  has$ = "Nein" : If gUnicodeText <> "" : has$ = "Ja" : EndIf
  AddGadgetItem(#G_FormatsList, -1, "Unicode Text" + Chr(10) + has$)
  
  has$ = "Nein" : If gAnsiText <> "" : has$ = "Ja" : EndIf
  AddGadgetItem(#G_FormatsList, -1, "ANSI Text" + Chr(10) + has$)
  
  has$ = "Nein"
  If gFiles <> ""
    has$ = "Ja (" + Str(CountNonEmptyLines(gFiles)) + " Dateien)"
  EndIf
  AddGadgetItem(#G_FormatsList, -1, "Files (CF_HDROP)" + Chr(10) + has$)
  
  has$ = "Nein"
  If IsImage(gImage)
    has$ = "Ja (" + Str(ImageWidth(gImage)) + "×" + Str(ImageHeight(gImage)) + ")"
  EndIf
  AddGadgetItem(#G_FormatsList, -1, "Image" + Chr(10) + has$)
EndProcedure

; === NEU: Panel-Tab-Titel anhand Inhalt aktualisieren ===
Procedure UpdatePanelTabTitles()
  Protected t$, i
  If IsGadget(#G_Panel) = 0 : ProcedureReturn : EndIf
  
  ; Basistitel + Indikator " • " wenn Inhalt vorhanden
  ; Formats: bleibt ohne Indikator
  SetGadgetItemText(#G_Panel, #IDX_FORMATS , #TITLE_FORMATS)
  
  t$ = #TITLE_HTML_RAW  : If gHtmlRaw$   <> "" : t$ + " •" : EndIf : SetGadgetItemText(#G_Panel, #IDX_HTML_RAW , t$)
  t$ = #TITLE_HTML_FRAG : If gHtmlFrag$  <> "" : t$ + " •" : EndIf : SetGadgetItemText(#G_Panel, #IDX_HTML_FRAG, t$)
  t$ = #TITLE_RTF       : If gRtf$       <> "" : t$ + " •" : EndIf : SetGadgetItemText(#G_Panel, #IDX_RTF      , t$)
  t$ = #TITLE_TEXTU     : If gUnicodeText<> "" : t$ + " •" : EndIf : SetGadgetItemText(#G_Panel, #IDX_TEXTU    , t$)
  t$ = #TITLE_TEXTA     : If gAnsiText   <> "" : t$ + " •" : EndIf : SetGadgetItemText(#G_Panel, #IDX_TEXTA    , t$)
  t$ = #TITLE_FILES
  If gFiles <> ""
    t$ + " •"
  EndIf
  SetGadgetItemText(#G_Panel, #IDX_FILES, t$)
  
  t$ = #TITLE_IMAGE     : If IsImage(gImage) : t$ + " •" : EndIf : SetGadgetItemText(#G_Panel, #IDX_IMAGE    , t$)
  
  ; Ablage: stets mit Slot-Anzahl
  t$ = #TITLE_STORAGE + " (" + Str(ListSize(Storage())) + ")"
  SetGadgetItemText(#G_Panel, #IDX_STORAGE, t$)
  
  For i = #IDX_HTML_RAW to #IDX_IMAGE
    
    If Right(GetGadgetItemText(#G_Panel, i), 1) = "•"
      SetGadgetState(#G_Panel, i)
      Break 
    Endif
  Next
  
EndProcedure

Procedure UpdateUIFromModel()
  UpdateFormatsOverview()
  If IsGadget(#G_HtmlRaw)    : SetGadgetText(#G_HtmlRaw, gHtmlRaw$)       : EndIf
  If IsGadget(#G_HtmlFrag)   : SetGadgetText(#G_HtmlFrag, gHtmlFrag$)     : EndIf
  If IsGadget(#G_Rtf)        : SetGadgetText(#G_Rtf, gRtf$)               : EndIf
  If IsGadget(#G_TextUnicode): SetGadgetText(#G_TextUnicode, gUnicodeText): EndIf
  If IsGadget(#G_TextAnsi)   : SetGadgetText(#G_TextAnsi, gAnsiText)      : EndIf
  
  If IsGadget(#G_ImagePreview)
    If IsImage(gImage)
      SetGadgetState(#G_ImagePreview, ImageID(gImage))
      SetGadgetText(#G_ImageInfo, "Bildgröße: " + Str(ImageWidth(gImage)) + "×" + Str(ImageHeight(gImage)))
    Else
      SetGadgetState(#G_ImagePreview, 0)
      SetGadgetText(#G_ImageInfo, "Kein Bild in der Zwischenablage.")
    EndIf
  EndIf
  
  If IsGadget(#G_FilesList)
    ClearGadgetItems(#G_FilesList)
    If gFiles <> ""
      Protected i, line.s, total
      total = CountString(gFiles, #CRLF$) + 1
      For i=1 To total
        line = StringField(gFiles, i, #CRLF$)
        If line <> ""
          AddGadgetItem(#G_FilesList, -1, GetFilePart(line) + Chr(10) + line)
        EndIf
      Next
    EndIf
  EndIf
  
  ; Tab-Indikatoren aktualisieren
  UpdatePanelTabTitles()
EndProcedure

; ==============================================
; Window Callback (WM_CLIPBOARDUPDATE)
; ==============================================
Procedure.i MainWindowCallback(hWnd.i, uMsg.i, wParam.i, lParam.i)
  Select uMsg
    Case #WM_CLIPBOARDUPDATE
      RefreshClipboardModel()
      UpdateUIFromModel()
      If IsGadget(#G_Status)
        SetGadgetText(#G_Status, "Zwischenablage geändert (System).")
      EndIf
      ProcedureReturn 0
  EndSelect
  ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure

; ==============================================
; UI Aufbau
; ==============================================
Procedure.i BuildUI()
  Protected winW=1040, winH=760
  If OpenWindow(#W_Main, 0, 0, winW, winH, "Clipboard Inspector", #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_ScreenCentered) = 0
    ProcedureReturn 0
  EndIf
  
  ; Window callback setzen
  SetWindowCallback(@MainWindowCallback())
  ; Listener registrieren
  If AddClipboardFormatListener(WindowID(#W_Main))
    gClipboardListenerAdded = #True
  EndIf
  
  PanelGadget(#G_Panel, 10, 10, winW-20, winH-120)
    ; Reihenfolge entspricht #IDX_* Konstanten
    AddGadgetItem(#G_Panel, -1, #TITLE_FORMATS)
      ListIconGadget(#G_FormatsList, 10, 10, GadgetWidth(#G_Panel)-30, GadgetHeight(#G_Panel)-40, "Format", 260, #PB_ListIcon_FullRowSelect | #PB_ListIcon_GridLines)
      AddGadgetColumn(#G_FormatsList, 1, "Verfügbar", 180)
    
    AddGadgetItem(#G_Panel, -1, #TITLE_HTML_RAW)
      EditorGadget(#G_HtmlRaw, 10, 10, GadgetWidth(#G_Panel)-30, GadgetHeight(#G_Panel)-40)
    
    AddGadgetItem(#G_Panel, -1, #TITLE_HTML_FRAG)
      EditorGadget(#G_HtmlFrag, 10, 10, GadgetWidth(#G_Panel)-30, GadgetHeight(#G_Panel)-40)
    
    AddGadgetItem(#G_Panel, -1, #TITLE_RTF)
      EditorGadget(#G_Rtf, 10, 10, GadgetWidth(#G_Panel)-30, GadgetHeight(#G_Panel)-40)
    
    AddGadgetItem(#G_Panel, -1, #TITLE_TEXTU)
      EditorGadget(#G_TextUnicode, 10, 10, GadgetWidth(#G_Panel)-30, GadgetHeight(#G_Panel)-40)
    
    AddGadgetItem(#G_Panel, -1, #TITLE_TEXTA)
      EditorGadget(#G_TextAnsi, 10, 10, GadgetWidth(#G_Panel)-30, GadgetHeight(#G_Panel)-40)
    
    AddGadgetItem(#G_Panel, -1, #TITLE_FILES)
      ListIconGadget(#G_FilesList, 10, 10, GadgetWidth(#G_Panel)-30, GadgetHeight(#G_Panel)-40, "Name", 320, #PB_ListIcon_FullRowSelect | #PB_ListIcon_GridLines)
      AddGadgetColumn(#G_FilesList, 1, "Pfad", 620)
    
    AddGadgetItem(#G_Panel, -1, #TITLE_IMAGE)
      ImageGadget(#G_ImagePreview, 10, 10, GadgetWidth(#G_Panel)-30, GadgetHeight(#G_Panel)-80, 0, #PB_Image_Border)
      TextGadget(#G_ImageInfo, 10, GadgetY(#G_ImagePreview)+GadgetHeight(#G_ImagePreview)+10, 540, 24, "—")
    
    AddGadgetItem(#G_Panel, -1, #TITLE_STORAGE)
      ListIconGadget(#G_StoreList, 10, 10, GadgetWidth(#G_Panel) - 30, GadgetHeight(#G_Panel) - 150, "ID", 60, #PB_ListIcon_FullRowSelect | #PB_ListIcon_GridLines)
      AddGadgetColumn(#G_StoreList, 1, "Typ", 90)
      AddGadgetColumn(#G_StoreList, 2, "Label", 230)
      AddGadgetColumn(#G_StoreList, 3, "Vorschau", 340)
      AddGadgetColumn(#G_StoreList, 4, "Zeit", 210)

      EditorGadget(#G_StoreText, 10, GadgetY(#G_StoreList) + GadgetHeight(#G_StoreList) + 10, GadgetWidth(#G_Panel) - 30, 90, #PB_Editor_ReadOnly)
      HideGadget(#G_StoreText, #True)

      ImageGadget(#G_StoreImage, 10, GadgetY(#G_StoreList) + GadgetHeight(#G_StoreList) + 10, GadgetWidth(#G_Panel) - 30, 90, 0)
      HideGadget(#G_StoreImage, #True)
  CloseGadgetList()
  
  ButtonGadget(#G_BtnRefresh, 10, winH-100, 120, 32, "Refresh")
  ButtonGadget(#G_BtnStoreAdd       , 140, winH - 100, 170, 32, "In Ablage speichern")
  ButtonGadget(#G_BtnStoreToClipboard, 320, winH - 100, 210, 32, "Ablage → Zwischenablage")
  ButtonGadget(#G_BtnStoreDelete    , 540, winH - 100, 160, 32, "Slot löschen")
  ButtonGadget(#G_BtnStoreClear     , 710, winH - 100, 160, 32, "Ablage leeren")

  TextGadget(#G_Status, 10, winH-60, winW-20, 22, "Bereit.")
  
  ; Shortcuts
  AddKeyboardShortcut(#W_Main, #PB_Shortcut_Return, #M_CopyFromStorage)
  AddKeyboardShortcut(#W_Main, #PB_Shortcut_Delete, #M_DeleteSlot)
  
  ProcedureReturn #W_Main
EndProcedure

Procedure ResizeUI()
  Protected winW = WindowWidth(#W_Main)
  Protected winH = WindowHeight(#W_Main)
  ResizeGadget(#G_Panel, 10, 10, winW-20, winH-120)
  If IsGadget(#G_FormatsList)
    ResizeGadget(#G_FormatsList, 10, 10, GadgetWidth(#G_Panel)-30, GadgetHeight(#G_Panel)-40)
  EndIf
  If IsGadget(#G_HtmlRaw)
    ResizeGadget(#G_HtmlRaw, 10, 10, GadgetWidth(#G_Panel)-30, GadgetHeight(#G_Panel)-40)
  EndIf
  If IsGadget(#G_HtmlFrag)
    ResizeGadget(#G_HtmlFrag, 10, 10, GadgetWidth(#G_Panel)-30, GadgetHeight(#G_Panel)-40)
  EndIf
  If IsGadget(#G_Rtf)
    ResizeGadget(#G_Rtf, 10, 10, GadgetWidth(#G_Panel)-30, GadgetHeight(#G_Panel)-40)
  EndIf
  If IsGadget(#G_TextUnicode)
    ResizeGadget(#G_TextUnicode, 10, 10, GadgetWidth(#G_Panel)-30, GadgetHeight(#G_Panel)-40)
  EndIf
  If IsGadget(#G_TextAnsi)
    ResizeGadget(#G_TextAnsi, 10, 10, GadgetWidth(#G_Panel)-30, GadgetHeight(#G_Panel)-40)
  EndIf
  If IsGadget(#G_FilesList)
    ResizeGadget(#G_FilesList, 10, 10, GadgetWidth(#G_Panel)-30, GadgetHeight(#G_Panel)-40)
  EndIf
  If IsGadget(#G_ImagePreview)
    ResizeGadget(#G_ImagePreview, 10, 10, GadgetWidth(#G_Panel)-30, GadgetHeight(#G_Panel)-80)
    ResizeGadget(#G_ImageInfo, 10, GadgetY(#G_ImagePreview)+GadgetHeight(#G_ImagePreview)+10, 540, 24)
  EndIf
  If IsGadget(#G_StoreList)
    ResizeGadget(#G_StoreList, 10, 10, GadgetWidth(#G_Panel)-30, GadgetHeight(#G_Panel)-150)
    ResizeGadget(#G_StoreText, 10, GadgetY(#G_StoreList) + GadgetHeight(#G_StoreList) + 10, GadgetWidth(#G_Panel) - 30, 90)
    ResizeGadget(#G_StoreImage, 10, GadgetY(#G_StoreList) + GadgetHeight(#G_StoreList) + 10, GadgetWidth(#G_Panel) - 30, 90)
  EndIf
  ResizeGadget(#G_BtnRefresh         , 10          , winH - 100, 120, 32)
  ResizeGadget(#G_BtnStoreAdd        , 140         , winH - 100, 170, 32)
  ResizeGadget(#G_BtnStoreToClipboard, 320         , winH - 100, 210, 32)
  ResizeGadget(#G_BtnStoreDelete     , 540         , winH - 100, 160, 32)
  ResizeGadget(#G_BtnStoreClear      , 710         , winH - 100, 160, 32)
  ResizeGadget(#G_Status, 10, winH-60, winW-20, 22)
EndProcedure

; ==============================================
; Main
; ==============================================
Define event, evgad, evtype, row, tab

If BuildUI() = 0 : End : EndIf
RefreshClipboardModel()
UpdateUIFromModel()
StoragePopulateList()
UpdatePanelTabTitles()

Repeat
  event = WaitWindowEvent()
  Select event
    Case #PB_Event_SizeWindow
      ResizeUI()
      
    Case #PB_Event_Menu
      Select EventMenu()
        Case #M_CopyFromStorage
          If gStoreSelectedId > 0
            StorageCopyToClipboard(gStoreSelectedId)
            SetGadgetText(#G_Status, "Ablage → Zwischenablage kopiert.")
            UpdatePanelTabTitles()
          EndIf
        Case #M_DeleteSlot
          If gStoreSelectedId > 0
            StorageDeleteById(gStoreSelectedId)
            SetGadgetText(#G_Status, "Slot gelöscht.")
            UpdatePanelTabTitles()
          EndIf
      EndSelect
      
    Case #PB_Event_Gadget
      evgad = EventGadget()
      evtype = EventType()
      
      Select evgad
        Case #G_BtnRefresh
          RefreshClipboardModel()
          UpdateUIFromModel()
          SetGadgetText(#G_Status, "Zwischenablage aktualisiert.")
          
        Case #G_StoreList
          If evtype = #PB_EventType_LeftClick Or evtype = #PB_EventType_LeftDoubleClick
            row = GetGadgetState(#G_StoreList)
            If row >= 0
              gStoreSelectedId = Val(GetGadgetItemText(#G_StoreList, row, 0))
              StorageShowPreviewById(gStoreSelectedId)
              If evtype = #PB_EventType_LeftDoubleClick
                StorageCopyToClipboard(gStoreSelectedId)
                SetGadgetText(#G_Status, "Ablage → Zwischenablage kopiert.")
              EndIf
            EndIf
          EndIf
          
        Case #G_BtnStoreAdd
          tab = GetGadgetState(#G_Panel)
          Select tab
            Case #IDX_FORMATS  ; nichts
            Case #IDX_HTML_RAW
              If gHtmlRaw$ <> "" : StorageAddText("HTML (raw)", gHtmlRaw$) : EndIf
            Case #IDX_HTML_FRAG
              If gHtmlFrag$ <> "" : StorageAddText("HTML (fragment)", gHtmlFrag$) : EndIf
            Case #IDX_RTF
              If gRtf$ <> "" : StorageAddText("RTF", gRtf$) : EndIf
            Case #IDX_TEXTU
              If gUnicodeText <> "" : StorageAddText("Unicode Text", gUnicodeText) : EndIf
            Case #IDX_TEXTA
              If gAnsiText <> "" : StorageAddText("ANSI Text", gAnsiText) : EndIf
            Case #IDX_FILES
              If gFiles <> "" : StorageAddText("Files", gFiles) : EndIf
            Case #IDX_IMAGE
              If IsImage(gImage) : StorageAddImage("Image (Clipboard)", gImage) : EndIf
            Case #IDX_STORAGE
              ; nichts
          EndSelect
          SetGadgetText(#G_Status, "In Ablage gespeichert.")
          UpdatePanelTabTitles()
          
        Case #G_BtnStoreToClipboard
          If gStoreSelectedId > 0
            StorageCopyToClipboard(gStoreSelectedId)
            SetGadgetText(#G_Status, "Ablage → Zwischenablage kopiert.")
          Else
            SetGadgetText(#G_Status, "Bitte einen Slot in der Ablage auswählen.")
          EndIf
          
        Case #G_BtnStoreDelete
          If gStoreSelectedId > 0
            StorageDeleteById(gStoreSelectedId)
            SetGadgetText(#G_Status, "Slot gelöscht.")
            UpdatePanelTabTitles()
          Else
            SetGadgetText(#G_Status, "Bitte einen Slot in der Ablage auswählen.")
          EndIf
          
        Case #G_BtnStoreClear
          If MessageRequester("Ablage leeren", "Wirklich alle Speicherplätze löschen?", #PB_MessageRequester_YesNo | #PB_MessageRequester_Warning) = #PB_MessageRequester_Yes
            StorageClearAll()
            SetGadgetText(#G_Status, "Ablage geleert.")
            UpdatePanelTabTitles()
          EndIf
      EndSelect
      
    Case #PB_Event_CloseWindow
      Break
  EndSelect
ForEver

; Cleanup
If gClipboardListenerAdded
  RemoveClipboardFormatListener(WindowID(#W_Main))
EndIf

If IsImage(gImage) : FreeImage(gImage) : EndIf
ForEach Storage()
  If Storage()\kind = 1 And IsImage(Storage()\img)
    FreeImage(Storage()\img)
  EndIf
Next

HeX0R · Post by **HeX0R** » Wed Nov 12, 2025 2:56 pm

Why not add a auto refresh?

Code: Select all

Import "User32.lib"
	AddClipboardFormatListener(hwnd)
EndImport
#WM_CLIPBOARDUPDATE = $031D
;then call AddClipboardFormatListener(WindowID(0)) and react to #WM_CLIPBOARDUPDATE

[Edit]
oh o.k., you have implemented that already

PureBasic Forums - English

Clipboard UI Inspector

Clipboard UI Inspector

Re: Clipboard UI Inspector

Re: Clipboard UI Inspector

Re: Clipboard UI Inspector

Re: Clipboard UI Inspector

Re: Clipboard UI Inspector

Re: Clipboard UI Inspector

Re: Clipboard UI Inspector

Re: Clipboard UI Inspector

Re: Clipboard UI Inspector