解决了。
var a,b:boolean;
a:=false;b:=false;
procedure TForm1.FormCanResize(Sender: TObject; var NewWidth,
NewHeight: Integer; var Resize: Boolean);
begin
if NewHeight <> Height then
if b then NewHeight := trunc(NewWidth/1.5)
else
begin
a:=true;
NewWidth := trunc(NewHeight * 1.5);
end
else if newwidth<>width then
if a then NewWidth := trunc(NewHeight * 1.5)
else
begin
b:=true;
NewHeight := trunc(NewWidth/1.5);
end;
end;
procedure WMEXITSIZEMOVE(var Message: TMessage);
message WM_EXITSIZEMOVE;
procedure TForm1.WMEXITSIZEMOVE(var Message: TMessage);
begin
a:=false;
b:=false;
end;
感谢张工,WM_EXITSIZEMOVE这条消息是他提供的。
在高手眼里,我的程序可能有点笨。我的水平也就这样了,
请大家多多包涵。