mmwing.pas

一套及时通讯的原码

{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Tel.: [phone]                   =}
{=  Loewenstr.7a                = [e-mail]                     =}
{========================================================================}
{=  Actual versions on http://www.swiftsoft.de/mmtools.html             =}
{========================================================================}
{=  This code is for reference purposes only and may not be copied or   =}
{=  distributed in any format electronic or otherwise except one copy   =}
{=  for backup purposes.                                                =}
{=                                                                      =}
{=  No Delphi Component Kit or Component individually or in a collection=}
{=  subclassed or otherwise from the code in this unit, or associated   =}
{=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
{=  without express permission from SwiftSoft.                          =}
{=                                                                      =}
{=  For more licence informations please refer to the associated        =}
{=  HelpFile.                                                           =}
{========================================================================}
{=  $Date: 20.01.1998 - 18:00:00 $                                      =}
{========================================================================}
{=  Aufgabe: WinG Import Unit                                           =}
{========================================================================}
{=  This code is for reference purposes only and may not be copied or   =}
{=  distributed in any format electronic or otherwise except one copy   =}
{=  for backup purposes.                                                =}
{=                                                                      =}
{=  No Delphi Component Kit or Component individually or in a collection=}
{=  subclassed or otherwise from the code in this unit, or associated   =}
{=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
{=  without express permission from SwiftSoft.                          =}
{=                                                                      =}
{=  For more licence informations please refer to the associated        =}
{=  HelpFile.                                                           =}
{========================================================================}
unit MMWinG;

{$I COMPILER.INC}

interface

uses
{$IFDEF WIN32}
    Windows,
{$ELSE}
    WinTypes,
    WinProcs,
{$ENDIF}
    SysUtils,
    Dialogs;

{ WinG Types }

type
   PPointer = ^pointer;
   PRGBQuad = ^TRGBQuad;
   WING_DITHER_TYPE = word;

const
   WINGDLLLoaded: Boolean = False;
   WinGDLLHandle: THandle = 0;

   WING_DISPERSED_4x4 = 0;
   WING_DISPERSED_8x8 = 1;
   WING_CLUSTERED_4x4 = 2;

var
   { WinG DC's & WinG Bitmaps }
   WinGCreateDC: function: HDC;{$IFDEF WIN32}stdcall;{$ENDIF}

   WinGCreateBitmap: function (hWinGDC: HDC;
                               pHeader: PBitmapInfo;
                               ppBits : PPointer ): HBitmap;{$IFDEF WIN32}stdcall;{$ENDIF}

   WinGGetDIBPointer: function (hWinGBitmap: HBitmap;
                                pHeader    : PBitmapInfo): pointer;{$IFDEF WIN32}stdcall;{$ENDIF}

   WinGRecommendDIBFormat: function (pHeader: PBitmapInfo): Bool;{$IFDEF WIN32}stdcall;{$ENDIF}

   WinGGetDIBColorTable: function (hWinGDC        : HDC;
                                   StartIndex     : Cardinal;
                                   NumberOfEntries: Cardinal;
                                   pColors        : PRGBQuad): Cardinal;{$IFDEF WIN32}stdcall;{$ENDIF}

   WinGSetDIBColorTable: function (hWinGDC        : HDC;
                                   StartIndex     : Cardinal;
                                   NumberOfEntries: Cardinal;
                                   pColors        : PRGBQuad): Cardinal;{$IFDEF WIN32}stdcall;{$ENDIF}
   { Blts }
   WinGBitBlt: function (hdcDest     : HDC;
                         nXOriginDest: integer;
                         nYOriginDest: integer;
                         nWidthDest  : integer;
                         nHeightDest : integer;
                         hdcSrc      : HDC;
                         nXOriginSrc : integer;
                         nYOriginSrc : integer): Bool;{$IFDEF WIN32}stdcall;{$ENDIF}

   WinGStretchBlt: function (hdcDest     : HDC;
                             nXOriginDest: integer;
                             nYOriginDest: integer;
                             nWidthDest  : integer;
                             nHeightDest : integer;
                             hdcSrc      : HDC;
                             nXOriginSrc : integer;
                             nYOriginSrc : integer;
                             nWidthSrc   : integer;
                             nHeightSrc  : integer): Bool;{$IFDEF WIN32}stdcall;{$ENDIF}

   { Halftoning }
   WinGCreateHalftoneBrush: function (DC        : HDC;
                                      Color     : TColorRef ;
                                      DitherType: WING_DITHER_TYPE ): HBrush;{$IFDEF WIN32}stdcall;{$ENDIF}

   WinGCreateHalftonePalette: function: HPalette;{$IFDEF WIN32}stdcall;{$ENDIF}

implementation

{$IFNDEF WIN32}
const
    MAX_PATH  = 260;
{$ENDIF}

var
   ErrorMode: Cardinal;
   aBuf     : PChar;

procedure NewExitProc; Far;
begin
   if WinGDLLHandle >= HINSTANCE_ERROR then FreeLibrary(WinGDLLHandle);
end;

Initialization
     aBuf := Nil;
     ErrorMode := SetErrorMode(SEM_NoOpenFileErrorBox);
     try
        aBuf := StrAlloc(MAX_PATH);
        if GetSystemDirectory(aBuf, MAX_PATH) <> 0 then
        begin
           {$IFDEF WIN32}
           aBuf := StrCat(aBuf, '\WING32.DLL');
           {$ELSE}
           aBuf := StrCat(aBuf, '\WING.DLL');
           {$ENDIF}

           WinGDLLHandle := LoadLibrary(aBuf);

           if abs(WinGDLLHandle) >= HINSTANCE_ERROR then
           begin
              WinGDLLLoaded := True;
              {$IFNDEF WIN32}
              AddExitProc(NewExitProc);
              {$ENDIF}
              @WinGCreateDC := GetProcAddress(WinGDLLHandle,'WinGCreateDC');
              @WinGCreateBitmap := GetProcAddress(WinGDLLHandle,'WinGCreateBitmap');
              @WinGGetDIBPointer := GetProcAddress(WinGDLLHandle,'WinGGetDIBPointer');
              @WinGRecommendDIBFormat := GetProcAddress(WinGDLLHandle,'WinGRecommendDIBFormat');
              @WinGGetDIBColorTable := GetProcAddress(WinGDLLHandle,'WinGGetDIBColorTable');
              @WinGSetDIBColorTable := GetProcAddress(WinGDLLHandle,'WinGSetDIBColorTable');
              @WinGBitBlt := GetProcAddress(WinGDLLHandle,'WinGBitBlt');
              @WinGStretchBlt := GetProcAddress(WinGDLLHandle,'WinGStretchBlt');
              @WinGCreateHalftoneBrush := GetProcAddress(WinGDLLHandle,'WinGCreateHalftoneBrush');
              @WinGCreateHalftonePalette := GetProcAddress(WinGDLLHandle,'WinGCreateHalftonePalette');
           end;
        end;

     finally
        SetErrorMode(ErrorMode);
        StrDispose(aBuf);
     end;

{$IFDEF WIN32}
Finalization
     NewExitProc;
{$ENDIF}
end.