Недавно добавленные исходники

•  DeLiKaTeS Tetris (Тетрис)  4 023

•  TDictionary Custom Sort  6 127

•  Fast Watermark Sources  5 925

•  3D Designer  8 773

•  Sik Screen Capture  6 254

•  Patch Maker  6 674

•  Айболит (remote control)  6 671

•  ListBox Drag & Drop  5 530

•  Доска для игры Реверси  95 687

•  Графические эффекты  6 898

•  Рисование по маске  6 115

•  Перетаскивание изображений  5 059

•  Canvas Drawing  5 429

•  Рисование Луны  5 145

•  Поворот изображения  4 691

•  Рисование стержней  3 305

•  Paint on Shape  2 544

•  Генератор кроссвордов  3 433

•  Головоломка Paletto  2 748

•  Теорема Монжа об окружностях  3 543

•  Пазл Numbrix  2 328

•  Заборы и коммивояжеры  3 012

•  Игра HIP  1 969

•  Игра Go (Го)  1 887

•  Симулятор лифта  2 241

•  Программа укладки плитки  1 951

•  Генератор лабиринта  2 394

•  Проверка числового ввода  2 080

•  HEX View  2 406

•  Физический маятник  2 042

 
скрыть

  Форум  

Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Delphi Sources

Копирование экрана




Новая марка монохромных мониторов ViewSonic имеет в качестве символа трех пингвинов.


unit ScrnCap;

interface

uses
  WinTypes, WinProcs, Forms, Classes, Graphics, Controls;

{ Копирует прямоугольную область экрана }
function CaptureScreenRect(ARect : TRect) : TBitmap;
{ Копирование всего экрана }
function CaptureScreen : TBitmap;
{ Копирование клиентской области формы или элемента }
function CaptureClientImage(Control : TControl) : TBitmap;
{ Копирование всей формы элемента }
function CaptureControlImage(Control : TControl) : TBitmap;

implementation

function GetSystemPalette : HPalette;
var
  PaletteSize : integer;
  LogSize : integer;
  LogPalette : PLogPalette;
  DC : HDC;
  Focus : HWND;
begin
  result:=0;
  Focus:=GetFocus;
  DC:=GetDC(Focus);
  try
    PaletteSize:=GetDeviceCaps(DC, SIZEPALETTE);
    LogSize:=SizeOf(TLogPalette)+(PaletteSize-1)*SizeOf(TPaletteEntry);
    GetMem(LogPalette, LogSize);
    try
      with LogPalette^ do
      begin
        palVersion:=$0300;
        palNumEntries:=PaletteSize;
        GetSystemPaletteEntries(DC, 0, PaletteSize, palPalEntry);
      end;
      result:=CreatePalette(LogPalette^);
    finally
      FreeMem(LogPalette, LogSize);
    end;
  finally
    ReleaseDC(Focus, DC);
  end;
end;


function CaptureScreenRect(ARect : TRect) : TBitmap;
var
  ScreenDC : HDC;
begin
  Result:=TBitmap.Create;
  with result, ARect do
  begin
    Width:=Right-Left;
    Height:=Bottom-Top;
    ScreenDC:=GetDC(0);
    try
      BitBlt(Canvas.Handle, 0,0,Width,Height,ScreenDC, Left, Top, SRCCOPY );
    finally
      ReleaseDC(0, ScreenDC);
    end;
    Palette:=GetSystemPalette;
  end;
end;

function CaptureScreen : TBitmap;
begin
  with Screen do
    Result:=CaptureScreenRect(Rect(0,0,Width,Height));
end;

function CaptureClientImage(Control : TControl) : TBitmap;
begin
  with Control, Control.ClientOrigin do
    result:=CaptureScreenRect(Bounds(X,Y,ClientWidth,ClientHeight));
end;

function CaptureControlImage(Control : TControl) : TBitmap;
begin
  with Control do
    if Parent=nil then
      result:=CaptureScreenRect(Bounds(Left,Top,Width,Height))
    else
      with Parent.ClientToScreen(Point(Left, Top)) do
        result:=CaptureScreenRect(Bounds(X,Y,Width,Height));
end;

end.





Похожие по теме исходники

Хранитель экрана Папины Дочки

Передача удаленного экрана по сети (Remote Screen)




Copyright © 2004-2025 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте