Last active
August 29, 2015 14:27
-
-
Save MisterTimur/30a217abcefc812be744 to your computer and use it in GitHub Desktop.
utigr.pas
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
unit UTiGr;{Абдулов Тимур Рифович 2015 год Email hostingurifa@gmail.com . | |
;INFO | |
;Site https://sites.google.com/site/timpascallib/ | |
;Youtube https://www.youtube.com/watch?v=N_PZVx062bo | |
;Google+ https://plus.google.com/u/0/+%D0%A2%D0%B8%D0%BC%D1%83%D1%80%D0%90%D0%B1%D0%B4%D1%83%D0%BB%D0%BE%D0%B2/posts | |
;GIST https://gist.github.com/MisterTimur/30a217abcefc812be744 | |
;------------------------------------------------------------------------------} | |
{$mode objfpc}{$H+} | |
interface | |
uses Windows,Classes, SysUtils,Forms,Graphics; | |
Const TiMaxKOlPix=4000000; // Максимальное количкество пикселей | |
Type TiImg=Class // Класс для работы с графикой | |
BitMap:TBitMap; | |
info:TBitMapInfo; | |
Pixels:Array[0..TiMaxKOlPix] of LongWord; | |
Function RePiX(X,Y:LongWord):LongWord; | |
Procedure WrPix(X,Y,C:LongWord); | |
Procedure ReCan(C:TCanvas); | |
Procedure WrCan(C:TCanvas); | |
Procedure ReEcr; | |
Constructor Create; | |
end; | |
implementation | |
Procedure TiImg.ReCan(C:TCanvas);// Читает изображение | |
begin | |
BitMap.Height:=c.Height; | |
BitMap.Width:=c.Width; | |
BitMap.PixelFormat:=pf24bit; | |
with info.bmiHeader do begin | |
biWidth:=c.Width; | |
biHeight:=c.Height; | |
biSize:=SizeOf(TBITMAPINFOHEADER); | |
biCompression:=BI_RGB; | |
biBitCount:=32; | |
biPlanes:=1; | |
biSizeImage:=0; | |
end; | |
BitBlt(BitMap.canvas.Handle,0,0,C.Width, C.Height,c.Handle,0,0,SRCCOPY); | |
GetDIBits(BitMap.Canvas.Handle,BitMap.Handle,0,BitMap.Height-1,addr(Pixels),info,DIB_RGB_COLORS); | |
end; | |
Procedure TiImg.WrCan(C:TCanvas);// Записывает изображение | |
var | |
ORect,IREct:TRect; | |
begin | |
ORect.Left:=0; | |
ORect.Top:=0; | |
ORect.Right:=C.Width; | |
ORect.Bottom:=c.Height; | |
IRect.Left:=0; | |
IRect.Top:=0; | |
IRect.Right:=BitMap.Width; | |
IRect.Bottom:=BitMap.Height; | |
SetDIBits(BitMap.Canvas.Handle,BitMap.Handle,0,BitMap.Height-1,addr(Pixels),info,DIB_RGB_COLORS); | |
c.CopyRect(orect,BitMap.Canvas,irect); | |
end; | |
Procedure TiImg.ReEcr; // итает каритнку с экрана | |
begin | |
BitMap.Height:=Screen.Height; | |
BitMap.Width:=Screen.Width; | |
BitMap.PixelFormat:=pf24bit; | |
with info.bmiHeader do begin | |
biWidth:=Screen.Width; | |
biHeight:=Screen.Height; | |
biSize:=SizeOf(TBITMAPINFOHEADER); | |
biCompression:=BI_RGB; | |
biBitCount:=32; | |
biPlanes:=1; | |
biSizeImage:=0; | |
end; | |
BitBlt(BitMap.canvas.Handle,0,0,Screen.Width, Screen.Height,GetDC(0),0,0,SRCCOPY); | |
GetDIBits(BitMap.Canvas.Handle,BitMap.Handle,0,BitMap.Height-1,addr(Pixels),info,DIB_RGB_COLORS); | |
end; | |
Constructor TiImg.Create; | |
begin | |
BitMap:=TBitMap.Create; | |
end; | |
Function TiImg.RePiX(X,Y:LongWord):LongWord;// Читает цвет пикселя | |
begin | |
RePiX:=Pixels[(BitMap.Width*Y)+X]; | |
end; | |
Procedure TiImg.WrPiX(X,Y,C:LongWord);// Записывает цвет пикселя | |
begin | |
Pixels[(BitMap.Width*Y)+X]:=C | |
end; | |
end. |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment