rotatebm.pas

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

{*************************************************************}
{            Rotate Image Component for Delphi 16             }
{ Version:   1.00                                             }
{ Author:    Aleksey Kuznetsov                                }
{ E-Mail:    [e-mail]                                }
{ Home Page: http://www.utilmind.com                          }
{ Created:   March, 4, 1998                                   }
{ Modified:  March, 6, 1998                                   }
{ Legal:     Copyright (c) 1998, UtilMind Solutions           }
{*************************************************************}
{  TROTATEIMAGE:                                              }
{ Extended TImage with flip and rotate functions.             }
{*************************************************************}
{ Extended METHODS:                                           }
{                                                             }
{       FlipVertical: Flip image vertical.                    }
{     FlipHorizontal: Flip image horizontal.                  }
{          Rotate180: Rotates image on 180 degrees            }
{           Rotate90: Rotates image on 90 degrees             }
{                                                             }
{ All of this methods will return False if no Bitmap present. }
{*************************************************************}
{ Also see demonstration program.                             }
{*************************************************************}
{                     IMPORTANT NOTE:                         }
{ This software is provided 'as-is', without any express or   }
{ implied warranty. In no event will the author be held       }
{ liable for any damages arising from the use of this         }
{ software.                                                   }
{ Permission is granted to anyone to use this software for    }
{ any purpose, including commercial applications, and to      }
{ alter it and redistribute it freely, subject to the         }
{ following restrictions:                                     }
{ 1. The origin of this software must not be misrepresented,  }
{    you must not claim that you wrote the original software. }
{    If you use this software in a product, an acknowledgment }
{    in the product documentation would be appreciated but is }
{    not required.                                            }
{ 2. Altered source versions must be plainly marked as such,  }
{    and must not be misrepresented as being the original     }
{    software.                                                }
{ 3. This notice may not be removed or altered from any       }
{    source distribution.                                     }
{*************************************************************}
{ If at occurrence of any questions concerning these          }
{ component, please visit our website: www.utilmind.com       }
{*************************************************************}
unit RotateBM;

interface

uses
  {$IFDEF WIN32} Windows, {$ELSE} WinTypes, WinProcs, {$ENDIF}
  Classes, ExtCtrls, Graphics;

type
  TRotateImage = class(TImage)
  private
  protected
  public
    function FlipVertical: Boolean;
    function FlipHorizontal: Boolean;
    function Rotate180: Boolean;
    function Rotate90: Boolean;
  published
  end;

procedure Register;

implementation

type
  LongType = record
    case Word of
      0: (Ptr: Pointer);
      1: (Long: LongInt);
      2: (Lo: Word;
	  Hi: Word);
  end;

procedure AHIncr; far; external 'KERNEL' index 114;

function TRotateImage.FlipVertical: Boolean;
var
  Alloc: LongInt;
  ts, te, Start, Endp, FromAddr, ToAddr, Bits, SecondBits: LongType;
  {$IFDEF WIN32}
  Info: Windows.TBitmap;
  {$ELSE}
  Info: WinTypes.TBitmap;
  {$ENDIF}
  Hand, SecondHand: THandle;
  i: 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;
      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);
    Start.Long := 0;
    Endp.Long := Alloc - Info.bmWidthBytes;
    for i := 0 to Info.bmHeight - 1 do
     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;
      w := $FFFF - FromAddr.Lo;
      if w < Info.bmWidthBytes then
       begin
        inc(w);
        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 := Info.bmWidthBytes - w;
        move(FromAddr.Ptr^, ToAddr.Ptr^, w);
       end
      else
       begin
        w := $FFFF - ToAddr.Lo;
        inc(w);
        if w < Info.bmWidthBytes then
         begin
          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 := Info.bmWidthBytes - w;
          move(FromAddr.Ptr^, ToAddr.Ptr^, w);
         end
        else move(FromAddr.Ptr^, ToAddr.Ptr^, Info.bmWidthBytes);
       end;
      Start.Long := Start.Long + Info.bmWidthBytes;
      Endp.Long := Endp.Long - Info.bmWidthBytes;
     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.FlipHorizontal: 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;
  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;
    if (ByteForPixel <= 2) and Odd(Info.bmWidth) and Odd(ByteForPixel) then b := ByteForPixel else b := 0;
    for i := 0 to Info.bmHeight-1 do
     begin
      l := i;
      Start.Long := l * Info.bmWidthBytes;
      Endp.Long := Start.Long+(Info.bmWidthBytes - ByteForPixel - b);
      if (ByteForPixel > 2) and Odd(ByteForPixel) and Odd(Info.bmWidth) then dec(Endp.Long);
      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;