Повернуть DIB-изображение

function
 RotateBitmap(var
 hDIB: HGlobal; radang: Double; clrBack: TColor): Boolean;
 // (c) Copyright original C Code: Code Guru 
var

   lpDIBBits: Pointer;
   lpbi, hDIBResult: PBitmapInfoHeader;
   bpp, nColors, nWidth, nHeight, nRowBytes: Integer;
   cosine, sine: Double;
   x1, y1, x2, y2, x3, y3, minx, miny, maxx, maxy, ti, x, y, w, h: Integer;
   nResultRowBytes, nHeaderSize: Integer;
   i, len: longint;
   lpDIBBitsResult: Pointer;
   dwBackColor: DWORD;
   PtrClr: PRGBQuad;
   RbackClr, GBackClr, BBackClr: Word;
   sourcex, sourcey: Integer;
   mask: Byte;
   PtrByte: PByte;
   dwpixel: DWORD;
   PtrDWord: PDWord;
   hDIBResInfo: HGlobal;
 begin
;
   // Get source bitmap info 
  lpbi := PBitmapInfoHeader(GlobalLock(hdIB));
   nHeaderSize := lpbi^.biSize + lpbi^.biClrUsed * SizeOf(TRGBQUAD);
   lpDIBBits := Pointer(Longint(lpbi) + nHeaderSize);
   bpp := lpbi^.biBitCount; // Bits per pixel 
  ncolors := lpbi^.biClrUsed; // Already computed when bitmap was loaded 
  nWidth := lpbi^.biWidth;
   nHeight := lpbi^.biHeight;
   nRowBytes := ((((nWidth * bpp) + 31) and
 (not
 31)) shr
 3);

   // Compute the cosine and sine only once 
  cosine := cos(radang);
   sine := sin(radang);

   // Compute dimensions of the resulting bitmap 
  // First get the coordinates of the 3 corners other than origin 
  x1 := ceil(-nHeight * sine); // Originally floor at all places 
  y1 := ceil(nHeight * cosine);
   x2 := ceil(nWidth * cosine - nHeight * sine);
   y2 := ceil(nHeight * cosine + nWidth * sine);
   x3 := ceil(nWidth * cosine);
   y3 := ceil(nWidth * sine);

   minx := min(0, min(x1, min(x2, x3)));
   miny := min(0, min(y1, min(y2, y3)));
   maxx := max(0, max(x1, max(x2, x3)));// added max(0, 
  maxy := max(0, max(y1, max(y2, y3)));// added max(0, 

  w := maxx - minx;
   h := maxy - miny;

   // Create a DIB to hold the result 
  nResultRowBytes := ((((w * bpp) + 31) and
 (not
 31)) div
 8);
   len := nResultRowBytes * h;
   hDIBResInfo := GlobalAlloc(GMEM_MOVEABLE, len + nHeaderSize);
   if
 hDIBResInfo = 0 then

   begin

     Result := False;
     Exit;
   end
;

   hDIBResult := PBitmapInfoHeader(GlobalLock(hDIBResInfo));
   // Initialize the header information 
  CopyMemory(hDIBResult, lpbi, nHeaderSize);
   //BITMAPINFO &bmInfoResult = *(LPBITMAPINFO)hDIBResult ; 
  hDIBResult^.biWidth := w;
   hDIBResult^.biHeight := h;
   hDIBResult^.biSizeImage := len;
   lpDIBBitsResult := Pointer(Longint(hDIBResult) + nHeaderSize);

   // Get the back color value (index) 
  ZeroMemory(lpDIBBitsResult, len);
   case
 bpp of

     1:
       begin
 //Monochrome 
        if
 (clrBack = RGB(255, 255, 255)) then

           FillMemory(lpDIBBitsResult, len, $ff);
       end
;
     4,
     8:
       begin
 //Search the color table 
        PtrClr := PRGBQuad(Longint(lpbi) + lpbi^.bisize);
         RBackClr := GetRValue(clrBack);
         GBackClr := GetGValue(clrBack);
         BBackClr := GetBValue(clrBack);
         for
 i := 0 to
 nColors - 1 do
 // Color table starts with index 0 
        begin

           if
 (PtrClr^.rgbBlue = BBackClr) and

             (PtrClr^.rgbGreen = GBackClr) and

             (PtrClr^.rgbRed = RBackClr) then

           begin

             if
 (bpp = 4) then
 //if(bpp==4) i = i | i<<4; 
              ti := i or
 (i shl
 4)
             else

               ti := i;
             FillMemory(lpDIBBitsResult, ti, len);
             break;
           end
;
           Inc(PtrClr);
         end
;// If not match found the color remains black 
      end
;
     16:
       begin

         (* When the Compression field is
 set
 to
 BI_BITFIELDS,
         Windows 95 supports
         only the following 16bpp color masks: A 5-5-5 16-bit image, where the blue mask
         is
 $001F, the green mask is
 $03E0, and
 the red mask is
 $7C00; and
 a 5-6-5
         16-bit image, where the blue mask is
 $001F, the green mask is
 $07E0,
         and
 the red mask is
 $F800. *)
         PtrClr := PRGBQuad(Longint(lpbi) + lpbi^.bisize);
         if
 (PtrClr^.rgbRed = $7c00) then
 // Check the Red mask 
        begin
 // Bitmap is RGB555 
          dwBackColor := ((GetRValue(clrBack) shr
 3) shl
 10) +
             ((GetRValue(clrBack) shr
 3) shl
 5) +
             (GetBValue(clrBack) shr
 3);
         end

         else

         begin
 // Bitmap is RGB565 
          dwBackColor := ((GetRValue(clrBack) shr
 3) shl
 11) +
             ((GetRValue(clrBack) shr
 2) shl
 5) +
             (GetBValue(clrBack) shr
 3);
         end
