gfdict.dpr

如何用delphi在windows 2000 windows xp下实现获取屏幕的汉字

    result := ExtTextOutA(DC, X, Y, Options, Rect, Str, Count, Dx);
    InstallThunkFunc(tfExtTextOutA);
    //  UnInstallGanFilter;

    //  LeaveCriticalSection(g_CriticalSection);
end;

function GanExtTextOutW(DC: HDC; X, Y: Integer; Options: Longint;
 Rect: PRect; Str: PWideChar; Count: Longint; Dx: PInteger): BOOL; stdcall;
var
    posDcOrg : TPoint;
    posDc : TPoint;
    RectText : TRect;
    size : TSize;
    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
            StrCopy(CommonData.BufferA,PChar(WideCharToString(Str)));
            CommonData^.Rect := RectText;
        except
            GanWarning;
            StrCopy(CommonData.BufferA, 'ERROR in ExtTextOutW');
        end;
        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
            StrCopy(CommonData.BufferA,PChar(WideCharToString(Str)));
            CommonData^.Rect := RectText;
        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;
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
                StrCopy(CommonData.BufferA,PChar(WideCharToString(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',
                               '^_^',
                               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;


procedure InitServerWnd;
var