⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 imagecap.pas

📁 数字图像模式识别工程软件设计第1章基于图像分析的黄豆质量评估系统
💻 PAS
字号:
//华东交通大学研制  2000年11月于南昌
//Programer:Jiang Xiangang
unit ImageCap;
///////////////////////////////////////////////////////////////////////////
interface
///////////////////////////////////////////////////////////////////////////
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  OleCtrls, CAPWNDLib_TLB, StdCtrls, Menus, ExtCtrls, Grids, DBGrids;
///////////////////////////////////////////////////////////////////////////
type
  TImageCapForm = class(TForm)
    MainMenu1: TMainMenu;
    mnuFile: TMenuItem;
    mnuFileSet: TMenuItem;
    mnuFileSpilt: TMenuItem;
    mnuFileExit: TMenuItem;
    mnuEdit: TMenuItem;
    mnuEditSnopshot: TMenuItem;
    mnuEditSpilt: TMenuItem;
    Options1: TMenuItem;
    mnuOptPreView: TMenuItem;
    mnuOptOverlay: TMenuItem;
    mnuOptFreeze: TMenuItem;
    mnuOptFormat: TMenuItem;
    mnuOptSource: TMenuItem;
    mnuOptSpilt3: TMenuItem;
    erewr1: TMenuItem;
    Capwnd1: TCapwnd;
    N1: TMenuItem;
    R1: TMenuItem;
    RelativeRecordMenuItem: TMenuItem;
    NoRelativeRecordMenuItem: TMenuItem;
    procedure FrmClose(Sender: TObject; var Action: TCloseAction);
    procedure FormActivate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure mnuOptPreViewClick(Sender: TObject);
    procedure mnuOptOverlayClick(Sender: TObject);
    procedure mnuOptFreezeClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure mnuOptSourceClick(Sender: TObject);
    procedure mnuOptFormatClick(Sender: TObject);
    procedure mnuOptCompressionClick(Sender: TObject);
    procedure mnuEditSnopshotClick(Sender: TObject);
    procedure erewr1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure mnuFileSetClick(Sender: TObject);
    procedure mnuFileExitClick(Sender: TObject);
    procedure R1Click(Sender: TObject);
  //  procedure Button1Click(Sender: TObject);
    procedure Setimagename(sender: TObject);
    procedure NoRelativeRecordMenuItemClick(Sender: TObject);
    procedure RelativeRecordMenuItemClick(Sender: TObject);
    procedure GetRelativeRecord(Sender: TObject);
  private
    { Private declarations }
    procedure SizeWindow_1;
  public
    { Public declarations }
    lTemp: Longint;
    RelativeRecord:Integer;
    bIsInit: Boolean;
    bManual: Boolean;
  end;
///////////////////////////////////////////////////////////////////////////
var
  ImageCapForm: TImageCapForm;
  ImageName,OldImageName,ImageNameBmp,OldCaption: string;
  ImageAdd:Integer;
implementation
  uses ImageNameInput, MIDDM, MID2000Main, WriteRecord, SearchRecord;
{$R *.DFM}
///////////////////////////////////////////////////////////////////////////
procedure TImageCapForm.FrmClose(Sender: TObject; var Action: TCloseAction);
begin
     Capwnd1.DisConnect();
     Action:=caFree;
     MIDDMForm.RelativeRecord:=0;
end;
///////////////////////////////////////////////////////////////////////////
procedure TImageCapForm.FormActivate(Sender: TObject);
begin
     if bIsInit = False then
      begin
          Capwnd1.Connect();
          bIsInit := True
      end;
///////////////////////////////////////////////////////////////////////////
end;

