Отправляет email-рассылки с помощью сервиса Sendsay

Советы по Delphi

Рассылка закрыта

При закрытии подписчики были переданы в рассылку "Delphi - проблемы и решения" на которую и рекомендуем вам подписаться.

Вы можете найти рассылки сходной тематики в Каталоге рассылок.

←   Август 2001   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Автор
Сергей

Статистика

13.545 подписчиков
-22 за неделю
←   Все выпуски   →

Советы по Delphi


Служба Рассылок Subscribe.Ru проекта Citycat.Ru

Быстрый поворот изображения

Здравствуйте, уважаемые подписчики! Я прошу прощения - в прошлой рассылке получилась ошибка: в html варианте я не заменил знаки < и > и вышло недоразумение. В html варианте я привожу исправленный код: 

const
  d = 5;

procedure TForm1.Button1Click(Sender: TObject);
type
  PRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = array [0..0] of TRGBTriple;
var
  bi: PBitmapInfo;
  InfoSize, ImageSize: cardinal;
  bmS, bmD: TBitmap;
  p: pointer;
  line: PRGBTripleArray;
  t: cardinal;
  r, g, b: integer;
  w, h, x, y, x1, y1: integer;
  left, right, top, bottom: integer;
  dw, norm: integer;
begin
  bmS := TBitmap.Create;
  bmS.LoadFromFile('ex.bmp');
  bmS.PixelFormat := pf24bit;
  w := bmS.Width; h := bmS.Height;
  bmD := TBitmap.Create;
  bmD.Width := w; bmD.Height := h;
  bmD.PixelFormat := pf24bit;
  t := GetTickCount;
  dw := w mod 4;
  GetDIBSizes(bmS.Handle, InfoSize, ImageSize);
  GetMem(p, ImageSize);
  GetMem(bi, InfoSize);
  GetDIB(bmS.Handle, 0, bi^, p^);
  for y := 0 to h - 1 do begin
    line := bmD.ScanLine[y];
    if y > d then top := y - d else top := 0;
    if y + d < h - 1 then bottom := y + d else bottom := h - 1;
    for x := 0 to w - 1 do begin
      r := 0; g := 0; b := 0;
      if x > d then left := x - d else left := 0;
      if x + d < w - 1 then right := x + d else right := w - 1;
      for y1 := top to bottom do
        for x1 := left to right do with PRGBTriple(integer(p) +
          (h - y1 - 1) * (3 * w + dw) + x1 * 3)^ do begin
          r := r + rgbtRed;
          g := g + rgbtGreen;
          b := b + rgbtBlue;
        end;
      norm := (bottom - top + 1) * (right - left + 1);
      with line^[x] do begin
        rgbtRed := r div norm;
        rgbtGreen := g div norm;
        rgbtBlue := b div norm;
      end;
    end;
  end;
  Form1.Caption := IntToStr(GetTickCount - t);
  Form1.Canvas.Draw(0, 0, bmS);
  Form1.Canvas.Draw(0, h + 5, bmD);
  bmS.Destroy; bmD.Destroy;
  FreeMem(p, ImageSize);
  FreeMem(bi, InfoSize);
end;

procedure TForm1.Button2Click(Sender: TObject);
type
  PRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = array [0..0] of TRGBTriple;
var
  bmS, bmD: TBitmap;
  t: cardinal;
  r, g, b: integer;
  w, h, x, y, x1, y1: integer;
  left, right, top, bottom: integer;
  norm: integer;
  c: TColor;
