unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,ClipBrd, ExtCtrls,Jpeg,ShellAPI, Menus;
    //fuentes delphiacces,seoane,delphiallimite y muchos masss!!



type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    PopupMenu1: TPopupMenu;
    restaurarventana1: TMenuItem;
    capturaryguardar1: TMenuItem;
    salir1: TMenuItem;
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
 
    procedure restaurarventana1Click(Sender: TObject);
    procedure salir1Click(Sender: TObject);
    procedure Minimizar;
     procedure Icontray(var Msg: TMessage);
    procedure capturaryguardar1Click(Sender: TObject);
  private
    { Private declarations }
      IconData: TNotifyIconData;

     procedure WMSysCommand( var Msg: TWMSysCommand ); message WM_SYSCOMMAND;
 procedure Restaurar( var Msg: TMessage ); message WM_USER+1;


  public
    { Public declarations }
  end;

var
  Form1: TForm1;



implementation

{$R *.dfm}
    procedure Tform1.WMSysCommand( var Msg: TWMSysCommand );
begin
  if Msg.CmdType = SC_MINIMIZE then
   Minimizar
  else
    DefaultHandler( Msg );
end;

    procedure tform1.Minimizar;
begin
  with IconData do
  begin
    cbSize := sizeof( IconData );
    Wnd := Handle;
    uID := 100;
    uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
    uCallbackMessage := WM_USER + 1;

    // Usamos de icono el mismo de la aplicación
    hIcon := Application.Icon.Handle;

    // Como Hint del icono, el nombre de la aplicación
    StrPCopy( szTip, Application.Title );
  end;

  // Ponemos el icono al lado del reloj
  Shell_NotifyIcon( NIM_ADD, @IconData );

  // Ocultamos el formulario
  Hide;
end;

procedure TForm1.Icontray(var Msg: TMessage);
var
  CursorPos : TPoint;
begin
  if Msg.lParam = WM_RBUTTONDOWN then begin
    GetCursorPos(CursorPos);
    PopupMenu1.Popup(CursorPos.x, CursorPos.y);
  end else
    inherited;
end;

procedure TForm1.Restaurar( var Msg: TMessage );
var p: TPoint;
begin
  // ¿Ha pulsado el botón izquierdo del ratón?
  if Msg.lParam = WM_LBUTTONDOWN then
    restaurarventana1Click( Self );

  // ¿Ha pulsado en la bandeja del sistema con el botón derecho del ratón?
  if Msg.lParam = WM_RBUTTONDOWN then
  begin
    SetForegroundWindow( Handle );
    GetCursorPos( p );
     PopupMenu1.Popup( p.x, p.y );
    PostMessage( Handle, WM_NULL, 0, 0 );
  end;
end;


procedure TForm1.Button1Click(Sender: TObject);
 var

 DC: HDC;
   Bmp: Tbitmap;
begin



Bmp:= TBitmap.Create;
  try
     with Bmp do
         begin
              Width:= GetSystemMetrics(SM_CXSCREEN);
                    Height:= GetSystemMetrics(SM_CYSCREEN);
                          Dc:= GetDC(GetDesktopWindow);
                                try
   BitBlt(Canvas.Handle, 0, 0, Width, Height, Dc, 0, 0, SRCCOPY);
         finally
       ReleaseDC(GetDesktopWindow,Dc);
        end;
     Clipboard.Assign(Bmp);
      Image1.Picture.Assign(bmp);
     end;
    finally
    Bmp.free;
end;
 end;






procedure TForm1.Button2Click(Sender: TObject);
var

  foto: TJPEGImage;


begin
foto := TJPEGImage.Create;
  // assign the bitmap to the jpeg, this converts the bitmap
  foto.Assign(Image1.Picture.Bitmap);
  // and save it to file
    foto.CompressionQuality := 75;

  foto.SaveToFile('foto de timage.jpg');

end;


procedure TForm1.FormCreate(Sender: TObject);
begin

image1.Stretch:=true;

end;

procedure TForm1.restaurarventana1Click(Sender: TObject);
begin
  // Volvemos a mostrar de nuevo el formulario
  Form1.Show;
  ShowWindow( Application.Handle, SW_SHOW );

  // Eliminamos el icono de la bandeja del sistema
  Shell_NotifyIcon( NIM_DELETE, @IconData );
  IconData.Wnd := 0;


end;

procedure TForm1.salir1Click(Sender: TObject);
begin
 Shell_NotifyIcon(NIM_DELETE,@IconData);
  Application.ProcessMessages;
  Application.Terminate;

end;

procedure TForm1.capturaryguardar1Click(Sender: TObject);
var
  DC: HDC;
  Bmp: Tbitmap;
  Jpg: TJPEGImage;
begin
  Bmp:= TBitmap.Create;
  Jpg:= TJPEGImage.Create;
  try
    with Bmp do
    begin
      Width:= GetSystemMetrics(SM_CXSCREEN);
      Height:= GetSystemMetrics(SM_CYSCREEN);
      Dc:= GetDC(GetDesktopWindow);
      try
        BitBlt(Canvas.Handle, 0, 0, Width, Height, Dc, 0, 0, SRCCOPY);
      finally
        ReleaseDC(GetDesktopWindow,Dc);
      end;
    end;
    with Jpg do
    begin
      Assign(Bmp);
      CompressionQuality:= 60;
      Compress;
      SaveToFile('foto.jpg');
    end;
  finally
    Bmp.free;
    Jpg.free;
  end;
end;




end.
paresco malo ,pero soy bueno
Responder

Volver a “Fuentes”