Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2005.07.11;
Скачать: [xml.tar.bz2];

Вниз

Работа со сканером   Найти похожие ветки 

 
Vitalis   (2005-06-10 16:13) [0]

Задача стоит подсчет размера отсканированной картинки, разрешения и пр.
Заодно вывожу отсканированный участок на форму в Image. Но... почему-то все время выводится только первый отсканированный рисунок (визуально), а размеры, разрешения получаю правильно. Подскажите, где у меня ошибка.
Спасибо заранее

unit MainUnit;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 MultiTwain, Dialogs, Menus, ExtCtrls, ExtDlgs, StdCtrls;

type
 TMainForm = class(TForm)
   ScanImage: TImage;
   MainMenu1: TMainMenu;
   N3: TMenuItem;
   N4: TMenuItem;
   N5: TMenuItem;
   Label1: TLabel;
   Label2: TLabel;
   N6: TMenuItem;
   Label3: TLabel;
   lbHeight: TLabel;
   lbWidth: TLabel;
   lbResolution: TLabel;
   A1: TMenuItem;
   SaveDialog1: TSaveDialog;
   Label4: TLabel;
   OpenPictureDialog1: TOpenPictureDialog;
   lbStatus: TLabel;
   lbSquare: TLabel;
   N1: TMenuItem;
   procedure N2Click(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure N4Click(Sender: TObject);
   procedure N5Click(Sender: TObject);
   procedure N6Click(Sender: TObject);
   procedure A1Click(Sender: TObject);
   procedure N1Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 MainForm: TMainForm;
 Shum_: real;
 ScanBitmap: TBitmap;

implementation

uses SetUnit;

{$R *.dfm}
var
 Resolution:integer;

procedure TMainForm.N2Click(Sender: TObject);
begin
 Close;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
 ScanBitmap:=TBitmap.Create;
 Shum_:=1;
end;

procedure TMainForm.N5Click(Sender: TObject);
begin
 if SaveDialog1.Execute
 then ScanImage.Picture.SaveToFile(SaveDialog1.FileName);
end;

procedure TMainForm.N4Click(Sender: TObject);
var
dat: hBitMap;
PInfo: PBitMapInfoHeader;
Height, Width: integer;
i,j: longint;
k, l, shum: integer;
FiltPix: longint;
Square: real;
temp: TBitmap;

begin
 Twain_SelectImageSource(Handle);
 dat:=Twain_AcquireNative(Handle,0);
 if dat<>0 then begin
   PInfo:=GlobalLock(dat);
   Height:=PInfo.biHeight;
   Width:=PInfo.biWidth;
   lbWidth.Caption:= floatToStrF(100/PInfo.biXPelsPerMeter*Width,ffNumber,8,2);
   lbHeight.Caption:= floatToStrF(100/PInfo.biYPelsPerMeter*Height,ffNumber,8,2);
   Resolution:=round(2.54 * sqrt((Width * Height)/((100/PInfo.biXPelsPerMeter*Width)*(100/PInfo.biYPelsPerMeter*Height))));
   lbResolution.Caption:= IntToStr(Resolution) + " dpi";
   GlobalUnlock(dat);
   try
     ScanBitmap.Palette :=Twain_CreateDibPalette(dat);
     ScanBitmap.Width := Width;
     ScanBitmap.Height := Height;
     Twain_DrawDibToDC(ScanBitmap.Canvas.Handle,0,0,Width,Height,dat,0,0);
   except
     on EOutOFResources do
     MessageDlg("TBitMap: Нет ресурсов для загрузки изображения!",mtError,[mbOk],0);
   end;
 ScanImage.Picture.Graphic:=ScanBitmap;
 Twain_FreeNative(dat);
 end;

   lbStatus.Caption:="Идет обработка изображения!";
   temp:=ScanBitmap;
   temp.Monochrome:=True;
   Filtpix:=0;
   shum:= round(Resolution/25.4*Shum_);
   for i:=0 to ScanBitmap.Width-1 do
     for j:=0 to ScanBitmap.Height-1 do
       if temp.Canvas.Pixels[i,j] = 0 then begin l:=0;
                                            for k:=1 to shum-1 do if ((temp.Canvas.Pixels[i+k,j] = 0) and (temp.Canvas.Pixels[i-k,j] = 0)) or ((temp.Canvas.Pixels[i,j+k] = 0) and (temp.Canvas.Pixels[i,j-k] = 0)) then inc(l);
                                            if l + 1 >= shum then inc(FiltPix);
                                           end;
   Square:= Filtpix/(sqr(Resolution/2.54));
   lbSquare.Caption:= FloatToStrF(Square,ffNumber,8,2)+" кв. см";
   lbStatus.Caption:="";
end;

procedure TMainForm.N6Click(Sender: TObject);
begin
 Close;
end;

procedure TMainForm.A1Click(Sender: TObject);
var
i,j: longint;
k, l, shum: integer;
FiltPix: longint;
Square: real;
temp: TBitmap;

begin
 lbStatus.Caption:="Идет обработка изображения!";
 temp:=ScanBitmap;
 temp.Monochrome:=True;
 Filtpix:=0;
 shum:= round(Resolution/25.4*Shum_);
 for i:=ScanBitmap.Width-1 downto 0 do
   for j:=ScanBitmap.Height-1 downto 0 do
     if temp.Canvas.Pixels[i,j] = 0 then begin l:=0;
                                          for k:=1 to shum-1 do if ((temp.Canvas.Pixels[i+k,j] = 0) and (temp.Canvas.Pixels[i-k,j] = 0)) and ((temp.Canvas.Pixels[i,j+k] = 0) and (temp.Canvas.Pixels[i,j-k] = 0)) then inc(l);
                                          if l + 1 >= shum then inc(FiltPix);
                                         end;
 Square:= Filtpix/(sqr(Resolution/2.54));
 lbSquare.Caption:= FloatToStrF(Square,ffNumber,8,2)+" кв. см";
 lbStatus.Caption:="";
end;

procedure TMainForm.N1Click(Sender: TObject);
begin
SetForm.Show;
end;

end.


 
Eugene74   (2005-06-10 18:38) [1]

Я вряд ли смогу что-то подсказать по сути проблемы.
Но, может, стоит выложить куда-нибудь весь проект, включая MultiTwain (мне разные попадались)? Тогда, наверное, кто-то что-то смог бы подсказать. Ведь гораздо легче открыть проект и прогнать его в IDE, чем анализировать код "вручную".



Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2005.07.11;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.46 MB
Время: 0.037 c
9-1109414441
Xerx
2005-02-26 13:40
2005.07.11
Помогите реализовать алгоритм


1-1119593595
webpauk
2005-06-24 10:13
2005.07.11
Преобразование


14-1117875014
lookin
2005-06-04 12:50
2005.07.11
Репортаж...


4-1115595703
NikNet
2005-05-09 03:41
2005.07.11
PopupMenu! как сделать для ListView (WinAPI)???


14-1118808521
DelphiN!
2005-06-15 08:08
2005.07.11
Защита от ICQ снифа в локалке





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский