Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2007.03.18;
Скачать: CL | DM;

Вниз

ScreenShot в двухмониторных системах   Найти похожие ветки 

 
TCrash   (2007-01-20 10:27) [0]

Непонятное что-то происходит. Сделал свой модуль для снятия скриншота, в него включил класс TMonitor из Forms (чтобы полностью не присоединять его).
Делаю оконное приложение - все работает нормально., делаю приложение без окон - ошибка.
Само приложение :
program test;
uses
 cScreenShot;
begin
 ScreenShot:=TScreenShot.Create;
 ScreenShot.GetMonitors;
 ScreenShot.GetScreenShot(0);
 ScreenShot.SaveToFile("a.bmp");
 ScreenShot.Free;
end.


cScreenShot:

unit cScreenShot;
interface
uses Windows, MultiMon, Classes, Graphics;

type
 TMonitor = class(TObject)
// полностью скопировано из Forms
 end;

type
 TMonitors=class(TObject)
   Count: integer;
   Items: array of TMonitor;
   constructor Create;
   destructor Destroy; override;
   procedure Add(m: TMonitor);
   procedure Clear;
 end;

type
 TScreenShot=class
   Monitors: TMonitors;
   BitMap: TBitMap;
   PixelFormat: TPixelFormat;
   constructor Create;
   destructor Destroy; override;
   procedure GetMonitors;
   procedure GetScreenShot(Index: integer);
   procedure SaveToFile(const fName: string);
   procedure SaveToStream(Dest: TStream);
 private
   DC: HDC;
 end;

var
 ScreenShot: TScreenShot;

implementation
{ TMonitor полностью скопировано из Forms}

{TMonitors}

procedure TMonitors.Add(m: TMonitor);
begin
 Inc(Count);
 SetLength(Items,Count);
 Items[Count-1]:=m;
end;

{TScreenShot по образу и подобию :}
function EnumMonitorsProc(hm: HMONITOR; dc: HDC; r: PRect;
                         Data: Pointer): Boolean; stdcall;
var
 l: TMonitors;
 m: TMonitor;
begin
 l:=TMonitors(Data);
 M := TMonitor.Create;
 M.FHandle := hm;
 M.FMonitorNum := L.Count;
 L.Add(M);
 Result := True;
end;

procedure TScreenShot.GetMonitors;
begin
 Monitors.Clear;
 EnumDisplayMonitors(0, nil, @EnumMonitorsProc, LongInt(Monitors));
end;

procedure TScreenShot.GetScreenShot(Index: integer);
var
 m: TMonitor;
 Left,Top,Width,Height: DWORD;
 r: TRect;
begin
 m:=Monitors.Items[Index];
 r:=m.GetBoundsRect; //в r попадают несусветные значения. Дома и на работе разные
 Left:=r.Left;
 Top:=r.Top;
 Width:=r.Right-r.Left;
 Height:=r.Bottom-r.Top;
 BitMap.Width:=Width; // Width~=800000 и здесь вываливается, естесственно ошибка
                             // EOutOfResources Параметр задан неправильно :(
 BitMap.Height:=Height;
 BitBlt(BitMap.Canvas.Handle,0,0,Width,Height,DC,Left,Top,SrcCopy);
 BitMap.PixelFormat:=PixelFormat;
end;

Почему при использовании того же модуля из формы все работает корретно?


 
Дмитрий Белькевич ©   (2007-01-24 07:07) [1]

А чем так принципиально окно не нравиться?


 
TCrash   (2007-01-24 10:07) [2]

Дмитрий Белькевич ©   (24.01.07 7:07) [1]
Хочется оформить это сервисом.
Суть задачи такая - нечто похожее на RAdmin, но свое и с некоторыми доп. функциями. Для чего - Начальство настаивает чтобы весь софт был лицензионный, а RAdmin мне пакупать не хочет. Как впрочем и другие аналогичные утилиты :(


 
Котик Б   (2007-01-24 10:49) [3]


> RAdmin мне пакупать не хочет

VNC



Страницы: 1 вся ветка

Текущий архив: 2007.03.18;
Скачать: CL | DM;

Наверх




Память: 0.47 MB
Время: 0.052 c
2-1172600453
Lonix
2007-02-27 21:20
2007.03.18
Запись в файл


15-1171865166
Чапаев
2007-02-19 09:06
2007.03.18
Звериный оскал копирайта %-)


2-1172489086
Cara
2007-02-26 14:24
2007.03.18
Щелчёк на заголовке.


15-1172143121
Rouse_
2007-02-22 14:18
2007.03.18
Директор, это ерунда. Депутаты - круче :)


15-1172322646
Суслик
2007-02-24 16:10
2007.03.18
Delphi Turbo for Win32 Prof VS Delphi for Win32 Prof