capframe.~pas

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

unit CapFrame;

interface

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

type
  TfamCapture = class(TFrame)
    ToolBar: TToolBar;
    btnLive: TToolButton;
    btnSnapOne: TToolButton;
    btnFreeze: TToolButton;
    btnSetup: TToolButton;
    ToolButton2: TToolButton;
    btnPlayBack: TToolButton;
    btnSaveFromMem: TToolButton;
    ToolButton6: TToolButton;
    ToolButton1: TToolButton;
    ToolButton3: TToolButton;
    ImageList: TImageList;
    VideoPanel: TPanel;
    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);//
    procedure ToolButton1Click(Sender: TObject);//
    procedure ToolButton3Click(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
    function GetOneBmp(): TBitmap;

  end;

implementation

{$R *.DFM}

uses
  CG300API, 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;

{ TfamCaputure }

//调节VideoPanel的大小满足图像卡的要求，即VideoPanel的左上角的屏幕坐标必须是
//x方向为4的倍数，y方向为2的倍数，VideoPanel的宽是4的倍数，高是2的倍数，如果不
//满足，采集的图像可能会不正常。当应用程序最大化，最小化，移动，Resize时都要调用
//本过程来重新设定VideoPanel的尺寸和位置以满足图像卡的需要。
procedure TfamCapture.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 TfamCapture.OnMove(var Msg: TMsg);
begin
  if isCapture then
  begin
    AdjustWndPos;
  end;
  inherited;
end;

procedure TfamCapture.OnNCActivate(var Msg: TMsg);
begin

  if isCapture then
  begin
    StopCapture();
    isReset := True;
  end
  else if isReset then
  begin
    BeginCapture();
    isReset := False;
  end;

{
  if Msg.message = 0  then
  begin
    StopCapture();
    isReset := True;
  end
  else if Msg.message >0 then
  begin
    //BeginCapture();
    StopCapture();
    isReset := False;
  end;
}

  inherited;
end;

procedure TfamCapture.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 TfamCapture.btnLiveClick(Sender: TObject);
begin
  BeginCapture();
end;

//初始化图像卡，并写入缺省参数
procedure TfamCapture.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 TfamCapture.ExitCG300;
begin
  if hcg > 4 then
  begin
    StopCapture();
    EndCG300(hcg);
  end;
end;

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

procedure TfamCapture.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 TfamCapture.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 TfamCapture.FormResize(Sender: TObject);
begin
  if isCapture then
  begin
    AdjustWndPos;
  end;