captureform.pas

求是科技出版的《Delphi串口通信工程开发实例导航》所有的源代码。是一本很好的书。拿出来与大家共享。

unit CaptureForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, ComCtrls, ToolWin, Menus, ImgList;

type
  TfrmCapture = class(TForm)
    MainMenu: TMainMenu;
    Live1: TMenuItem;
    VideoPanel: TPanel;
    ToolBar: TToolBar;
    btnLive: TToolButton;
    btnFreeze: TToolButton;
    btnSetup: TToolButton;
    ToolButton2: TToolButton;
    btnPlayBack: TToolButton;
    btnSaveFromMem: TToolButton;
    ToolButton6: TToolButton;
    btnSnapOne: TToolButton;
    ImageList: TImageList;
    procedure FormCreate(Sender: TObject);
    procedure btnLiveClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure btnFreezeClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnSnapOneClick(Sender: TObject);
    procedure btnSetupClick(Sender: TObject);
    procedure btnPlayBackClick(Sender: TObject);
    procedure btnSaveFromMemClick(Sender: TObject);
  private
    { Private declarations }
    //截获窗体移动的消息，并重新定位显示窗口
    procedure OnMove(var Msg: TMsg); message WM_MOVE;
    //截获窗体切换的消息，并处理该消息
    procedure OnNCActivate(var Msg: TMsg); message WM_NCACTIVATE;
    //调节窗口位置，以保证显示正常
    procedure AdjustWndPos();
    //初始化图像卡并设置缺省参数
    procedure InitCG300();
    //关闭图像卡
    procedure ExitCG300();
    //开始采集到屏幕
    procedure BeginCapture();
    //停止采集到屏幕
    procedure StopCapture();
    //如果采集8bit数据要建立调色板
    procedure SetPallete(var hPal: HPalette);
    //为指定窗口选择已经建立的逻辑调色板
    procedure UsePallete(hForm: HWND;  hPal: HPalette);
    //删除建立的逻辑调色板
    procedure DelPallete(hPal: HPalette);
    //得到当前桌面颜色位数
    procedure GetDeskColor(var DeskColor: Word);
  public
    { Public declarations }
  end;

var
  frmCapture: TfrmCapture;

implementation

{$R *.DFM}
uses
  CG300API, MemAllocAPI, SetupForm;

var
  //图像卡句柄
  hcg: Dword;
  //晶振类型
  CryOSC: Integer;
  //视频信号类型，NTSC或PAL
  VideoStandard: Integer;
  //颜色空间类型
  ColorSpace: Integer;
  //采集模式，帧或场
  DispMode: Integer;
  //源路
  Source: integer;
  //亮度
  Brightness: integer;
  //对比度
  Contrast: integer;
  //色调
  Hue: integer;
  //包含度
  Saturation: integer;

  //标记正在采集到屏幕
  isCapture: Boolean;
  //标记正在采集到内存
  isSnapOne: Boolean;
  //
  isReset: Boolean;
  //桌面窗口句柄
  hDeskWnd: HWND;
  //桌面颜色位数
  DeskColor: Word;
  //程序使用的逻辑调色板
  hPal: HPalette;

const
  MinVideoWidth = 0;
  MinVideoHeight = 0;

{ TSelf }

//调节VideoPanel的大小满足图像卡的要求，即VideoPanel的左上角的屏幕坐标必须是
//x方向为4的倍数，y方向为2的倍数，VideoPanel的宽是4的倍数，高是2的倍数，如果不
//满足，采集的图像可能会不正常。当应用程序最大化，最小化，移动，Resize时都要调用
//本过程来重新设定VideoPanel的尺寸和位置以满足图像卡的需要。
procedure TfrmCapture.AdjustWndPos();
var
  LeftMargin: integer;
  TopMargin: integer;
  WidthMargin: integer;
  HeightMargin: integer;
  P: TPoint;
  //采集窗口的大小和位置
  DispX, DispY, DispWidth, DispHeight: integer;
begin
  if hcg < 4 then exit;

  DispX := Self.Left;
  DispY := Self.Top;
  DispWidth := Self.Width;
  DispHeight := Self.Height;

  WidthMargin := VideoPanel.Width mod 4;
  HeightMargin := VideoPanel.Height mod 2;

  DispWidth := DispWidth - WidthMargin;
  DispHeight := DispHeight - HeightMargin;

  if VideoStandard = PAL then
  begin
    if (VideoPanel.Width - WidthMargin) > 768 then
       DispWidth := 768 + Self.Width - VideoPanel.Width;
    if (VideoPanel.Height - HeightMargin) > 576 then
       DispHeight := 576 + Self.Height - VideoPanel.Height;
  end
  else//是NTSC
  begin
    if (VideoPanel.Width - WidthMargin) > 640 then
       DispWidth := 640 + Self.Width - VideoPanel.Width;
    if (VideoPanel.Height - HeightMargin) > 480 then
       DispHeight := 480 + Self.Height - VideoPanel.Height;
  end;

  if (VideoPanel.Width - WidthMargin) < MinVideoWidth then
       DispWidth := MinVideoWidth + Self.Width - VideoPanel.Width;
  if (VideoPanel.Height - HeightMargin) < MinVideoHeight then
       DispHeight := MinVideoHeight + Self.Height - VideoPanel.Height;

  P.x := 0;
  P.y := 0;
  P := VideoPanel.ClientToScreen(P);

  LeftMargin :=  P.x mod 4;
  TopMargin := P.y mod 2;

  DispX := DispX - LeftMargin;
  DispY := DispY - TopMargin;

  if DispX > (screen.Width - DispWidth) then DispX:= screen.Width - DispWidth;
  if DispY > (screen.Height - DispHeight) then DispY:= screen.Height - DispHeight;
  if DispX < 0 then DispX:= DispX - (DispX div 4 * 4);
  if DispY < 0 then DispY:= DispY - (DispY div 2 * 2);

  MOveWindow(Self.Handle, DispX, DispY, DispWidth, DispHeight, True);


  P.x := 0;
  P.y := 0;
  P := VideoPanel.ClientToScreen(P);

  CG300SetDispWindow(hcg, p.x, p.y, VideoPanel.Width, VideoPanel.Height);
  //重新绘制桌面
  RedrawWindow(hDeskWnd, nil, 0, RDW_ERASENOW Or RDW_UPDATENOW
        Or RDW_ERASE Or RDW_FRAME Or RDW_INVALIDATE Or RDW_ALLCHILDREN);

  Self.Caption := Format('CG300Delphi (%d*%d; x=%d; y=%d)',
       [VideoPanel.Width, VideoPanel.Height, p.x,p.y]);
end;

procedure TfrmCapture.OnMove(var Msg: TMsg);
begin
  if isCapture then
  begin
    AdjustWndPos;
  end;
  inherited;
end;

procedure TfrmCapture.OnNCActivate(var Msg: TMsg);
begin
  if isCapture then
  begin
    StopCapture();
    isReset := True;
  end
  else if isReset then
  begin
    BeginCapture();
    isReset := False;
  end;
  inherited;
end;

procedure TfrmCapture.FormCreate(Sender: TObject);
begin
  hDeskWnd := GetDesktopWindow();
  //晶振类型, 默认为35M
  CryOSC := 0;
  //视频信号类型，默认PAL
  VideoStandard := PAL;
  //颜色空间类型，按照当前Windows显示属性设置
  self.GetDeskColor(DeskColor);
  case DeskColor of
    8: ColorSpace := All8Bit;
    16: ColorSpace := RGB565;
    24: ColorSpace := RGB888;
    32: ColorSpace := RGB8888;
  end;

  //采集模式，帧方式
  DispMode := FRAME;
  //源路，默认是第一路
  Source := 0;
  //亮度，默认是128
  Brightness := 128;
  //对比度，默认是128
  Contrast := 128;
  //色调，默认是128
  Hue := 128;
  //包含度，默认是128
  Saturation := 128;
  //标记正在采集到屏幕
  isCapture := False;
  //标记正在采集到内存
  isSnapOne := False;
  //
  isReset := False;
  //初始化图像卡
  InitCG300();
  //
  //
  SetPallete(hPal);
end;

procedure TfrmCapture.btnLiveClick(Sender: TObject);
begin
  BeginCapture();
end;

//初始化图像卡，并写入缺省参数
procedure TfrmCapture.InitCG300;
begin
  hcg := BeginCG300(1);
  if hcg > 4 then
  begin
    //晶振类型, 默认为35M
    CG300SelectCryOSC(hcg, CryOSC);
    //视频信号类型，默认PAL
    CG300SetVideoStandard(hcg, VideoStandard);
    //颜色空间类型，按照当前Windows显示属性设置
    CG300SetColorSpace(hcg, ColorSpace);
    //采集模式，帧方式
    CG300SetDispMode(hcg, DispMode);
    //源路，默认是第一路
    CG300SetADParam(hcg, AD_SOURCE, Source);
    //亮度，默认是128
    CG300SetADParam(hcg, AD_BRIGHTNESS, Brightness);
    //对比度，默认是128
    CG300SetADParam(hcg, AD_CONTRAST, Contrast);
    //色调，默认是128
    CG300SetADParam(hcg, AD_HUE, Hue);
    //包含度，默认是128
    CG300SetADParam(hcg, AD_SATURATION, Saturation);
    //设置输入视频窗口大小
    if VideoStandard = PAL then
      CG300SetInpVideoWindow(hcg, 0, 0, 768, 576)
    else
      CG300SetInpVideoWindow(hcg, 0, 0, 640, 480);
    //设置输出窗口大小和位置
    AdjustWndPos;
  end
  else
  begin
    ShowMessage('图像卡初始化失败！');
  end;
end;

//结束对图像卡的操作，释放资源
procedure TfrmCapture.ExitCG300;
begin
  if hcg > 4 then
  begin
    StopCapture();
    EndCG300(hcg);
  end;
end;

procedure TfrmCapture.FormDestroy(Sender: TObject);
begin
  ExitCG300();
  DelPallete(hPal);
end;

procedure TfrmCapture.BeginCapture;
begin
  if hcg > 4 then
  begin
    //如果Windows显示属性中颜色位数设置与图像卡设置不同则
    //不能调用CG300Capture函数直接采集到屏幕，因为采集会花屏
    GetDeskColor(DeskColor);
    Case DeskColor of
      8:
        begin
          if (ColorSpace = RGB555)or
             (ColorSpace = RGB565)or
             (ColorSpace = RGB888)or
             (ColorSpace = RGB8888) then
          begin
            ShowMessage('    当前Windows颜色设置与图像卡' + #13 +
                        '所使用色彩空间设置不符，采用直' + #13 +
                        '接采集到屏幕方式采集图像会花屏，' + #13 +
                        '请重新设置图像卡的色彩空间值!');
            exit;
          end;
        end;
      16:
        begin
          if (ColorSpace = All8bit)or
             (ColorSpace = Limited8Bit)or
             (ColorSpace = RGB888)or
             (ColorSpace = RGB8888)  then
          begin
            ShowMessage('    当前Windows颜色设置与图像卡' + #13 +
                        '所使用色彩空间设置不符，采用直' + #13 +
                        '接采集到屏幕方式采集图像会花屏，' + #13 +
                        '请重新设置图像卡的色彩空间值!');
            exit;
          end;
        end;
      24:
        begin
          if (ColorSpace<>RGB888) then
          begin
            ShowMessage('    当前Windows颜色设置与图像卡' + #13 +
                        '所使用色彩空间设置不符，采用直' + #13 +
                        '接采集到屏幕方式采集图像会花屏，' + #13 +
                        '请重新设置图像卡的色彩空间值!');
            exit;
          end;
        end;
      32:
        begin
          if (ColorSpace<>RGB8888) then
          begin
            ShowMessage('    当前Windows颜色设置与图像卡' + #13 +
                        '所使用色彩空间设置不符，采用直' + #13 +
                        '接采集到屏幕方式采集图像会花屏，' + #13 +
                        '请重新设置图像卡的色彩空间值!');
            exit;
          end;
        end;
    end;
    AdjustWndPos;
    if (ColorSpace = All8Bit)or(ColorSpace = Limited8Bit)then
       UsePallete(VideoPanel.Handle, hPal);
    CG300Capture(hcg, True);
    isCapture := True;
  end;
end;

procedure TfrmCapture.StopCapture;
begin
  if hcg > 4 then
  begin
    isCapture := False;
    isSnapOne := False;
    CG300Capture(hcg, False);
    //调节按钮状态
    btnFreeze.Enabled := True;
    btnSnapOne.Enabled := True;
    btnLive.Enabled := True;
    btnSetup.Enabled := True;
    btnPlayBack.Enabled := True;
    btnSaveFromMem.Enabled := True;
  end;
end;

procedure TfrmCapture.FormResize(Sender: TObject);
begin
  if isCapture then
  begin
    AdjustWndPos;
  end;
end;

procedure TfrmCapture.btnFreezeClick(Sender: TObject);
begin
  StopCapture();
end;

procedure TfrmCapture.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if isSnapOne then
  begin
    Action := caNone;
    ShowMessage('请先停止SnapOne操作!');
  end
  else
  begin
    Action := caFree;
  end;
end;

//演示通过内存进行双Buffer图像采集显示
procedure TfrmCapture.btnSnapOneClick(Sender: TObject);
var
  nStatus: integer; //采集状态，完成还是没有
  BufLength: Dword; //buf大小为多少字节
  pBuf: Pchar;//帧缓存指针
  Num:integer;
  BlockSize, PhysMemAdrr, MemHandle, LineAddr: Dword; //内存参数
  pBMIInfo: PBITMAPINFO;
  VideoDc: HDC;
  i: integer;
begin
  if hcg < 4 then Exit;

  //停止采集
  StopCapture();

  // 动态分配Buf的大小是多少字节，由于按当前显示的图象大小   //
  // 保存，且DLL中函数一定要求以24Bit保存，即每像素3字节，   //
  // 所以用到的buf大小应该是paintbox.Width*PaintBox.Height*3 //
  // 但是如果用户在sanpone的过程动态改变了程序窗体大小有可能 //
  // 造成buf的空间过小使得操作内存出错，为了安全buf设置为最大//
  // 即(768*576*3)表示768*576像素，每个像素是32bit           //
  Case ColorSpace of
    RGB888 :
      BufLength := 768 * 576 * 3;
    RGB565 :
      BufLength := 768 * 576 * 3;
    RGB555 :
      BufLength := 768 * 576 * 3;
    RGB8888 :
      BufLength := 768 * 576 * 4;
    All8Bit :
      BufLength := 768 * 576 * 1;
    Limited8Bit :
      BufLength := 768 * 576 * 1;
  else
    BufLength := 768 * 576 * 4;
  end;

  //使用控制面版中分派的静态内存保存图象
  StaticMemAlloc(BlockSize, PhysMemAdrr, MemHandle, LineAddr);
  //检测静态内存是否够用,静态内存应该为两个BufLength大小
  if (BlockSize * 4096) > (BufLength*2) then
  begin
    //更改按钮状态
    btnFreeze.Enabled := True;
    btnSnapOne.Enabled := False;
    btnLive.Enabled := False;
    btnSetup.Enabled := False;
    btnPlayBack.Enabled := False;
    btnSaveFromMem.Enabled := False;

    //切换SanpOne状态控制
    isSnapOne := True;
    //重新设置窗口
    Self.AdjustWndPos;