비주얼씨로 프로그램되어 있는 걸 델로 변환해서 사용하고 있는데 잘안되요.
다 되는데... 아무래도 변환하는 관정에서 어떤 차이가 있었던 것 같습니다.
프로그램은 클라이언트/서버 형태로 되어 있습니다. 서버만 돌아 갈때는 아무 문제 없습니다.하지만 클라이언트가 접속한 후 좀 있으면 에러가 발생합니다. 어떤 값이 계속 싸여서 에러가 나는데... 어떤 이유에서 그러는지 잘 모르겠습니다. 꼭 해결해야 합니다.
고수님들을 믿어 보겠습니다. 소스를 봐 주시기 바람니다. ## still image capture를 잘 봐주시기 바랍니다...
unit Video;
interface
//Client IP Address
//ServerSocket1.Socket.Connections[접속한 순번].RemoteAddress;
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, jpeg, clipbrd, ScktComp, Buttons, SpeedBar, RXClock,
ToolWin, ComCtrls, Menus, ClipMon, RXShell, RxMenus, AppUtils, PicClip,
VCLUtils, Placemnt, RXCtrls, shellapi, ImgList;
type
ProTocol = record
SendSize : Integer;
ImgSize : Integer;
ImgData : PChar;
end;
TVideoForm = class(TForm)
MainMenu1: TMainMenu;
N1: TMenuItem;
Q1: TMenuItem;
Overlay1: TMenuItem;
VideoSource: TMenuItem;
O1: TMenuItem;
T1: TMenuItem;
SB_Message: TStatusBar;
Timer1: TTimer;
Timer2: TTimer;
CCTV_ServerSocket: TServerSocket;
A1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
Display1: TMenuItem;
Preview: TMenuItem;
Overlay: TMenuItem;
OD01: TOpenDialog;
PopupMenu: TRxPopupMenu;
RXDemo1: TMenuItem;
About1: TMenuItem;
MenuItem1: TMenuItem;
Exit1: TMenuItem;
PopupImg: TPicClip;
TrayIcon: TRxTrayIcon;
Timer3: TTimer;
PopupMenu1: TPopupMenu;
N11: TMenuItem;
N41: TMenuItem;
N81: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
N10: TMenuItem;
N12: TMenuItem;
N13: TMenuItem;
N14: TMenuItem;
N15: TMenuItem;
VideoFormat: TMenuItem;
ClientIPList: TListBox;
Panel2: TPanel;
VideoArea: TPanel;
ToolBar: TSpeedBar;
SpeedbarSection1: TSpeedbarSection;
Screen_1: TSpeedItem;
Screen_4: TSpeedItem;
Screen_8: TSpeedItem;
Screen_Prev: TSpeedItem;
Screen_Next: TSpeedItem;
Screen_Auto: TSpeedItem;
Still_Encode: TSpeedItem;
Motion_Encode: TSpeedItem;
Motion_Decode: TSpeedItem;
Board_Init: TSpeedItem;
Quit: TSpeedItem;
ComboBox1: TComboBox;
Label3: TLabel;
About2: TMenuItem;
N18: TMenuItem;
N19: TMenuItem;
N20: TMenuItem;
Image1: TImage;
a: TGroupBox;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure Q1Click(Sender: TObject);
procedure VideoSourceClick(Sender: TObject);
procedure T1Click(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure Screen_1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure CCTV_ServerSocketClientConnect(Sender: TObject; Socket: TCustomWinSocket);
procedure CCTV_ServerSocketClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
procedure CCTV_ServerSocketClientRead(Sender: TObject; Socket: TCustomWinSocket);
procedure A1Click(Sender: TObject);
procedure PreviewClick(Sender: TObject);
procedure PopupMenuDrawMargin(Sender: TMenu; Rect: TRect);
procedure PopupMenuGetItemParams(Sender: TMenu; Item: TMenuItem;
State: TMenuOwnerDrawState; AFont: TFont; var Color: TColor;
var Graphic: TGraphic; var NumGlyphs: Integer);
procedure TrayIconDblClick(Sender: TObject);
// procedure M1Click(Sender: TObject);
procedure About1Click(Sender: TObject);
procedure Timer3Timer(Sender: TObject);
procedure N15Click(Sender: TObject);
procedure VideoFormatClick(Sender: TObject);
procedure cctv_serverSocketClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
procedure ComboBox1Change(Sender: TObject);
{ Private declarations }
procedure DoHint(Sender: TObject);
procedure OnDivision1;
procedure OnDivision4;
procedure OnDivision8;
procedure OnFirstPage;
procedure OnNextPage;
procedure OnAutocamera;
procedure OnMotionEncode;
procedure OnMotionDecode;
procedure OnBordInit;
procedure VideoScreenCenter;
procedure EnablePrevNext;
function isCamera(incType: Byte): Integer;
procedure GetScreenCapture;
procedure CopyPChar(dst,src: PChar; cnt:integer);
procedure SendNextBuf;
procedure EndSendBuf;
procedure OnStillEncode;
function CheckClientsReceiveState: Boolean;
procedure SetClientsReceiveFlag(sHandle: String);
procedure ClearClientRecord;
// procedure ResizeImageWindow(hwnd: THandle; w, h: Integer);
procedure RequestNextImage(ReceiveStr, sHandle: String);
procedure ClientMenuChange(MenuIdx: String);
procedure SetAutoCamera(bAuto: Boolean);
procedure SetCameraMenu(nTag: Integer);
procedure SendCameraNameToClient(Socket: TCustomWinSocket);
procedure Button4Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
public
{ Public declarations }
procedure SetCameraName(i: Integer; sStr: String);
end;
var
VideoForm: TVideoForm;
isReceived : array[0..9] of Boolean;
isNormalSendFlag: Boolean;
OrgJpeg, CurrentBmp: PChar;
FullJpgSize: integer;
ClientCount: integer;
// JPG_Name: String;
svSendSize, TotalSendSize : integer;
CameraStr: array [0..10] of String = (
'1 채널','4 채널', '8 채널','','','자동 카메라',
'','녹화중..','','',''
);
implementation
uses AviCap, VideoCap, VideoSet, CommonUnit, ClientConnect, AVIUnit, ThreadUnit, About,
helpunit, aviplay, AVIUnit2;
{$R *.DFM}
procedure TVideoForm.DoHint(Sender: TObject);
begin
SB_Message.Panels[0].Text := Application.Hint;
end;
procedure TVideoForm.ClearClientRecord;
var i: Integer;
begin
ClientIPList.Clear;
for i:=0 to 7 do
isReceived[i] := False;
TotalSendSize := 0;
FullJpgSize := 0;
ClientCount := 0;
SB_Message.Panels[0].Text := '';
SB_Message.Panels[1].Text := '';
isNormalSendFlag := False;
end;
procedure TVideoForm.FormCreate(Sender: TObject);
begin
// WindowState := wsMaximized;
Application.OnHint := DoHint;
ReadShgIni;
CapSetVideoArea( VideoArea );
if Not CapOpenDriver then begin
ShowMessage('Can''t Load Video Driver !!' + #13 + 'Please Restart Window');
Close;
exit
end;
OnInitialUpdate;
Videofor_Overlay;
// VideoScreenCenter;
CCTV_Initialize;
Screen_1.Down := True;
Screen_Prev.Enabled := Not (shDefault.Dsp_Page = 0);
Screen_Auto.Down := False;
Timer1.Enabled := False;
Timer1.Interval := 0;
Overlay.Checked := True;
isNormalSendFlag := False;
ClientCount := 0;
ClearClientRecord;
// JPG_Name := GetSystemFilePath+'$$TMPJPG##.JPG';
SB_Message.Panels[2].Text := CameraStr[0];
ComboBox1.ItemIndex := 0;
CCTV_ServerSocket.Open;
end;
// 이전 카메라
procedure TVideoForm.EnablePrevNext;
begin
Screen_Prev.Enabled := (shDefault.Dsp_Page > 0);
Screen_Next.Enabled := (shDefault.Dsp_Page < shDefault.End_Page-1);
end;
// 카메라가 연결되어 있는지...
function TVideoForm.isCamera(incType: Byte): Integer;
begin
With shDefault do begin
While Not Camera_Status[Dsp_Page] do begin
if incType=1 then begin
Inc(Dsp_Page);
if Dsp_Page = End_Page then Dsp_Page := 0;
end
else begin
Dec(Dsp_Page);
if Dsp_Page < 0 then Dsp_Page := End_Page - 1;
end;
EnablePrevNext;
end;
Result := Dsp_Page;
end;
end;
{
// 채널에 따른 이미지 화면크기 변경
procedure TVideoForm.ResizeImageWindow(hwnd: THandle; w, h: Integer);
begin
exit;
ShowWindow(ghCapWnd, SW_HIDE);
ShowWindow(hwnd, SW_HIDE);
MoveWindow(ghCapWnd, 5, 5, w, h, True);
MoveWindow(hwnd, 5, 5, w, h, True);
ShowWindow(ghCapWnd, SW_SHOW);
ShowWindow(hwnd, SW_SHOW);
VideoScreenCenter;
end;
}
// 1 채널
procedure TVideoForm.OnDivision1;
begin
if Division_Mode=1 then exit;
Screen_1.Down := True;
Division_Mode := 1;
With shDefault do begin
Dsp_Mode := 0;
ScreenSplit(Dsp_Mode, Dsp_Page);
if (Max_Channel=8) then
End_Page := 8
else
End_Page := 16;
end;
EnablePrevNext;
end;
// 4 채널
procedure TVideoForm.OnDivision4;
begin
if Division_Mode=2 then exit;
// ResizeImageWindow(Panel2.Handle, CH4WIDTH, CH4HEIGHT);
Screen_4.Down := True;
Division_Mode := 2;
With shDefault do begin
// Dsp_Page := 0;
Dsp_Mode := 1;
ScreenSplit(Dsp_Mode, 0);
if (Max_Channel=8) then
End_Page := 2
else
End_Page := 4;
end;
EnablePrevNext;
end;
// 8 채널
procedure TVideoForm.OnDivision8;
begin
if Division_Mode=3 then exit;
// ResizeImageWindow(Panel2.Handle, CH8WIDTH, CH8HEIGHT);
Screen_8.Down := True;
Division_Mode := 3;
With shDefault do begin
// Dsp_Page := 0;
Dsp_Mode := 2;
ScreenSplit(Dsp_Mode, 0);
if (Max_Channel=8) then
End_Page := 1
else
End_Page := 2;
end;
EnablePrevNext;
end;
// 다음 카메라
procedure TVideoForm.OnNextPage;
var
cPge: Integer;
begin
Screen_Next.Down := True;
With shDefault do begin
Inc(Dsp_Page);
if Dsp_Mode<1 then begin
cPge := isCamera(1);
if cPge = Dsp_Page-1 then exit; // 카메라 1대
end;
if Display_Mode=0 then begin
if (Dsp_Page >= End_Page) then Dsp_Page := 0; // shDefault.End_Page-1;
ScreenSplit(Dsp_Mode, Dsp_Page);
end
else begin
End_Page := Max_Channel;
if (Dsp_Page >= End_Page) then Dsp_Page := End_Page-1;
SetCamera(Dsp_Page, 0);
end;
EnablePrevNext;
ComboBox1.ItemIndex := Dsp_Page;
end;
end;
// 이전 카메라
procedure TVideoForm.OnFirstPage;
var
cPge: Integer;
begin
Screen_Prev.Down := True;
With shDefault do begin
if Dsp_Page > 0 then begin
Dec(Dsp_Page);
if Dsp_Mode<1 then begin
cPge := isCamera(0);
if cPge = Dsp_Page+1 then exit; // 카메라 1대
end;
if Display_Mode = 0 then begin
if Dsp_Page <= 0 then Dsp_Page := 0;
ScreenSplit(Dsp_Mode, Dsp_Page);
end
else begin
End_Page := Max_Channel;
if(Dsp_Page <= 0) then Dsp_Page := 0;
SetCamera(Dsp_Page, 0);
end;
end;
EnablePrevNext;
ComboBox1.ItemIndex := Dsp_Page;
end;
end;
// Sequential Switching
procedure TVideoForm.OnAutocamera;
begin
if Display_Mode>0 then Screen_Real;
case Division_Mode of
1: OnDivision1;
2: OnDivision4;
end;
Timer1.Interval := StrToInt(Load_Init('AutoTime'));
end;
// 정지화상
procedure TVideoForm.OnStillEncode;
var
sPath: String;
A: array [0..255] of Char;
bmp: TBitmap;
jpg: TJPEGImage;
begin
sPath := GetSystemFilePath+'';
IsImagesDirectory(sPath);
sPath := sPath + FormatDateTime('YYYYMMDDHHMMSS',Now) + '.BMP';
capFileSaveDIB(ghCapWnd, Longint(StrPCopy(A, sPath)));
bmp := TBitmap.Create;
bmp.LoadFromFile(sPath);
jpg := TJPEGImage.Create;
jpg.CompressionQuality := 100;
jpg.Assign(bmp);
jpg.SaveToFile(copy(sPath,1,length(sPath)-4)+'.jpg');
jpg.Free;
bmp.free;
GoScreen;
end;
// 동화상
procedure TVideoForm.OnMotionEncode;
var
sPath: String;
A: array [0..255] of Char;
begin
sPath := GetSystemFilePath+'';
IsImagesDirectory(sPath);
sPath := sPath + FormatDateTime('YYYYMMDDHHMM',Now) + '.AVI';
Funtion_init;
if Display_Mode > 0 then Screen_Real;
Display_Mode := 0;
Encode_Mode := 2;
capFileSetCaptureFile(ghCapWnd, Longint(StrPCopy(A, sPath)));
capCaptureSequence(ghCapWnd);
GoScreen;
TAvi2MpegThred.Create(sPath, Copy(sPath, 1, Length(sPath)-4) + '.MPG');
end;
procedure TVideoForm.OnMotionDecode;
var I: Integer;
begin
if not OD01.Execute then Exit;
if not FileExists(OD01.FileName) then begin
ShowMessage('Can''t find the file : ' + #13 + #13 + OD01.FileName);
Exit;
end;
for I := MDIChildCount - 1 downto 0 do
if MDIChildren[I] is TAVIWindow then
if MDIChildren[I].Caption = OD01.FileName then begin
(MDIChildren[I] as TAVIWindow).FormActivate(Self);
Exit;
end;
TAVIWindow.Create(Application);
end;
procedure TVideoForm.OnBordInit;
begin
GoScreen;
end;
procedure TVideoForm.Q1Click(Sender: TObject);
begin
Close;
end;
procedure TVideoForm.VideoSourceClick(Sender: TObject);
begin
// CapDlgVDisplay;
CapDlgVSource;
end;
procedure TVideoForm.VideoFormatClick(Sender: TObject);
begin
CapDlgVFormat;
end;
procedure TVideoForm.T1Click(Sender: TObject);
begin
try
VideoSetup := TVideoSetup.Create(Application);
VideoSetup.ShowModal;
except
VideoSetup.Free;
end;
end;
procedure TVideoForm.VideoScreenCenter;
begin
// Panel2.Left := Panel1.Left + (Panel1.Width - Panel2.Width) div 2;
// Panel2.Top := Panel1.Top + (Panel1.Height - Panel2.Height) div 2 - CoolBar1.Height;
end;
procedure TVideoForm.FormResize(Sender: TObject);
begin
if ghCapWnd = 0 then exit;
VideoScreenCenter;
end;
procedure TVideoForm.SetAutoCamera(bAuto: Boolean);
begin
Timer1.Interval := 0;
Timer1.Enabled := bAuto;
end;
procedure TVideoForm.SetCameraMenu(nTag: Integer);
begin
SetAutoCamera(nTag = 5);
SB_Message.Panels[2].Text := CameraStr[nTag];
case nTag of
0: OnDivision1;
1: OnDivision4;
2: OnDivision8;
3: OnFirstPage;
4: OnNextPage;
5: OnAutocamera;
6: OnStillEncode;
7: OnMotionEncode;
8: OnMotionDecode;
9: OnBordInit;
10: VideoForm.Hide;
end;
Screen_Auto.Enabled := shDefault.End_Page > 1;
end;
procedure TVideoForm.Screen_1Click(Sender: TObject);
begin
SetCameraMenu(TSpeedBar(Sender).Tag);
end;
procedure TVideoForm.Timer1Timer(Sender: TObject);
begin
OnNextPage;
end;
procedure TVideoForm.Timer2Timer(Sender: TObject);
begin
VideoForm.Hide;
Timer2.Enabled := False;
end;
procedure TVideoForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
MotionStop;
CCTV_ServerSocket.Close;
Action := caFree;
end;
procedure TVideoForm.FormDestroy(Sender: TObject);
begin
EnableOSD(FALSE);
CloseBoard;
capSetCallbackOnStatus(ghCapWnd, LongInt(0));
if Overlay_View > 0 then
capDriverDisconnect(ghCapWnd);
DestroyWindow(ghCapWnd);
ghCapWnd := 0;
end;
procedure TVideoForm.A1Click(Sender: TObject);
begin
try
ClientConnectForm := TClientConnectForm.Create(Application);
ClientConnectForm.ShowModal;
except
ClientConnectForm.Free;
end;
end;
procedure TVideoForm.CCTV_ServerSocketClientConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
Inc(ClientCount);
if ClientCount > 0 then begin
ClientIPList.Items.Add(IntToStr(Socket.Handle));
SB_Message.Panels[1].Text := 'Client Connected : ' + IntToStr(ClientCount);
end;
end;
procedure TVideoForm.CCTV_ServerSocketClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
var i: Integer;
begin
Dec(ClientCount);
if ClientCount > 0 then begin
SB_Message.Panels[1].Text := 'Client Connected : ' + IntToStr(ClientCount);
for i:=0 to ClientCount-1 do begin
if IntToStr(socket.Handle) = ClientIPList.Items.Strings[i] then begin
ClientIPList.Items.Delete(i);
isReceived[i] := False;
exit;
end;
end;
end
else begin
Funtion_init;
ClearClientRecord;
end;
end;
function TVideoForm.CheckClientsReceiveState: Boolean;
var i: Integer;
begin
Result := False;
for i:=0 to ClientCount-1 do
if (Not isReceived[i]) and (ClientIPList.Items.Strings[i]<>'') then exit;
Result := True;
end;
procedure TVideoForm.SetClientsReceiveFlag(sHandle: String);
var i: Integer;
begin
for i:=0 to ClientCount-1 do begin
if sHandle = ClientIPList.Items.Strings[i] then begin
isReceived[i] := True;
break;
end;
end;
end;
procedure TVideoForm.RequestNextImage(ReceiveStr, sHandle: String);
begin
if ReceiveStr='ReceiveOK$' then begin
SetClientsReceiveFlag(sHandle);
if CheckClientsReceiveState then begin
if TotalSendSize >= FullJpgSize then begin // 한 화면 전송 완료
EndSendBuf;
GetScreenCapture;
end
else SendNextBuf;
end;
end
else if ReceiveStr='ReceiveNO$' then begin
CurrentBmp := CurrentBmp - svSendSize;
SendNextBuf;
end;
end;
procedure TVideoForm.ClientMenuChange(MenuIdx: String);
var oObj: TObject;
idx: Integer;
begin
oObj := nil;
try
idx := StrToInt(MenuIdx);
if idx >= 6 then begin
ComboBox1.ItemIndex := idx - 6;
ComboBox1Change(ComboBox1);
exit;
end;
case idx of
0: oObj := Screen_1;
1: oObj := Screen_4;
2: oObj := Screen_8;
3: begin
if Not Screen_Prev.Enabled then exit;
oObj := Screen_Prev;
end;
4: begin
if Not Screen_Next.Enabled then exit;
oObj := Screen_Next;
end;
5: begin
oObj := Screen_Auto;
Screen_Auto.Down := True;
end;
end;
Screen_1Click(oObj);
except
end;
end;
procedure TVideoForm.SendCameraNameToClient(Socket: TCustomWinSocket);
var
sStr, key: String;
i: Integer;
begin
sStr := '';
for i:=1 to 8 do begin
if shDefault.Camera_Status[i-1] then begin
key := Load_Init(Format('Camera%d', [i]));
sStr := sStr + key + '@';
end;
end;
Socket.SendText(sStr);
end;
procedure TVideoForm.CCTV_ServerSocketClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
sStr: String[11];
s1,s2: String;
sLen: Integer;
begin
sStr := Socket.ReceiveText;
sLen := Length(sStr);
if ((sStr = 'ReceiveOK$') or (sStr='ReceiveNO$')) and (sLen=10) then
RequestNextImage(sStr, IntToStr(Socket.Handle))
else if (sStr = 'CameraNam$') and (sLen=10) then
SendCameraNameToClient(Socket)
else if (sLen <= 2) then
ClientMenuChange(sStr) // Client Menu Tag
else begin // Invalid String : Menu + 'ReceiveOK$'
s1 := Copy(sStr,1,sLen-1);
s2 := Copy(sStr,2,sLen-1);
if (s1='ReceiveOK$') or (s2='ReceiveOK$') then begin
if s1='ReceiveOK$' then
ClientMenuChange(Copy(sStr,sLen,1))
else if s2='ReceiveOK$' then
ClientMenuChange(Copy(sStr,1,1));
RequestNextImage(sStr, IntToStr(Socket.Handle));
end;
end;
end;
// Still Image Capture
procedure TVideoForm.GetScreenCapture;
var
still_size: longint;
still_buf: ^PWord;
jpg_buf: ^PByte;
still: array of Word;
jpg: array of Byte;
begin
if ClientCount=0 then exit;
FullJpgSize := 0;
try
SetLength(still, 100000);
still_buf := @still;
SetLength(jpg, 100000);
jpg_buf := @jpg;
try
still_size := EncodeStill(still_buf^, 100000-1024, 0);
if still_size <= 0 then exit;
except
exit;
end;
try
FullJpgSize := JPToJPG(PByte(still_buf^),jpg_buf^,shDefault.Compress+1,shDefault.Resolution,still_size);
if FullJpgSize <= 0 then exit;
except
exit;
end;
if OrgJpeg<>nil then begin
GlobalFreePtr(OrgJpeg);
OrgJpeg := nil;
end;
OrgJpeg := GlobalAllocPtr(GHND, FullJpgSize);
FillChar(OrgJpeg^, FullJpgSize, 0);
CopyPChar(OrgJpeg, PChar(jpg_buf^), FullJpgSize);
finally
GoScreen;
end;
CurrentBmp := OrgJpeg;
TotalSendSize := 0;
SendNextBuf;
end;
procedure TVideoForm.CopyPChar(dst,src:Pchar; cnt:integer);
var
i:integer;
begin
for i:=0 to cnt-1 do
(dst+i)^ := (src+i)^;
end;
// 버퍼 전송 끝
procedure TVideoForm.EndSendBuf;
begin
GlobalFreePtr(OrgJpeg);
OrgJpeg := nil;
end;
procedure TVideoForm.SendNextBuf;
var
prot : ^Protocol;
DSize, SendSize, i: integer;
begin
if ClientCount=0 then exit;
SendSize := 2048; // 프로토콜의 크기
DSize := 2040; // 실제 전송되는 비트맵 크기
if FullJpgSize - TotalSendSize < DSize then
DSize := FullJpgSize - totalSendSize;
// 프로토콜 셋팅
prot := GlobalAllocPtr(GHND, SendSize);
GetMem(prot, SendSize);
prot^.SendSize := DSize; // 순수 데이타 사이즈
if TotalSendSize = 0 then // 첫번째 보낼때
prot^.ImgSize := FullJpgSize // 비트맵 전체 사이즈
else prot^.ImgSize := 0;
CopyPChar(@prot^.ImgData, CurrentBmp, DSize);
SB_Message.Panels[0].Text := 'Sending : ' + IntToStr(FullJpgSize) + ' Bytes';
for i := 0 to ClientCount - 1 do begin
// for i := 0 to CCTV_ServerSocket.Socket.ActiveConnections - 1 do begin
try
if ClientIPList.Items.Count>0 then
CCTV_ServerSocket.Socket.Connections[i].SendBuf(prot^, SendSize);
isReceived[i] := False;
except
break;
end;
end;
GlobalFreePtr(prot);
FreeMem(prot, SendSize);
CurrentBmp := CurrentBmp + DSize;
svSendSize := DSize;
TotalSendSize := TotalSendSize + DSize;
end;
// Overlay <==> Preview Mode
procedure TVideoForm.PreviewClick(Sender: TObject);
var
bool: Boolean;
begin
bool := TMenuItem(Sender).Tag=0;
Preview.Checked := bool;
Overlay.Checked := Not bool;
capOverlay(ghCapWnd, Integer(Overlay.Checked));
capPreview(ghCapWnd, Integer(Preview.Checked));
if bool then capPreviewRate(ghCapWnd, 1);
GoScreen;
end;
{
procedure TVideoForm.M1Click(Sender: TObject);
begin
try
MotionSaveForm := TMotionSaveForm.Create(Application);
MotionSaveForm.ShowModal;
except
MotionSaveForm.Free;
end;
end;
}
procedure TVideoForm.PopupMenuDrawMargin(Sender: TMenu; Rect: TRect);
const
Txt = '삼화';
begin
with PopupMenu.Canvas.Font do begin
Name := '궁서';
Style := [fsBold];
Size := 20;
Color := clWhite;
Handle := CreateRotatedFont(PopupMenu.Canvas.Font, 90);
end;
PopupMenu.DefaultDrawMargin(Rect, clLime, RGB(GetRValue(clLime) div 4,
GetGValue(clLime) div 4, GetBValue(clLime) div 4));
SetBkMode(PopupMenu.Canvas.Handle, TRANSPARENT);
ExtTextOut(PopupMenu.Canvas.Handle, Rect.Left, Rect.Bottom - 5, ETO_CLIPPED,
@Rect, Txt, Length(Txt), nil);
end;
procedure TVideoForm.PopupMenuGetItemParams(Sender: TMenu; Item: TMenuItem;
State: TMenuOwnerDrawState; AFont: TFont; var Color: TColor;
var Graphic: TGraphic; var NumGlyphs: Integer);
begin
case Item.Tag of
1..4: Graphic := PopupImg.GraphicCell[Item.Tag - 1];
end;
end;
procedure TVideoForm.TrayIconDblClick(Sender: TObject);
begin
VideoForm.Show;
end;
procedure TVideoForm.About1Click(Sender: TObject);
var
nCcount: Integer;
begin
// TrayIcon.Animated := False;
try
ShowDialog(TAboutForm);
finally
// TrayIcon.Animated := True;
end;
end;
procedure TVideoForm.Timer3Timer(Sender: TObject);
begin
SB_Message.Panels[3].Text := FormatDateTime('YYYY-MM-DD HH:MM:SS DDDD',Now);
end;
procedure TVideoForm.N15Click(Sender: TObject);
begin
SetCameraMenu(TMenuItem(Sender).Tag);
end;
procedure TVideoForm.SetCameraName(i: Integer; sStr: String);
begin
if i > 8 then exit;
ComboBox1.Items.Add(sStr);
end;
procedure TVideoForm.CCTV_ServerSocketClientError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
ErrorCode := 0;
if ErrorEvent = eeDisconnect then begin
CCTV_ServerSocketClientDisconnect(Sender, Socket);
end;
Socket.Close;
end;
procedure TVideoForm.ComboBox1Change(Sender: TObject);
begin
With shDefault do begin
Dsp_Page := ComboBox1.ItemIndex;
if Dsp_Mode > 0 then begin
Dsp_Mode := 0;
Screen_1.Down := True;
end;
ScreenSplit(Dsp_Mode, Dsp_Page);
SetAutoCamera(False);
end;
end;
procedure TVideoForm.Button4Click(Sender: TObject);
begin
CLOSE
end;
procedure TVideoForm.Button2Click(Sender: TObject);
begin
HELP.SHOW;
end;
procedure TVideoForm.Button3Click(Sender: TObject);
begin
winexec('"mplayer.exe"',sw_show);
end;
procedure TVideoForm.Button1Click(Sender: TObject);
begin
try
VideoSetup := TVideoSetup.Create(Application);
VideoSetup.ShowModal;
except
VideoSetup.Free;
end;
end;
end.