当前位置:主页>仓库管理软件> 列表

客户想在程序运行的时候新建、拖动Edit、Lable等简单 找进销存系统源码

记账软件版1楼: 1. 要求可以新建
2. 点击控件的时候,有象delphi设计界面上一样,在控件四个角上有小黑点
3. 可以保存控件位置,下次运行自动产生控件

以前见过一个极酷的仿Delphi开发环境的DEMO,不知道谁有,可否恭喜一下,给个下载地址研究研究!

2楼: 这个应该保存到流中
启动程序时,从流中读出来 如进销存系统源码

3楼: 有程序運行時設計控件,像在DELPHI設計時一樣具有各項屬性。
到網站上下載:http://www.delphifans.com htpp:/www.2ccc.com

4楼: to bbscom : 能具体点吗?不知道从哪里查起?

5楼: 自已用代码已实现;并且是将信息保存到后台数据库中;

6楼: 找个地方存放这些控件的类型 font caption left top height width 等等信息,然后根据这些信息,在显示窗体前,动态生成控件。

记账软件版7楼: 看我的:
unit Unit2;


interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
TSizerControl = class(TCustomControl)
private
FControl: TControl;
FRectList: Array [1..8] of TRect;


FPosList: Array [1..8] of Integer;

{ Private declarations }
protected
{ Protected declarations }
public
constructor Create(AOwner: TComponent; AControl: TControl);
procedure CreateParams(var Params: TCreateParams); override;
procedure Createhandle;override;
procedure WmNcHitTest(var Msg: TWmNcHitTest); message wm_NcHitTest;
procedure WmSize(var Msg:TWmSize); message wm_Size;
procedure WmLButtonDown(var Msg: TWmLButtonDown); message wm_LButtonDown;
procedure WmMove(var Msg: TWmMove); message Wm_Move;
procedure Paint; override;
procedure SizeControlExit(Sender: TObject);

{ Public declarations }
published
{ Published declarations }
end;
const
sc_DragMove: Longint = $F012;


procedure Register;

implementation

constructor TSizerControl.Create(AOwner: TComponent; AControl: TControl);
var
R: TRect;
begin
inherited Create(AOwner);
FControl := AControl;
OnExit := SizeControlExit;

R := FControl.BoundsRect;
InflateRect(R, 2, 2);
BoundsRect := R;
Parent := FControl.Parent;
FPosList[1] := htTopLeft;
FPosList[2] := htTop;
FPosList[3] := htTopRight;
FPosList[4] := htRight;
FPosList[5] := htBottomRight;
FPosList[6] := htBottom;
FPosList[7] := htBottomLeft;
FPosList[8] := htLeft;

end;
procedure TSizerControl.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
//增加透明特性
Params.ExStyle := Params.ExStyle
+ WS_EX_TRANSPARENT;
end;

procedure TSizerControl.Createhandle;
begin
inherited Createhandle;
SetFocus;
end;

procedure TSizerControl.WmNcHitTest(var Msg: TWmNcHitTest);
var
Pt: TPoint;
I: Integer;
begin
Pt := Point(Msg.XPos, Msg.YPos);
Pt := ScreenToClient(Pt);
Msg.Result := 0;
//检测鼠标位置并改变状态
for I := 1 to 8 do
if PtInRect(FRectList[I], Pt) then
Msg.Result := FPosList[I];
if Msg.Result = 0 then
inherited;
end;


procedure TSizerControl.WmSize(var Msg:TWmSize);
var
R: TRect;
begin
R := BoundsRect;
InflateRect( R, -2, -2);
FControl.BoundsRect := R;
//计算8个黑方框 //left,top,right,bottom
FRectList[1] := Rect(0 ,0, 5, 5);
FRectList[2] := Rect(Width div 2 - 3, 0, Width div 2 + 2, 5);
FRectList[3] := Rect(Width - 5, 0, Width, 5);
FRectList[4] := Rect(Width - 5, height div 2 - 3, Width, Height div 2 + 2);
FRectList[5] := Rect(Width - 5, Height - 5, Width, Height);
FRectList[6] := Rect(Width div 2 - 3, Height - 5, Width div 2 + 2, Height);
FRectList[7] := Rect(0, Height -5, 5, Height);
FRectList[8] := Rect(0, Height div 2 - 3, 5, Height div 2 + 2);
end;


procedure TSizerControl.WmLButtonDown(var Msg: TWmLButtonDown);
begin
//执行拖动命令
Perform(Wm_SysCommand, sc_DragMove, 0);
end;

procedure TSizerControl.WmMove(var Msg: TWmMove);
var
R: TRect;
begin
R := BoundsRect;
InflateRect( R, -2, -2);
FControl.Invalidate;
FControl.BoundsRect := R;
end;

procedure TSizerControl.Paint;
var
I: Integer;
begin
Canvas.Brush.Color := clBlack;
for I := 1 to 8 do
with FRectList[I] do
Canvas.Rectangle (Left, Top, Right, Bottom);
end;

procedure TSizerControl.SizeControlExit(Sender: TObject);
begin
Free;
end;


procedure Register;
begin
RegisterComponents(''Samples'', [TSizerControl]);
end;

end.



/////////////////////////////////////
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons;

type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
Button2: TButton;
Edit2: TEdit;
SpeedButton1: TSpeedButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
a : TSizerControl;
begin
a := TSizerControl.Create(self,SpeedButton1);
end;

end.

8楼: 试试 hhjjhhjj 的代码

9楼: 测试了 代码,在移动 SpeedButton1 时候,会不见了几个 小黑点

10楼: 帮顶!

╭=========================================╮

80G海量源代码,控件,书籍全免费狂下不停!

http://www.source520.com

个人网站站长开发推广同盟,让所有人知道你的世界!

http://www.source520.com/search/search.asp

╰=========================================╯

11楼: 多人接受答案了。