unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, ComCtrls, Unit2; type TForm1 = class(TForm) procedure FormDestroy(Sender: TObject); procedure FormCreate(Sender: TObject); private procedure WMHotkey(var msg: TWMHotkey); message WM_HOTKEY; end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.WMHotkey(var msg: TWMHotkey); begin Unit2.Form2.Show; end; procedure TForm1.FormDestroy(Sender: TObject); begin UnregisterHotKey(Self.Handle, 1); end; procedure TForm1.FormCreate(Sender: TObject); begin If not RegisterHotkey(Self.Handle, 1, MOD_CONTROL, VK_F1) then begin ShowMessage('Impossible de créer la hotkey sur ctrl + espace'); Application.Terminate; end; end; end.
unit Unit2; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, ExtCtrls; type TForm2 = class(TForm) Image1: TImage; StatusBar1: TStatusBar; procedure FormCreate(Sender: TObject); procedure FormShow(Sender: TObject); procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); private nLeft: Integer; nTop: Integer; nRight: Integer; nBottom: Integer; bMouseDown: Boolean; public { Déclarations publiques } end; var Form2: TForm2; implementation {$R *.dfm} procedure TForm2.FormCreate(Sender: TObject); begin Self.BorderStyle:= bsNone; Self.WindowState:= wsMaximized; StatusBar1.SimplePanel:= True; bMouseDown:= False; end; procedure TForm2.FormShow(Sender: TObject); var hDesktopDC: HDC; hDesktop: THandle; begin Image1.Picture.Bitmap.Width:= Screen.Width; Image1.Picture.Bitmap.Height:= Screen.Height; Image1.Width:= Screen.Width; Image1.Height:= Screen.Height; Image1.Top:= 0; image1.Left:= 0; hDesktop:= GetDesktopWindow; hDesktopDC:= GetDC(hDesktop); try BitBlt(Image1.Picture.Bitmap.Canvas.Handle, 0, 0, Screen.Width, Screen.Height, hDesktopDC, 0, 0, SrcCopy); finally ReleaseDC(hDesktop, hDesktopDC); end; end; procedure TForm2.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if bMouseDown then begin Canvas.Pen.Mode:= pmNot; Canvas.Pen.Width:= 1; Canvas.Brush.Style:= bsClear; Canvas.Rectangle(nLeft, nTop, nRight, nBottom); nRight:= X; nBottom:= Y; Canvas.Rectangle(nLeft, nTop, nRight, nBottom); StatusBar1.SimpleText:= IntToStr(Abs(nRight - nLeft)) + ' ' + IntToStr(Abs(nBottom - nTop)); end; end; procedure TForm2.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin nLeft:= X; nTop:= Y; nRight:= X; nBottom:= Y; bMouseDown:= True; end; procedure TForm2.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if bMouseDown then begin bMouseDown:= False; Canvas.Pen.Mode:= pmNot; Canvas.Brush.Style:= bsClear; Canvas.Rectangle(nLeft, nTop, nRight, nBottom); end; end; end.
procedure TForm1.Timer1Timer(Sender: TObject); var ScreenPt : TPoint; H : THandle; WinRect : TRect; begin if GetKeyState(VK_LBUTTON) < 0 then begin GetCursorPos(ScreenPt); //On récupère la position du curseur à l'écran. H := WindowFromPoint(ScreenPt);//On récupère le handle de la fenêtre survolée. GetWindowRect(H, WinRect); //On récupère la taille de cette fenêtre. Edit1.Text := 'Larg= ' +IntToStr(WinRect.Right-WinRect.Left) + ' Haut= '+IntToStr(WinRect.Bottom-WinRect.Top); end else Edit1.Text := ''; end;
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question