belge tarama

[mazhargemci]

belge tarama kodlarını bileniniz var mı ?

[speed60]

Kod: Tümünü seç

unit Uscanner;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, DBCtrls, ExtCtrls, Buttons, MPlayer, Db,
  ComCtrls;

type
  TFmScanner = class(TForm)
    ScrollBox: TScrollBox;
    ToolBar: TPanel;
    OpenBtn: TSpeedButton;
    SaveBtn: TSpeedButton;
    CopyBtn: TSpeedButton;
    PasteBtn: TSpeedButton;
    ScanBtn: TSpeedButton;
    PrintBtn: TSpeedButton;
    CancelBtn: TSpeedButton;
    PostBtn: TSpeedButton;
    OpenDialog: TOpenDialog;
    Scanner: TMediaPlayer;
    MailBtn: TSpeedButton;
    SaveDialog: TSaveDialog;
    DBImage: TImage;
    CutBtn: TSpeedButton;
    StatusBar: TStatusBar;
    procedure OpenBtnClick(Sender: TObject);
    procedure SaveBtnClick(Sender: TObject);
    procedure CopyBtnClick(Sender: TObject);
    procedure PasteBtnClick(Sender: TObject);
    procedure ScanBtnClick(Sender: TObject);
    procedure PostBtnClick(Sender: TObject);
    procedure CancelBtnClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure CutBtnClick(Sender: TObject);
    procedure PrintBtnClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
  private
    FTable: TDataSet;
    FField: string;
    FFileName: string;
    FScanning: Boolean;
    procedure ClipBoardChanged(var Message: TMessage); message WM_DRAWCLIPBOARD;
    procedure EnableButtons(Btns: array of TSpeedButton);
    procedure DisableButtons(Btns: array of TSpeedButton);
    procedure CenterPicture;
    function LoadFile(FileName: string): Boolean;
    { Private declarations }
  public
    procedure Initialize(ADataSource: TDataSource; AFieldName: string);
    procedure Execute;
    procedure UpdateMenus;
     { Public declarations }
  end;

var
  FmScanner: TFmScanner;

implementation
{$R *.DFM}
uses ClipBrd, General, Globals, Printers, Optu, ShellApi;
procedure TFmScanner.ClipBoardChanged(var Message: TMessage);
begin
  if Visible then UpDateMenus;
end;

procedure TFmScanner.UpdateMenus;
begin
  try
    CutBtn.Enabled := not DbImage.Picture.Bitmap.Empty;
    CopyBtn.Enabled := not DbImage.Picture.Bitmap.Empty;
    PasteBtn.Enabled := Clipboard.HasFormat(CF_Bitmap);
    PrintBtn.Enabled := not DbImage.Picture.Bitmap.Empty;
    SaveBtn.Enabled := not DbImage.Picture.Bitmap.Empty;
    MailBtn.Enabled := not DbImage.Picture.Bitmap.Empty;
  except
  end;
end;

function TFmScanner.LoadFile(FileName: string): Boolean;
begin
  if not (FTable.State in [dsEdit, dsInsert]) then FTable.Edit;
  try
    DbImage.Picture.LoadFromFile(OpenDialog.FileName);
    UpdateMenus;
    CenterPicture;
  except
    CancelBtnClick(Self);
    raise Exception.Create('Geçersiz resim formatı');
  end;
end;
procedure TFmScanner.CenterPicture;
var L, T: Integer;
begin
  try
  with DbImage do
  begin
    if Parent = nil then Exit;
    L := Parent.Width div 2 - Width div 2;
    if L < 0 then L := 0;
    T := Parent.Height div 2 - Height div 2;
    if T < 0 then T := 0;
    SetBounds(L, T, Width, Height);
  end;
  except
  end;
end;

procedure TFmScanner.Execute;
begin
  ShowModal;
end;

procedure TFmScanner.Initialize(ADataSource: TDataSource; AFieldName: string);
begin
  FTable := ADatasource.Dataset;
  FFileName := GetAppPath + '~Temp1~.Bmp';
  DbImage.AutoSize := True;
  FField := AFieldName;
  try
    DbImage.Picture := TPicture(FTable.FieldByName(FField));
  except
    MessageDlg('Resim açılırken bir hata oluştu.', mtWarning, [mbOk], 0);
  end;
  FScanning := False;
  CenterPicture;
  EnableButtons([OpenBtn, SaveBtn, CopyBtn, PasteBtn, PrintBtn, MailBtn, ScanBtn]);
  UpdateMenus;
  ScanBtn.Tag := 0;
  ScanBtn.Caption := '&Taramaya Başla';
end;

procedure TFmScanner.EnableButtons(Btns: array of TSpeedButton);
var I: Word;
begin
  for I := 0 to High(Btns) do
    if Btns[I] <> nil then Btns[I].Enabled := True;
end;

procedure TFmScanner.DisableButtons(Btns: array of TSpeedButton);
var I: Word;
begin
  for I := 0 to High(Btns) do
    if Btns[I] <> nil then Btns[I].Enabled := False;
end;

procedure TFmScanner.OpenBtnClick(Sender: TObject);
begin
  OpenDialog.FileName := '*.bmp';
  if OpenDialog.Execute then
  begin
    LoadFile(OpenDialog.FileName);
    OpenDialog.HistoryList.Add(OpenDialog.FileName);
  end;
end;

procedure TFmScanner.SaveBtnClick(Sender: TObject);
begin
  SaveDialog.FileName := 'Adsız.bmp';
  if SaveDialog.Execute then
  begin
    try
      DbImage.Picture.SaveToFile(SaveDialog.FileName);
    except
      raise Exception.Create(SaveDialog.FileName + ' kaydedilemiyor');
    end;
  end;
end;

procedure TFmScanner.CopyBtnClick(Sender: TObject);
begin
  try
    ClipBoard.Assign(DbImage.Picture.Graphic);
    UpdateMenus;
  except
    raise Exception.Create('Panoya kopyalanamıyor');
  end;
end;

procedure TFmScanner.PasteBtnClick(Sender: TObject);
begin
  if not (FTable.State in [dsInsert, dsEdit]) then FTable.Edit;
  try
    DbImage.Picture.Assign(Clipboard);
    CenterPicture;
    UpdateMenus;
  except
    CancelBtnClick(Self);
    raise Exception.Create('Geçersiz pano formatı');
  end;
end;

procedure TFmScanner.ScanBtnClick(Sender: TObject);
begin
  case ScanBtn.Tag of
  0:
  begin
    Scanner.FileName := FFileName;
    try
      Scanner.Open;
      Scanner.StartRecording;
      FScanning := True;
    except
      FScanning := False;
      raise Exception.Create('Sisteminizde tarayıcı bulunamadı.'+#13+'Sistem Mesajı:'+#13+Scanner.ErrorMessage);
    end;
    DisableButtons([OpenBtn, SaveBtn, CopyBtn, PasteBtn, PrintBtn, MailBtn, CancelBtn, PostBtn]);
    UpdateMenus;
    ScanBtn.Caption := '&Taramayı durdur';
    ScanBtn.Tag := 1;
  end;
  1:
  begin
    EnableButtons([OpenBtn, SaveBtn, CopyBtn, PasteBtn, PrintBtn, MailBtn]);
    UpdateMenus;
    ScanBtn.Caption := '&Taramaya Başla';
    ScanBtn.Tag := 0;
    FScanning := False;
    try
      Scanner.Save;
      try
        LoadFile(FFileName);
      except
        raise Exception.Create('Tarama yapıldı ancak dosya yüklenemiyor');
      end;
    except
      raise Exception.Create('Tarayıcı hatası:' + #13 + Scanner.ErrorMessage);
    end;
  end;
  end; { Case }
end;

procedure TFmScanner.PostBtnClick(Sender: TObject);
begin
  try
    if not DBImage.Picture.Graphic.Empty then
    begin
      TGraphic(FTable.FieldByName(FField)).Assign(DBImage.Picture);
      FTable.Post;
    end else
    begin
      TGraphic(FTable.FieldByName(FField)).Assign(nil);
      FTable.Post;
    end;
  except
    if not (DbImage.Picture.Graphic is TBitmap) then
      raise Exception.Create('Seçtiğiniz resim formatı desteklenmiyor. Bitmap formatını kullanın')
    else raise Exception.Create('Kayıt yapılamıyor');
  end;
end;

procedure TFmScanner.CancelBtnClick(Sender: TObject);
begin
  FTable.Cancel;
  DbImage.Picture := TPicture(FTable.FieldByName(FField));
  UpdateMenus;
  CenterPicture;
end;

procedure TFmScanner.FormResize(Sender: TObject);
begin
  CenterPicture;
end;

procedure TFmScanner.CutBtnClick(Sender: TObject);
begin
  try
    ClipBoard.Assign(DbImage.Picture.Graphic);
    DbImage.Picture := nil;
    UpdateMenus;
    if not (FTable.State in [dsInsert, dsEdit]) then FTable.Edit;
  except
  end;
end;

procedure TFmScanner.PrintBtnClick(Sender: TObject);
var DestFile, OpenType : array[0..255] of Char;
    Result: THandle;
begin
  with OptionsFrm do
  if ShowScannerPreview then
    StrPCopy(OpenType, 'Open')
  else StrPCopy(OpenType, 'Print');
  try
    DbImage.Picture.SaveToFile(GetAppPath + '~Temp2~.bmp');
  except
    raise Exception.Create('Geçici dosya yaratılamıyor');
  end;
  StatusBar.SimpleText := 'Lütfen bekleyin . . .';
  StrPCopy(DestFile, GetAppPath + '~Temp2~.bmp');
  Result := ShellExecute(Self.Handle, OpenType, DestFile, '', '', SW_SHOWNORMAL);
  StatusBar.SimpleText := '';
  if Result = 31 then
    MessageDlg('Sisteminiz bu dosya tipini kabul etmiyor.', mtInformation, [mbOk], 0)
  else if Result <= 32 then
    MessageDlg(Format('%s %d', ['Sistemde bir hata oluştu. Hata Kodu:', Result]), mtInformation, [mbOk], 0);
end;

procedure TFmScanner.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if FScanning then
    raise Exception.Create('İlk önce tarama işlemini iptal ediniz')
  else if (FTable.State in [dsInsert, dsEdit]) then
  begin
    case MessageDlg('Kayıt yapılsın mı?', mtConfirmation, [mbYes, mbNo, mbCancel], 0) of
    mrYes: PostBtnClick(Self);
    mrNo : CancelBtnClick(Self);
    mrCancel: Action := caNone;
    end;
  end;
end;

procedure TFmScanner.FormCreate(Sender: TObject);
begin
  SaveDialog.IniTialDir := GetAPpPath + 'Evraklar\';
  OpenDialog.IniTialDir := GetAPpPath + 'Evraklar\';
end;

end.

sana fikir vermesi açısından uniti verdim Delphi 4 ile yazılmıştır.

[csunguray]

Windows, yazıcı veya kameradan görüntü almak için iki standart arabirim sunmaktadır. TWAIN ve WIA. Bu arabirimlerden birini kullanmak için de kamera veya tarayıcınızın TWAIN veya WIA sürülerinin sisteminize yüklenmiş olması gerekmektedir. Bazı cihazların TWAIN bazı cihazların WIA ve bazı cihazların da hem WIA hem TWAIN sürücüleri vardır. Daha çok bilgi edinmek için google da "Delphi WIA" veya "Delphi TWAIN" diye arama yaptırmanız gerekir. Bu kavramramları öğrendikten sonra buraya bunları nasıl kullanacağınız konusunda daha spesifik bir soru sorabilirsiniz.

Sizin sorunuz "şu sihiri yapmak için büyülü değneğimi hangi yöne sallamalıyım" gibi olmuş.