中国IT动力,最新最全的IT技术教程
最新100篇 | 推荐100篇 | 专题100篇 | 排行榜 | 搜索 | 在线API文档 | 网通镜像
首 页 | 程序开发 | 操作系统 | 软件应用 | 图形图象 | 网络应用 | 精文荟萃 | 教育认证 | 硬件维护 | 未整理篇 | 站长教程
ASP JS PHP工程 ASP.NET 网站建设 UML J2EESUN .NET VC VB VFP 网络维护 数据库 DB2 SQL2000 Oracle Mysql
服务器 Win2000 Office C DreamWeaver FireWorks Flash PhotoShop 上网宝典 CorelDraw 协议大全 网络安全 微软认证
硬件维护  CPU  主板  硬盘  内存  显卡  显示器  键盘鼠标  声卡音箱  打印机  机箱电源  BIOS  网卡  C#  Java  Delphi  vs.net2005
  当前位置:> 程序开发 > 编程语言 > 综合其它
Delphi: A Cool and Easy Method for Resizing and Mo
作者:未知 时间:2005-09-13 23:34 出处:Blog.ChinaUnix.net 责编:chinaitpower
              摘要:Delphi: A Cool and Easy Method for Resizing and Mo

A Cool and Easy Method for Resizing and Moving Controls at Run Time

Whilst browsing the newsgroups I came across this very useful article by Brent Eagles describing how to enable your own components to be resized and moved around at run time (like when you design your forms in the Delphi IDE). If you find this useful I am sure Brent would appreciate any feedback. I think that is enough said by me so read and enjoy.

I was hacking at one of my software projects and was trying to come up with a way to allow the user to resize my controls onscreen with the mouse. I knew the way to code it, but didn't care for it very much. While I was eating my supper (PIZZA!) I was flipping through a couple of TI's I had downloaded from Borland's sight. TI2909 caught my eye, it described a way to make a control moveable at run time by using a magic number as a WPARAM to a WM_SYSCOMMAND message. The value was a variation on the standard SC_MOVE parameter (SC_MOVE+2). I tried it and it worked. I said to myself "Cool! But what would make it really neat is if I could resize it too."

In the WinAPI help file I noticed that there was a standard SC_SIZE parameter. I thought to myself "Wouldn't it be something if I could make the control re sizeable just by using SC_SIZE+n?" Guess What! You CAN! Now this may be documented somewhere or even common knowledge but I didn't know about it and couldn't find it anywhere so I figured it is undocumented, unknown and too cool to keep to myself.

If people want to pass it on, that's great, but I would like them to show who it came from. I am little known programmer in Atlantic Canada trying to make his way to fame.

Here are the parameters and a piece of source showing how I used them:


unit AnalysisControl;

interface

uses Winprocs, Messages, Graphics, Controls, Classes;

type
 TAnalysisControl = class( TCustomControl)
  public
    constructor Create(AOwner: TComponent); override;
    procedure MouseDown( Button : TMouseButton; 
                          Shift : TShiftState;
                          X, Y : integer); override;
    procedure MouseMove( Shift : TShiftState;
                          X, Y : Integer);override;
    procedure Paint; override;
  end;

implementation

const
  sizeBorder = 2;
  sc_SizeLeft              = $F001;  { these are the variations }
  sc_SizeRight           = $F002;  { on the SC_SIZE value }
  sc_SizeTop             = $F003;
  sc_SizeTopLeft       = $F004;
  sc_SizeTopRight     = $F005;
  sc_SizeBottom         = $F006;
  sc_SizeBottomRight  = $F008;
  sc_SizeBottomLeft   = $F007;
  sc_DragMove          = $F012;


constructor TAnalysisControl.Create(AOwner: TComponent);
begin
    inherited;
    Width := 100;
    Height := 100;

end;

procedure TAnalysisControl.MouseDown( Button : TMouseButton;
                                      Shift : TShiftState;
                                      X, Y : integer);
begin
  if Button = mbLeft then
  begin
   WinProcs.ReleaseCapture;
    if(X >= Width - sizeBorder) And
       NOT((Y <= sizeBorder)  or (Y >= Height -sizeBorder)) then
       Self.Perform(WM_SysCommand, sc_SizeRight, 0)
    else
    if Not((X <= sizeBorder) or (X >= Width -sizeBorder)) And
       (Y <= sizeBorder) then
       Self.Perform(WM_SysCommand, sc_SizeTop, 0)
    else
    if (X <= sizeBorder) And (Y <= sizeBorder) then
       Self.Perform(WM_SysCommand, sc_SizeTopLeft, 0)
    else
    if (X >= Width -sizeBorder) and (Y <= sizeBorder) then
       Self.Perform(WM_SysCommand, sc_SizeTopRight , 0)
    else
    if Not((X <= sizeBorder) or (X >= Width -sizeBorder)) And
       (Y >= Height - sizeBorder)  then
       Self.Perform(WM_SysCommand, sc_SizeBottom , 0)
    else
    if (Y >= Height -sizeBorder)  And (X <= sizeBorder)  then
       Self.Perform(WM_SysCommand, sc_SizeBottomLeft , 0)
    else
    if (Y >= Height -sizeBorder) and (X >= Width - sizeBorder)
then
       Self.Perform(WM_SysCommand, sc_SizeBottomRight , 0)
    else
    if Not((Y <= sizeBorder) or (Y >= Height -sizeBorder)) And
       (X <= sizeBorder)  then
       Self.Perform(WM_SysCommand, sc_SizeLeft , 0)
    else
    begin
       Self.Perform(WM_SysCommand, SC_DragMove, 0);
    end;
  end;
end;

procedure TAnalysisControl.Paint;
begin
   With Canvas do
   begin
      Brush.Color := clRed;
      Brush.Style := bsSolid;
      FillRect( GetClientRect );
   end;
end;

procedure TAnalysisControl.MouseMove( Shift : TShiftState;
                                      X, Y : Integer );

begin
   if ( X <= sizeBorder ) or ( X >= Width -sizeBorder ) then
   begin
      if ( Y >= Height - sizeBorder ) then
      begin
        if ( X >= Width - sizeBorder ) then
          Cursor := crSizeNWSE
        else
          Cursor := crSizeNESW;
      end
      else
      if ( Y <= sizeBorder ) then
      begin
        if ( X >= Width -sizeBorder ) then
          Cursor := crSizeNESW
        else
          Cursor := crSizeNWSE;
      end
      else
        Cursor := crSizeWE;
   end
   else
   if ( Y <= sizeBorder ) or ( Y >= Height - sizeBorder ) then
   begin
      Cursor := crSizeNS;
   end
   else
      Cursor := crDefault;
end;


end.
关闭本页
 
首页 | 投资与合作 | 服务条款 | 隐私政策 | 收藏本站 | 设为首页 | 新用户注册 | 免责声明 | 使用帮助
Copyright ©2005-2008 chinaitpower.com All rights reserved. www.chinaitpower.com 版权所有