this slowpoke moves

Flip Desktop Screen Vertical

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

Beliebte Posts

Translate