destructor TBMPLite.Destroy; begin FreeMem(m_bmi,m_BmpInfoLen); if m_lpLineBits <> nil then SysFreeMem(m_lpLineBits); DeleteObject(m_hBmp); DeleteDC(m_hDc); inherited; end;
procedure TBMPLite.SetSize(fWidth, fHeight: Integer;biBitCount :byte;hDeskDc:hdc); var x,i,color_num,color:integer; pe:array of TPaletteEntry; begin if (m_bmi <> nil) then // m_bmi :=nil; FreeMem(m_bmi,m_BmpInfoLen); Bpp := biBitCount; if biBitCount <= 8 then color_num := 1 shl biBitCount else color_num :=0; m_BmpInfoLen := SizeOf(TBitmapInfoHeader) + color_num * SizeOf(TRGBQuad); GetMem(m_bmi,m_BmpInfoLen); m_Width := fWidth; m_Height := fHeight; AbsHeight := Abs(fHeight); { case Bpp of 1: begin X := (fWidth + 7) and -8; BWidth := ((X + 31) and -32) shr 3; end; 4: begin X := ((fWidth shl 2) + 7) and -8; BWidth := ((X + 31) and -32) shr 3; end; 8: begin BWidth := (((fWidth shl 3) + 31) and -32) shr 3; end; 16: begin BWidth := (((fWidth shl 4) + 31) and -32) shr 3; end; 24: begin BWidth := (((fWidth * 24) + 31) and -32) shr 3; end; 32: begin BWidth := (((fWidth shl 5) + 31) and -32) shr 3; end; end; } BWidth := (((fWidth * Bpp) +31) and not 31) shr 3; //div 8 m_DataSize := BWidth * abs(fHeight);
if (m_hDc <> 0) then DeleteDC(m_hDc); if (m_hBmp <> 0) then DeleteObject(m_hBmp); //hDeskDc := GetDC(0); n_hdc := hDeskDc; m_hDc := CreateCompatibleDC(n_hdc); { 调色板 } if color_num <> 2 then begin //getmem(pe,color_num*sizeof(TPaletteEntry)); //FillChar(pe, color_num*sizeof(TPaletteEntry), 0); setlength(pe,color_num); m_hPal := CreateHalftonePalette(0); GetPaletteEntries(m_hPal,0,color_num,pe[0]); //GetPaletteEntries(m_hPal,0,color_num,Pointer(@m_bmi.bmiColors[0])^); // SelectPalette(m_hDc,m_hPal,False); // RealizePalette(m_hDc); //SetDIBColorTable(m_hDc,0,color_num,PRGBQuadArray(@m_bmi.bmiColors[0])^); DeleteDC(m_hPal); for i:=0 to color_num-1 do begin if Bpp <= 8 then begin color := RGB2GRAY(pe[i].peRed, pe[i].peGreen, pe[i].peBlue); m_bmi^.bmiColors[i].rgbRed := color ; m_bmi^.bmiColors[i].rgbGreen := color ; m_bmi^.bmiColors[i].rgbBlue := color; m_bmi^.bmiColors[i].rgbReserved := pe[i].peFlags; end else begin m_bmi^.bmiColors[i].rgbRed := pe[i].peRed ; m_bmi^.bmiColors[i].rgbGreen:= pe[i].peGreen ; m_bmi^.bmiColors[i].rgbBlue := pe[i].peBlue ; m_bmi^.bmiColors[i].rgbReserved := pe[i].peFlags; end; end; //freemem(pe,color_num*sizeof(TPaletteEntry)); end else begin m_bmi^.bmiColors[0].rgbRed := 255; m_bmi^.bmiColors[0].rgbGreen:= 255; m_bmi^.bmiColors[0].rgbBlue := 255; m_bmi^.bmiColors[0].rgbReserved := 0; i:=1; m_bmi^.bmiColors[i].rgbRed := 0; m_bmi^.bmiColors[i].rgbGreen:= 0; m_bmi^.bmiColors[i].rgbBlue := 0; m_bmi^.bmiColors[i].rgbReserved := 0; end;
if (m_lpLineBits <> nil) and FreeBits then ReAllocMem(m_lpLineBits, 0); m_hBmp := CreateDIBSection(n_hdc,m_bmi^,DIB_RGB_COLORS, pointer(m_lpLineBits), 0,0); SelectObject(m_hDc,m_hBmp); FreeBits := False;
//ReleaseDC(0,hDeskDc); //m_lpLineBits := SysGetMem(m_LineSize); if (AbsHeight > 0) and (fWidth >1) then begin //if Scanlines <> nil then Scanlines := nil; ReAllocMem(Scanlines, AbsHeight shl 2); X := Integer(m_lpLineBits); for I := 0 to AbsHeight - 1 do begin Scanlines[I] := Ptr(X); inc(X, BWidth); end; end; end;
procedure TBMPLite.SetSizeEX(fWidth, fHeight: Integer); var X,i :Integer; begin if (fWidth = m_Width) and (fHeight = m_Height) then exit; BWidth := (((fWidth * Bpp) +31) and not 31) shr 3; //div 8 AbsHeight := Abs(fHeight); m_DataSize := AbsHeight * BWidth; m_bmi^.bmiHeader.biSizeImage := m_DataSize; m_bmi^.bmiHeader.biWidth := fWidth; m_bmi^.bmiHeader.biHeight := fHeight; DeleteObject(m_hBmp); m_hBmp := CreateDIBSection(n_hdc,m_bmi^,DIB_RGB_COLORS, pointer(m_lpLineBits), 0,0); SelectObject(m_hDc,m_hBmp); end;
function TBMPLite.getScanLine(i: Integer): Pointer; begin Result := nil; if GetDIBits(m_hDc, m_hBmp, m_Height- i-1,1,m_lpLineBits,m_bmi^,DIB_RGB_COLORS) <> 0 then Result := m_lpLineBits; end;
procedure TBMPLite.InfoTostream(AStream: TStream); var cSize, I: DWord; begin //AStream.Size := 0; AStream.WriteBuffer(m_BmpInfoLen, 4); AStream.WriteBuffer(m_bmi^, m_BmpInfoLen); end;
procedure TBMPLite.BitsTostream(AStream: TStream); begin AStream.WriteBuffer(m_DataSize,4); AStream.WriteBuffer(m_lpLineBits^,m_DataSize); end;
function TBMPLite.RGB2GRAY(r, g, b: byte): integer; begin result:=(b*117 + g*601 + r*306) shr 10 ; end;
//获得第一副图并发送 function TScreenMonitor.GetFirst: Boolean; begin Result := False; BitBlt(FFullBmp.m_hDc, 0, 0, m_nFullWidth, m_nFullHeight, m_hFullDC, 0, 0, SRCCOPY); SetRect(FRect, 0, 0, m_nFullWidth, m_nFullHeight);//赋值FRect; FScrStream.Clear; FScrStream.WriteBuffer(FRect, SizeOf(TRect)); //FFullBmp.SaveToFile('1.bmp'); FFullBmp.BitsTostream(FScrStream); if SendInfo then Result :=CompressAndSend(FScrStream); First :=not Result; end; function TScreenMonitor.CompressAndSend(AStream: TMemoryStream): Boolean; begin try FSendStream.Clear; AStream.Position :=0; ZCompressStream(AStream, FSendStream); FSendStream.Position := 0;
FCmd.Cmd := 2; FCmd.Size := FSendStream.Size;//流长度 while ((Fserv.Connected) and (Fserv.SendBuffer(FCmd, SizeOf(TCapCmd)) = -1)) do Sleep(1); if Fserv.Connected then begin Fserv.SendStream(FSendStream); end; except
end; end;
function TScreenMonitor.SendInfo: Boolean; var FInfoStream: TMemoryStream; begin result := false; FInfoStream := TMemoryStream.Create; try FFullBmp.InfoTostream(FInfoStream); FCmd.Cmd := 1; //发送第一副图 FCmd.Size := FInfoStream.Size; FCmd.Width := m_nFullWidth; //传屏幕长宽 FCmd.Height := m_nFullHeight; FInfoStream.Position :=0; Fserv.SendBuffer(FCmd, SizeOf(TCapCmd)); Fserv.SendStream(FInfoStream); result := true; finally FInfoStream.Free; end; end;