Clipviewer

[Volkmar]

Hallo Frank

Da war ich in der Tat inkonsequent. Ich wollte es nicht editierbar und über die Kontextfunktionen ging es doch.
So sollte das nun besser laufen.

$H windows.ph
$H messages.ph
Declare OrgWinProc&
Declare Titel$, NextViewer&, LastSender&, Text&, Static&, DelBtn&, EditBtn&, CopyBtn&, IsText&, IsPic&, Font&, Static$
Declare Rect#
Declare RRect#
Declare Bitmap#
Declare Buffer#
Struct Rect = ~TRect
Struct Bitmap = ~TBitmap
DIM Rect#, Rect
DIM RRect#, Rect
DIM Bitmap#, Bitmap
DIM Buffer#, 60

Proc EditSubClass
  Parameters _Wnd&, _Msg&, _WParam&, _LParam&
  Case _Msg& = ~wm_ContextMenu : Return 1
  Return ~CallWindowProc(OrgWinProc&, _Wnd&, _Msg&, _WParam&, _LParam&)
EndProc

Proc BildHolen
  Declare _Ratio!, _Ratio$, _BMH&
  If ~OpenClipBoard(%HWnd) <> 0
    IsPic& = 1
    _BMH& = ~GetClipboardData(~cf_Bitmap)
    ~GetObject(_BMH&, 28, Bitmap#)
    ~CloseClipboard()
    MCLS Bitmap#.bmWidth&, Bitmap#.bmheight&
    StartPaint -1
    ClipLoadBMP 0, 0; 0
    Endpaint
    ' Verhältnis Breite zu Höhe für Anzeige berechnen
    _Ratio! = Bitmap#.bmheight& / Bitmap#.bmWidth&
    _Ratio$ = "  [B : H = 1 : " + Format$ ("0.00", _Ratio!) + "]"
    If _Ratio! < 1
      _Ratio! = Bitmap#.bmWidth& / Bitmap#.bmheight&
      _Ratio$ = "  [B : H = " + Format$ ("0.00", _Ratio!) + " : 1]"
    EndIf
    Static$ = "Bild (" + Str$(Bitmap#.bmWidth&) + " x " + Str$(Bitmap#.bmheight&) + ") Pixel"
    SetText Static&, Static$ + _Ratio$
  Else
    SetText Static&, "Bildholen gescheitert"
    IsPic& = 0
  EndIf
EndProc

Proc BildSetzen
  Declare _Zoom1!, _Zoom2!, _BW&, _BH&
  Case IsPic& = 2  : BildHolen        ' War Fenster verkleinert, Bild jetzt holen
                        ' BildHolen funktioniert nicht, wenn Programm verkleinert!
  If IsPic& = 1
    ' Proportional in vorhandene Fenstergröße einpassen
    _Zoom1! = %BMPX / Rect#.Right&
    _Zoom2! = %BMPY / (Rect#.Bottom& - 49)
    If _Zoom1! > _Zoom2!
      _BW& = %BMPX / _Zoom1!
      _BH& = %BMPY / _Zoom1!
    Else
      _BW& = %BMPX / _Zoom2!
      _BH& = %BMPY / _Zoom2!
    EndIf
    MCopySizedBMP 0, 0 - %BMPX, %BMPY > 0, 26 - _BW&, _BH&; 0  ' Bild in Fenster einzoomen
  EndIf
EndProc

Proc Size       ' Größenänderung Fenster
  Case ~IsIconic(%HWnd) : Return        ' nichts tun bei verkleinertem Fenster
                                        ' Vorschau wird ohnehin nicht aktualisiert
                                        ' und Bildeinfügen ist hier nicht möglich
  CLS ~GetSysColor(~Color_BtnFace)
  ~GetClientRect(%HWnd, Rect#)
  RRect#.Left& = -1
  RRect#.Top& = -1
  RRect#.Right& = Rect#,Right& - 6
  RRect#.Bottom& = 25
  ~DrawEdge(%HDC, RRect#, 9, 15)
  ~DrawEdge(%HDC2, RRect#, 9, 15)
  SetWindowPos Static& = 2, (Rect#.Bottom& - 22) - (Rect#.Right& - 3), 22
  If IsText&    ' Textdisplay einpassen
    SetWindowPos Text& = 0, 26 - Rect#.Right&, Rect#.Bottom& - 48
    SetText Static&, Static$
    ShowWindow(Text&, 1)
  ElseIf IsPic& ' Bild einpassen
    BildSetzen
  Else
    SetText Static&, Static$
  EndIf
EndProc

Proc ShowText   ' Steuerung Sichtbarkeit Textdisplay
  Parameters _Text&
  IsText& = _Text&
  Case IsText& : IsPic& = 0
  ShowWindow (Text&, IsText&<>0)
  ShowWindow (EditBtn&, IsText&=1)
  ShowWindow (CopyBtn&, IsText&=1)
  EnableWindow CopyBtn&, 0
  SetCheck EditBtn&, 0
EndProc

Proc TextFormat ' Aktion Text
  Declare _Text$, _Len&
  _Text$ = GetClip$()
  _Len& = Len (_Text$)
  ShowText 1
  SetText Text&, _Text$
  Static$ = "Text (" + Str$(_Len&) + " Zeichen)"
EndProc

Proc BildFormat ' Aktion Bild
  ShowText 0
  IsPic& = 2  ' Veranlaßt Bildholen wenn Fenster anzeigebereit ist
EndProc

Proc AnsiString
  Parameters _Offs&
  Declare _AString$
  _AString$ = MkStr$(Chr$(0), 260)
  ~WideCharToMultiByte(~CP_ACP,0,_Offs&,-1,Addr(_AString$),260,0,0)
  Return Trim$(_AString$)
EndProc

Proc DropFileFormat
  Declare _Data&, _Offs&, _File$, _FileList$, _Files&
  If ~OpenClipBoard(%HWnd) <> 0
    _Data& = ~GetClipboardData(~cf_HDrop)
    _Offs& = Long(_Data&, 0)
    _File$ = AnsiString (_Data& + _Offs&)
    While _File$ <> ""
      Inc _Files&
      _FileList$ = _FileList$ + Chr$(13) + Chr$(10) + _File$
      _Offs& = _Offs& + Len(_File$)*2 + 2
      _File$ = AnsiString (_Data& + _Offs&)
    EndWhile
  EndIf
  ~CloseClipboard()
  SetText Text&, @Del$(_FileList$, 1, 2)
  Static$ = "HDrop-Struktur mit " + Str$(_Files&) + " Einträgen"
  ShowText 2
EndProc

Proc XFormat    ' Aktion Unbekanntes Format
  Parameters _Static$
  ShowText 0
  Static$ = _Static$
  IsPic& = 0
EndProc

Proc ClipAction         ' Änderungen des Inhalts der Zwischenanlage auswerten
  Declare _Icon&
  CLS ~GetSysColor(~Color_BtnShadow)
  If ~CountClipboardFormats()
    If ~IsClipboardFormatAvailable(~cf_Text)
      Textformat
    ElseIf ~IsClipboardFormatAvailable(~cf_Bitmap)
      BildFormat
    ElseIf ~IsClipboardFormatAvailable(~cf_HDrop)
      DropFileFormat
    Else
      XFormat "Nicht darstellbar"
    EndIf
  Else
    XFormat "Leer"
  EndIf
  Size
  Case NextViewer& : SendMessage(NextViewer&, ~wm_DrawClipboard, &uwParam, &ulParam)
  ' Kommando durchreichen an nächsten Viewer
EndProc

Proc CopyEdit
  ClearClip
  PutClip GetText$(Text&)
  ClipAction
EndProc

Proc CBChain    ' Änderung der Viewerkette behandeln
  If &uwParam = NextViewer&
    NextViewer& = &ulParam
  ElseIf NextViewer& <> 0
    SendMessage(NextViewer&, ~wm_ChangeCBChain, &uwParam, &ulParam)
  EndIf
EndProc

Proc MakeTextDisplay
  Font& = ~GetStockObject(~Default_GUI_Font)
  ~GetObject(Font&, 60, Buffer#)
  Long Buffer#, 0 = 16
  Long Buffer#, 4 = 0
  Font& = ~CreateFontIndirectA(Buffer#)                 ' Eigenen Font basiert auf Systemschrift Default_GUI_Font
  SetDialogFont Font&
  Text& = Create("MultiEdit", %HWnd, "", 0, 0, 0, -1)   ' Textanzeige
  SendMessage(Text&, ~em_SetReadOnly, 1, 0)             ' Text als NurLesen anzeigen
  IsText& = 1
  Static& = Control("Static", "", $50000000, 0, 0, 0, 0, %HWnd, 100, %HInstance, $200)  ' Statusanzeige
  DelBtn& = Create("Button", %HWnd, "Löschen", 2, 2, 64, 22)
  EditBtn& = Create("CheckBox", %HWnd, "Bearbeiten", 88, 3, 88, 20)
  CopyBtn& = Create("Button", %HWnd, "Alles kopieren", 176, 2, 96, 22)
  OrgWinProc& = ~GetWindowLong(Text&, ~gwl_WndProc)
  ~SetWindowLong(Text&, ~gwl_WndProc, ProcAddr("EditSubClass", 4))
  Size
EndProc

Proc EditEnable
  Declare _CanEdit&
  _CanEdit& = GetCheck (EditBtn&)
  SendMessage(Text&, ~em_SetReadOnly, Not(_CanEdit&), 0)
  EnableWindow CopyBtn&, _CanEdit&
  If _CanEdit&
    ~SetWindowLong(Text&, ~gwl_WndProc, OrgWinProc&)
  Else
    ~SetWindowLong(Text&, ~gwl_WndProc, ProcAddr("EditSubClass", 4))
  EndIf
EndProc

WindowStyle 575
WindowTitle "ClipView"
Window %MaxX\12, %MaxY\12 - %MaxX\2, %MaxY\2
UseIcon "Windows"
CLS ~GetSysColor(~Color_BtnShadow)
Set("FastMode", 1)
Set("ErrorLevel", 0)
MakeTextDisplay
NextViewer& = ~SetClipboardViewer(%HWnd)        ' Viewer anmelden
UserMessages ~wm_DrawClipboard, ~wm_ChangeCBChain
ClipAction
While 1
  WaitInput
  EditEnable
  If %Key = 2
    Break
  ElseIf %Key = 4
    Size
  ElseIf %UMessage = ~wm_DrawClipboard
    ClipAction
  ElseIf %UMessage = ~wm_ChangeCBChain
    CBChain
  ElseIf %Key = 255
    If GetFocus(DelBtn&)
      ClearClip
      ClipAction
    EndIf
  ElseIf GetFocus(CopyBtn&)
    CopyEdit
  EndIf
EndWhile
Dispose Rect#
Dispose Bitmap#
Dispose Buffer#
DeleteObject Font&
~ChangeClipboardChain(%HWnd, NextViewer&)       ' Viewer abmelden, unbedingt bei Ende ausführen!!!

Man kann zwar immer noch was markieren, aber nichts mehr kopieren, wenn der Editmodus nicht eingeschalten ist.

Gruß Volkmar

[Frabbing]

Sehr schön. Aber ich kann's noch löschen, obwohl Bearbeiten verboten ist...
Dein Subclassing benutzt auch noch die unsicherere ProcAddr-Methode. Welche XProfan-Version verwendest du?

[Volkmar]

Löschen ja, mit der Löschtaste. Die gilt immer. Wollte Thomas generell für jeden Inhalt drin haben. Und das Löschen war auch bei MS im Menü des Viewers drin, wenn ich mich da recht entsinne. Oder gibts noch was, was ich immer noch nicht gesehen habe?

Gruß Volkmar

[Frabbing]

Nein, das war's, was ich gemeint hatte.

[Volkmar]

Na super, dann kann ich jetzgt beruhigt ins Bett gehen. Hust - Schnief

Gruß Volkmar

[Frabbing]

Ach du auch? Na dann gute Besserung und angenehme Nachtruhe!

[ts-soft]

Lasst mir bloß mein Löschknöpje, Ihr kranken Hühner .
Ich bin Gesund und will Knöpje drücke

[Frabbing]

Volkmar, speziell für Thomas solltest du eine Löschautomatik einbauen.
30 oder 40 mal pro Minute oder so...

[Volkmar]

@Frank
Erst mal danke und Dir auch.
Und ansonsten, Thomas kann ja auch programmieren. Eine Löschautomatik per Timer einbauen sollte für ihn kein Problem sein. aber das will er ja nicht, er will ja Knöpje drücke.

Gruß Volkmar

[Frabbing]

Genau.