g-po.gml

开放源码的编译器open watcom 1.6.0版的源代码

.millust begin
#define NOCOVERRC
#include <windows.h>
.millust end
.do end
.beglevel
.*
.section Window Sub-classing
.*
.np
Sub-classing a Windows control in the 32-bit environment is
straightforward.
In fact, the code is identical to the code used in the 16-bit
environment.
A simple example is:
.if '&lang' eq 'FORTRAN 77' .do begin
.code begin
*$include winapi.fi
*$pragma aux (callback) SubClassProc parm( value, value, value, value )

      integer*4 function SubClassProc( hWnd, msg, wp, lp )
      integer*2 hWnd
      integer*2 msg
      integer*2 wp
      integer*4 lp
~b
.code break
      include 'windows.fi'

      common fpOldProc
      integer*4 fpOldProc

      ! code for sub-classing here

      SubClassProc = CallWindowProc( fpOldProc, hWnd, msg, wp, lp )

      end
~b
.code break
      program SubClassDemo
      integer*2 hControl
      common fpOldProc
      integer*4 fpOldProc
      integer*4 fp;

      include 'windows.fi'

      integer*4 SubClassProc
      external SubClassProc
      integer*4 ProgramInstance
      external ProgramInstance
~b
.code break
      ! assume hControl gets created in here

      fpOldProc = GetWindowLong( hControl, GWL_WNDPROC )
      fp = MakeProcInstance( SubClassProc, ProgramInstance )
      call SetWindowLong( hControl, GWL_WNDPROC, fp )

      ! set it back
      call SetWindowLong( hControl, GWL_WNDPROC, fpOldProc )
      call FreeProcInstance( fp )

      end
.code end
.do end
.if '&lang' eq 'C' or '&lang' eq 'C/C++' .do begin
.code begin
FARPROC fpOldProc;

long FAR PASCAL SubClassProc( HWND hWnd,
                              unsigned message,
                              WORD wParam,
                              LONG lParam )
{
    /*
     * code for sub-classing here
     */
    return( CallWindowProc( fpOldProc, hWnd, message,
                            wParam, lParam ) );
}
~b
.code break
void SubClassDemo( void )
{
    HWND                hControl;
    FARPROC             fp;
    extern HANDLE       ProgramInstance;

    /* assume hControl gets created in here */

    fpOldProc = (FARPROC) GetWindowLong( hControl, GWL_WNDPROC );
    fp = MakeProcInstance( SubClassProc, ProgramInstance );
    SetWindowLong( hControl, GWL_WNDPROC, (LONG) fp );

    /* set it back */
    SetWindowLong( hControl, GWL_WNDPROC, (LONG) fpOldProc );
    FreeProcInstance( fp );
}
.code end
.do end
.np
Note that
.kw SetWindowLong
is covered to recognize
.kw GWL_WNDPROC
and automatically
creates a 16-bit callback for the 32-bit callback.
When replacing the callback routine with the original 16-bit routine,
the covered version of
.kw SetWindowLong
recognizes that the function is not a 32-bit callback, and so passes
the pointer right through to Windows unchanged.
.endlevel
.endlevel
.*
.section Calling 16-bit DLLs
.*
.np
A 16-bit function in a DLL can be called using the
.kw _Call16
function.
The first argument to
.kw _Call16
is the address of the 16-bit function.
This address is usually obtained by calling
.kw GetProcAddress
with the name of the desired function.
The second argument to
.kw _Call16
is a string identifying the types of the parameters to be passed to
the 16-bit function.
.begnote $compact
:DTHD.Character
:DDHD.Parameter Type
.note c
call a 'cdecl' function as opposed to a 'pascal' function
(if specified, it must be listed first)
.note b
unsigned BYTE
.note w
16-bit WORD
.note d
32-bit DWORD
.note f
double precision floating-point
.note p
32-bit flat pointer (converted to 16:16 far pointer)
.endnote
.np
The 16-bit function must use either the
.kw PASCAL
or
.kw CDECL
calling convention.
.kw PASCAL
calling convention is the default.
If the function uses the
.kw CDECL
calling convention, then you must specify the letter "c" as the
first character of the argument type string.
.np
Pointer types will automatically be converted from 32-bit near
pointers to 16-bit far pointers before the function is invoked.
Note that this pointer is only valid over the period of the call;
after control returns to the 32-bit application, the 16-bit pointer
created by the Supervisor is no longer valid.
.np
The return value from
.kw _Call16
is a
.kw DWORD.
.np
.if '&lang' eq 'FORTRAN 77' .do begin
.code begin
*$include winapi.fi

      integer*2 function FWinMain( hInstance,
     &                             hPrevInstance,
     &                             lpszCmdLine,
     &                             nCmdShow )
      integer*2 hInstance
      integer*2 hPrevInstance
      integer*4 lpszCmdLine
      integer*2 nCmdShow

      include 'windows.fi'

      integer*2 hDrv, hWnd
      integer*4 lpfn, cb

      hDrv = LoadLibrary( 'your.dll'c )
      if( hDrv .lt. 32 )then
          return
      end if
.code break
      lpfn = GetProcAddress( hDrv, 'ExtDeviceMode'c )
      if( lpfn .eq. 0 )then
           return
      end if
.code break
      ! Invoke the function.
      cb = _Call16( lpfn, 'wwdppddw'c,
     &              hWnd, hDrv, NULL,
     &              'POSTSCRIPT PRINTER'c,
     &              'LPT1'c,
     &              NULL, NULL, 0 )
.code end
.do end
.if '&lang' eq 'C' or '&lang' eq 'C/C++' .do begin
.millust begin
#include <windows.h>
HANDLE hDrv;
FARPROC lpfn;
int cb;
.millust break
    if( (hDrv = LoadLibrary ("foo.dll")) < 32 )
        return FALSE;
    if( !(lpfn = GetProcAddress (hDrv, "ExtDeviceMode")) )
        return FALSE;
.millust break
    /*
     * now, invoke the function
     */
    cb = (WORD) _Call16(
           lpfn,                // address of function
           "wwdppddw",          // parameter type info
           hwnd,                // parameters ...
           hDrv,
           NULL,
           "POSTSCRIPT PRINTER",
           "LPT1",
           NULL,
           NULL,
           0
            );
.millust end
.do end
.if '&lang' eq 'C' or '&lang' eq 'C/C++' .do begin
.beglevel
.*
.section Making DLL Calls Transparent
.*
.np
This section gives an example of how to make your source code look
as if you are calling the 16-bit DLL directly.
.np
Assume there are 3 functions that you want to call in the 16-bit DLL,
with prototypes as follows:
.millust begin
HWND FAR PASCAL Initialize( WORD start_code );
BOOL FAR PASCAL DoStuff( HWND win_hld, HDC win_dc );
void FAR PASCAL Finish( void );
.millust end
.np
A fragment from the header file that you would include in your 32-bit
application would be as follows:
.millust begin
extern FARPROC InitializeAddr;
extern FARPROC DoStuffAddr;
extern FARPROC FinishAddr;
#define Initialize( start_code ) \
  _Call16( InitializeAddr, "w", (WORD)start_code )
#define DoStuff( win_hld, data ) \
  _Call16( DoStuffAddr, "wp", (HWND)win_hld, (LPVOID)data )
#define Finish( void )  _Call16( FinishAddr, "" )
.millust end
.np
The header file fragment gives external references for the
function addresses for each function, and sets up macros do a
.kw _Call16
for each of the functions.
.np
At start up, you would call the following function:
.millust begin
/*
 * LoadDLL - get DLL ready for 32-bit use
 */
BOOL LoadDLL( void )
{
    HANDLE  dll;

    dll = LoadLibrary( "chart.dll" );
    if( dll < 32 ) return( FALSE);
.millust break

    InitializeAddr = GetProcAddress( dll, "Initialize" );
    DoStuffAddr = GetProcAddress( dll, "DoStuff" );
    FinishAddr = GetProcAddress( dll, "Finish" );
    return( TRUE );
}
.millust end
.np
This function loads the 16-bit DLL and gets the addresses
for all of the entry points in the DLL.
By including the header file with all the macros in it, you can code
calls to the DLL functions as if you were calling the functions
directly.
For example:
.millust begin
#include <windows.h>
#include "fragment.h"
char *data = "the data";

