delphi4arab منتديات دلفي للعرب

السلام عليكم ورحمة الله وبركاته
الكود الأصلي من هذا الموضوع

كود :
http://www.at4re.com/f/showthread.php?11697-Custom-MessageBox

مكتوب بـ c++ قمت بتحويله إلى delphi
مرفق SRC مع BIN بنكهتين 32/64 مترجم على نسخة Delphi 10 Seattle.

كود :
unit uCustomMessageBox;

interface

uses
  Windows, Messages, RichEdit, ShellAPI;

function ShowHypeMessageBox(hWnd: HWND; lpText: PChar; lpCaption: PChar; uType: UINT ): Integer;

var
  hMsgBoxHook: HHOOK;
  hArrow, hIbeam: HCURSOR;

implementation

var
  lpWndProc: Pointer;

function EditDlgProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM):
  Integer; stdcall;
begin
  Result := 0;
  lpWndProc := Pointer(GetWindowLong(hWnd, GWL_USERDATA));
  case uMsg of
    WM_SETFOCUS: Result := 1;
    WM_MOUSEWHEEL: Result := 0;
  end;
  if GetCursor = hIbeam then
    SetCursor(hArrow);
  Result := CallWindowProc(lpWndProc, hWnd, uMsg, wParam, lParam);
end;

function StaticDlgProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM):
  Integer; stdcall;
type
  PENLINK = ^ENLINK;
var
  bCursor: Boolean;
  lpLink: PENLINK;
  szBuf: array[0..260-1] of Char;
begin
  Result := 0;
  bCursor := False;
  lpWndProc := Pointer(GetWindowLong(hWnd, GWL_USERDATA));
  case uMsg of
    WM_NOTIFY:
      begin
        case PNMHdr(lParam)^.code of
          EN_LINK:
            begin
               lpLink := PENLINK(lParam);
              if (lpLink^.msg = WM_LBUTTONUP) then
              begin
                SendMessage(lpLink^.nmhdr.hwndFrom,
                  EM_EXSETSEL,
                  0,
                  Integer(@lpLink^.chrg));

                SendMessage(lpLink^.nmhdr.hwndFrom,
                  EM_GETSELTEXT,
                  0,
                  Integer(@szBuf));

                ShellExecute(0,
                  'open',
                  szBuf,
                  nil,
                  nil,
                  SW_SHOWNORMAL);
              end;
              bCursor := true;
              Exit;
            end;
        end;
      end;
  end;
  Result := CallWindowProc(lpWndProc, hWnd, uMsg, wParam, lParam);
end;

function MsgProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT;
  stdcall;
var
  lpMsg: PCWPStruct;
  hStatic: HWND;
  rcStatic: TRect;
  hFont: HGDIOBJ;
  hRich: HWND;
  szBuf: array[0..260-1] of Char;
  pt: TPoint;
begin
  Result := 0;
  if (nCode = HC_ACTION) then
    lpMsg := PCWPStruct(lParam);
  case LOWORD(lpMsg^.message) of
    WM_INITDIALOG:
      begin
        hStatic := GetDlgItem(lpMsg^.hwnd, $FFFF);
        GetClientRect(hStatic, rcStatic);
        GetWindowText(hStatic, szBuf, 260);
        hFont := SendMessage(hStatic,
          WM_GETFONT,
          0,
          0);

        hRich := CreateWindowEx(WS_EX_NOPARENTNOTIFY,
          RICHEDIT_CLASS,
          nil,
          WS_CHILD + ES_READONLY + WS_VISIBLE + ES_MULTILINE,
          0,
          0,
          rcStatic.right - rcStatic.left + 2,
          rcStatic.bottom - rcStatic.top,
          hStatic,
          0,
          0,
          nil);

        SendMessage(hRich, WM_SETFONT, hFont, 0);
        SendMessage(hRich, EM_SETBKGNDCOLOR, 0, $00FFFFFF);
        SendMessage(hRich, EM_SETEVENTMASK, 0, ENM_LINK);
        SendMessage(hRich, EM_AUTOURLDETECT, 1, 0);

        SetWindowText(hRich, szBuf);

        ScreenToClient(lpMsg^.hwnd, pt);
        SetWindowLong(hStatic,
          GWL_USERDATA,
          SetWindowLong(hStatic,
          GWL_WNDPROC,
          LONG_PTR(@StaticDlgProc))
          );

        SetWindowLong(hRich,
          GWL_USERDATA,
          SetWindowLong(hRich,
          GWL_WNDPROC,
          LONG_PTR(@EditDlgProc))
          );

        Exit;
      end;
  end;
  Result := CallNextHookEx(hMsgBoxHook, nCode, wParam, lParam);
end;

function ShowHypeMessageBox(hWnd: HWND; lpText: PChar; lpCaption: PChar; uType: UINT ): Integer;
var
  dwResult: Integer;
begin
  dwResult := 0;
  hMsgBoxHook := SetWindowsHookEx(WH_CALLWNDPROC,
    MsgProc,
    0,
    GetCurrentThreadId()
    );
  dwResult := MessageBox(hWnd, lpText, lpCaption, uType);
  UnhookWindowsHookEx(hMsgBoxHook);
  Result := dwResult;
end;

end.  

delphi4arab منتديات دلفي للعرب

Agmcz