Мерцание

// в interface формы
procedure WMExitSz(var msg: TMessage); message WM_EXITSIZEMOVE;
procedure WMSz(var msg: TMessage); message WM_SIZE;
procedure WMPos(var msg: TMessage); message WM_WINDOWPOSCHANGED;
 
// в implementation
procedure TForm1.WMExitSz(var msg: TMessage);
begin
  // окончание изменения размера/перемещения
  ShowMessage('ExitSzMove');
end;
 
procedure TForm1.WMPos(var msg: TMessage);
begin
  // любое изменение
  ShowMessage('Pos');
end;
 
procedure TForm1.WMSz(var msg: TMessage);
begin
  // изменение размера/восстановление из развернутого/развертывание
  ShowMessage('Sz');
end;
// еще есть WM_MOVING, WM_SIZING, WM_GETMINMAXINFO и другие

procedure TForm1.WMExitSz(var msg: TMessage);
begin
  // окончание изменения размера/перемещения
  ShowMessage('ExitSzMove');
end;

  if form1.WindowState=wsMaximized then
  ShowMessage('q');

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    flag,maxFlag,minFlag:boolean;
    procedure WMExitSz(var msg: TMessage); message WM_EXITSIZEMOVE;
    procedure My_WM_ENTERSIZEMOVE(var msg: TMessage); message WM_ENTERSIZEMOVE;
    //procedure WMSysCommand(var Msg: TWMSysCommand);message WM_SYSCOMMAND;
    procedure My_WM_SIZE(var Msg:TMessage );message WM_SIZE;
  public
    { Public declarations }
 
  procedure q(Sender: TObject);
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
{procedure TForm1.WMSysCommand(var Msg: TWMSysCommand);
begin
    //if (Msg.CmdType = SC_MINIMIZE) then
  //ListBox1.AddItem('SC_MINIMIZE',nil);
  //if (Msg.CmdType = SC_MAXIMIZE) then
  //ListBox1.AddItem('SC_MAXIMIZE',nil);
  //if (Msg.CmdType = SC_RESTORE) then
  //ListBox1.AddItem('SC_RESTORE',nil);
inherited;
end;}
 
procedure TForm1.FormCreate(Sender: TObject);
begin
flag:=false;
maxFlag:=false;
minFlag:=false;
end;
 
procedure TForm1.q(Sender: TObject);
begin
ShowMessage('qwe');
end;
 
procedure TForm1.WMExitSz(var msg: TMessage);
begin
  if flag then
  ListBox1.AddItem(('WMExitSz'),nil);
inherited;
end;
 
procedure TForm1.My_WM_ENTERSIZEMOVE(var msg: TMessage);
var
p:tpoint;
q:integer;
begin
GetCursorPos(p);
q:=SendMessage(form1.Handle,WM_NCHITTEST,0,MAKELPARAM(p.X,p.Y));
flag:=true;
  if q=HTCAPTION then
  flag:=false;
inherited;
//ListBox1.AddItem('HTCAPTION',nil);
end;
 
procedure tform1.My_WM_SIZE(var Msg:TMessage );
begin
inherited;
  if maxFlag then
  begin
  ListBox1.AddItem('WM_SIZE+Normal+maxFlag',nil);
  maxFlag:=false;
  end;
  if minFlag then
  begin
  ListBox1.AddItem('WM_SIZE+Normal+minFlag',nil);
  minFlag:=false;
  end;
  if form1.WindowState=wsMaximized then
  begin
  ListBox1.AddItem('WM_SIZE+wsMaximized',nil);
  maxFlag:=true;
  end;
  if form1.WindowState=wsMinimized then
  begin
  ListBox1.AddItem('WM_SIZE+wsMinimized',nil);
  minFlag:=true;
  end;
end;
 
end.

unit unit2;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ActnList, StdCtrls, StdActns, AppEvnts;
 
type
  TOnSpecResize = procedure (sMsg:string) of object;
  MyApplicationEvents=class(TApplicationEvents)
  private
    { Private declarations }
    FOnSpecResize:TOnSpecResize;
    flag,maxFlag,minFlag:boolean;
    procedure Message1(var Msg: tagMSG; var Handled: Boolean);// override;
    procedure DoSpecResize(sMsg:string);
  public
    { Public declarations }
  procedure M();
  property OnSpecResize: TOnSpecResize read FOnSpecResize write FOnSpecResize ;
  end;
implementation
 
procedure MyApplicationEvents.M();
begin
flag:=false;
maxFlag:=false;
minFlag:=false;
OnMessage:=Message1;
//OutputDebugString('qwe');
end;
 
procedure MyApplicationEvents.Message1(var Msg: tagMSG;
  var Handled: Boolean);
var
p:tpoint;
q:integer;
begin
{  if (Msg.message = WM_NCRBUTTONDOWN) then
  begin
  inherited;
  OutputDebugString('WM_NCRBUTTONDOWN');
  end;}
//inherited;
 
OutputDebugString(pansichar(IntToStr(msg.message)));
  if msg.message=5 then
  begin
  OutputDebugString('qwe');
  inherited;
  end;
 
  if msg.message=WM_SIZE then
  begin
  //OutputDebugString('qwe');
    if maxFlag then
    begin
    DoSpecResize('WM_SIZE+Normal+maxFlag');
    maxFlag:=false;
    end;
    if minFlag then
    begin
    DoSpecResize('WM_SIZE+Normal+minFlag');
    minFlag:=false;
    end;
    if tform(Owner).WindowState=wsMaximized then
    begin
    DoSpecResize('WM_SIZE+wsMaximized');
    maxFlag:=true;
    end;
    if tform(Owner).WindowState=wsMinimized then
    begin
    DoSpecResize('WM_SIZE+wsMinimized');
    minFlag:=true;
    end;
  end;
  if msg.message=WM_EXITSIZEMOVE then
  begin
      if flag then
      DoSpecResize('WMExitSz');
      inherited;
  end;
  if msg.message=WM_ENTERSIZEMOVE then
  begin
  GetCursorPos(p);
  q:=SendMessage(tform(owner).Handle,WM_NCHITTEST,0,MAKELPARAM(p.X,p.Y));
  flag:=true;
      if q=HTCAPTION then
      flag:=false;
  inherited;
  end;
end;
 
procedure MyApplicationEvents.DoSpecResize(sMsg:string);
begin
  if assigned(FOnSpecResize) then
  FOnSpecResize(sMsg);
//OutputDebugString('qwe');
end;
 
end.

procedure TPhotoLV.A_ReDrawListView();
var
i:integer;
begin
try
items.Clear;
finally
Items.EndUpdate;
end;
  if iImgCountForMas=0 then exit;
items.BeginUpdate;
  for i:=0 to iImgCountForMas-1 do
  begin
  AddItem(masImgRec[i].FileName,nil);
  Items.Item[i].ImageIndex:=i;
  Items.Item[i].Checked:=masImgRec[i].checked;
  end;
items.EndUpdate;
end;
 
procedure TPhotoLV.Resize();
var
l,t:integer;
begin
  if iImgCountForMas>0 then
  A_ReDrawListView();
  if iCurItemIndex>-1 then
  ItemIndex:=iCurItemIndex;
  if ItemIndex=-1 then exit;
  SetImgSize;
end;
 
procedure TPhotoLV.SetImgSize();//Установить размер рисунка
var
k:double;
begin
k:=1;
img.AutoSize:=true;
  if img.Width>(Width div 2) then
  k:=img.Width/(Width div 2);
  if (img.Height/k)>(Height div 2) then
  k:=((img.Height/k/(Height div 2))*k);
img.AutoSize:=false;
img.Width:=round(img.Width/k);
img.Height:=round(img.Height/k);
panel.Width:=img.Width;
panel.Height:=img.Height;
end;

type
  TOnSzEvent = procedure(Sender: TObject; NewClientWidth, NewClientHeight: Word) of object;
 
type
  // меняя тип класса - предка, получаем нужный
  // здесь взят TMemo, но лучше брать классы с префиксом Custom
  TMyClass = class(TMemo)
  private
    FOnSize: TOnSzEvent;
    procedure WMSize(var m: TMessage); message WM_SIZE;
  published
    property OnSzEvent: TOnSzEvent read FOnSize write FOnSize;
  end;
 
type
  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    sample1: TMyClass;
    Splitter1: TSplitter;
 
    // подмена WndProc
    OldWndProc: LongInt;
    procedure NewWndProc(var m: TMessage);
    procedure SubClassing;
 
    // использование Delphi-свойства
    procedure ObjResize(Sender: TObject; NewClientWidth, NewClientHeight: Word);
  public
 
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.DFM}
 
// всякая лабуда
procedure TForm1.FormCreate(Sender: TObject);
begin
  Memo1.Align := alTop;
  Memo1.Lines.Clear;
  SubClassing;
 
  Splitter1 := TSplitter.Create(Self);
  with Splitter1 do begin
    Parent := Self;
    Align := alTop;
    Visible := True;
  end;
 
  sample1 := TMyClass.Create(Self);
  with sample1 do begin
    Parent := Self;
    Align := alClient;
    OnSzEvent := ObjResize;
    Lines.Clear;
    Visible := True;
  end;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  sample1.Free;
  Splitter1.Free;
end;
 
// что касается субклассинга
procedure TForm1.NewWndProc(var m: TMessage);
begin
  with m do begin
    if Msg = WM_SIZE then
      Memo1.Lines.Add(FormatDateTime('nn:ss', Time) + Format('=%d:%d', [LOWORD(LParam), HiWord(LParam)]));
  //else - если полностью обработаем все связанное с изменением размера элемента
  //       иначе - все равно вызовем стандартную обработку
    Result := CallWindowProc(Pointer(OldWndProc), Memo1.Handle, Msg, WParam, LParam);
  end;
end;
 
function NotObjMethodWndProc(wHandle: HWND; msg: LongWord; wParam: Integer; lParam: Integer): Integer; stdcall; // обязательно stdcall
begin
  if msg = WM_SIZE then
    Form1.Memo1.Lines.Add(FormatDateTime('nn:ss', Time) + Format('=%d:%d', [LOWORD(lParam), HIWORD(lParam)]));
  Result := CallWindowProc(Pointer(Form1.OldWndProc), wHandle, msg, wParam, lParam);
end;
 
procedure TForm1.SubClassing;
begin
  // если обработчик - в составе класса
  OldWndProc := SetWindowLong(Memo1.Handle, GWL_WNDPROC, LongInt(MakeObjectInstance(NewWndProc)));
  // если обработчик - отдельная фунция
  // OldWndProc := SetWindowLong(Memo1.Handle, GWL_WNDPROC, LongInt(@NotObjMethodWndProc));
end;
 
// -----------------------------------------------------------------------------
// собственно, только то, что нужно
procedure TMyClass.WMSize(var m: TMessage);
var
  W, H: Word;
begin
  if Assigned(FOnSize) then begin
    W := LOWORD(m.lParam);
    H := HIWORD(m.lParam);
    FOnSize(Self, W, H);
  end;
end;
 
procedure TForm1.ObjResize(Sender: TObject; NewClientWidth, NewClientHeight: Word);
begin
  sample1.Lines.Add(FormatDateTime('nn:ss', Time) + Format('=%d:%d', [NewClientWidth, NewClientHeight]));
end;