void TestDLL( void )
{
    HWND res;
.millust break

    if( !LoadDLL() ) {
        MessageBox( NULL, "Could not load DLL",
                    "Error", MB_OK );
        return;
    }
.millust break

    res = Initialize( 1 );
    DoStuff( res, data );
    Finish();
}
.millust end
.endlevel
.*
.section Far Pointer Manipulation
.*
.np
The following C library functions are available for manipulating far
data.
These are useful when using pointers obtained by
.kw MK_FP32
and
.kw MK_LOCAL32.
.np
Memory manipulation:
.* .ix '_fmemccpy'
.* .ix '_fmemchr'
.* .ix '_fmemcmp'
.* .ix '_fmemcpy'
.* .ix '_fmemicmp'
.* .ix '_fmemmove'
.* .ix '_fmemset'
.* .ix 'far data' '_fmemccpy'
.* .ix 'far data' '_fmemchr'
.* .ix 'far data' '_fmemcmp'
.* .ix 'far data' '_fmemcpy'
.* .ix 'far data' '_fmemicmp'
.* .ix 'far data' '_fmemmove'
.* .ix 'far data' '_fmemset'
.begbull $compact
.bull
_fmemccpy
.bull
_fmemchr
.bull
_fmemcmp
.bull
_fmemcpy
.bull
_fmemicmp
.bull
_fmemmove
.bull
_fmemset
.endbull
.np
String manipulation:
.* .ix '_fstrcat'
.* .ix '_fstrchr'
.* .ix '_fstrcmp'
.* .ix '_fstrcpy'
.* .ix '_fstrcspn'
.* .ix '_fstricmp'
.* .ix '_fstrlen'
.* .ix '_fstrlwr'
.* .ix '_fstrncat'
.* .ix '_fstrncmp'
.* .ix '_fstrncpy'
.* .ix '_fstrnicmp'
.* .ix '_fstrnset'
.* .ix '_fstrpbrk'
.* .ix '_fstrrchr'
.* .ix '_fstrrev'
.* .ix '_fstrset'
.* .ix '_fstrspn'
.* .ix '_fstrtok'
.* .ix '_fstrupr'
.* .ix 'far data' '_fstrcat'
.* .ix 'far data' '_fstrchr'
.* .ix 'far data' '_fstrcmp'
.* .ix 'far data' '_fstrcpy'
.* .ix 'far data' '_fstrcspn'
.* .ix 'far data' '_fstricmp'
.* .ix 'far data' '_fstrlen'
.* .ix 'far data' '_fstrlwr'
.* .ix 'far data' '_fstrncat'
.* .ix 'far data' '_fstrncmp'
.* .ix 'far data' '_fstrncpy'
.* .ix 'far data' '_fstrnicmp'
.* .ix 'far data' '_fstrnset'
.* .ix 'far data' '_fstrpbrk'
.* .ix 'far data' '_fstrrchr'
.* .ix 'far data' '_fstrrev'
.* .ix 'far data' '_fstrset'
.* .ix 'far data' '_fstrspn'
.* .ix 'far data' '_fstrtok'
.* .ix 'far data' '_fstrupr'
.begbull $compact
.bull
_fstrcat
.bull
_fstrchr
.bull
_fstrcmp
.bull
_fstrcpy
.bull
_fstrcspn
.bull
_fstricmp
.bull
_fstrlen
.bull
_fstrlwr
.bull
_fstrncat
.bull
_fstrncmp
.bull
_fstrncpy
.bull
_fstrnicmp
.bull
_fstrnset
.bull
_fstrpbrk
.bull
_fstrrchr
.bull
_fstrrev
.bull
_fstrset
.bull
_fstrspn
.bull
_fstrtok
.bull
_fstrupr
.endbull
.do end
.*
.section _16 Functions
.*
.np
Every Windows API function that accepts a pointer has a corresponding
_16 function.
The _16 version of the function will not convert any of the pointers
that it accepts; it will assume that all pointers are 16-bit far
pointers already.
This applies to both data and function pointers.
.if '&lang' eq 'C' or '&lang' eq 'C/C++' .do begin
.np
Some sample code demonstrating the use for this is:
.millust begin
void ReadEditBuffer( char *fname, HWND hwndEdit )
{
    int       file;
    HANDLE    hText;
    char far *flpData;
    LPSTR     lpData;
    WORD      filelen;
.millust break
    /*
     * no error checking is performed; we just
     * assume everything works for this example.
     */
    file = _lopen( fname, 0);
    filelen = _llseek( file, 0L, 2 );

.millust break
    hText = (HANDLE) SendMessage( hwndEdit, EM_GETHANDLE,
                                  0, 0L );
    LocalReAlloc( hText, filelen+1, LHND );
    flpData = MK_LOCAL32( LocalLock( hText ) );
    lpData = (LPSTR) MK_FP16( flpB );
    _16_lread( file, lpData, filelen );
    _lclose( file );

}
.millust end
.np
This example reads the contents of a file into the buffer of an edit
window.
Because the edit window's memory is located in the local heap, which
is the Supervisor's heap, the
.kw MK_LOCAL32
function is needed to access the data.
The
.kw MK_FP16
macro compresses the 32-bit far pointer into a 16-bit far pointer,
which can then be used by the _16_lread function.
.do end