📄 imagecap.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 + -