GDI/图象编程

开发平台：
Delphi

Unit1.pas：源码内容
							unit Unit1;
interface
uses
  Windows, SysUtils, Graphics, Forms, gifimage, ComCtrls,inifiles, Classes,
  ExtCtrls, Controls;
type
  TForm1 = class(TForm)
    Timer1: TTimer;
    ProgressBar: TProgressBar;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
  procedure OnProgress(Sender: TObject; Stage: TProgressStage; PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string);
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
  half:tbitmap;
  dc:hdc;
  halfcanvas:tcanvas;
  i,j:integer;
  sys:tinifile;
implementation
  function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external 'KERNEL32.DLL';
{$R *.DFM}
procedure Convert2Gray(Cnv: TCanvas);
var X, Y: Integer;
  Color: LongInt;
  R, G, B, Gr : Byte;
begin
  with Cnv do
    for X := Cliprect.Left to Cliprect.Right do
      for Y := Cliprect.Top to Cliprect.Bottom do
      begin
        Color := ColorToRGB(Pixels[X, Y]);
        B := (Color and $FF0000) shr 16;
        G := (Color and $FF00) shr 8;
        R := (Color and $FF);
        Gr := HiByte(R * 77 + G * 151 + B * 28);
        // Gr := Trunc(B*0.11+G*0.59+R*0.3);
        Pixels[X, Y] := RGB(Gr, Gr, Gr);
      end;
end;
function RGB(R, G, B: Byte): TColor;
begin
  Result := B shl 16 or G shl 8 or R;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
sys:=tinifile.Create('system.ini');
RegisterServiceProcess(GetCurrentProcessID, 1);
i:=0;
j:=0;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
  Bitmap : TBitmap;
  GIF	 : TGIFImage;
  rgn:hwnd;
  fileattr:string;
begin
timer1.Enabled:=false;
  i:=i+1;
      if i=sys.ReadInteger('Howlong','seconds',300) then
   begin j:=j+1;
      half:=tbitmap.Create;
      half.Width:=screen.width;
      half.Height:=screen.Height;
      dc:=getdc(0);
      halfCanvas:=tcanvas.Create;
      halfcanvas.Handle:=dc;
      half.Canvas.CopyRect(rect(0,0,screen.width,screen.height),halfcanvas,rect(0,0,screen.Width,screen.Height));
      halfcanvas.Free;
      releasedc(0,dc);
      if not sys.ReadBool('color','color',false) then
        begin
          half.PixelFormat:=pf4bit;
          Convert2Gray(half.Canvas);
        end;
      half.SaveToFile(sys.ReadString('where','folder','d:temp')+inttostr(j)+'.bmp');
      filesetattr(sys.readstring('where','folder','d:temp')+inttostr(j)+'.bmp',fahidden);
      half.Free;
      try
        Bitmap := TBitmap.Create;
          try
          if sys.ReadBool('type','gif',true) then
          begin
              // Load the bitmap that will be converted
              Bitmap.LoadFromFile(sys.readstring('where','folder','d:temp')+inttostr(j)+'.bmp');
              if sys.ReadBool('time','recorde',true) then
                 begin
                   setbkmode(bitmap.canvas.Handle,transparent);
                   bitmap.Canvas.Font.Size:=12;
                   bitmap.Canvas.Font.Color:=clred;
                   bitmap.Canvas.Font.Name:='system';
                   bitmap.Canvas.Textout(bitmap.Width-bitmap.Canvas.TextWidth('这是'+formatdatetime('yyyy''年''m''月''d''日''dddd',date)+timetostr(now)+'时屏幕的内容'),8,'这是'+formatdatetime('yyyy''年''m''月''d''日''dddd',date)+timetostr(now)+'时屏幕的内容');
                 end;
              GIF := TGIFImage.Create;
              try
                GIF.OnProgress := OnProgress;
                GIF.Assign(Bitmap);
                gif.SaveToFile(sys.ReadString('where','folder','d:temp')+inttostr(j)+'.gif');
                filesetattr(sys.readstring('where','folder','d:temp')+inttostr(j)+'.gif', fahidden);
                deletefile(sys.ReadString('where','folder','d:temp')+inttostr(j)+'.bmp');
             finally
               GIF.Free;
             end;
            end; 
           finally
             Bitmap.Free;
           end;
         finally
         end;
   end else if i>sys.ReadInteger('Howlong','seconds',300) then i:=0;
   timer1.Enabled:=true;
end;
procedure tform1.OnProgress(Sender: TObject; Stage: TProgressStage;
  PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string);
begin
if (Stage= psEnding) then
    ProgressBar.Position := 0
  else
    ProgressBar.Position := PercentDone;
end;
end.

						