Unit DesktopCanvas.pas
unit DesktopCanvas;
interface
uses
Graphics, Windows;
type
TDesktopCanvas = class(TCanvas)
private
DC : HDC;
function GetWidth:Integer;
function GetHeight:Integer;
public
constructor Create;
destructor Destroy; override;
published
property Width: Integer read GetWidth;
property Height: Integer read GetHeight;
end;
implementation
{ TDesktopCanvas object }
function TDesktopCanvas.GetWidth:Integer;
begin
Result:=GetDeviceCaps(Handle,HORZRES);
end;
function TDesktopCanvas.GetHeight:Integer;
begin
Result:=GetDeviceCaps(Handle,VERTRES);
end;
constructor TDesktopCanvas.Create;
begin
inherited Create;
DC := GetDC(0);
Handle := DC;
end;
destructor TDesktopCanvas.Destroy;
begin
Handle := 0;
ReleaseDC(0, DC);
inherited Destroy;
end;
end.
Unit QuickPixel.pas
unit QuickPixel;
interface
uses
Windows, Graphics;
type
TQuickPixel = class
private
FBitmap: TBitmap;
FScanLines: array of PRGBTriple;
function GetPixel(X, Y: Integer): TColor;
procedure SetPixel(X, Y: Integer; const Value: TColor);
function GetHeight: Integer;
function GetWidth: Integer;
public
constructor Create(const ABitmap: TBitmap);
property Pixel[X, Y: Integer]: TColor read GetPixel write SetPixel;
property Width: Integer read GetWidth;
property Height: Integer read GetHeight;
end;
implementation
{ TQuickPixel }
constructor TQuickPixel.Create(const ABitmap: TBitmap);
var
I: Integer;
begin
inherited Create;
FBitmap:= ABitmap;
FBitmap.PixelFormat:= pf24bit;
SetLength(FScanLines, FBitmap.Height);
for I:= 0 to FBitmap.Height-1 do
FScanLines[I]:= FBitmap.ScanLine[I];
end;
function TQuickPixel.GetHeight: Integer;
begin
Result:= FBitmap.Height;
end;
function TQuickPixel.GetPixel(X, Y: Integer): TColor;
var
P: PRGBTriple;
begin
P:= FScanLines[Y];
Inc(P, X);
Result:= (P^.rgbtBlue shl 16) or (P^.rgbtGreen shl 8) or P^.rgbtRed;
end;
function TQuickPixel.GetWidth: Integer;
begin
Result:= FBitmap.Width;
end;
procedure TQuickPixel.SetPixel(X, Y: Integer; const Value: TColor);
var
P: PRGBTriple;
begin
P:= FScanLines[Y];
Inc(P, X);
P^.rgbtBlue:= (Value and $FF0000) shr 16;
P^.rgbtGreen:= (Value and $00FF00) shr 8;
P^.rgbtRed:= Value and $0000FF;
end;
end.
Unit1 :
uses DesktopCanvas, QuickPixel
//
procedure TForm1.FormCreate(Sender: TObject);
var
B: TBitmap;
Desktop: TDesktopCanvas;
QP: TQuickPixel;
X, Y: Integer;
EndCopyIndex: Integer;
Temp: TColor;
begin
Left:=0;
Top:=0;
Width:=Screen.Width;
Height:=Screen.Height;
B:=nil;
Desktop:=nil;
try
Desktop:=TDesktopCanvas.Create;
B:=TBitmap.Create;
B.Width:=Screen.Width;
B.Height:=Screen.Height;
B.Canvas.CopyRect(Rect(0,
0,
B.Width,
B.Height),
Desktop,
Rect(0, 0, B.Width, B.Height));
B.PixelFormat:=pf24bit;
QP:=TQuickPixel.Create(B);
try
for Y:=0 to (QP.Height div 2)-1 do
begin
EndCopyIndex:=(QP.Height-1)-Y;
for X:=0 to QP.Width-1 do
begin
Temp:=QP.Pixel[X, Y];
QP.Pixel[X,Y]:=QP.Pixel[X, EndCopyIndex];
QP.Pixel[X,EndCopyIndex]:=Temp;
end;
end;
finally
QP.Free;
end;
with Image1.Picture.Bitmap do
begin
Width:=Image1.Width;
Height:=Image1.Height;
Canvas.CopyRect(Rect(0, 0, Width, Height),
B.Canvas, Rect(0, 0, Width, Height));
end;
finally
B.Free;
Desktop.Free;
end;
end;
procedure TForm1.Image1Click(Sender: TObject);
begin
Close;
end;
Keine Kommentare:
Kommentar veröffentlichen