哦，我有一个，可以发给你，代码在下面
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, jpeg, ExtCtrls, Mask, Grids, Buttons, dbcgrids,
AppEvnts;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Label1: TLabel;
BitBtn1: TBitBtn;
StringGrid1: TStringGrid;
DrawGrid1: TDrawGrid;
MaskEdit1: TMaskEdit;
StaticText1: TStaticText;
Image: TImage;
Panel1: TPanel;
Button3: TButton;
Panel2: TPanel;
Label2: TLabel;
Label3: TLabel;
Button4: TButton;
Shape1: TShape;
Shape2: TShape;
Label4: TLabel;
ListBox1: TListBox;
ComboBox1: TComboBox;
procedure Button1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ImageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure ImageMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{自定义过程}
procedure DrawMultiDots(ACtr: TControl; i: integer);
procedure DrawDots(ACtr: TControl);
procedure PMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure DelSelect(iSelect: integer);
procedure AddSelect(Sender: TObject);
procedure ClearSelect;
procedure SetPalColor(iColor: Integer);
procedure GetControl(iX0, iY0, iX1, iY1: Integer; AParent: TWinControl);
{自定义函数}
function ChkSelect(Sender: TObject): Integer;
function GetMaxNumber(iLen: integer): Longint;
function GetMinNumber(iLen: integer): Longint;
function ChkInS(str: string): boolean;
procedure GetNumbers(s: string; iLen: integer);
{ Private declarations }
public
{ Public declarations }
end;
type
TDt = (dtLeftTop, dtLeftMiddle, dtLeftBottom, dtTop, dtBottom, dtRightTop,
dtRightMiddle, dtRightBottom);
TPal = record
P: TPanel; {黑点}
DT: TDt; {方向}
end;
TSP = record
C: TControl; {选中的对象}
AP: array of TPal; {控件数组}
end;
var
Form1: TForm1;
iLX, iLY: longint;
iOW, iOH: longint;
spDot: array of TSP;
iPX, iPY: LongInt;
iPB, iPS: Integer;
iPW: LongInt = 6; //黑点宽高
iPH: LongInt = 6;
iRX0, iRY0, iRX1, iRY1: LongInt; //鼠标拖拉画框时所需的两点坐标
bSelect: boolean; //选择标志
cc: TControlCanvas; //该画布的(0,0)点在窗体的Caption上，包括Caption和Client
//而Form的画布只包括Client，所以需要调整坐标
//==========================
SA: array of char;
const
iTX = 3; //坐标调整
iTY = 23;
implementation
{$R *.dfm}
//-----------------------------------//
//函数名
MouseDown
//功能:"黑点"的鼠标控下事件
procedure TForm1.PMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
iPX := X;
iPY := Y;
end;
//-----------------------------------//
//函数名
MouseMove
//功能:"黑点"的鼠标移动事件
procedure TForm1.PMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
i: integer;
iCH, iCW, iHH, iHW: LongInt;
begin
if spDot[0].AP[0].P.Color = clGray then Exit;
for i := 0 to High(spDot[0].AP) do
begin
if TControl(Sender) = spDot[0].AP
.P then
begin
StaticText1.Caption := spDot[0].AP.P.ClassName;
Label1.Caption := spDot[0].C.Name;
if Shift = [ssLeft] then
with spDot[0].AP do
case DT of
dtLeftTop: //左上
begin
P.Left := P.Left + X - iPX;
P.Top := P.Top + Y - iPY;
with spDot[0].C do
begin
Left := P.Left + iPB;
Top := P.Top + iPB;
Width := spDot[0].AP[7].P.Left + iPS - (P.Left + iPB);
Height := spDot[0].AP[7].P.Top + iPS - (P.Top + iPB);
end;
iCH := spDot[0].C.Height;
iCW := spDot[0].C.Width;
iHH := Round(iCH / 2);
iHW := Round(iCW / 2);
with spDot[0].AP[1].P do
begin
Left := P.Left;
Top := P.Top + iPB + iHH - iPS;
end;
spDot[0].AP[2].P.Left := P.Left;
with spDot[0].AP[3].P do
begin
Left := P.Left + iHW;
Top := P.Top;
end;
spDot[0].AP[4].P.Left := spDot[0].AP[3].P.Left;
spDot[0].AP[5].P.Top := P.Top;
spDot[0].AP[6].P.Top := spDot[0].AP[1].P.Top;
end;
dtRightBottom: //右下
begin
P.Left := P.Left + X - iPX;
P.Top := P.Top + Y - iPY;
with spDot[0].C do
begin
Width := P.Left + iPS - (spDot[0].AP[0].P.Left + iPB);
Height := P.Top + iPS - (spDot[0].AP[0].P.Top + iPB);
end;
iCH := spDot[0].C.Height;
iCW := spDot[0].C.Width;
iHH := Round(iCH / 2);
iHW := Round(iCW / 2);
spDot[0].AP[1].P.Top := P.Top - iHH;
spDot[0].AP[2].P.Top := P.Top;
spDot[0].AP[3].P.Left := P.Left + iPS - iHW - iPB;
with spDot[0].AP[4].P do
begin
Left := spDot[0].AP[3].P.Left;
Top := P.Top;
end;
spDot[0].AP[5].P.Left := P.Left;
with spDot[0].AP[6].P do
begin
Left := P.Left;
Top := spDot[0].AP[1].P.Top;
end;
end;
dtLeftBottom: //左下
begin
P.Left := P.Left + X - iPX;
P.Top := P.Top + Y - iPY;
with spDot[0].C do
begin
Left := P.Left + iPS;
Width := spDot[0].AP[5].P.Left + iPS - (P.Left + iPB);
Height := P.Top + iPS - (spDot[0].AP[5].P.Top + iPB);
end;
iCH := spDot[0].C.Height;
iCW := spDot[0].C.Width;
iHH := Round(iCH / 2);
iHW := Round(iCW / 2);
spDot[0].AP[0].P.Left := P.Left;
with spDot[0].AP[1].P do
begin
Left := P.Left;
Top := P.Top - iHH;
end;
spDot[0].AP[3].P.Left := P.Left + iHW;
with spDot[0].AP[4].P do
begin
Left := spDot[0].AP[3].P.Left;
Top := P.Top;
end;
spDot[0].AP[6].P.Top := spDot[0].AP[1].P.Top;
spDot[0].AP[7].P.Top := P.Top;
end;
dtRightTop: //右上
begin
P.Left := P.Left + X - iPX;
P.Top := P.Top + Y - iPY;
with spDot[0].C do
begin
Top := P.Top + iPB;
Width := P.Left + iPS - (spDot[0].AP[2].P.Left + iPB);
Height := spDot[0].AP[2].P.Top + iPS - (P.Top + iPB);
end;
iCH := spDot[0].C.Height;
iCW := spDot[0].C.Width;
iHH := Round(iCH / 2);
iHW := Round(iCW / 2);
spDot[0].AP[0].P.Top := P.Top;
spDot[0].AP[1].P.Top := P.Top + iPB + iHH - iPS;
with spDot[0].AP[3].P do
begin
Left := P.Left + iPS - iHW - iPB;
Top := P.Top;
end;
spDot[0].AP[4].P.Left := spDot[0].AP[3].P.Left;
with spDot[0].AP[6].P do
begin
Left := P.Left;
Top := P.Top + iPB + iHH - iPS;
end;
spDot[0].AP[7].P.Left := P.Left;
end;
dtLeftMiddle: //左中
begin
P.Left := P.Left + X - iPX;
with spDot[0].C do
begin
Left := P.Left + iPB;
Width := spDot[0].AP[6].P.Left + iPS - (P.Left + iPB);
end;
iCW := spDot[0].C.Width;
iHW := Round(iCW / 2);
spDot[0].AP[0].P.Left := P.Left;
spDot[0].AP[2].P.Left := P.Left;
spDot[0].AP[3].P.Left := P.Left + iHW;
spDot[0].AP[4].P.Left := P.Left + iHW;
end;
dtRightMiddle: //右中
begin
P.Left := P.Left + X - iPX;
with spDot[0].C do
Width := P.Left + iPS - (spDot[0].AP[1].P.Left + iPB);
iCW := spDot[0].C.Width;
iHW := Round(iCW / 2);
spDot[0].AP[3].P.Left := P.Left + iPS - iHW - iPB;
spDot[0].AP[4].P.Left := P.Left + iPS - iHW - iPB;
spDot[0].AP[5].P.Left := P.Left;
spDot[0].AP[7].P.Left := P.Left;
end;
dtTop: //顶
begin
P.Top := P.Top + Y - iPY;
with spDot[0].C do
begin
Top := P.Top + iPB;
Height := spDot[0].AP[4].P.Top + iPS - (P.Top + iPB);
end;
iCH := spDot[0].C.Height;
iHH := Round(iCH / 2);
spDot[0].AP[0].P.Top := P.Top;
spDot[0].AP[1].P.Top := P.Top + iPB + iHH - iPS;
spDot[0].AP[5].P.Top := P.Top;
spDot[0].AP[6].P.Top := spDot[0].AP[1].P.Top;
end;
dtBottom: //底
begin
P.Top := P.Top + Y - iPY;
with spDot[0].C do
Height := P.Top + iPS - (spDot[0].AP[3].P.Top + iPB);
iCH := spDot[0].C.Height;
iHH := Round(iCH / 2);
spDot[0].AP[1].P.Top := P.Top - iHH;
spDot[0].AP[2].P.Top := P.Top;
spDot[0].AP[6].P.Top := spDot[0].AP[1].P.Top;
spDot[0].AP[7].P.Top := P.Top;
end;
end; //End Case
end;
end;
end;
procedure TForm1.Button1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
// ReleaseCapture;
// (Sender as TButton).Perform(WM_SYSCOMMAND, SC_SIZE + 1, 1);
end;
//-----------------------------------//
//函数名
rawMultiDots
//功能:画多选控件时单个控件四周的"点"
//参数:ACtr->控件
// i->控件序号
procedure TForm1.DrawMultiDots(ACtr: TControl; i: integer);
var
iL, iT, iW, iH, iHX, iHY: longint;
begin
with ACtr do
begin
iL := Left;
iT := Top;
iW := Width;
iH := Height;
iHX := Round(iW / 2);
iHY := Round(iH / 2);
end;
with spDot.AP[0].P do
begin
Left := iL;
Top := iT;
Show;
end;
with spDot.AP[1].P do
begin
Left := iL - iPB;
Top := iT + iHY - iPS;
Visible := False;
end;
with spDot.AP[2].P do
begin
Left := iL;
Top := iT + iH - iPH;
Show;
end;
with spDot.AP[3].P do
begin
Left := iL + iHX - iPB;
Top := iT - iPB;
Visible := False;
end;
with spDot.AP[4].P do
begin
Left := iL + iHX - iPB;
Top := iT + iH - iPS;
Visible := False;
end;
with spDot.AP[5].P do
begin
Left := iL + iW - iPW;
Top := iT;
Show;
end;
with spDot.AP[6].P do
begin
Left := iL + iW - iPS;
Top := iT + iHY - iPS;
Visible := False;
end;
with spDot.AP[7].P do
begin
Left := iL + iW - iPW;
Top := iT + iH - iPH;
Show;
end;
end;
//-----------------------------------//
//函数名rawDots
//功能:画单个控件四周的"点"
//参数:ACtr->控件
procedure TForm1.DrawDots(ACtr: TControl);
var
iL, iT, iW, iH, iHX, iHY: longint;
i: Integer;
begin
with ACtr do
begin
iL := Left;
iT := Top;
iW := Width;
iH := Height;
iHX := Round(iW / 2);
iHY := Round(iH / 2);
end;
for i := 0 to High(spDot) do
begin
with spDot.AP[0].P do
begin
Left := iL - iPB;
Top := iT - iPB;
Show;
end;
with spDot.AP[1].P do
begin
Left := iL - iPB;
Top := iT + iHY - iPS;
Show;
end;
with spDot.AP[2].P do
begin
Left := iL - iPB;
Top := iT + iH - iPB;
Show;
end;
with spDot.AP[3].P do
begin
Left := iL + iHX - iPB;
Top := iT - iPB;
Show;
end;
with spDot.AP[4].P do
begin
Left := iL + iHX - iPB;
Top := iT + iH - iPS;
Show;
end;
with spDot.AP[5].P do
begin
Left := iL + iW - iPS;
Top := iT - iPB;
Show;
end;
with spDot.AP[6].P do
begin
Left := iL + iW - iPS;
Top := iT + iHY - iPS;
Show;
end;
with spDot.AP[7].P do
begin
Left := iL + iW - iPS;
Top := iT + iH - iPS;
Show;
end;
end;
end;
procedure TForm1.ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
i, j, iHigh: integer;
begin
if Shift = [ssLeft] then
begin
iHigh := High(spDot);
for i := 0 to iHigh do
begin
with spDot.C do
begin
Left := Left + X - iLX;
Top := Top + Y - iLY;
end;
end;
if spDot[0].AP[0].P.Visible then
for i := 0 to iHigh do
for j := 0 to High(spDot.AP) do
spDot.AP[j].P.Visible := False;
end;
if bSelect then
if Shift = [ssCtrl, ssLeft] then
begin
// with Canvas do
with cc do
begin
cc.Handle := GetWindowDC(Form1.Handle);
Pen.Mode := pmNotXor;
Pen.Style := psDot;
Pen.Width := 1;
Brush.Style := bsClear;
Rectangle(iRX0, iRY0, iRX1, iRY1);
Rectangle(iRX0, iRY0,
X + TControl(Sender).Left + iTX, Y + TControl(Sender).Top + iTY);
iRX1 := X + TControl(Sender).Left + iTX;
iRY1 := Y + TControl(Sender).Top + iTY;
end;
iRX1 := X + TControl(Sender).Left + iTX;
iRY1 := Y + TControl(Sender).Top + iTY;
end;
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ClearSelect;
//按Ctrl+鼠标左键或直接按住鼠标左键开始画框
if (Shift = [ssCtrl, ssLeft]) or (Shift = [ssLeft]) then
begin
bSelect := True;
iRX0 := X + iTX;
iRY0 := Y + iTY;
iRX1 := X + iTX;
iRY1 := Y + iTY;
end;
end;
//-----------------------------------//
//函数名:ChkSelect
//功能:检测控件是否已经选中
//参数:Sender -> 控件
//返回值:记录号
function TForm1.ChkSelect(Sender: TObject): Integer;
var
i: integer;
begin
Result := -1;
for i := 0 to high(spDot) do
begin
if spDot.C = TControl(Sender) then
begin
Result := i;
Break;
end;
end;
end;
//-----------------------------------//
//过程名elSelect
//功能:删除选择的控件
//参数:iSelect -> 记录号
procedure TForm1.DelSelect(iSelect: integer);
var
i, iH: integer;
begin
iH := High(spDot);
for i := High(spDot[iSelect].AP) downto 0 do
begin
// spDot[iSelect].AP.P.Visible := False;
spDot[iSelect].AP.P.Free;
end;
for i := iSelect to iH - 1 do
spDot := spDot[i + 1];
SetLength(spDot, iH);
end;
//-----------------------------------//
//过程名:AddSelect
//功能:选择控件
//参数:Sender -> 控件
procedure TForm1.AddSelect(Sender: TObject);
var
i, iHR: integer;
ACtr: TControl;
begin
iHR := High(spDot);
iHR := iHR + 2;
//*调试*//
Label2.Caption := IntToStr(iHR);
ACtr := TControl(Sender);
SetLength(spDot, iHR);
SetLength(spDot[iHR - 1].AP, 8);
spDot[iHR - 1].C := TControl(Sender);
//*调试*//
Label1.Caption := spDot[iHR - 1].C.Name;
for i := 0 to High(spDot[iHR - 1].AP) do
begin
with spDot[iHR - 1].AP do
begin
P := TPanel.Create(Self);
with P do
begin
// Name := 'Pal_' + IntToStr(iHR - 1) + '_' + IntToStr(i);
Caption := '';
Parent := ACtr.Parent;
Width := iPW;
Height := iPH;
iPB := Round(iPH / 2);
iPS := Width - iPB;
Color := clBlack;
BevelInner := bvNone;
BevelOuter := bvNone;
OnMouseDown := PMouseDown;
OnMouseMove := PMouseMove;
BringToFront;
case i of
0:
begin
Dt := dtLeftTop; //左上
Cursor := crSizeNWSE;
Visible := False;
end;
1:
begin
Dt := dtLeftMiddle; //左中
Cursor := crSizeWE;
Visible := False;
end;
2:
begin
Dt := dtLeftBottom; //左下
Cursor := crSizeNESW;
Visible := False;
end;
3:
begin
Dt := dtTop; //顶
Cursor := crSizeNS;
Visible := False;
end;
4:
begin
Dt := dtBottom; //底
Cursor := crSizeNS;
Visible := False;
end;
5:
begin
Dt := dtRightTop; //右上
Cursor := crSizeNESW;
Visible := False;
end;
6:
begin
Dt := dtRightMiddle; //右中
Cursor := crSizeWE;
Visible := False;
end;
7:
begin
Dt := dtRightBottom; //右下
Cursor := crSizeNWSE;
Visible := False;
end;
end; {End Case}
end;
end;
end;
end;
//-----------------------------------//
//过程名:ClearSelect
//功能:清除选择
procedure TForm1.ClearSelect;
var
i, j: integer;
begin
for i := 0 to High(spDot) do
begin
for j := 0 to 7 do
spDot.AP[j].P.Free;
SetLength(spDot.AP, 0);
end;
SetLength(spDot, 0);
end;
//-----------------------------------//
//过程名:SetPalColor
//功能:设置颜色
//参数:iCOlor->颜色值
procedure TForm1.SetPalColor(iColor: LongInt);
var
i, j: integer;
begin
for i := 0 to High(spDot) do
for j := 0 to High(spDot.AP) do
spDot.AP[j].P.Color := iColor;
end;
//-----------------------------------//
//函数名:GetControl
//功能:得到两个坐标形成的矩形框内的所有控件
//参数:iX0,iY0,iX1,iY1:两点坐标
// AParent->控件的"父亲"
procedure TForm1.GetControl(iX0, iY0, iX1, iY1: Longint; AParent: TWinControl);
var
ACtr: TControl;
iCL, iCT, iCW, iCH,
iDX0, iDY0,
{iDX1,} iDY1,
iDX2 {, iDY2,}
{iDX3, iDY3}: LongInt;
i, iHigh: integer;
bIn: boolean;
begin
for i := 0 to ComponentCount - 1 do
begin
bIn := True;
ACtr := TControl(Components);
with ACtr do
begin
iCL := Left + iTX; //控件在画布cc中的坐标
iCT := Top + iTY;
iCW := Width;
iCH := Height;
end;
if Actr.Parent <> AParent then Continue;
{四个顶点坐标}
//左上角
iDX0 := iCL;
iDY0 := iCT;
//左下角
// iDX1 := iCL;
iDY1 := iCT + iCH;
//右上角
iDX2 := iCL + iCW;
// iDY2 := iCT;
//右下角
{ iDX3 := iCL + iCW;
iDY3 := iCT + iCH;}
//判断是否在范围内
if iDX0 > iX1 then bIn := False;
if iDX2 < iX0 then bIn := False;
if iDY0 > iY1 then bIn := False;
if iDY1 < iY0 then bIn := False;
if bIn then
if ChkSelect(ACtr) = -1 then
AddSelect(ACtr);
end;
iHigh := High(spDot);
if iHigh < 0 then Exit;
if iHigh = 0 then
DrawDots(spDot[0].C)
else
begin
for i := 0 to iHigh do
DrawMultiDots(spDot.C, i);
SetPalColor(clGray);
end;
end;
procedure TForm1.ImageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
iSelect: integer;
begin
iLX := X;
iLY := Y;
if Shift = [ssShift, ssLeft] then //按Shift+鼠标左键
begin
iSelect := ChkSelect(Sender);
if iSelect = -1 then //控件未选中则添加
begin
//如果选择了不同"父亲"的控件则只能选中最后选择的控件
//也就是先清除所有选择的控件,再添加最后选中的的控件
if TControl(Sender).Parent <> spDot[0].C.Parent then
ClearSelect;
AddSelect(Sender)
end
else //控件已选中则删除
DelSelect(iSelect);
if High(spDot) > 0 then
SetPalColor(clGray)
else
SetPalColor(clBlack);
end;
if Shift = [ssLeft] then //直接用鼠标左键点击
begin
iSelect := ChkSelect(Sender);
if iSelect = -1 then
begin
ClearSelect;
AddSelect(Sender);
end;
end;
if Shift = [ssCtrl, ssLeft] then //按Ctrl+鼠标左键画框
begin
ClearSelect;
bSelect := True;
iRX0 := X + TControl(Sender).Left + iTX;
iRY0 := Y + TControl(Sender).Top + iTY;
iRX1 := X + TControl(Sender).Left + iTX;
iRY1 := Y + TControl(Sender).Top + iTY;
iSelect := ChkSelect(Sender);
if iSelect = -1 then
AddSelect(Sender);
end;
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
cc.Free;
ClearSelect;
end;
procedure TForm1.ImageMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
i, iHigh: integer;
begin
if bSelect then
begin
bSelect := False;
// Canvas.Rectangle(iRX0, iRY0, iRX1, iRY1);
cc.Rectangle(iRX0, iRY0, iRX1, iRY1);
GetControl(iRX0, iRY0, iRX1, iRY1, TControl(Sender).Parent);
end;
iHigh := High(spDot);
if iHigh < 0 then Exit;
if iHigh = 0 then
DrawDots(spDot[0].C)
else
for i := 0 to iHigh do
DrawMultiDots(spDot.C, i);
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if (Shift = [ssCtrl, ssLeft]) or (Shift = [ssLeft]) then
begin
with cc do
begin
Handle := GetWindowDC(Form1.Handle);
Pen.Mode := pmNotXor;
Pen.Style := psDot;
Pen.Width := 1;
Brush.Style := bsClear;
Rectangle(iRX0, iRY0, iRX1, iRY1);
Rectangle(iRX0, iRY0, X + iTX, Y + iTY);
end;
iRX1 := X + iTX;
iRY1 := Y + iTY;
end;
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
iTRX, iTRY: Integer;
begin
if bSelect then
begin
cc.Rectangle(iRX0, iRY0, iRX1, iRY1);
// Canvas.Rectangle(iRX0, iRY0, iRX1, iRY1);
bSelect := False;
//缺省是从左上角往右下角画框
if iRX0 > iRX1 then //从右下角往左上角画框
begin
iTRX := iRX0;
iRX0 := iRX1;
iRX1 := iTRX;
iTRY := iRY0;
iRY0 := iRY1;
iRY1 := iTRY;
end;
if iRY0 > iRY1 then //从左下角往右上角画框
begin
if iRX0 < iRX1 then
begin
iTRY := iRY0;
iRY0 := iRY1;
iRY1 := iTRY;
end
else
begin //从右上角往左下角画框
iTRX := iRX0;
iRX0 := iRX1;
iRX1 := iTRX;
end;
end;
if TControl(Sender) = Form1 then
GetControl(iRX0, iRY0, iRX1, iRY1, Form1)
else
GetControl(iRX0, iRY0, iRX1, iRY1, TControl(Sender).Parent);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
cc := TControlCanvas.Create;
// cc.Handle := GetWindowDC(Form1.handle);
// AnimateWindow(Handle, 500, AW_CENTER)
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
GetNumbers('123', 4);
end;
//GetNumbers:得到符体条件的数字
//s:字符表,如'123'
//iLen:要得到的数字的位数,如:4位数
procedure TForm1.GetNumbers(s: string; iLen: integer);
var
i, j, k, h, isLen, iMinLen, iMaxLen:integer;
slStr: TStrings;
sTmp, s0, s1: string;
bIn: boolean;
begin
slStr := TStringList.Create;
isLen := Length(s);
SetLength(SA, isLen);
for i := 1 to isLen do //取到单个字符
SA[i - 1] := s;
iMinLen := GetMinNumber(iLen); //位数的最小值
iMaxLen := GetMaxNumber(iLen); //位数的最大值
for i := iMinLen to iMaxLen do
begin
bIn := True;
sTmp := IntToStr(i);
for j := 1 to iLen do
if not ChkIns(sTmp[j]) then //判断数字是否以s中的字符组合而来的?
begin
bIn := False;
Break;
end;
if not bIn then Continue;
{两个相邻子序列是否相同?}
h := Round(iLen / 2);
for j := 1 to h do
begin
s0 := Trim(Copy(sTmp, 1, j));
for k := 1 to Length(sTmp) do
begin
s1 := Trim(Copy(sTmp, 1 + k * j, j));
if Length(s1) < Length(s0) then Break;
if s0 = s1 then
begin
bIn := False;
Break;
end
else s0 := s1;
end;
if not bIn then Break;
end;
if not bIn then Continue;
slStr.Add(IntToStr(i));
end;
// Showmessage(slStr.Text); //显示得到的数字
ListBox1.Clear;
ListBox1.Items.Assign(slStr);
slStr.Free;
end;
//检测数字的每个字符是否包含在"字符表"中
function TForm1.ChkInS(str: string):boolean;
var
i : integer;
begin
Result := False;
for i := 0 to High(SA) do
if str = SA then
begin
Result := True;
Break;
end;
end;
//得到iLen位数的最大值,如:4位数最大值为9999
function TForm1.GetMaxNumber(iLen: integer): Longint;
const
s = '9';
var
i : integer;
sRst: String;
begin
Result := 0;
if iLen = 0 then Exit;
sRst := '';
for i := 0 to iLen - 1 do
sRst := sRst + s;
Result := StrToInt(sRst);
end;
//得到iLen位数的最小值,如:4位数最大值为1000
function TForm1.GetMinNumber(iLen: integer): Longint;
var
i : integer;
begin
Result := 1;
for i := 1 to iLen - 1 do
Result := Result * 10;
end;
end.