begin
  bmS := TBitmap.Create;
  bmS.LoadFromFile('ex.bmp');
  bmS.PixelFormat := pf24bit;
  w := bmS.Width; h := bmS.Height;
  bmD := TBitmap.Create;
  bmD.Width := w; bmD.Height := h;
  bmD.PixelFormat := pf24bit;
  t := GetTickCount;
  for y := 0 to h - 1 do begin
    if y > d then top := y - d else top := 0;
    if y + d < h - 1 then bottom := y + d else bottom := h - 1;
    for x := 0 to w - 1 do begin
      r := 0; g := 0; b := 0;
      if x > d then left := x - d else left := 0;
      if x + d < w - 1 then right := x + d else right := w - 1;
      for y1 := top to bottom do
        for x1 := left to right do begin
          c := bmS.Canvas.Pixels[x1,y1];
          r := r + GetRValue(c);
          g := g + GetGValue(c);
          b := b + GetBValue(c);
        end;
      norm := (bottom - top + 1) * (right - left + 1);
      bmD.Canvas.Pixels[x,y] := rgb(r div norm, g div norm, b div norm);
    end;
  end;
  Form1.Caption := IntToStr(GetTickCount - t);
  Form1.Canvas.Draw(0, 0, bmS);
  Form1.Canvas.Draw(0, h + 5, bmD);
  bmS.Destroy; bmD.Destroy;
end;


Однажды я уже рассказывал о повороте изображения. Но тот алгоритм не был оптимизирован и использовал медленное свойство Pixels. Для поворота изображения я использовал те же формулы, что и в прошлый раз, но значительно упрощенные. В добавок к этому, для формирования изображения здесь используется ScanLine, а для считывания - GetDIB. Поскольку поворот одного и того же изображения производится многократно (на разные углы), то выгодно вызвать GetDIB только один раз перед циклом.

После поворота изображения на 360 градусов, в заголовок окна выводится время в миллисекундах, затраченное в среднем на один поворот. 

var
  p: pointer;
  bi: PBitmapInfo;
  InfoSize, ImageSize: cardinal;
  w, h: integer;
  dw: integer;

procedure Rotate(dstBitmap: TBitmap; xc, yc: Integer;
  Angle: Double);
type
  PRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = array [0..0] of TRGBTriple;
var
  cosA, sinA: double;
  xsrc, ysrc, xdst, ydst: integer;
  dx, dy: integer;
  row: PRGBTripleArray;
begin
  sinA := sin(angle);
  cosA := cos(angle);
  for ydst := 0 to h - 1 do begin
    row := dstBitmap.ScanLine[ydst];
    dy := ydst - yc;
    for xdst := 0 to w - 1 do begin
      dx := xdst - xc;
      xsrc := xc + round(dx * cosA - dy * sinA);
      ysrc := yc + round(dx * sinA + dy * cosA);
      if (xsrc >= 0) and (xsrc < w) and (ysrc >= 0) and (ysrc < h)
        then row[xdst] := PRGBTriple(integer(p) +
          (h - ysrc - 1) * (3 * w + dw) + xsrc * 3)^;
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  bmS, bmD: TBitMap;
  t: cardinal;
  i: integer;
begin
  Button1.Enabled := false;
  bmS := TBitMap.Create;
  bmD := TBitMap.Create;
  bmS.LoadFromFile('ex.bmp');
  bmS.PixelFormat := pf24bit;
  w := bmS.Width;
  h := bmS.Height;
  dw := width mod 4;
  bmD.PixelFormat := pf24bit;
  bmD.Width := w;
  bmD.Height := h;
  GetDIBSizes(bmS.handle, InfoSize, ImageSize);
  GetMem(p, ImageSize);
  GetMem(bi, InfoSize);
  GetDIB(bmS.Handle, 0, bi^, p^);
  Form1.Canvas.Draw(0, 0, bmS);
  t := GetTickCount;
  for i := 1 to 200 do begin
    PatBlt(bmD.Canvas.Handle, 0, 0, w, h, WHITENESS);
    Rotate(bmD, w div 2, h div 2, Pi * i / 100);
    Form1.Canvas.Draw(0, 0, bmD);
    Application.ProcessMessages;
    if Application.Terminated then break;
  end;
  Form1.Caption := IntToStr((GetTickCount - t) div 200);
  FreeMem(p, ImageSize);
  FreeMem(bi, InfoSize);
  Button1.Enabled := true;
end;

До конца августа рассылка выходить не будет, но потом я ее возобновлю.

Снова жду ваших идей,
Даниил Карапетян.

На сайте http://delphi4all.narod.ru Вы найдете еще более 100 советов по Delphi.
Email: delphi4all@narod.ru

http://subscribe.ru/
E-mail: ask@subscribe.ru 		Отписаться Рейтингуется SpyLog
В избранное