Tips (1541)

Tip Rating (7):

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;