Показать сообщение отдельно
  #12  
Старый 22.12.2012, 19:42
Аватар для Algplux
Algplux Algplux вне форума
Прохожий
 
Регистрация: 03.11.2012
Адрес: Березники, Пермский край
Сообщения: 20
Версия Delphi: 7
Репутация: 10
По умолчанию

Ладно. Послушаю совета.
Код:
unit MyImage;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, jpeg, ExtDlgs, Buttons, Spin, Math;

type
  MyImage = class(TImage)
  private
    { Private declarations }
  protected
    { Protected declarations }
  public
    constructor Create(AOwner: TComponent); override;
    procedure Turn (X:Integer; Y:String);   //поворот
  published
    { Published declarations }
  end;

var
  StartBitmap: TBitmap;
  ImageLeft,ImageTop,OldHeight,OldWidth: integer;
  NewWidths,NewHeights: array [0..90] of extended; //массив всех возможных размеров
  OBs,OHs,aBOHs: array of array of extended; //параметры для расчёта координат
  d: array [0..90] of array [0..1] of integer; //сдвиги
  AnglesRad: array [0..360] of extended; //углы в радианах
  //максимальные размеры и радиус окружности, в которую со 100% попадают точки изображения
  MaxWidth,MaxHeight,MaxRadius: extended;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('MyComponents', [MyImage]);
end;

constructor MyImage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner); //Вызываем унаследованный конструктор
end;

procedure TMyImage.Turn (X:Integer; Y:String);
var
  bm: TBitmap;
  j,k,Angle,RotateAngle,NewX,NewY: integer;
  OB,OH,aBOH,dx,dy,NewHeight,NewWidth: extended;
begin
  Center:=true;
  //берем значение угла из элемента на форме
  Angle:=X;
  //приводим его к значению от 0 до 360
  if Angle<0 then Angle:=(Angle mod 360)+360
  else Angle:=Angle mod 360;
  //приводим к значению от 0 до 90 (для вычисления новых размеров угол 
  // должен быть в этом интервале
  if Angle<=180 then begin
    RotateAngle:=Angle mod 180;
    if RotateAngle>90 then RotateAngle:=180-RotateAngle;
  end
  else begin
    RotateAngle:=abs(Angle-360);
    if RotateAngle>90 then RotateAngle:=180-RotateAngle;
  end;
  //новые размеры
  NewWidth:=2*(sqrt(power(StartBitmap.Width,2)+power(StartBitmap.Height,2))/2*sin(arctan(StartBitmap.Width/StartBitmap.Height)+RotateAngle*pi/180));
  NewHeight:=2*(sqrt(power(StartBitmap.Width,2)+power(StartBitmap.Height,2))/2*sin(arctan(StartBitmap.Height/StartBitmap.Width)+RotateAngle*pi/180));
  //сдвиги
  dx:=(NewWidth-OldWidth)/2;
  dy:=(NewHeight-OldHeight)/2;
  //сдвигаем координаты элемента
  Left:=ImageLeft-round(dx);
  Top:=ImageTop-round(dy);

  Width:=round(NewWidth);
  Height:=round(NewHeight);

  bm:=TBitmap.Create;
  bm.Width:=round(NewWidth);
  bm.Height:=round(NewHeight);
  bm.PixelFormat:=pf32bit;

  NewWidth:=(NewWidth-1);
  NewHeight:=(NewHeight-1);

  for j:=0 to round(NewWidth) do begin
    for k:=0 to round(NewHeight) do begin
      OB:=sqrt(power(NewWidth/2-(j),2)+
      power(NewHeight/2-(k),2));
      OH:=NewWidth/2-(j);
      if (OB<>0) then aBOH:=arccos(abs(OH)/OB) else aBOH:=0;
      if ((k>=NewHeight/2) and (j<NewWidth/2)) or
      ((k<NewHeight/2) and (j>=NewWidth/2)) then
        aBOH:=-aBOH;
      if OH>0 then begin
        //новые координаты для четвертей 2 и 3
        NewX:=round(NewWidth/2 - cos(aBOH+Angle*pi/180)*OB-dx);
        NewY:=round(NewHeight/2 - sin(aBOH+Angle*pi/180)*OB-dy);
      end
      else begin
        //новые координаты для четвертей 1 и 4
        NewX:=round(NewWidth/2 - cos(aBOH+Angle*pi/180+pi)*OB-dx);
        NewY:=round(NewHeight/2 - sin(aBOH+Angle*pi/180+pi)*OB-dy);
      end;
      //если полученные координаты попадают в старое изображение...
      if (NewX>=0) and (NewY>=0) and (NewX<=OldWidth-1) and (NewY<=OldHeight-1) then
      //...берем из него точку
      bm.Canvas.Pixels[j,k]:=StartBitmap.Canvas.Pixels[NewX,NewY]
      else bm.Canvas.Pixels[j,k]:=$f5f5f5;
    end;
  end;
  //выводим результат
  Picture.Bitmap.Assign(bm);
  bm.Free;
end;

end.
Похоже на правду?
Ответить с цитированием