gfdict.~dpr

屏幕取词的delphi代码

  posDc : TPoint;
  RectText : TRect;
  size : TSize;
  wstr:WideString;
  astr:string;
  charindex:Integer;
label last;
begin
//  EnterCriticalSection(g_CriticalSection);
  result := FALSE;
  UnInstallThunkFunc(tfExtTextOutW);
{$IFNDEF MSG_NOT_SEND}
  if CommonData^.bInSpec then begin
    (*if (Options and ETO_CLIPPED)=0 then goto last;*)
    try


        //wstr:=Str;
       //StrCopy(CommonData.BufferA,PChar(UTF8Encode(wStr)));
       lstrcpyW(CommonData.Bufferw,str);
       CommonData^.charcount:=Count;
      // StrCopy(CommonData.BufferA,PChar(aStr));

        CommonData^.Rect := RectText;
    except

        GanWarning;
        StrCopy(CommonData.BufferA, 'ERROR in ExtTextOutW');
    end;
    commondata^.bInSpec:=false;
    SendMessage(CommonData^.CallBackHandle, idMsg, Integer(tfExtTextOutW), 0);
    goto last;
  end;

  GetDcOrgEx(dc, posDcOrg);
  posDc.x := x;
  posDc.y := y;

  LPtoDP(dc, posDc, 1);

  RectText.Left := posDc.x + posDcOrg.x;
  RectText.Top := posDc.y + posDcOrg.y;



  if BOOL(GetTextAlign(dc) and TA_UPDATECP) then begin
    GetCurrentPositionEx(dc, @posDc);
    Inc(RectText.Left, posDc.x);
    Inc(RectText.Top, posDc.y);
  end;

  GetTextExtentPointW(dc, Str, Count, size); {Get The Length and Height of str}
  with RectText do begin
    Right := Left + size.cx;
    Bottom := Top + Size.cy;
  end;



  if (CommonData<>nil) {and false} and PtInRect(RectText, CommonData.MousePos) then begin
    {Bug Find 2002-05-13}
    try
        //wstr:=Str;

        //StrCopy(CommonData.BufferA,PChar(UTF8Encode(wstr)));
      // StrCopy(CommonData.BufferA,PChar(aStr));

        lstrcpyW(commondata.BufferW,str);
        CommonData^.charcount:=Count;

        CommonData^.Rect := RectText;
        charindex:=Round(Count*((commondata.MousePos.X-recttext.Left)/(RectText.Right-recttext.Left)));
        CommonData.mousechar:=charindex;

    except
        GanWarning;
        StrCopy(CommonData.BufferA, 'ERROR in ExtTextOutW');
    end;
    SendMessage(CommonData^.CallBackHandle, idMsg, Integer(tfExtTextOutW), 0);
  end;
{$ENDIF}
last:
  result := ExtTextOutW(DC, X, Y, Options, Rect, Str, Count, Dx);
  InstallThunkFunc(tfExtTextOutW);
//  UnInstallGanFilter;

//  LeaveCriticalSection(g_CriticalSection);
end;

{===================  DrawText  ==============================================}
function GanDrawTextA(hDC: HDC; lpString: PAnsiChar; nCount: Integer;
  var lpRect: TRect; uFormat: UINT): Integer; stdcall;
var
  RectSave : TRect;
  posDcOrg : TPoint;
begin
//  EnterCriticalSection(g_CriticalSection);

  UnInstallThunkFunc(tfDrawTextA);
{$IFNDEF MSG_NOT_SEND}
  if (CommonData<>nil) {and false} then begin
    GetDcOrgEx(hDc, posDcOrg);
    RectSave := lpRect;
    OffsetRect(RectSave, posDcOrg.x, posDcOrg.y);

    if PtInRect(RectSave, CommonData^.MousePos) then begin
      try
        StrCopy(CommonData.BufferA, lpString);
        CommonData^.Rect := lpRect;
      except
        GanWarning;
      end;
      SendMessage(CommonData^.CallBackHandle, idMsg, Integer(tfDrawTextA), 0);
    end;
  end;
{$ENDIF}
  result := DrawTextA(hDC, lpString, nCount, lpRect, uFormat);
  InstallThunkFunc(tfDrawTextA);

//  UnInstallGanFilter;

//  LeaveCriticalSection(g_CriticalSection);
end;

function GanDrawTextW(hDC: HDC; lpString: PWideChar; nCount: Integer;
  var lpRect: TRect; uFormat: UINT): Integer; stdcall;
var
  RectSave : TRect;
  posDcOrg : TPoint;
  wstr:WideString;
begin
//  EnterCriticalSection(g_CriticalSection);

  UnInstallThunkFunc(tfDrawTextW);
{$IFNDEF MSG_NOT_SEND}
  if (CommonData<>nil) {and false} then begin
    GetDcOrgEx(hDc, posDcOrg);
    RectSave := lpRect;
    OffsetRect(RectSave, posDcOrg.x, posDcOrg.y);

    if PtInRect(RectSave, CommonData^.MousePos) then begin
      try
        //wstr:=lpString;
        //StrCopy(CommonData.BufferA,PChar(UTF8Encode(wstr) ));
        lstrcpyW(CommonData.Bufferw,lpString);

        CommonData^.Rect := lpRect;
      except
        GanWarning;
      end;
    end;
    SendMessage(CommonData^.CallBackHandle, idMsg, Integer(tfDrawTextW), 0);
  end;
{$ENDIF}
  result := DrawTextW(hDC, lpString, nCount, lpRect, uFormat);
  InstallThunkFunc(tfDrawTextW);
//  UnInstallGanFilter;

//  LeaveCriticalSection(g_CriticalSection);
end;

procedure InstallGanFilter;
var
  tfType : TThunkFunc;
begin
  if bDllInstalled then exit;

  for tfType := tfTextOutA to {tfExtTextOutW}tfDrawTextW do
  // for tfType := LOW(TThunkFunc) to TThunkFunc(Ord(HIGH(TThunkFunc))-2) do
    InstallThunkFunc(tfType);

  bDllInstalled := true;
end;

procedure UnInstallGanFilter;
var
  tfType : TThunkFunc;
begin
  if not bDllInstalled then exit;

  for tfType := tfTextOutA to {tfExtTextOutW}tfDrawTextW do
  // for tfType := LOW(TThunkFunc) to TThunkFunc(Ord(HIGH(TThunkFunc))-2) do
    UnInstallThunkFunc(tfType);

  bDllInstalled := false;
end;

{==================  =========================================================}
function WMCoverGetMinMaxInfo(
                hWnd    : THandle;
                Msg     : LongWord;
                wParam  : WPARAM;
                lParam  : LPARAM):BOOL;stdcall;
var
  info : ^MINMAXINFO;
begin
  result := BOOL(0);
  info := Pointer(lParam);
  info^.ptMaxSize.x := GetSystemMetrics(SM_CXFULLSCREEN);
  info^.ptMaxSize.y := GetSystemMetrics(SM_CYFULLSCREEN);
  info^.ptMinTrackSize.x := 0;
  info^.ptMinTrackSize.y := 0;
  info^.ptMaxTrackSize.x := GetSystemMetrics(SM_CXFULLSCREEN);
  info^.ptMaxTrackSize.y := GetSystemMetrics(SM_CYFULLSCREEN);
end;

function CoverMainProc(
    hWnd:LongWord;
    Message:LongWord;
    wParam:WPARAM;
    lParam:LPARAM
    ):BOOL;stdcall;
begin
  case Message of
    WM_CLOSE :
            begin
               DestroyWindow(hWnd);
               // PostQuitMessage(0);
            end;
  end;
  result := BOOL(DefWindowProc(hWnd, Message, lParam, lParam));
end;


procedure GanGetWordTimer(wnd : HWND; msg, idTimer : Cardinal; dwTime : DWORD);far pascal;
begin
  SendMessage(CommonData^.hWndMouse, idMsg, 1, 0);
  if (CommonData.BufferA='') then begin
        SendMessage(CommonData.CallBackHandle, idMsg, 0, 2);
  end;
  KillTimer(CommonData^.hWndFloat, 2);
end;

procedure WndCoverTimer(wnd : HWND; msg, idTimer : Cardinal; dwTime : DWORD);far pascal; //CallBack Type
var
  mouseWnd : HWnd;
  szClass : PChar;
  strClass : string;
  iLeft, iWidth : Integer;
  rect : TRect;
begin
  if (CommonData=nil) or (not CommonData^.bCapture) then begin
    exit;
  end;

  mouseWnd := WindowFromPoint(CommonData^.MousePos);
  if (mouseWnd=CommonData^.CallBackHandle) then begin
    exit;
  end;
  szClass := StrAlloc(256);
  GetClassName(mouseWnd, szClass, 255);
  strClass := Strpas(szClass);
  StrDispose(szClass);

  CommonData^.bInSpec := FALSE;

  if (Pos('Internet Explorer_Server', strClass)>0) then begin
    GetWindowRect(mouseWnd, rect);
    iLeft := rect.Left - 4;
    iWidth := rect.Right - rect.Left + 14;
    if (CommonData^.MousePos.x - iLeft > 200) then begin
      iLeft := CommonData^.MousePos.x - 200;
      iWidth := 210;
    end;
    CommonData^.bInSpec := TRUE;
  end
  else begin
    iLeft := CommonData^.MousePos.x - 1;
    iWidth := 1;
  end;
  // InstallGanFilter;
(*
  SetWindowPos(CommonData^.hWndFloat,
               HWND_TOPMOST,
               CommonData.MousePos.x, CommonData.MousePos.y, 10, 10,
               SWP_NOACTIVATE or SWP_SHOWWINDOW);
  ShowWindow(CommonData^.hWndFloat, SW_HIDE);
*)
  CommonData^.BufferA := '';
  SetWindowPos(CommonData^.hWndFloat,
               HWND_TOPMOST,
               iLeft{CommonData.MousePos.x-1}, CommonData.MousePos.y-1,
               iWidth, 2,
               88{SWP_NOACTIVATE or SWP_NOREDRAW});

  SendMessage(CommonData^.hWndMouse, idMsg, 0, 0);


MoveWindow(CommonData^.hWndFloat, -1, -1, 1, 1, TRUE);

  {
  SetWindowPos(CommonData^.hWndFloat,
               HWND_TOPMOST,
               CommonData.MousePos.x, CommonData.MousePos.y,
               120, 1,
               SWP_NOACTIVATE or SWP_SHOWWINDOW);
  ShowWindow(CommonData^.hWndFloat, SW_HIDE);
  }
  SetTimer(CommonData^.hWndFloat, 2, 300, @GanGetWordTimer);
end;

procedure InitCoverWindow(hInst : LongWord);
var
  WndClass : TWndClass; //Ex;
begin
  with WndClass do begin
    style              := WS_EX_TOPMOST;
    lpfnWndProc        := @CoverMainProc;  (*消息处理函数*)
    hInstance          := hInst;
    hbrBackground      := color_btnface + 1;
    lpszClassname      := 'GanFreeDict';
    hicon              := 0;
    hCursor            := 0;
    cbClsExtra         := 0;
    cbWndExtra         := 0;
  end;

  try
    if not BOOL(RegisterClass{Ex}(WndClass)) then begin
      MessageBox(0,
                 PChar(Format('$EEEE, Can not register class CHILD %d',[GetLastError])),
                 'Register Error',
                 MB_OK);
    end;
  except
    MessageBox(0, 'EXCEPTION', 'Register Class', MB_OK);
  end;

  hWndCover := CreateWindowEx(WS_EX_TOPMOST or WS_EX_TOOLWINDOW,
                              'GanFreeDict',
                              'gettxt',
                              WS_POPUP or WS_VISIBLE,
                              -1,-1,1,1,
                              0,
                              0,
                              hInst, // GetModuleHandle('dll.dll'), // 98 for this, 2000 for 0
                              nil);

  if CommonData<>nil then begin
    CommonData^.hWndFloat := hWndCover;
  end;
  SetTimer(hWndCover, 1, 450, @WndCoverTimer);

end;
(******************************************************************************)
function GanServerProc(
    hWnd:LongWord;
    Message:LongWord;
    wParam:WPARAM;
    lParam:LPARAM
    ):BOOL;stdcall;
begin
  if (Message=idMsg) then  begin
    if (wParam = 0) then begin
      InstallGanFilter;
    end
    else begin
      UnInstallGanFilter;
    end;
  end;
  case Message of
    WM_CLOSE :
            begin
               DestroyWindow(hWnd);
               // PostQuitMessage(0);
            end;
  end;
  result := BOOL(DefWindowProc(hWnd, Message, lParam, lParam));
end;