capframe.~pas

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

end;

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

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

//演示通过内存进行双Buffer图像采集显示
procedure TfamCapture.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;

    VideoDc := GetDc(VideoPanel.Handle);
    //分配帧缓存
    pBuf := AllocMem(BufLength);
    pBMIInfo := AllocMem(sizeof(TBITMAPINFO)+ (255 * sizeof(TRGBQuad)));
    try
      //设定BMP的头信息
      pBMIInfo^.bmiHeader.biSize := sizeof(BITMAPINFOHEADER);
      pBMIInfo^.bmiHeader.biWidth := VideoPanel.Width;
      pBMIInfo^.bmiHeader.biHeight := VideoPanel.Height;
      pBMIInfo^.bmiHeader.biPlanes := 1;
      if (ColorSpace = All8Bit)or(ColorSpace = Limited8Bit) then
      begin
        pBMIInfo^.bmiHeader.biBitCount := 8;
        for i :=0 to 255 do
        begin
          pBMIInfo^.bmiColors[i].rgbBlue := i;
          pBMIInfo^.bmiColors[i].rgbGreen := i;
          pBMIInfo^.bmiColors[i].rgbRed := i;
          pBMIInfo^.bmiColors[i].rgbReserved := 0;
        end;
      end
      else
         pBMIInfo^.bmiHeader.biBitCount := 24;
      pBMIInfo^.bmiHeader.biCompression := BI_RGB;
      pBMIInfo^.bmiHeader.biSizeImage := 0;
      pBMIInfo^.bmiHeader.biXPelsPerMeter := 0;
      pBMIInfo^.bmiHeader.biYPelsPerMeter := 0;
      pBMIInfo^.bmiHeader.biClrUsed := 0;
      pBMIInfo^.bmiHeader.biClrImportant := 0;

      if (ColorSpace = All8Bit)or(ColorSpace = Limited8Bit) then
      begin

      end;

      //开始启动SnapOne采集
      CG300SnapOneToMem(hcg, PhysMemAdrr, BlockSize * 4096, FRAME);
      nStatus := 1;
      SetStretchBltMode(VideoDC, COLORONCOLOR);
      while isSnapOne do
      begin
        Application.ProcessMessages;
        //不断得到图像的采集状态
        CG300GetSnappingStatus(hcg, nStatus);
        if nstatus = 3 then //采集完成
        begin
          Num:=1;
          CG300ReadfromMem(hcg, Pchar(LineAddr), BlockSize * 1024 * 4,Num-1, pBuf);
        end;
        if nstatus = 1 then //采集完成
        begin
          Num:=2;
          CG300ReadfromMem(hcg, Pchar(LineAddr), BlockSize * 1024 * 4,Num-1, pBuf);
        end;
        //8位数据使用调色板
        if (ColorSpace = All8Bit)or(ColorSpace = Limited8Bit) then
        begin
          SelectPalette(VideoDC, hPal, False);
          RealizePalette(VideoDC);
        end;
        //显示图像
        StretchDIBits(VideoDC, 0, 0, VideoPanel.Width, VideoPanel.Height,
                 0, 0, pBMIInfo^.bmiHeader.biWidth, pBMIInfo^.bmiHeader.biHeight,
                 pBuf, pBMIInfo^, DIB_RGB_COLORS, SRCCOPY);
      end;
    finally
      //释放内存
      FreeMem(pBMIInfo, sizeof(TBITMAPINFO)+ (255 * sizeof(TRGBQuad)));
      FreeMem(pBuf, BufLength);
      ReleaseDC(VideoPanel.Handle, VideoDC);
    end;
  end
  else
  begin
    Application.MessageBox('调用控制面版中分派的静态内存失败，停止抓图！', '提示', MB_OK);
  end;
end;

//弹出设置窗口
procedure TfamCapture.btnSetupClick(Sender: TObject);
begin
  if hcg < 4 then exit;

  StopCapture();
  if frmSetup = nil then
  begin
      frmSetup := TfrmSetup.Create(Self);
  end;
  //调整frmSetup的显示内容
  case CryOSC of
    0: frmSetup.rdgCryOSC.ItemIndex := 0;
    1: frmSetup.rdgCryOSC.ItemIndex := 1;
  end;

  case VideoStandard of
    PAL:  frmSetup.rdgVideoStandard.ItemIndex := 0;
    NTSC: frmSetup.rdgVideoStandard.ItemIndex := 1;
  end;

  case ColorSpace of
    RGB555: frmSetup.rdgColor.ItemIndex := 0;
    RGB565: frmSetup.rdgColor.ItemIndex := 1;
    RGB888: frmSetup.rdgColor.ItemIndex := 2;
    RGB8888: frmSetup.rdgColor.ItemIndex := 3;
    All8Bit: frmSetup.rdgColor.ItemIndex := 4;
    Limited8Bit: frmSetup.rdgColor.ItemIndex := 5;
  end;
  case DispMode of
    FRAME: frmSetup.rdgDispMode.ItemIndex := 0;
    FIELD: frmSetup.rdgDispMode.ItemIndex := 1;
  end;
  case Source of
    0: frmSetup.rdgSource.ItemIndex := 0;
    1: frmSetup.rdgSource.ItemIndex := 1;
    2: frmSetup.rdgSource.ItemIndex := 2;
    3: frmSetup.rdgSource.ItemIndex := 4;
    4: frmSetup.rdgSource.ItemIndex := 3;
  end;

  frmSetup.updBrightness.Position := Brightness;
  frmSetup.edtBrightness.Text := IntToStr(frmSetup.updBrightness.Position);

  frmSetup.updContrast.Position := Contrast;
  frmSetup.edtContrast.Text := IntToStr(frmSetup.updContrast.Position);

  frmSetup.updHue.Position := Hue;
  frmSetup.edtHue.Text := IntToStr(frmSetup.updHue.Position);

  frmSetup.updSaturation.Position := Saturation;
  frmSetup.edtSaturation.Text := IntToStr(frmSetup.updSaturation.Position);

  //显示frmSetup
  frmSetup.ShowModal;
  //更新设置
  case frmSetup.rdgCryOSC.ItemIndex of
    0: CryOSC := 0;
    1: CryOSC := 1;
  end;

  case frmSetup.rdgVideoStandard.ItemIndex of
    0: VideoStandard := PAL;
    1: VideoStandard := NTSC;
  end;

  case frmSetup.rdgColor.ItemIndex of
    0: ColorSpace := RGB555;
    1: ColorSpace := RGB565;
    2: ColorSpace := RGB888;
    3: ColorSpace := RGB8888;
    4: ColorSpace := All8Bit;
    5: ColorSpace := Limited8Bit;
  end;
  case frmSetup.rdgDispMode.ItemIndex of
    0: DispMode := FRAME;
    1: DispMode := FIELD;
  end;
  case frmSetup.rdgSource.ItemIndex of
    0: Source := 0;
    1: Source := 1;
    2: Source := 2;
    4: Source := 3;
    3: Source := 4;
  end;

  Brightness := frmSetup.updBrightness.Position;
  Contrast := frmSetup.updContrast.Position;
  Hue := frmSetup.updHue.Position;
  Saturation := frmSetup.updSaturation.Position;

  CG300SelectCryOSC(hcg, CryOSC);
  CG300SetVideoStandard(hcg, VideoStandard);
  CG300SetColorSpace(hcg, ColorSpace);
  CG300SetDispMode(hcg, DispMode);
  CG300SetADParam(hcg, AD_SOURCE, Source);
  CG300SetADParam(hcg, AD_BRIGHTNESS, Brightness);
  CG300SetADParam(hcg, AD_CONTRAST, Contrast);
  CG300SetADParam(hcg, AD_HUE, Hue);
  CG300SetADParam(hcg, AD_SATURATION, Saturation);
  if VideoStandard = PAL then
     CG300SetInpVideoWindow(hcg, 0, 0, 768, 576)
  else
     CG300SetInpVideoWindow(hcg, 0, 0, 640, 480);
  AdjustWndPos;

  //
  if frmSetup <> nil then
  begin
      frmSetup.Free;
      frmSetup := nil;
  end;
end;

//采集图像到内存
procedure TfamCapture.btnPlayBackClick(Sender: TObject);
var
  pBuf: Pchar;
  BufLength: Dword;
  BlockSize, PhysMemAdrr, MemHandle, LineAddr: Dword;
  pBMIInfo: PBITMAPINFO;
  VideoDC: HDC;
  //采集到内存中的图像数
  Sum: DWORD;
  //控制回放次数
  i,j : integer;
begin
  if hcg < 4 then exit;
  //停止播放
  StopCapture();
  //重新设置窗口
  AdjustWndPos();

  //使用控制面版中分派的静态内存保存图象
  if (StaticMemAlloc(BlockSize, PhysMemAdrr, MemHandle, LineAddr)<>1) then
  begin
    ShowMessage('访问静态保留内存失败！');
    exit;
  end;

  //动态分配Buf的大小是多少字节
  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;

  //得到显示DC
  VideoDc := GetDc(VideoPanel.Handle);
  //分配帧缓存
  pBuf := AllocMem(BufLength);
  pBMIInfo := AllocMem(sizeof(TBITMAPINFO)+ (255 * sizeof(TRGBQuad)));
  try
    //设定BMP的头信息
    pBMIInfo^.bmiHeader.biSize := sizeof(BITMAPINFOHEADER);
    pBMIInfo^.bmiHeader.biWidth := VideoPanel.Width;
    pBMIInfo^.bmiHeader.biHeight := VideoPanel.Height;
    pBMIInfo^.bmiHeader.biPlanes := 1;
    if (ColorSpace = All8Bit)or(ColorSpace = Limited8Bit) then
    begin
      pBMIInfo^.bmiHeader.biBitCount := 8;
      for i :=0 to 255 do
      begin
        pBMIInfo^.bmiColors[i].rgbBlue := i;
        pBMIInfo^.bmiColors[i].rgbGreen := i;
        pBMIInfo^.bmiColors[i].rgbRed := i;
        pBMIInfo^.bmiColors[i].rgbReserved := 0;
      end;
    end
    else
    pBMIInfo^.bmiHeader.biBitCount := 24;
    pBMIInfo^.bmiHeader.biCompression := BI_RGB;
    pBMIInfo^.bmiHeader.biSizeImage := 0;
    pBMIInfo^.bmiHeader.biXPelsPerMeter := 0;
    pBMIInfo^.bmiHeader.biYPelsPerMeter := 0;
    pBMIInfo^.bmiHeader.biClrUsed := 0;
    pBMIInfo^.bmiHeader.biClrImportant := 0;

    //控制面版中分派的静态内存可以保存当前尺寸的采集图象的总数SUM
    case ColorSpace of
      RGB888 : Sum := (BlockSize * 1024 * 4) div Dword(VideoPanel.Width * VideoPanel.Height * 3);
      RGB565 : Sum := (BlockSize * 1024 * 4) div Dword(VideoPanel.Width * VideoPanel.Height * 2);
      RGB555 : Sum := (BlockSize * 1024 * 4) div Dword(VideoPanel.Width * VideoPanel.Height * 2);
      RGB8888 : Sum := (BlockSize * 1024 * 4) div Dword(VideoPanel.Width * VideoPanel.Height * 4);
      All8Bit : Sum := (BlockSize * 1024 * 4) div Dword(VideoPanel.Width * VideoPanel.Height);
      Limited8Bit :Sum := (BlockSize * 1024 * 4) div Dword(VideoPanel.Width * VideoPanel.Height);
    else
      Sum := 0;
    end;
    Sum := 1;

    //采集到内存中
    Sum :=CG300CaptureToMem(hcg, PhysMemAdrr, BlockSize * 1024 * 4, 0, FRAME, Sum);
    //提示一共采集到内存中的图象数
    Application.MessageBox(pchar('共有' + IntToStr(Sum) + '帧图象采集到主机内存，开始从内存回放！'),
        '提示', MB_OK);

    // PlayBack播放十次
    for j := 1 to 10 do
    begin
      for i := 1 to Sum do
      begin
        //从内存中读取一图
        CG300ReadfromMem(hcg, Pchar(LineAddr), BlockSize * 1024 * 4, i - 1, pBuf);
        //8位数据使用调色板
        if (ColorSpace = All8Bit)or(ColorSpace = Limited8Bit) then
        begin
          SelectPalette(VideoDC, hPal, False);
          RealizePalette(VideoDC);
        end;
        //调用win32的API函数将Buf中的数据以图象形式显示在VideoPanel上
        SetStretchBltMode(VideoDC, COLORONCOLOR);
        StretchDIBits(VideoDC, 0, 0, VideoPanel.Width, VideoPanel.Height,
                0, 0, pBMIInfo^.bmiHeader.biWidth, pBMIInfo^.bmiHeader.biHeight,
                pBuf, pBMIInfo^, DIB_RGB_COLORS, SRCCOPY);
      end;
    end;
  finally
    //释放内存
    FreeMem(pBMIInfo, sizeof(TBITMAPINFO)+ (255 * sizeof(TRGBQuad)));
    FreeMem(pBuf, BufLength);
    ReleaseDC(VideoPanel.Handle, VideoDC);
  end;
end;

procedure TfamCapture.SetPallete(var hPal: HPalette);
var
  //循环控制
  i: Integer;
  //程序使用的逻辑调色板
  lpPal: PLOGPALETTE;
  PaletteSize: Word;
begin
  lpPal := AllocMem(sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
  try
    PaletteSize := 256;
    lpPal^.palVersion := $300;
    lpPal^.palNumEntries := PaletteSize;
    for i :=0 to lpPal^.palNumEntries-1 do
    begin
      lpPal^.palPalEntry[i].peRed := i;
      lpPal^.palPalEntry[i].peGreen := i;
      lpPal^.palPalEntry[i].peBlue := i;
      lpPal^.palPalEntry[i].peFlags := PC_NOCOLLAPSE;
      hPal := CreatePalette(lpPal^);
    end;
  finally
    FreeMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
  end;
end;

procedure TfamCapture.UsePallete(hForm: HWND; hPal: HPalette);
var