procedure TImageCapForm.FormCreate(Sender: TObject);
begin
     MIDDMForm.MIDTable.Active:=true;
     MIDDMForm.MIDTable.GotoBookmark(MIDDMFORM.MIDTableBookmark);
     bIsInit := False  ;
     bManual := True  ;
     ImageAdd:=1;
     RelativeRecord:=0;
     Setimagename(sender);
     OldCaption:=Caption;
     GetRelativeRecord(Sender);
     if MIDDMForm.RelativeRecord=1
     then
     begin
      ImageName:=MIDDMForm.ImageName+IntToStr(MIDDMForm.DMImageSelected);
      ImageNameBmp:=ImageName+IntToStr(ImageAdd)+'.BMP';
      Caption:=OldCaption+'-'+ImageNameBmp+'-'+'图像号:'+IntToStr(MIDDMForm.DMImageSeleCTED);
     end
     else
     begin
      imagename:='Image';
      ImageNameBmp:=imagename+IntToStr(ImageAdd)+'.BMP';
      Caption:=OldCaption+'-'+ImageNameBmp;
    end;
///////////////////////////////////////////////////////////////////////////
end;
///////////////////////////////////////////////////////////////////////////
procedure TImageCapForm.mnuOptPreViewClick(Sender: TObject);
begin
     mnuOptPreview.Checked := True  ;
     mnuOptOverlay.Checked := False  ;
     mnuOptfreeze.Checked := False  ;
     capwnd1.Preview                ;
end;
///////////////////////////////////////////////////////////////////////////
procedure TImageCapForm.mnuOptOverlayClick(Sender: TObject);
begin
     mnuOptPreview.Checked := False  ;
     mnuOptOverlay.Checked := True  ;
     mnuOptfreeze.Checked := False  ;
     capwnd1.Overlay                ;
end;
///////////////////////////////////////////////////////////////////////////
procedure TImageCapForm.mnuOptFreezeClick(Sender: TObject);
begin
     mnuOptPreview.Checked := False  ;
     mnuOptOverlay.Checked := False  ;
     mnuOptfreeze.Checked := True  ;
     capwnd1.Freeze                ;
end;
///////////////////////////////////////////////////////////////////////////
procedure TImageCapForm.FormResize(Sender: TObject);
begin
    if True = bManual then
    Begin
    SizeWindow_1 ; //有这个而无信号源的话,WINDOWS将很小
    End;
end;
///////////////////////////////////////////////////////////////////////////
procedure TImageCapForm.SizeWindow_1;
var
  // lTemp: LongInt;
   lWidth,lHeight: LongInt;
begin
     bManual := false  ;
     lWidth := capwnd1.ImgWidth;
     lHeight := capwnd1.ImgHeight;
     capwnd1.Width := lWidth      ;
     capwnd1.height := lHeight    ;
     Height := (height - ClientHeight )+ lHeight +12  ;
     Width := lWidth +12    ;
     bManual := true    ;
end;
///////////////////////////////////////////////////////////////////////////
procedure TImageCapForm.mnuOptSourceClick(Sender: TObject);
begin 
  capwnd1.SetVideoSource;
end;
///////////////////////////////////////////////////////////////////////////
procedure TImageCapForm.mnuOptFormatClick(Sender: TObject);
begin
     capwnd1.SetVideoFormat;
end;
///////////////////////////////////////////////////////////////////////////
procedure TImageCapForm.mnuOptCompressionClick(Sender: TObject);
begin
     capwnd1.Setcompression ;
end;

procedure TImageCapForm.mnuEditSnopshotClick(Sender: TObject);
begin
  capwnd1.EditCopy;
end;
///////////////////////////////////////////////////////////////////////////
procedure TImageCapForm.erewr1Click(Sender: TObject);
var
BackupName,SaveImageName: string;
PathString:string;
begin
 Pathstring:=ExtractFilePath(Application.ExeName);
 SaveImageName:=Pathstring+'Images\'+ ImageNameBmp;
 if FileExists(SaveImageName) then
    begin
      BackupName := ExtractFileName(SaveImageName);
      BackupName := ChangeFileExt(BackupName, '.BAK');
      BackupName:= Pathstring+'Bak\'+BackupName;
      if not RenameFile(SaveImageName, BackupName) then
      begin
      DeleteFile(BackupName);
      RenameFile(SaveImageName, BackupName)
      end;
      DeleteFile(SaveImageName);
      end;
      capwnd1.SaveDib(SaveImageName);
   
///////////////////////////////////////////////////////////////
    if  MIDDMForm.RelativeRecord=1 then
begin
    MIDDMForm.MIDTable.Active:=true;
    MIDDMForm.MIDTable.Edit;
case  MIDDMForm.DMImageSelected of
 1: MIDDMForm.MIDTable.fieldbyname('Image1').Value:=SaveImageName;
 2:MIDDMForm.MIDTable.fieldbyname('Image2').Value:=SaveImageName;
 3:MIDDMForm.MIDTable.fieldbyname('Image3').Value:=SaveImageName;
 4:MIDDMForm.MIDTable.fieldbyname('Image4').Value:=SaveImageName;
 5:MIDDMForm.MIDTable.fieldbyname('Image5').Value:=SaveImageName;
 6:MIDDMForm.MIDTable.fieldbyname('Image6').Value:=SaveImageName;
 7:MIDDMForm.MIDTable.fieldbyname('Image7').Value:=SaveImageName;
 8:MIDDMForm.MIDTable.fieldbyname('Image8').Value:=SaveImageName;
 end;
 end;
//////////////////////////////////////////////////////////////////////////
 ImageAdd:=ImageAdd+1;
 ImageNameBmp:=ImageName+IntToStr(ImageAdd)+'.bmp';
 if MIDDMForm.RelativeRecord=1 then
 Caption:=OldCaption+'-'+ImageNameBmp+'-'+'图像号:'+IntToStr(MIDDMForm.DMImageSelected)
 else Caption:=OldCaption+'-'+ImageNameBmp;
end;
///////////////////////////////////////////////////////////////////////////
procedure TImageCapForm.FormDestroy(Sender: TObject);
begin
ImageCapForm:=nil;
end;
///////////////////////////////////////////////////////////////////////////
procedure TImageCapForm.mnuFileSetClick(Sender: TObject);
begin
   if  ImageNameInputForm.ShowModal=mrOK
    then
    begin
    ImageName:=ImageNameInputForm.ImageNameEdit.Text;
    OldImageName:=ImageName;
    ImageNameBmp:=ImageName+'.bmp';
 if MIDDMForm.RelativeRecord=1 then
    Caption:=OldCaption+'-'+ImageNameBmp+'-'+'图像号:'+IntToStr(MIDDMForm.DMImageSelected)
 else  Caption:=OldCaption+'-'+ImageNameBmp;
    ImageAdd:=0;
    end;
end;
///////////////////////////////////////////////////////////////////////////
procedure TImageCapForm.mnuFileExitClick(Sender: TObject);
begin
Close;
end;
///////////////////////////////////////////////////////////////////////////
procedure TImageCapForm.R1Click(Sender: TObject);
begin
 Close;
end;
///////////////////////////////////////////////////////////////////////////
procedure  TImageCapForm.Setimagename(sender: TObject);
begin
 MIDDMForm.ImageName:=MIDDMForm.MIDTable.fieldbyname('Name').Value;
end;

procedure TImageCapForm.NoRelativeRecordMenuItemClick(Sender: TObject);
begin
     OldImageName:='Image';
     ImageAdd:=1;
     ImageName:=OldImageName;
     ImageNameBmp:=OldImageName+IntToStr(ImageAdd)+'.bmp';
     Caption:=OldCaption+'-'+OldImageName+IntTostr(ImageAdd)+'.bmp';
     MIDDMForm.RelativeRecord:=0;
end;
///////////////////////////////////////////////////////////////////////////
procedure TImageCapForm.RelativeRecordMenuItemClick(Sender: TObject);
begin
  MIDDMForm.RelativeRecord:=1;
    ImageAdd:=1;
    Setimagename(sender);
    ImageName:=MIDDMForm.ImageName+IntToStr(MIDDMForm.DMImageSelected);
    ImageNameBmp:=ImageName+IntToStr(ImageAdd)+'.BMP';
    OldImageName:=MIDDMForm.ImageName+IntToStr(ImageAdd);
    Caption:=oldCaption+'-'+ImageNameBmp+'-'+'图像号:'+IntToStr(MIDDMForm.DMImageSeleCTED);
end;
///////////////////////////////////////////////////////////////////////////
procedure TImageCapForm. GetRelativeRecord(Sender: TObject);
begin
 RelativeRecord:=MIDDMForm.RelativeRecord;
end;
end.
///////////////////////////////////////////////////////////////////////////

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -