Модератор: Модераторы
// ******************************//
// * блокировка изменения формы *//
// ******************************//
unit myLockWindow;
{$mode objfpc}
interface
uses
Classes, SysUtils, Graphics, Forms, ExtCtrls, LCLType, LCLIntf, Controls;
function myLockWindowOn(Form: TForm): Boolean;
procedure myLockWindowOff;
implementation
var
Bitmap: TBitmap;
Panel: TPanel;
Image: TImage;
// получение "фотки" формы и отрисовка изображения
function myLockWindowOn(Form: TForm): Boolean;
var
ScreenDC: HDC;
begin
Result := True;
try
Bitmap := TBitmap.Create;
Bitmap.Width := Form.Width;
Bitmap.Height := Form.Height;
ScreenDC := GetDC(Form.Handle);
try
Bitmap.LoadFromDevice(ScreenDC);
finally
ReleaseDC(0, ScreenDC);
end;
Panel := TPanel.Create(Form);
Panel.Visible := False;
Panel.Parent := Form;
Image := TImage.Create(Form);
Image.Parent := Panel;
Image.Picture.Bitmap := Bitmap;
Image.Left := 0;
Image.Top := 0;
Image.Width := Form.Width;
Image.Height := Form.Height;
Panel.BringToFront;
Panel.Align := alClient;
Panel.Visible := True;
except
Result := False;
Bitmap.Free;
Bitmap := nil;
Image.Free;
Image := nil;
Panel.Free;
Panel := nil;
raise;
end;
end;
// закрытие рисунка
procedure myLockWindowOff;
begin
if Panel <> nil then
begin
Panel.SendToBack;
Panel.Visible := False;
Bitmap.Free;
Bitmap := nil;
Image.Free;
Image := nil;
Panel.Free;
Panel := nil;
end;
end;
end.
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 231