home *** CD-ROM | disk | FTP | other *** search
/ Chip: Shareware for Win 95 / Chip-Shareware-Win95.bin / ostatni / delphi / delphi2 / wowsrc.exe / MOVEPIC.PAS < prev    next >
Pascal/Delphi Source File  |  1996-01-13  |  5KB  |  202 lines
  1. unit MovePic;
  2.  
  3. interface
  4. Uses
  5.   WinTypes, WinProcs, Graphics, Classes, IniFiles, StdCtrls;
  6.  
  7. const
  8.    NULL = 0;
  9. var
  10.    mHBMImage:       HBITMAP;
  11.    mHBMMask:        HBITMAP;
  12.    mHBMSave:        HBITMAP;
  13.    mX, mY:          Integer;
  14.    mWidth, mHeight: Integer;
  15.    HMemDC:  HDC;
  16.    HMemDCHold: HDC;
  17.  
  18. Function Initialize (HBMMask: HBITMAP; HBMImage: HBITMAP): Boolean;
  19. Function MoveTo (HDc: HDC; X: Integer; Y: Integer): Boolean;
  20.  
  21. implementation
  22.  
  23. Function Initialize (HBMMask: HBITMAP; HBMImage: HBITMAP): Boolean;
  24. { assigns the bitmaps containing the sprite image and
  25.   prepares the sprite object for a new animation sequence; may
  26.   be called more than once for a given object}
  27. var
  28.    HDCScreen:  HDC;
  29.    HBMSave: HBITMAP;
  30.    ImageBM: TBitmap;
  31.    MaskBM: TBitmap;
  32.    GetResult: Integer;
  33. Begin
  34.    {get and compare the sizes of the mask and image bitmaps: }
  35.    
  36.    GetResult := GetObject (HBMMask, sizeof (TBitmap), MaskBM);
  37.    if (GetResult = 0) then
  38.       Result := FALSE;
  39.  
  40.    GetResult := GetObject (HBMImage, sizeof (TBitmap), ImageBM);
  41.    if (GetResult = 0) then
  42.       Result := FALSE;
  43.  
  44.    { return an error code if sizes are unequal: }
  45.    if (MaskBM.Width <> ImageBM.Width) or
  46.       (MaskBM.Height <> ImageBM.Height) then
  47.       Result := FALSE;
  48.    
  49.    { create the "save" bitmap for saving and restoring screen
  50.      graphics: }
  51.    HDCScreen := GetDC (NULL);
  52.    HBMSave := CreateCompatibleBitmap
  53.       (HDCScreen,
  54.       MaskBM.Width,    { same size as mask and image bitmaps }
  55.       MaskBM.Height);
  56.    ReleaseDC (NULL, HDCScreen);
  57.    if (HBMSave = NULL) then
  58.       Result := FALSE;
  59.       
  60.    { delete prior "save" bitmap, if any: }
  61.    if (mHBMSave <> 0) then
  62.       DeleteObject (mHBMSave);
  63.                                          
  64.    { function is successful; now assign values to data members: }
  65.    mHBMSave := HBMSave;
  66.    mHBMMask := HBMMask;
  67.    mHBMImage := HBMImage;
  68.    mWidth := MaskBM.Width;
  69.    mHeight := MaskBM.Height;
  70.    mX := 0;
  71.    mY := 0;
  72.  
  73.    Result := FALSE;
  74. End;
  75.  
  76. Function MoveTo (HDc: HDC; X: Integer; Y: Integer): Boolean;
  77. { moves the sprite to a new position }
  78. Var
  79.    HBMHold: HBITMAP;
  80.    RectNew: TRect;
  81.    RectOld: TRect;
  82.    RectUnion: TRect;
  83.  
  84. Begin
  85.    { (1) create temporary hold bitmap: }
  86.  
  87.    { calculate coordinates of entire affected screen area: }
  88.    RectOld := Rect(mX, mY, mX + mWidth, mY + mHeight);
  89.    RectNew := Rect(X, Y, X + mWidth, Y + mHeight);
  90.  
  91.    UnionRect(RectUnion, RectOld, RectNew);
  92.    RectUnion.left := RectUnion.left - RectUnion.left MOD 8;
  93.  
  94.    HBMHold := CreateCompatibleBitmap
  95.       (HDc,
  96.       RectUnion.right - RectUnion.left,
  97.       RectUnion.bottom - RectUnion.top);
  98.    if (HBMHold <> 0) then
  99.       Result := FALSE;
  100.  
  101.    { (2) copy affected area of screen into hold bitmap: }
  102.    
  103.    HMemDCHold := CreateCompatibleDC (HDc);
  104.    SelectObject (HMemDCHold, HBMHold);
  105.  
  106.    BitBlt
  107.       (HMemDCHold,
  108.       0,
  109.       0,
  110.       RectUnion.right - RectUnion.left,
  111.       RectUnion.bottom - RectUnion.top,
  112.       HDc,
  113.       RectUnion.left,
  114.       RectUnion.top,
  115.       SRCCOPY);
  116.  
  117.    { (3) erase sprite in hold bitmap: }
  118.  
  119.    HMemDC := CreateCompatibleDC (HDc);
  120.    SelectObject (HMemDC, mHBMSave);
  121.    
  122.    BitBlt
  123.       (HMemDCHold,
  124.       mX - RectUnion.left,
  125.       mY - RectUnion.top,
  126.       mWidth,
  127.       mHeight,
  128.       HMemDC,
  129.       0,
  130.       0,
  131.       SRCCOPY);
  132.  
  133.    { (4) save screen graphics at new sprite position: }
  134.    
  135.    BitBlt
  136.       (HMemDC,
  137.       0,
  138.       0,
  139.       mWidth,
  140.       mHeight,
  141.       HMemDCHold,
  142.       X - RectUnion.left,
  143.       Y - RectUnion.top,
  144.       SRCCOPY);
  145.  
  146.    { (5) transfer mask bitmap: }
  147.  
  148.    SelectObject (HMemDC, mHBMMask);
  149.    BitBlt
  150.       (HMemDCHold,
  151.       X - RectUnion.left,
  152.       Y - RectUnion.top,
  153.       mWidth,
  154.       mHeight,
  155.       HMemDC,
  156.       0,
  157.       0,
  158.       SRCAND);
  159.  
  160.    { (6) transfer image bitmap: }
  161.  
  162.    SelectObject (HMemDC, mHBMImage);
  163.    BitBlt
  164.       (HMemDCHold,
  165.       X - RectUnion.left,
  166.       Y - RectUnion.top,
  167.       mWidth,
  168.       mHeight,
  169.       HMemDC,
  170.       0,
  171.       0,
  172.       SRCINVERT);
  173.  
  174.    { (7) copy hold bitmap back to screen: }
  175.  
  176.    BitBlt
  177.       (HDc,
  178.       RectUnion.left,
  179.       RectUnion.top,
  180.       RectUnion.right - RectUnion.left,
  181.       RectUnion.bottom - RectUnion.top,
  182.       HMemDCHold,
  183.       0,
  184.       0,
  185.       SRCCOPY);
  186.  
  187.    { delete the memory device contexts: }
  188.    DeleteDC (HMemDCHold);
  189.    DeleteDC (HMemDC);
  190.  
  191.    { (8) delete hold bitmap: }
  192.    DeleteObject (HBMHold);
  193.  
  194.    { (9) save coordinates of new sprite position: }
  195.    mX := X;
  196.    mY := Y;
  197.  
  198.    Result := TRUE;
  199. End;
  200.  
  201. end.
  202.