Face Change

Distorting an image

Introduction

After trying a few of Peter's motion graphics programs, have some fun with this image distorter. Program FaceChange provides the on-screen instructions. You need a 300 x 500 pixel bitmap of a face in the program folder. You could use our test file image.bmp which you can download here. Click on both eyes then the mouth to initiate the change. (If the result does not look right, even for a funny face, minimise then maximise the graphics window). We obtained the following screenshot from the test file.

Changed Face

Changed Face

In order to run the program you will need to have downloaded Stefan Berinde`s wingraph.zip file as described in our Graphics tutorial. You should copy the unzipped wincrt.pas, wingraph.pas and winmouse.pas (from the src folder) into your program folder.

Peter loads the image into the graphics window, copies the pixels to a 2D array, then manipulates the array representation of the image. To achieve the distortion he copies pixels in a region of the image from nearby points on the image according to expressions he has developed by trial and error, then writes all of the pixels back to the window.

The Program

program FaceChange;
{
    Copyright (c) 2011 Peter Hearnshaw
    
    Licensed under the Apache License, Version 2.0 (the "License"); you may not 
    use this file except in compliance with the License, as described at
    http://www.apache.org/licenses/ and http://www.pp4s.co.uk/licenses/
}
uses
  SysUtils, wincrt, wingraph, winmouse;
var
  gd, gm : smallint;
  i, a, tempNum, clicked, FaceSize, startRight, startLeft, mouthY : integer;
  tempImg : array [1 .. 1000, 1 .. 1000] of integer;
  eyesmouth : array [1 .. 6] of integer;
  me : MouseEventType;
  Ready : boolean;

procedure LoadBMP;
var
  f : file;
  bitmap : pointer;
  size : longint;
begin
  {$I-} Assign(f, 'image.bmp');
  Reset(f, 1); {$I+}
  if (IOResult <> 0) then
    Exit;
  size := FileSize(f);
  GetMem(bitmap, size);
  BlockRead(f, bitmap^ ,size);
  Close(f);
  PutImage(0, 0, bitmap^, NormalPut);
  FreeMem(bitmap);
end;

begin
  SetWindowSize(700, 550);
  gd := 9; gm := 13;
  InitGraph(gd, gm, 'Image Change');

  setcolor(white);
  outTextXY(10, 10, 'Instructions: Save a 24-bit bitmap image named image.bmp in the program folder.');
  outTextXY(10, 20, '    The image will contain an image of a person''s face.');
  outTextXY(10, 30, '    The image should be about 300 to 550 px across on both sides.');
  outTextXY(10, 40, '    Now click on the eye to the left of the screen, then the eye on the right.');
  outTextXY(10, 50, '    Then click on the mouth and the image should change.');
  outTextXY(10, 70, '    Once you have got the image ready, click on the screen.');
  Ready := false;
  repeat
    GetMouseEvent(me);
    with me do
      case action of
        MouseActionDown: begin //mouse button pressed
                           Ready := true;
                         end;
      end;
  until Ready = true;
  clearDevice;
  LoadBMP;
  for a := 1 to 500 do
    begin
      for i := 1 to 500 do
        begin
          tempImg[a][i] := getpixel(a, i);
        end;
    end;

  //THREE MOUSE CLICKS
  clicked := 0;
  repeat
    GetMouseEvent(me);
    with me do
      case action of
        MouseActionDown: begin //mouse button pressed
                           inc(clicked);
                           eyesmouth[(clicked * 2) - 1] := getMouseX;
                           eyesmouth[(clicked * 2)] := getMouseY;
                         end;
    end;
  until clicked = 3;
  //END THREE MOUSE CLICKS

  FaceSize := round(sqrt(((eyesmouth[1] - eyesmouth[5]) * (eyesmouth[1] - eyesmouth[5])) + ((eyesmouth[2] - eyesmouth[6]) * (eyesmouth[2] - eyesmouth[6]))));
  writeln(FaceSize);    //136
  startRight := eyesmouth[5] + round(FaceSize / 1.8);
  startLeft := eyesmouth[5] - round(FaceSize / 1.8) - 100;
  writeln(startLeft, ' ', startRight);
  mouthY := eyesmouth[6];

  for a := 1 to 40 do
    begin
      for i := 1 to 50 do
        begin
          tempImg[eyesmouth[3] - 20 + i][eyesmouth[4] + a + 15] :=  tempImg[eyesmouth[3] - 20 + i][eyesmouth[4] + 15 + round(a * 1.2)];
      end;
    end;
  for a := 1 to 40 do
    begin
      for i:= 1 to 50 do
        begin
          tempImg[eyesmouth[1] - 35 + i][eyesmouth[2] + a + 15] :=  tempImg[eyesmouth[1] - 35 + i][eyesmouth[2] + 15 + round(a * 1.2)];
        end;
    end;

  for i := 1 to 500 do
    begin
      for a := 1 to 300 do   //height of box to squash
        begin
          tempImg[i][round(mouthY + FaceSize / 3) + a] := tempImg[i][round(mouthY + FaceSize / 3) + round(a * 2)];
        end;
    end;
  for a := 1 to 100 do
    begin
      for i := 1 to 100 do
        begin
          tempNum := round(15 * sin(a * 0.031));
          tempImg[startRight + (100 - i)][(mouthY - 40) + (100 - a)] := tempImg[startRight + (100 - i) - tempNum][(mouthY - 40) + (100 - a)];
        end;
    end;
  for a := 1 to 100 do
    begin
      for i := 1 to 100 do
        begin
          tempNum := round(15 * sin(a * 0.031));
          tempImg[startLeft + i][(mouthY - 40) + a] := tempImg[startLeft + i + tempNum][(mouthY - 40) + a];
        end;
    end;
  for a := 1 to 500 do
    begin
      for i := 1 to 500 do
        begin
          putPixel(a, i, tempImg[a][i]);
        end;
    end;
  readln;
end.

Remarks

Could you develop this program by experimenting with the code to move the pixels? This may be necessary to achieve a satisfactory result for some images.

Programming - a skill for life!

Fourteen programs (with five web versions) including 3D-Driving, GASP and Knowledge by Peter Hearnshaw