[nonVCL] Send to Clipboard as Name - Eigenbau

[turboPASCAL]

Hi,

Wer kennt das nicht, man(n) (und oder auch Frau) braucht den kompletten Dateinamen mit Pfad. Irgendein Tool von MS stellt diese Funktion zwar schon zur Verfügung aber es geht ja nix über den Eigenbau.
Von diesem Programm eine Verknüpfung erstellt und ab in das SendTo-Verzeichnis von Windows
(zB. "C:\Dokumente und Einstellungen\Default User\SendTo\" für alle User). Nun kann mit 'nem Klick im Kontextmenü der Dateiname + Pfadangabe in das Clipboard kopiert werden.


Warum Poste ich das hier ?
- Wenn man mal was abgucken will. ( inc. Fehler )
- Irgend einer kann das gebrauchen.
- es ist ein "fertiges" Programm und Open-Source was sich jeder verändern kann wie er will

und:
- Wenn mir noch jemand einen Rat geben kann, zB. wie ich dieses Programm ohne Timer machen kann.

(ich hoffe der Code ist nicht zu lang, kann auf Wunsch ja verschwinden)

Delphi-Quellcode:

program SendtoClipboardAsName;

{$R 'SendtoClipboardAsName.res' 'SendtoClipboardAsName.rc'}
{$DESCRIPTION 'Send to Clipboard as Name'}

uses
  Windows, Messages;

const
  WINDOW_CLASS  = 'SendtoClipboardAsNameWnd';
  WINDOW_TITLE  = 'Send to Clipboard as Name V1.0';

  LWA_COLORKEY   = 1;       // Use crKey as the transparency color.
  LWA_ALPHA      = 2;       // Use Alpha to determine the opacity of the layered window.
  WS_EX_LAYERED  = $80000;  // Windowstyle transparent

var
  WndClass: TWndClassEx;
  Msg: TMsg;

procedure CopyTextToClipboard(aWnd: HWND; aText: PChar);
var
  Data: THandle;
  DataPtr: Pointer;
  Size: Integer;
  oldWND: HWND;
begin
  Size := Length(aText) + 1;
  OpenClipboard(aWnd); //Open Clipboard
  try
    EmptyClipboard; // Clear Clipboard
    oldWND := SetClipboardViewer(aWnd); // Clipboard für Programm registr.
    Data := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE, Size); // Get Memory
    try
      DataPtr := GlobalLock(Data);
      try
        Move(aText^, DataPtr^, Size);
        SetClipboardData(CF_TEXT, Data); // Clpbrd-Format as Text & send Text
      finally
        GlobalUnlock(Data);
      end;
    except
      GlobalFree(Data); // Free res. Memory
      raise; // Get global Memory Err
    end;
    ChangeClipboardChain(aWnd, oldWND);
  finally
    CloseClipboard; //Close Clipboard
  end;
end;

// --- Main Window Funktion -----------------------------------------------------
function WndProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM;
  lParam: LPARAM): LRESULT; stdcall;
var
  Bmp, oldBmp: HBitmap;
  MemDC: HDC;
  PS: PAINTSTRUCT;
  s: String;
  i: Integer;
begin
  Result := 0;
  case uMsg of
    WM_CREATE: // wird bei dem erstellen des Fensters aufgerufen
      begin
        SetWindowLong(hwnd, GWL_EXSTYLE,
          GetWindowLong(hwnd, GWL_EXSTYLE) or WS_EX_LAYERED);

        SetLayeredWindowAttributes(hwnd, $00FF00FF, 140, LWA_COLORKEY + LWA_ALPHA);

        // Get Cmd-Params
        s:='';
        if (ParamCount > 0) then
          for i := 1 to ParamCount do
            s := s + ' ' + paramstr(i);
        Delete(s,1,1);

        // Cmd to Clipboard
        CopyTextToClipboard(hWnd, PChar(s));

        Settimer(hWnd, 1, 250, nil);
      end;

    WM_COMMAND: ; // nix

    WM_TIMER: SendMessage(hWnd, WM_CLOSE, 0, 0);
    
    WM_PAINT:
      begin
        BeginPaint(hWnd, PS);

        MemDC := CreateCompatibleDC(0);
        Bmp:= LoadImage(hInstance, MAKEINTRESOURCE(1), IMAGE_BITMAP, 0, 0, 0);

        oldBmp := SelectObject(MemDC, Bmp);

        BitBlt(PS.hdc, 0, 0, 50, 50, MemDC, 0, 0, SRCCOPY);

        SelectObject(MemDC, oldBmp);
        DeleteDC(MemDC);
        DeleteObject(Bmp);

        EndPaint(hWnd, PS);
      end;

    WM_DESTROY:
      begin
        killtimer(hWnd, 1);
        PostQuitMessage(0);
      end;
  else
    Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
  end;
end;

begin
  // Fenster Parameter festlegen
  with WndClass do
  begin
    cbSize             := SizeOf(TWndClassEx);
    style              := cs_hRedraw or cs_vRedraw;
    lpfnWndProc        := @WndProc;
    cbClsExtra         := 0;
    cbWndExtra         := 0;
    hInstance          := SysInit.HInstance;
    hbrBackground      := CreateSolidBrush(RGB(255,0,255));
    lpszMenuName       := '';
    lpszClassname      := WINDOW_CLASS;
    hIcon              := LoadIcon(0, IDI_APPLICATION);
    hCursor            := LoadCursor(0, IDC_ARROW);
    hIconSm            := 0;
  end;

  RegisterClassEx(WndClass);
  
  // Fenster erstellen
  CreateWindowEx(
    WS_EX_TOPMOST or WS_EX_TOOLWINDOW, 
    WINDOW_CLASS,
    WINDOW_TITLE,
    WS_POPUP or WS_VISIBLE or WS_SYSMENU,
    Getsystemmetrics(SM_CXSCREEN)-70,
    20 {Getsystemmetrics(SM_CYSCREEN)-140},
    50,
    50,
    0,
    0,
    hInstance,
    nil);

  // "Application.Run"
  while GetMessage(Msg, 0, 0, 0) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
end.