;
       end
;
     24,
     32:
       begin

         dwBackColor := ((GetRValue(clrBack)) shl
 16) or

           ((GetGValue(clrBack)) shl
 8) or

           ((GetBValue(clrBack)));
       end
;
   end
;

   // Now do the actual rotating - a pixel at a time 
  // Computing the destination point for each source point 
  // will leave a few pixels that do not get covered 
  // So we use a reverse transform - e.i. compute the source point 
  // for each destination point 

  for
 y := 0 to
 h - 1 do

   begin

     for
 x := 0 to
 w - 1 do

     begin

       sourcex := floor((x + minx) * cosine + (y + miny) * sine);
       sourcey := floor((y + miny) * cosine - (x + minx) * sine);
       if
 ((sourcex >= 0) and
 (sourcex < nWidth) and

         (sourcey >= 0) and
 (sourcey < nHeight)) then

       begin
 // Set the destination pixel 
        case
 bpp of

           1:
             begin
 //Monochrome 
              mask := PByte(Longint(lpDIBBits) +
                 nRowBytes * sourcey +
                 (sourcex div
 8))^ and
 ($80 shr

                 (sourcex mod
 8));
               if
 mask <> 0 then

                 mask := $80 shr
 (x mod
 8);
               PtrByte  := PByte(Longint(lpDIBBitsResult) +
                 nResultRowBytes * y + (x div

                 8));
               PtrByte^ := PtrByte^ and
 (not
 ($80 shr
 (x mod

                 8)));
               PtrByte^ := PtrByte^ or
 mask;
             end
;
           4:
             begin

               if
 ((sourcex and
 1) <> 0) then

                 mask := $0f
               else

                 mask := $f0;
               mask := PByte(Longint(lpDIBBits) +
                 nRowBytes * sourcey +
                 (sourcex div
 2))^ and
 mask;
               if
 ((sourcex and
 1) <> (x and
 1)) then

               begin

                 if
 (mask and
 $f0) <> 0 then

                   mask := (mask shr
 4)
                 else

                   mask := (mask shl
 4);
               end
;
               PtrByte := PByte(Longint(lpDIBBitsResult) +
                 nResultRowBytes * y + (x div

                 2));
               if
 ((x and
 1) <> 0) then

                 PtrByte^ := PtrByte^ and
 (not
 $0f)
               else

                 PtrByte^ := PtrByte^ and
 (not
 $f0);
               PtrByte^ := PtrByte^ or
 Mask;
             end
;
           8:
             begin

               mask := PByte(Longint(lpDIBBits) +
                 nRowBytes * sourcey +
                 sourcex)^;
               PtrByte  := PByte(Longint(lpDIBBitsResult) +
                 nResultRowBytes * y + x);
               PtrByte^ := mask;
             end
;
           16:
             begin

               dwPixel := PDWord(Longint(lpDIBBits) +
                 nRowBytes * sourcey +
                 sourcex * 2)^;
               PtrDword  := PDWord(Longint(lpDIBBitsResult) +
                 nResultRowBytes * y + x * 2);
               PtrDword^ := Word(dwpixel);
             end
;
           24:
             begin

               dwPixel := PDWord(Longint(lpDIBBits) +
                 nRowBytes * sourcey +
                 sourcex * 3)^ and
 $ffffff;
               PtrDword  := PDWord(Longint(lpDIBBitsResult) +
                 nResultRowBytes * y + x * 3);
               PtrDword^ := PtrDword^ or
 dwPixel;
             end
;
           32:
             begin

               dwPixel := PDWord(Longint(lpDIBBits) +
                 nRowBytes * sourcey +
                 sourcex * 4)^;
               PtrDword := PDWord(Longint(lpDIBBitsResult) +
                 nResultRowBytes * y + x * 4);
               PtrDword^ := dwpixel;
             end
;
         end
; // Case 
      end

       else

       begin

         // Draw the background color. The background color 
        // has already been drawn for 8 bits per pixel and less 
        case
 bpp of

           16:
             begin

               PtrDWord := PDWord(Longint(lpDIBBitsResult) +
                 nResultRowBytes * y + x * 2);
               PtrDword^ := Word(dwBackColor);
             end
;
           24:
             begin

               PtrDWord := PDWord(Longint(lpDIBBitsResult) +
                 nResultRowBytes * y + x * 3);
               PtrDword^ := PtrDword^ or
 dwBackColor;
             end
;
           32:
             begin

               PtrDWord := PDWord(Longint(lpDIBBitsResult) +
                 nResultRowBytes * y + x * 4);
               PtrDword^ := dwBackColor;
             end
;
         end
;
       end
;
     end
;
   end
;
   GlobalUnLock(hDIBResInfo);
   GlobalUnLock(hDIB);
   GlobalFree(hDIB);
   hDIB := hDIBResInfo;
   Result := True;
 end
;

Другое по теме:

• Как из Делфи рисовать в любой части экрана или в чужом окне
• Зеркальное отображение
• Как создать список файлов с их изображением