PatBlt(SouBitmap.Canvas.Handle, 0, 0, Form1.ClientWidth, Form1.ClientHeight, WHITENESS);
   SouBitmap.Canvas.MoveTo(180,230);
   SouBitmap.Canvas.LineTo(ArrPos,40);
   PaintBox1.Canvas.CopyRect(Rect,SouBitmap.Canvas,Rect);

var
  DC: HDC;
  Canva: TCanvas;
  B: TBitmap;
begin
  Canva := TCanvas.Create;
  B := TBitmap.Create;
  DC := GetDC(0);
  try
    Canva.Handle := DC;
    with Screen do
    begin
      B.Width := Width;
      B.Height := Height;
      B.Canvas.CopyRect(Rect(0, 0, Width, Height),
      Canva, Rect(0, 0, Width, Height));
      B.SaveToFile('c:\Мои документы\screentofile.bmp');
    end
  finally
    ReleaseDC(0, DC);
    B.Free;
    Canva.Free
  end
end;

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    b:TBitmap;
    curX:longint;
    procedure DoPaint;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
     b:=TBitmap.Create;
     b.Width:=Paintbox1.Width;
     b.Height:=Paintbox1.Height;
     b.PixelFormat:=pf32bit;
     curX:=0;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
     b.Free;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
     curX:=curX+1;
     if curX>PaintBox1.Width then curX:=0;
     DoPaint;
end;

procedure TForm1.DoPaint;
begin
     {}
     b.Canvas.Brush.Color:=clBlack;
     b.Canvas.FillRect(rect(0,0,b.Width,b.Height));
     b.Canvas.Pen.Color:=clWhite;
     b.Canvas.MoveTo(curX,0);
     b.Canvas.LineTo(curX,PaintBox1.Height);
     PaintBox1.Canvas.Draw(0,0,b);

end;

end.

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

uses JPEG;

procedure TForm1.Button1Click(Sender: TObject);
var
JPEG: TJPEGImage;
Bitmap: TBitmap;
begin
JPEG := TJPEGImage.Create;
Bitmap := TBitmap.Create;
try
Bitmap.LoadFromFile('C:\Program Files\Common Files\alarm.bmp');
JPEG.Assign(Bitmap);
Image1.Picture.Assign(JPEG);
finally
JPEG.Free;
Bitmap.Free;
end;
end;

end.

JpegIm.CompressionQuality := 20;
JpegIm.Compress;

var
  DC: HDC;
  Canva: TCanvas;
  B: TBitmap;
  JPG: TJPEGImage
begin
  Canva := TCanvas.Create;
  B := TBitmap.Create;
  DC := GetDC(0);
  try
    Canva.Handle := DC;
    with Screen do
    begin
      B.Width := Width;
      B.Height := Height;
      B.Canvas.CopyRect(Rect(0, 0, Width, Height),
      Canva, Rect(0, 0, Width, Height));
      JPG.Assign(B);
      JPG.CompressionQuality := 95;
      JPG.SaveToFile('c:\Мои документы\screentofile.jpg');
    end
  finally
    ReleaseDC(0, DC);
    B.Free;
    Canva.Free
  end
end;

  protected
    procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;

var q: Boolean;
q := ( (year mod 4) = 0 ) and ( ( (year mod 100) <> 0 ) or ( (year mod 400) = 0 ) );
if q then // високосный
else //не високосный