Главная страница
    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.46 MB
Время: 0.03 c
2-1172581748
Ega23
2007-02-27 16:09
2007.03.18
SetFocus - как узнать в данный момент


15-1171961362
magisrtu
2007-02-20 11:49
2007.03.18
Скажите,


2-1172584874
Flood_control
2007-02-27 17:01
2007.03.18
OpenDialog и MediaPlayer


2-1172575174
trubin
2007-02-27 14:19
2007.03.18
PasswordChar не работает


9-1145545990
ArtemESC
2006-04-20 19:13
2007.03.18
Оптическая физика...





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский