Показать сообщение отдельно
  #25  
Старый 02.06.2011, 13:36
Аватар для AND_REY
AND_REY AND_REY вне форума
Активный
 
Регистрация: 31.03.2009
Адрес: Украина, г.Днепропетровск
Сообщения: 324
Версия Delphi: Delphi7
Репутация: 3877
По умолчанию

Навалял , вроде работет, разберайтесь.
Код:
procedure TForm1.Button1Click(Sender: TObject);
Type
 TRGB = Record
   B,G,R: Byte;
  end;
 PRGBLine = ^TRGBLine;
 TRGBLine = Array [0..65535] of TRGB;
Var
 F: TFileStream;
 Bmp: TBitmap;
 Line: PRGBLine;
 R, Mx, My, x, y, j, i, n: Integer;
 M: Array of Array of Integer;
begin
 if OpenDialog1.Execute Then
  F:= TFileStream.Create(OpenDialog1.FileName, fmOpenRead) Else Exit;
 Bmp:= TBitmap.Create;
 Bmp.PixelFormat:= pf24bit;
 if (F.Size Mod 3) = 0 Then R:= (F.Size Div 3)
  Else R:= (F.Size Div 3) + 1 ;
 Bmp.Width:= Round(Sqrt(R));
 Bmp.Height:= Bmp.Width;
 if (Bmp.Width*Bmp.Height) < R Then Bmp.Height:= Bmp.Height + 1;
 For j:= 0 To Bmp.Height - 1 Do
  begin
   Line:= Bmp.ScanLine[j];
   F.Read(Line^, Bmp.Width*3);
   For i:= 0 To Bmp.Width - 1 Do
    begin
     if (Line^[i].R + Line^[i].G + Line^[i].B) Div 3 > 127 Then
      begin
       Line^[i].R:= $FF; Line^[i].g:= $FF; Line^[i].B:= $FF;
      end
     Else
      begin
       Line^[i].R:= $00; Line^[i].g:= $00; Line^[i].B:= $00;
      end;
    end;
  end;
 if (Bmp.Width Mod 10) = 0 Then Mx:= Bmp.Width Div 10
  Else Mx:= (Bmp.Width Div 10) + 1;
 if (Bmp.Height Mod 10) = 0 Then My:= Bmp.Height Div 10
  Else My:= (Bmp.Height Div 10) + 1;
 Setlength(M, My*10, Mx);
 For j:= 0 To Bmp.Height - 1 Do
  begin
   Line:= Bmp.ScanLine[j];
   For i:= 0 To Mx - 1 Do
    begin
     n:= 0;
     For x:= 0 To 9 Do if Line^[i*10+x].R = $FF Then Inc(n) Else Dec(n);
     M[j,i]:= n;
   end;
  end;
 Image1.Width:= Mx*30;
 Image1.Height:= My*30;
 For i:= 0 To Mx - 1 Do
  For j:= 0 To My - 1 Do
   begin
    n:= 0;
    For y:= 0 To 9 Do n:= n + M[j*10+y,i];
    if n >= 0 Then Image1.Canvas.Brush.Color:= clWhite
     Else Image1.Canvas.Brush.Color:= clSilver;
    Image1.Canvas.Rectangle(i*30,j*30,i*30+30,j*30+30);
    Image1.Canvas.TextOut(i*30+5,j*30+10,IntToStr(n));
   end;
 Image1.Picture.SaveToFile('c:\test.bmp');
 Bmp.Free;
 F.Free;
end;
__________________
If end Then begin;
Ответить с цитированием