如题!请高手帮忙!
解决方案 »
- 不能设置类chartarea的height属性
- 300分求一题,此题和前面两题一样,急急急,求各位大虾帮忙看一题(用行列法求最小割集),分不够发帖再加
- RAVE开发人员指南 ravedevguide5哪儿有下载的?
- 按钮???
- 我用InstallShield Express Borland Limited Edition做安装软件,在BDE设置时选了BDE_ENT
- 头疼中...Win7(Vista)的bug?怎么绕过去?
- 发布新软件——《我从来不怕背单词》——帮您打造自己的生词本!!进者有分!!
- 有谁能告诉我怎样才能够在DELPHI中实现对*.dwg文件的函数调用?(调用后直接打开显示dwg图形文件)。
- 在哪里怎样判断插入和修改键的状态?
- 帮我看看这个程序代码哪里有问题
- ADVStringGrid、DBADVStringGrid如何设置点击标题列自动排序
- 急求:DevExpress.ExpressPageControl.Suite.1.xxx.for.Delphi6.with.Sources
用Canvas的方法直接绘制。
http://delphi.freemai.com/list.asp?id=914{ 作者: 彭 涵 }
{ 创建日期: 2002.07.15 }
{最后修改日期: 2002.07.17 }
unit Unit1;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;type
TForm1 = class(TForm)
Panel1: TPanel;
Memo1: TMemo;
procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Memo1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
{ Private declarations }
WFont:TMemo;
public
{ Public declarations }
procedure FontMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FontKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
function FontHeigth(WFont:TMemo;Text:string):integer;
end;var
Form1: TForm1;
cx,cy:integer;
implementation{$R *.dfm}procedure ManipulateControl(WinControl: TWinControl; Shift: TShiftState;
X, Y, Precision: integer);
var SC_MANIPULATE: Word;
begin
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//光标在控件的最左侧**********************************************************
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if (X<=Precision) and (Y>Precision) and (Y<WinControl.Height-Precision)
then begin
SC_MANIPULATE := $F001;
WinControl.Cursor := crSizeWE;
end
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//光标在控件的最右侧**********************************************************
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
else if (X>=WinControl.Width-Precision) and (Y>Precision) and (Y<WinControl.Height-Precision)
then begin
SC_MANIPULATE := $F002;
WinControl.Cursor := crSizeWE;
end
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//光标在控件的最上侧**********************************************************
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
else if (X>Precision) and (X<WinControl.Width-Precision) and (Y<=Precision)
then begin
SC_MANIPULATE := $F003;
WinControl.Cursor := crSizeNS;
end
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//光标在控件的左上角**********************************************************
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
else if (X<=Precision) and (Y<=Precision)
then begin
SC_MANIPULATE := $F004;
WinControl.Cursor := crSizeNWSE;
end
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//光标在控件的右上角**********************************************************
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
else if (X>=WinControl.Width-Precision) and (Y<=Precision)
then begin
SC_MANIPULATE := $F005;
WinControl.Cursor := crSizeNESW ;
end
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//光标在控件的最下侧**********************************************************
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
else if (X>Precision) and (X<WinControl.Width-Precision) and (Y>=WinControl.Height-Precision)
then begin
SC_MANIPULATE := $F006;
WinControl.Cursor := crSizeNS;
end
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//光标在控件的左下角**********************************************************
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
else if (X<=Precision) and (Y>=WinControl.Height-Precision)
then begin
SC_MANIPULATE := $F007;
WinControl.Cursor := crSizeNESW;
end
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//光标在控件的右下角**********************************************************
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
else if (X>=WinControl.Width-Precision) and (Y>=WinControl.Height-Precision)
then begin
SC_MANIPULATE := $F008;
WinControl.Cursor := crSizeNWSE;
end
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//光标在控件的客户区(移动整个控件)******************************************
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
else if (X>5) and (Y>5) and (X<WinControl.Width-5) and (Y<WinControl.Height-5)
then begin
SC_MANIPULATE := $F009;
WinControl.Cursor := crSizeAll;
end
else begin
SC_MANIPULATE := $F000;
WinControl.Cursor := crDefault;
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if Shift=[ssLeft] then
begin
ReleaseCapture;
WinControl.Perform(WM_SYSCOMMAND, SC_MANIPULATE, 0);
end;
end;procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
ManipulateControl(panel1,Shift,X, Y, 24);
end;procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var FontText:string;lines:integer;
begin
if not Assigned(WFont) then
begin
WFont:=TMemo.Create(nil);
WFont.Parent:=Form1;
WFont.Width:=50;
WFont.Height:=FontHeigth(WFont,'sd')+5;
WFont.Ctl3D:=False;
WFont.Top:=y;
WFont.Left:=x;
WFont.SetFocus;
WFont.OnMouseMove:=FontMouseMove;
WFont.OnKeyDown:=FontKeyDown;
cX:=WFont.Left+1;
cy:=WFont.Top+1;
end
else begin
WFont.Visible:=False;
for lines:=0 to WFont.Lines.Count-1 do
begin
FontText:=WFont.Lines[lines];
Form1.Canvas.TextOut(cx,cy,FontText);
cy:=cy+FontHeigth(WFont,'sd');
end;
FreeAndNil(WFont);
end;
end;procedure TForm1.FontMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
ManipulateControl(WFont,Shift,X, Y, 3);
cX:=WFont.Left+1;
cy:=WFont.Top+1;
end;function TForm1.FontHeigth(WFont:TMemo;Text:string):integer;
var bmp:TBitmap;
begin
bmp:=TBitmap.Create;
try
bmp.Canvas.Font:=WFont.Font;
Result:=bmp.Canvas.TextHeight(text);
finally
freeandnil(bmp);
end;
end;procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
var h:integer;
begin
if Key=VK_Return then
begin
h:=FontHeigth(Memo1,Memo1.Lines[1]);
if Memo1.Height<Memo1.Lines.Count*h+h then
Memo1.Height:=Memo1.Height+h;
end;
end;
procedure TForm1.FontKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
var h:integer;
begin
h:=FontHeigth(WFont,WFont.Lines[1]);
if WFont.Height<WFont.Lines.Count*h+h then
WFont.Height:=WFont.Height+h;
end;end.
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls;const
GRIDDEFAULT = 4;type
TResizer = class;
TMover = class; TMovingEvent = procedure(Sender: TResizer; var NewLeft, NewTop: integer) of object;
TSizingEvent = procedure(Sender: TResizer; var NewLeft, NewTop, NewWidth, NewHeight: integer) of object; TResizer = class(TComponent)
protected
FActive : boolean;
FControl : TControl;
Sizers : TList;
GroupMovers : TList;
FGroup : TWinControl;
FGridX : integer;
FGridY : integer;
FOnSized : TNotifyEvent;
FOnSizing : TSizingEvent;
FOnMoved : TNotifyEvent;
FOnMoving : TMovingEvent;
Sizing : boolean;
Moving : boolean;
OrigSize : TRect;
NewSize : TRect;
DownX : integer;
DownY : integer;
FAllowSize : boolean;
FAllowMove : boolean;
FKeepIn : boolean;
FHotTrack : boolean;
OneMover : TMover;
CurMover : TMover;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure SetActive(b: boolean);
procedure SetControl(c: TControl);
procedure SetGroup(p: TWinControl);
procedure CreateSizers;
procedure CheckSizers;
procedure ShowSizers;
procedure ShowSizers_1;
procedure HideSizers;
procedure SizerDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure SizerUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure SizerMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure MoverDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure MoverUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure MoverMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure DrawSizeRect(Rect: TRect);
procedure Calc_Size_Rect(SizerNum, dx, dy: integer);
procedure DoSizingEvent;
procedure Calc_Move_Rect(dx, dy: integer);
procedure DoMovingEvent;
procedure Constrain_Size;
procedure Constrain_Move;
procedure MoverKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure DoSizeMove(var Key: Word; Shift: TShiftState; dx, dy: integer);
procedure CreateGroupMovers;
procedure CreateOneMover(m: TMover; c: TControl);
function FindMoverByBuddy(c: TControl): TMover;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Active: boolean read FActive write SetActive default True;
property ResizeControl: TControl read FControl write SetControl;
property ResizeGroup: TWinControl read FGroup write SetGroup;
property GridX: integer read FGridX write FGridX default GRIDDEFAULT;
property GridY: integer read FGridY write FGridY default GRIDDEFAULT;
property OnSized: TNotifyEvent read FOnSized write FOnSized;
property OnSizing: TSizingEvent read FOnSizing write FOnSizing;
property OnMoved: TNotifyEvent read FOnMoved write FOnMoved;
property OnMoving: TMovingEvent read FOnMoving write FOnMoving;
property AllowSize: boolean read FAllowSize write FAllowSize default True;
property AllowMove: boolean read FAllowMove write FAllowMove default True;
property KeepInParent: boolean read FKeepIn write FKeepIn default True;
property HotTrack: boolean read FHotTrack write FHotTrack;
end; TInvisWin = class(TPanel) // This could also derive from TPanel
protected
procedure WndProc(var Message: TMessage); override;
procedure CreateParams(var Params: TCreateParams); override;
procedure WMDLGCode(var Message: TMessage); message WM_GETDLGCODE;
public
property OnKeyDown;
end; TMover = class(TInvisWin)
public
Buddy : TControl;
procedure Show;
procedure Show_1;
end;
procedure Register;implementationconst
SIZE = 6;
HALFSIZE = SIZE div 2;type
TSizer = class(TPanel)
end;procedure Register;
begin
RegisterComponents('Samples', [TResizer]);
end;
// *****************************************************************
// TInvisWinprocedure TInvisWin.WndProc(var Message: TMessage);
var
ps : TPaintStruct;
begin
case Message.Msg of
WM_ERASEBKGND: Message.Result := 1;
WM_PAINT: begin
BeginPaint(Handle, ps);
EndPaint(Handle, ps);
Message.Result := 1;
end;
else
inherited WndProc(Message);
end;
end;procedure TInvisWin.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;
end;procedure TInvisWin.WMDLGCode(var Message: TMessage);
begin
Message.Result := DLGC_WANTARROWS or DLGC_WANTALLKEYS;
end;
// *****************************************************************
// TMoverprocedure TMover.Show;
begin
Assert(Buddy <> nil);
BoundsRect := Buddy.BoundsRect;
Parent := Buddy.Parent;
Visible := True;
BringToFront;
end;procedure TMover.Show_1;
begin
Assert(Buddy <> nil);
BoundsRect := Buddy.BoundsRect;
Parent := Buddy.Parent;
Visible := True;
SendToBack;
end;// *****************************************************************
// TResizerconstructor TResizer.Create(AOwner: TComponent);
begin
inherited;
FActive := True;
FKeepIn := True;
FGridX := GRIDDEFAULT;
FGridY := GRIDDEFAULT;
FAllowSize := True;
FAllowMove := True;
GroupMovers := TList.Create;
Sizers := TList.Create; OneMover := TMover.Create(Self);
CreateOneMover(OneMover, nil); CreateSizers;
end;destructor TResizer.Destroy;
begin
GroupMovers.Free;
Sizers.Free;
Sizers := nil;
inherited;
end;procedure TResizer.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited;
if csDestroying in ComponentState then exit;
if (AComponent = ResizeControl) and (Operation = opRemove) then
ResizeControl := nil;
end;procedure TResizer.SetActive(b: boolean);
begin
if b<>FActive then
begin
FActive := b;
CheckSizers;
end;
end;procedure TResizer.SetControl(c: TControl);
begin
if c <> FControl then begin
if c<>nil then begin
if ResizeGroup<>nil then begin
Assert(c.Parent = ResizeGroup, 'ResizeControl is not in ResizeGroup!');
CurMover := FindMoverByBuddy(c);
end else begin
CurMover := OneMover;
CurMover.Buddy := c;
end;
CurMover.Show;
end;
FControl := c;
CheckSizers;
end;
end;procedure TResizer.SetGroup(p: TWinControl);
begin
if p <> FGroup then begin
FGroup := p;
CreateGroupMovers;
end;
end;
var
i : integer;
m : TMover;
c : TControl;
begin
if csDesigning in ComponentState then exit; // Clear out the old Movers
for i := 0 to GroupMovers.Count-1 do
TObject(GroupMovers[i]).Free;
GroupMovers.Clear; if ResizeGroup <> nil then begin
for i := 0 to ResizeGroup.ControlCount-1 do begin
c := ResizeGroup.Controls[i];
if (c is TMover) or (c is TSizer) then continue; m := TMover.Create(Self);
CreateOneMover(m, c);
GroupMovers.Add(m);
m.Show;
end;
end;
end;procedure TResizer.CreateSizers;
var
i : integer;
p : TSizer;
begin
if csDesigning in ComponentState then exit; for i := 0 to 7 do begin
p := TSizer.Create(Self);
Sizers.Add(p); p.BevelOuter := bvNone;
p.Width := SIZE;
p.Height := SIZE;
p.Color := clBlack;
p.Caption := '';
p.Tag := i;
p.OnMouseDown := SizerDown;
p.OnMouseUp := SizerUp;
p.OnMouseMove := SizerMove;
p.TabStop := False; case i of
0, 7 : p.Cursor := crSizeNWSE;
2, 5 : p.Cursor := crSizeNESW;
1, 6 : p.Cursor := crSizeNS;
3, 4 : p.Cursor := crSizeWE;
end;
end;
end;procedure TResizer.CreateOneMover(m: TMover; c: TControl);
begin
m.OnMouseDown := MoverDown;
m.OnMouseUp := MoverUp;
m.OnMouseMove := MoverMove;
m.TabStop := True;
m.OnKeyDown := MoverKeyDown;
m.Buddy := c;
end;procedure TResizer.CheckSizers;
begin
if (ResizeControl<>nil) and Active and (not (csDesigning in ComponentState)) then
ShowSizers
else
HideSizers;
end;procedure TResizer.ShowSizers;
var
i : integer;
p : TPanel;
c : TControl;
begin
c := ResizeControl;
Assert(c <> nil); for i := 0 to 7 do begin
p := TPanel(Sizers[i]);
case i of
0, 1, 2 : p.Top := c.Top - HALFSIZE;
3, 4 : p.Top := c.Top + c.Height div 2 - HALFSIZE;
5, 6, 7 : p.Top := c.Top + c.Height - HALFSIZE;
end; case i of
0, 3, 5 : p.Left := c.Left - HALFSIZE;
1, 6 : p.Left := c.Left + c.Width div 2 - HALFSIZE;
2, 4, 7 : p.Left := c.Left + c.Width - HALFSIZE;
end;
end; Assert(CurMover<>nil);
CurMover.Show; for i := 0 to Sizers.Count-1 do begin
p := TPanel(Sizers[i]);
p.Parent := c.Parent;
p.Visible := True;
p.BringToFront;
end; if CurMover.HandleAllocated and CurMover.CanFocus then
CurMover.SetFocus;
end;procedure TResizer.ShowSizers_1;
var
i : integer;
p : TPanel;
c : TControl;
begin
c := ResizeControl;
Assert(c <> nil); for i := 0 to 7 do begin
p := TPanel(Sizers[i]);
case i of
0, 1, 2 : p.Top := c.Top - HALFSIZE;
3, 4 : p.Top := c.Top + c.Height div 2 - HALFSIZE;
5, 6, 7 : p.Top := c.Top + c.Height - HALFSIZE;
end; case i of
0, 3, 5 : p.Left := c.Left - HALFSIZE;
1, 6 : p.Left := c.Left + c.Width div 2 - HALFSIZE;
2, 4, 7 : p.Left := c.Left + c.Width - HALFSIZE;
end;
end; Assert(CurMover<>nil);
CurMover.Show_1; for i := 0 to Sizers.Count-1 do begin
p := TPanel(Sizers[i]);
p.Parent := c.Parent;
p.Visible := True;
p.BringToFront;
end; if CurMover.HandleAllocated and CurMover.CanFocus then
CurMover.SetFocus;
end;procedure TResizer.HideSizers;
var
i : integer;
p : TPanel;
begin
for i := 0 to Sizers.Count-1 do begin
p := TPanel(Sizers[i]);
p.Visible := False;
p.Update;
end;
OneMover.Visible := False;
end;procedure TResizer.SizerDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
Sizing := True;
DownX := X;
DownY := Y;
HideSizers;
ResizeControl.Parent.Update;
ResizeControl.Update;
OrigSize := ResizeControl.BoundsRect;
NewSize := OrigSize;
DrawSizeRect(NewSize);
end;procedure DoSwap(DoSwap: boolean; var a, b: integer);
var
t : integer;
begin
if DoSwap then begin
t := a;
a := b;
b := t;
end;
end;procedure TResizer.SizerUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if NewSize.Right < NewSize.Left then
DoSwap(True, NewSize.Right, NewSize.Left);
if NewSize.Bottom < NewSize.Top then
DoSwap(True, NewSize.Bottom, NewSize.Top); Sizing := False;
DrawSizeRect(NewSize);
ResizeControl.Invalidate;
ResizeControl.BoundsRect := NewSize;
ShowSizers;
if Assigned(OnSized) then OnSized(Self);
end;procedure TResizer.SizerMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if Sizing then begin
DrawSizeRect(NewSize); if AllowSize then begin
Calc_Size_Rect((Sender as TSizer).Tag, X - DownX, Y - DownY);
DoSizingEvent;
end; DrawSizeRect(NewSize);
if HotTrack then ResizeControl.BoundsRect := NewSize;
end;
end;procedure TResizer.DoSizingEvent;
var
tmpWid, tmpHgt : integer;
begin
tmpWid := NewSize.Right - NewSize.Left;
tmpHgt := NewSize.Bottom - NewSize.Top;
if Assigned(OnSizing) then
OnSizing(Self, NewSize.Left, NewSize.Top, tmpWid, tmpHgt);
NewSize.Right := NewSize.Left + tmpWid;
NewSize.Bottom := NewSize.Top + tmpHgt;
end;