rotatebm.pas

delphi中能够旋转显示其内的图像的Image控件

          ToAddr.Hi := SecondBits.Hi + te.Hi * Ofs(AHIncr);
          ToAddr.Lo := te.Lo;
          w := ByteForPixel - w;
          move(FromAddr.Ptr^, ToAddr.Ptr^, w);
         end
        else
         begin
          FromAddr.Hi := Bits.Hi + Start.Hi * Ofs(AHIncr);
          FromAddr.Lo := Start.Lo;
          ToAddr.Hi := SecondBits.Hi+Endp.Hi * Ofs(AHIncr);
          ToAddr.Lo := Endp.Lo;
          move(FromAddr.Ptr^, ToAddr.Ptr^, ByteForPixel);
         end;
        Start.Long := Start.Long + ByteForPixel;
        Endp.Long := Endp.Long - ByteForPixel;
       end;
     end;
    SetBitmapBits(Picture.Bitmap.Handle, Alloc, SecondBits.Ptr);
    GlobalUnlock(SecondHand);
    GlobalUnlock(Hand);
    GlobalFree(SecondHand);
    GlobalFree(Hand);
    Repaint;
    Result := True;
   end
  else Result := False;
end;

function TRotateImage.Rotate180: Boolean;
var
  i, l, Alloc: LongInt;
  ts,te,Start, Endp, FromAddr, ToAddr, Bits, SecondBits: LongType;
  {$IFDEF WIN32}
  Info: Windows.TBitmap;
  {$ELSE}
  Info: WinTypes.TBitmap;
  {$ENDIF}
  Hand, SecondHand:THandle;
  ByteForPixel: Byte;
  b: Byte;
  w: Word;
begin
  if not Picture.Bitmap.Empty then
   begin
    {$IFDEF WIN32}
    GetObject(Picture.Bitmap.Handle, SizeOf(Windows.TBitmap), @Info);
    {$ELSE}
    GetObject(Picture.Bitmap.Handle, SizeOf(WinTypes.TBitmap), @Info);
    {$ENDIF}
    with Info do
     begin
      Alloc := bmPlanes * bmHeight;
      Alloc := Alloc * bmWidthBytes;
     end;
    Hand := GlobalAlloc(gmem_Moveable or gmem_ZeroInit, Alloc);
    SecondHand := GlobalAlloc(gmem_Moveable or gmem_ZeroInit, Alloc);
    Bits.Ptr := GlobalLock(Hand);
    SecondBits.Ptr := GlobalLock(SecondHand);
    GetBitmapBits(Picture.Bitmap.Handle, Alloc, Bits.Ptr);
    ByteForPixel := Info.bmWidthBytes div Info.bmWidth;
    Start.Long := 0;
    if Odd(Info.bmWidth) and Odd(ByteForPixel) then b := ByteForPixel else b := 0;
    Endp.Long := Alloc - ByteForPixel - b;
    l := (Alloc - (b + ByteForPixel)) div ByteForPixel;
    if (ByteForPixel > 2) and Odd(ByteForPixel) and
       Odd(Info.bmWidth) then
     begin
      inc(Endp.Long, b - 1);
      l:=l - Info.bmHeight div ByteForPixel + 1;
     end;
    for i := 0 to l do
     begin
      if (ByteForPixel > 2) and Odd(ByteForPixel) and
         ((Endp.Lo + ByteForPixel < Endp.Lo) or (Start.Lo + ByteForPixel < Start.Lo)) then
       begin
        if Endp.Lo + ByteForPixel < Endp.Lo then w := 0 - Endp.Lo
        else w := 0 - Start.Lo;
        ts.Long := Start.Long;
        te.Long := Endp.Long;
        FromAddr.Hi := Bits.Hi + ts.Hi * Ofs(AHIncr);
        FromAddr.Lo := ts.Lo;
        ToAddr.Hi := SecondBits.Hi + te.Hi * Ofs(AHIncr);
        ToAddr.Lo := te.Lo;
        move(FromAddr.Ptr^, ToAddr.Ptr^, w);
        ts.Long := Start.Long + w;
        te.Long := Endp.Long + w;
        FromAddr.Hi := Bits.Hi + ts.Hi * Ofs(AHIncr);
        FromAddr.Lo := ts.Lo;
        ToAddr.Hi := SecondBits.Hi + te.Hi * Ofs(AHIncr);
        ToAddr.Lo := te.Lo;
        w := ByteForPixel - w;
        move(FromAddr.Ptr^, ToAddr.Ptr^, w);
       end
      else
       begin
        FromAddr.Hi := Bits.Hi + Start.Hi * Ofs(AHIncr);
        FromAddr.Lo := Start.Lo;
        ToAddr.Hi := SecondBits.Hi+Endp.Hi * Ofs(AHIncr);
        ToAddr.Lo := Endp.Lo;
        move(FromAddr.Ptr^, ToAddr.Ptr^, ByteForPixel);
       end;
      if (ByteForPixel > 2) and Odd(ByteForPixel) and
         ((i + 1) mod Info.bmWidth = 0) and
         Odd(Info.bmWidth) then
       begin
        Start.Long := Start.Long + (ByteForPixel + 1);
        Endp.Long := Endp.Long - (ByteForPixel + 1);
       end
      else
       begin
        Start.Long := Start.Long + ByteForPixel;
        Endp.Long := Endp.Long - ByteForPixel;
       end;
     end;
    SetBitmapBits(Picture.Bitmap.Handle, Alloc, SecondBits.Ptr);
    GlobalUnlock(SecondHand);
    GlobalUnlock(Hand);
    GlobalFree(SecondHand);
    GlobalFree(Hand);
    Repaint;
    Result := True;
   end
  else Result := False;
end;

function TRotateImage.Rotate90: Boolean;
var
  Alloc, l: LongInt;
  ts, te, Start, Endp, FromAddr, ToAddr, Bits, SecondBits: LongType;
  {$IFDEF WIN32}
  Info: Windows.TBitmap;
  {$ELSE}
  Info: WinTypes.TBitmap;
  {$ENDIF}
  Hand, SecondHand: THandle;
  ByteForPixel: Byte;
  i, j: Integer;
  w: Word;
begin
  if not Picture.Bitmap.Empty then
   begin
    {$IFDEF WIN32}
    GetObject(Picture.Bitmap.Handle, SizeOf(Windows.TBitmap), @Info);
    {$ELSE}
    GetObject(Picture.Bitmap.Handle, SizeOf(WinTypes.TBitmap), @Info);
    {$ENDIF}
    with Info do
     begin
      Alloc := bmPlanes * bmHeight;
      if Odd(bmHeight) then inc(Alloc, bmPlanes);
      Alloc := Alloc * bmWidthBytes;
     end;
    Hand := GlobalAlloc(gmem_Moveable or gmem_ZeroInit, Alloc);
    Bits.Ptr := GlobalLock(Hand);
    GetBitmapBits(Picture.Bitmap.Handle, Alloc, Bits.Ptr);
    i := Picture.Bitmap.Width;
    j := Picture.Bitmap.Height;
    Picture.Bitmap.Width := j;
    Picture.Bitmap.Height := i;
    Width := j;
    Height := i;
    SecondHand := GlobalAlloc(gmem_Moveable or gmem_ZeroInit, Alloc);
    SecondBits.Ptr := GlobalLock(SecondHand);
    ByteForPixel := Info.bmWidthBytes div Info.bmWidth;
    for i := 0 to Info.bmHeight - 1 do
     begin
      l := i;
      Start.Long := l * Info.bmWidthBytes;
      Endp.Long := (Info.bmHeight - i) * ByteForPixel - ByteForPixel;
      for j := 0 to Info.bmWidth - 1 do
       begin
        if (ByteForPixel > 2) and Odd(ByteForPixel) and
           ((Endp.Lo + ByteForPixel < Endp.Lo) or (Start.Lo + ByteForPixel < Start.Lo)) then
         begin
          if Endp.Lo + ByteForPixel < Endp.Lo then w := 0 - Endp.Lo
          else w := 0 - Start.Lo;
          ts.Long := Start.Long;
          te.Long := Endp.Long;
          FromAddr.Hi := Bits.Hi + ts.Hi * Ofs(AHIncr);
          FromAddr.Lo := ts.Lo;
          ToAddr.Hi := SecondBits.Hi + te.Hi * Ofs(AHIncr);
          ToAddr.Lo := te.Lo;
          move(FromAddr.Ptr^, ToAddr.Ptr^, w);
          ts.Long := Start.Long + w;
          te.Long := Endp.Long + w;
          FromAddr.Hi := Bits.Hi + ts.Hi * Ofs(AHIncr);
          FromAddr.Lo := ts.Lo;
          ToAddr.Hi := SecondBits.Hi + te.Hi * Ofs(AHIncr);
          ToAddr.Lo := te.Lo;
          w := ByteForPixel - w;
          move(FromAddr.Ptr^, ToAddr.Ptr^, w);
         end
        else
         begin
          FromAddr.Hi := Bits.Hi + Start.Hi * Ofs(AHIncr);
          FromAddr.Lo := Start.Lo;
          ToAddr.Hi := SecondBits.Hi + Endp.Hi * Ofs(AHIncr);
          ToAddr.Lo := Endp.Lo;
          move(FromAddr.Ptr^, ToAddr.Ptr^, ByteForPixel);
         end;
        Start.Long := Start.Long + ByteForPixel;
        l:=Info.bmHeight * ByteForPixel;
        if Odd(l) then inc(l);
        Endp.Long := Endp.Long + l;
       end;
     end;
    SetBitmapBits(Picture.Bitmap.Handle, Alloc, SecondBits.Ptr);
    GlobalUnlock(SecondHand);
    GlobalUnlock(Hand);
    GlobalFree(SecondHand);
    GlobalFree(Hand);
    Repaint;
    Result := True;
   end
  else Result := False;
end;

procedure Register;
begin
  RegisterComponents('UtilMind', [TRotateImage]);
end;

end.