Solved

need more speed calculating average colour of a bitmap

Posted on 2000-05-12
11
174 Views
Last Modified: 2010-04-04
I have a BMP (or JPG) image in a TImage component. Im calculating the average colour of the bitmap using the next code fragment:
Count := 0;
for y := 0 to Image1.Picture.Height-1 do
  begin
    for x := 0 to Image1.Picture.Width -1 do
    begin
      inc(Count);
      L := Form1.Image1.Picture.Bitmap.Canvas.Pixels[x,y];
      R := R + ((L shr 16) and $FF);
      G := G + ((L shr 8) and $FF);
      B := B + (L and $FF);
    end;
  end;
  R1 := R div Count;
  G1 := G div Count;
  B1 := B div Count;
  showmessage(inttostr(R1)+','+inttostr(G1)+','+inttostr(B1));

This code fragment does the work, but it is very slow (around 30 secs. for a 960x1200 pixels image...).

Do any expert have a code to speed up this routine?

Thanks in advance,
Manuel López (lopem)
0
Comment
Question by:lopem
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 3
  • 3
11 Comments
 
LVL 15

Expert Comment

by:simonet
ID: 2806426
For one, you can remove the
  inc(Count)
line, because it will always evaluate to (Image1.Picture.Height * Image1.Picture.WIdth). Therefore, you can save remove it from the loop and add this to next line AFTER the loop:

  Count := Image1.Picture.Height * Image1.Picture.Width;

Besides, using WITH can speed up something:

  with Form1.Image1.Picture do
  begin
    for y := 0 to Height-1 do
      for x := 0 to Width -1 do
      begin
        L := Bitmap.Canvas.Pixels[x,y];
        R := R + ((L shr 16) and $FF);
        G := G + ((L shr 8) and $FF);
        B := B + (L and $FF);
      end;
    Count := Height * Width;
  end;
  R1 := ...

Try making the modifications above to the code and see how much improvement there is.

Yours,

Alex
 

0
 
LVL 15

Expert Comment

by:simonet
ID: 2806428
By the way: for saving a few CPU cycles, you should rewrite the routine I just sent you like this:

  with Form1.Image1.Picture do
  begin
    for y := 0 to Height-1 do
      for x := 0 to Width -1 do
      begin
        L := Bitmap.Canvas.Pixels[x,y];
        inc(R, ((L shr 16) and $FF));
        inc(G, ((L shr 8) and $FF));
        inc(B, (L and $FF));
      end;
    Count := Height * Width;
  end;
 
Make sure R, G and B are of an ordinal type (integer, longint, cardinal, word, etc);

Yours,

Alex
0
 
LVL 10

Expert Comment

by:ptmcomp
ID: 2806637
The access over the pixels property is slow. Perhaps you should use scanlines or something else.
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
LVL 10

Accepted Solution

by:
ptmcomp earned 30 total points
ID: 2806694
procedure TForm1.Button1Click(Sender: TObject);
var
  x, y: Integer;
  L: Integer;
  R, G, B: Int64;
  Count: Int64;
  res: Integer;
  OldTick: Cardinal;
begin
  R:=0; G:=0; B:=0;
  OldTick:= GetTickCount;
  with Form1.Image1.Picture.Bitmap do
  begin
    Count := Int64(Height * Width);
    if Count=0 then
      raise Exception.Create('Error Count=0');
    for y := 0 to Height-1 do
      for x := 0 to Width -1 do
      begin
        L := Canvas.Pixels[x,y];
        inc(R, ((L shr 16) and $FF));
        inc(G, ((L shr 8) and $FF));
        inc(B, (L and $FF));
      end;
    res:= (R+G+B) div Count;
  end;
  Label1.Caption:= IntToStr(GetTickCount-OldTick);
  Label2.Caption:= IntToStr(res);
end;

This is *MUCH* faster!:

procedure TForm1.Button2Click(Sender: TObject);
var
  x, x1, y: Integer;
  L: Integer;
  R, G, B: Int64;
  Count: Int64;
  res: Integer;
  OldTick: Cardinal;
  P : PByteArray;
begin
  R:=0; G:=0; B:=0;
  OldTick:= GetTickCount;
  with Form1.Image1.Picture.Bitmap do
  begin
    Count := Int64(Height * Width);
    if Count=0 then
      raise Exception.Create('Error Count=0');
    case PixelFormat of
      pf8bit:
        begin
          for y := 0 to Height-1 do
          begin
            P := ScanLine[y];
            for x := 0 to Width -1 do
            begin
              L := P[x];
              inc(R, ((L shr 16) and $FF));
              inc(G, ((L shr 8) and $FF));
              inc(B, (L and $FF));
            end;
          end;
        end;
      pf24bit:
        begin
          for y := 0 to Height-1 do
          begin
            P := ScanLine[y];
            x1:=0;
            for x := 0 to Width -1 do
            begin
              inc(R, P[x1]);
              inc(x1);
              inc(G, P[x1]);
              inc(x1);
              inc(B, P[x1]);
              inc(x1);
            end;
          end;
        end;
      else
        ShowMessage('Format not supported');
    end;
    res:= (R+G+B) div Count;
  end;
  Label1.Caption:= IntToStr(GetTickCount-OldTick);
  Label2.Caption:= IntToStr(res);
end;

Regards, ptm.
0
 
LVL 3

Author Comment

by:lopem
ID: 2806896
Thank you... You re very kind!

Best regards,
Manuel López (lopem)
0
 
LVL 15

Expert Comment

by:simonet
ID: 2806997
His answer was pretty good. Why did you give him a B? Besides, it's only a 30 points question.
0
 
LVL 10

Expert Comment

by:ptmcomp
ID: 2807017
Well, I gave you only the implementation for 8 and 24 bits per pixel, but the other formats are seldoma and it's quite easy to implement the others.
0
 
LVL 10

Expert Comment

by:ptmcomp
ID: 2807031
EE needs a spell checking option... ("seldoma"->"seldom")
0
 
LVL 3

Author Comment

by:lopem
ID: 2807341
Hi Simonet,

Maybe I guess was not a very difficult question... I'm not quite sure how to qualify an answer properly. Do you think he deserves more points? If this is the case, I apologize and I promise to give to him some more points...

Any suggestion is welcome, as usual!

Best regards,
Manuel López (lopem)
0
 
LVL 10

Expert Comment

by:ptmcomp
ID: 2807460
How does the point system work?

You assign the point value of the question based on its difficulty. As a guide, a basic question is worth 50 points; an intermediate question is 100 points, and an advanced question is 200 points. The more points assigned to a question, the more likely it will be answered.

When you accept an expert's answer, the question points you offered are deducted from your account. The expert's score is then increased by the number of points you offered for the question, multiplied by the grade you assigned to the answer. These expert points are not exchangeable back to question points. Although this seems unfair, we are forced into this position by our income tax authority (IRS), which could tax such interchangeable points as "barter income." An expert does earn question points, however, through their increased site participation. Experts mainly accrue "expert points" which may be used to purchase products through Experts-Exchange. They are also eligible to enter in a number of contests where they may win prizes.



0
 
LVL 3

Author Comment

by:lopem
ID: 2808752
Hi ptmcomp,

Just one little fix to your code:

                             :
                             :
                             :
       ShowMessage('Format not supported');
     end;
     res:= (R+G+B) div Count;
     end;
     Label1.Caption:= IntToStr(GetTickCount-OldTick);
                             :
                             :

res should be

                      res := ((R*65536)+(G*255)+(B));

Thank you again.

Best regards,
Manuel López

0

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
In this video, viewers will be given step by step instructions on adjusting mouse, pointer and cursor visibility in Microsoft Windows 10. The video seeks to educate those who are struggling with the new Windows 10 Graphical User Interface. Change Cu…
Monitoring a network: why having a policy is the best policy? Michael Kulchisky, MCSE, MCSA, MCP, VTSP, VSP, CCSP outlines the enormous benefits of having a policy-based approach when monitoring medium and large networks. Software utilized in this v…
Suggested Courses
Course of the Month9 days, 9 hours left to enroll

623 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question