mainform.pas

控制扫描仪源码 控制扫描仪源码

end;

{Source being disabled}
procedure TFormMain.TwainSourceDisable(Sender: TObject;
  const Index: Integer);
begin
 ItemStatus6.Checked := TRUE;
end;

{Current source being changed}
procedure TFormMain.ListSourcesChange(Sender: TObject);
begin
  CurrentSource := ListSources.ItemIndex;
end;

{Changing transference mode}
procedure TFormMain.Transfer1Click(Sender: TObject);
begin
  TransferMode := TTwainTransferMode(TMenuItem(Sender).Tag);
  TMenuItem(Sender).Checked := TRUE;
end;

{Checking use interface}
procedure TFormMain.ItemShowInterfaceClick(Sender: TObject);
begin
  TMenuItem(Sender).Checked := not TMenuItem(Sender).Checked;
end;

{Allow user to select the source}
procedure TFormMain.ItemSelectClick(Sender: TObject);
var
  NewSource: Integer;
begin
  {If user is using Status menu to execute process}
  if Twain.SourceManagerLoaded then
  begin
    NewSource := Twain.SelectSource;
    {In case some source was choosen}
    if NewSource <> -1 then
    begin
      CurrentSource := NewSource;
      ListSources.ItemIndex := CurrentSource;
    end {if NewSource <> -1}
  end
  else
  begin
    {Manually loading source}
    if Twain.LoadLibrary then
    begin
      {Load twain, show interface to select source and unload}
      Twain.LoadSourceManager;
      NewSource := Twain.SelectSource;
      if NewSource <> -1 then CurrentSource := NewSource;
      Twain.UnloadLibrary;
    end
    else
      ShowMessage('Library could not be loaded, check if source is loaded')
  end {if Twain.SourceManagerLoaded}
end;

{Acquire source}
procedure TFormMain.ItemAcquireClick(Sender: TObject);
begin
  {If user is already using Status menu}
  if Twain.LibraryLoaded then
    ItemStatus5Click(ItemStatus5)
  else
  begin
    {Load library, source manager and source}
    Twain.LoadLibrary;
    Twain.LoadSourceManager;
    Twain.Source[CurrentSource].Loaded := TRUE;
    {Enable source}
    Twain.Source[CurrentSource].TransferMode := Self.TransferMode;
    ClearImageList; {Clear list of images}
    Twain.Source[CurrentSource].EnableSource(ItemShowInterface.Checked, FALSE);
    while Twain.Source[CurrentSource].Enabled do Application.ProcessMessages;
    {Unload library}
    Twain.UnloadLibrary;
  end {if Twain.SourceLoaded}
end;

{Form being destroyed}
destructor TFormMain.Destroy;
begin
  {Call inherited method}
  inherited Destroy;
  {Free image list}
  ClearImageList;
  ImageList.Free;
end;

{Clear the list of images}
procedure TFormMain.ClearImageList;
var
  I: integer;
begin
  {Free each bitmap and then clear list}
  FOR i := 0 TO ImageList.Count - 1 DO
    TBitmap(ImageList[i]).Free;
  ImageList.Clear;
end;

{Image acquired using memory and handle transferences}
procedure TFormMain.TwainTwainAcquire(Sender: TObject;
  const Index: Integer; Image: TBitmap; var Cancel: Boolean);
begin
  {An image has being acquired, add to list}
  ImageList.Add(TBitmap.Create);
  TBitmap(ImageList[ImageList.Count - 1]).Assign(Image);
  {In case it's the first image, display}
  if ImageList.Count = 1 then SelectFirst;
  GoForward.Enabled := ImageList.Count - 1 > CurrentImage;
end;

{Image acquired file transferences}
procedure TFormMain.TwainSourceFileTransfer(Sender: TObject;
  const Index: Integer; Filename: TW_STR255; Format: TTwainFormat;
  var Cancel: Boolean);
var
  LoadFileName: String;
begin
  {Set file}
  LoadFileName := includetrailingbackslash(getcurrentdir) + 'picture.bmp';
  {Load and add to list}
  ImageList.Add(TBitmap.Create);
  TBitmap(ImageList[ImageList.Count - 1]).LoadFromFile(LoadFilename);
  DeleteFile(LoadFileName);
  {In case it's the first image, display}
  if ImageList.Count = 1 then SelectFirst;
  GoForward.Enabled := ImageList.Count - 1 > CurrentImage;
end;

{Selects the first image}
procedure TFormMain.SelectFirst;
begin
  Image.Picture.Assign(TBitmap(ImageList[0]));
  CurrentImage := 0;
  AdjustNavigate;
  Image.SetBounds(0, 0, 0, 0);
end;

{Adjust the buttons to navigate thru the image}
procedure TFormMain.AdjustNavigate;
begin
  {Adjust which button is enabled and the text}
  GoBack.Enabled := (CurrentImage > 0);
  GoForward.Enabled := ImageList.Count - 1 > CurrentImage;
  Current.Caption := Inttostr(CurrentImage + 1);
end;

{Previous image}
procedure TFormMain.GoBackClick(Sender: TObject);
begin
  dec(CurrentImage);
  Image.Picture.Assign(TBitmap(ImageList[CurrentImage]));
  AdjustNavigate;
  {Move image back to top}
  Image.SetBounds(0, 0, 0, 0);
end;

{Next image}
procedure TFormMain.GoForwardClick(Sender: TObject);
begin
  inc(CurrentImage);
  Image.Picture.Assign(TBitmap(ImageList[CurrentImage]));
  AdjustNavigate;
  {Move image back to top}
  Image.SetBounds(0, 0, 0, 0);
end;

{Returns the current image, if any}
function TFormMain.GetCurrent(var Image: TBitmap): Boolean;
begin
  Result := (ImageList.Count > 0);
  if Result then Image := TBitmap(ImageList[CurrentImage]);
end;

{Flip the current image vertically}
procedure TFormMain.ItemFlipVerticalClick(Sender: TObject);
var
  Image: TBitmap;
begin
  if GetCurrent(Image) then {In case there is an image}
  begin
    Image.Canvas.StretchDraw(Rect(0, Image.Height, Image.Width, 0), Image);
    Self.Image.Picture.Assign(TBitmap(ImageList[CurrentImage]));
  end {if GetCurrent}
end;

{Flip the current image horizontally}
procedure TFormMain.ItemFlipHorizontalClick(Sender: TObject);
var
  Image: TBitmap;
begin
  if GetCurrent(Image) then {In case there is an image}
  begin
    Image.Canvas.StretchDraw(Rect(Image.Width, 0, 0, Image.Height), Image);
    Self.Image.Picture.Assign(TBitmap(ImageList[CurrentImage]));
  end {if GetCurrent}
end;

{Dragging the image}
procedure TFormMain.ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  NewPos: TPoint;
begin
  {The left button was pressed}
  if ssLeft in Shift then
  begin
    {Calculate new position}
    NewPos.X := Image.Left + x - ClickPos.x;
    NewPos.Y := Image.Top + y - ClickPos.y;
    if NewPos.x + Image.Width < ContainImage.Width then
      NewPos.x := ContainImage.Width - Image.Width;
    if NewPos.y + Image.Height < ContainImage.Height then
      NewPos.y := ContainImage.Height - Image.Height;
    if NewPos.X > 0 then NewPos.X := 0;
    if NewPos.Y > 0 then NewPos.Y := 0;

    Image.Top := NewPos.Y;
    Image.Left := NewPos.X;
  end {if ssLeft in Shift}
end;

{Click on the image}
procedure TFormMain.ImageMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ClickPos.x := X;
  ClickPos.y := Y;
end;

{Being resized}
procedure TFormMain.ContainImageResize(Sender: TObject);
begin
  ClickPos.X := 0; ClickPos.Y := 0;
  ImageMouseMove(Self, [ssLeft], 0, 0);
end;

{Saving the current image}
procedure TFormMain.ItemSaveClick(Sender: TObject);
var
  Image: TBitmap;
begin
  {If there is an image}
  if GetCurrent(Image) and SavePic.Execute then
    case SavePic.FilterIndex of
      {JPEG image}
      0: with tjpegimage.Create do
      begin
        assign(Image);
        SaveToFile(SavePic.FileName);
        free;
      end;
      {Bitmap}
      1: Image.SaveToFile(SavePic.FileName);
    end {case}
end;

{User released one of the navigation buttons}
procedure TFormMain.GoMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  GoTimer.Enabled := FALSE;
end;

{Navigate between items}
procedure TFormMain.GoNavigation(Sender: TObject);
begin
  if (TTimer(Sender).Tag = 1) and GoBack.Enabled then
    GoBackClick(Self)
  else if (TTimer(Sender).Tag = 2) and GoForward.Enabled then
    GoForwardClick(Self);
  TTimer(Sender).Interval := 200;
end;

{User pressed one of the navigation buttons}
procedure TFormMain.GoMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
  begin
    GoTimer.Tag := TSpeedButton(Sender).Tag;
    GoTimer.Enabled := TRUE;
    GoTimer.Interval := 450;
  end
end;

{Defines the place to save the file}
procedure TFormMain.TwainSourceSetupFileXfer(Sender: TObject;
  const Index: Integer);
begin
  Twain.Source[Index].SetupFileTransfer(
    includetrailingbackslash(getcurrentdir) + 'picture.bmp', tfBmp);
end;

{Save image to clipboard}
procedure TFormMain.ItemCopyClick(Sender: TObject);
var
  Image: TBitmap;
  MyFormat: Word;
  AData: Cardinal;
  APalette : HPALETTE;
begin
  if GetCurrent(Image) then {In case there is an image}
  begin
    Image.SaveToClipboardFormat(MyFormat, AData, APalette);
    clipboard.SetAsHandle(MyFormat,AData);
  end {if GetCurrent(Image)}

end;

{Closing the application}
procedure TFormMain.ItemExitClick(Sender: TObject);
begin
  Close;
end;

initialization
  Screen.Cursors[HANDDRAGCURSOR] := LoadCursor(hInstance, MAKEINTRESOURCE(101));
finalization
  DeleteObject(Screen.Cursors[HANDDRAGCURSOR]);

end.