【delphi开源代码栏目提醒】:网学会员鉴于大家对delphi开源代码十分关注，论文会员在此为大家搜集整理了“CaptureForm.pas”一文，供大家参考学习

    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_CONTR

上一篇：DlgBaseInfoM.cpp
下一篇：法律专业开题报告范文