紧急求解,非高手勿言。怎样在image 中用鼠标选中图形的一部分,并对该部分用鼠标拖动、剪切、拷贝,粘贴等。(100分)

  • 主题发起人 主题发起人 learningguy
  • 开始时间 开始时间
>一个优秀DELPHI程序员应该善于利用第三方控件。
对,
透明的panel, 我以前也写过一个, 不过...(想起就心痛,以前的资料随着一块破硬盘!@#$%^)

后来看到了flatstyle,看了源程序,思路是一样的, 不过它考虑的东西多一些
下面是它的源程序:
unit TFlatPanelUnit;

interface

{$I DFS.inc}

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

type
TFlatPanel = class(TCustomPanel)
private
FTransparent: Boolean;
FColorHighlight: TColor;
FColorShadow: TColor;
procedure SetColors (Index: Integer; Value: TColor);
procedure CMEnabledChanged (var Message: TMessage); message CM_ENABLEDCHANGED;
procedure CMTextChanged (var Message: TWmNoParams); message CM_TEXTCHANGED;
procedure SetTransparent (const Value: Boolean);
protected
procedure Paint; override;
public
constructor Create (AOwner: TComponent); override;
published
property Transparent: Boolean read FTransparent write SetTransparent default false;
property Caption;
property Font;
property Color;
property ParentColor;
property Enabled;
property Visible;
property ColorHighLight: TColor index 0 read FColorHighlight write SetColors default $008396A0;
property ColorShadow: TColor index 1 read FColorShadow write SetColors default $008396A0;
property Align;
property Alignment;
property Cursor;
property Hint;
property ParentShowHint;
property ShowHint;
property PopupMenu;
property TabOrder;
property TabStop;
{$IFDEF DFS_DELPHI_4_UP}
property AutoSize;
property UseDockManager;
property Anchors;
property BiDiMode;
property Constraints;
property DragKind;
property DragMode;
property DragCursor;
property ParentBiDiMode;
property DockSite;
property OnEndDock;
property OnStartDock;
property OnCanResize;
property OnConstrainedResize;
property OnDockDrop;
property OnDockOver;
property OnGetSiteInfo;
property OnUnDock;
{$ENDIF}
{$IFDEF DFS_DELPHI_5_UP}
property OnContextPopup;
{$ENDIF}
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnStartDrag;
end;

implementation

constructor TFlatPanel.Create (AOwner: TComponent);
begin
inherited Create(AOwner);
ParentFont := True;
FColorHighLight := $008396A0;
FColorShadow := $008396A0;
ParentColor := True;
ControlStyle := ControlStyle + [csAcceptsControls, csOpaque];
SetBounds(0, 0, 185, 41);
end;

procedure TFlatPanel.SetColors (Index: Integer; Value: TColor);
begin
case Index of
0: FColorHighLight := Value;
1: FColorShadow := Value;
end;
Invalidate;
end;

procedure TFlatPanel.Paint;
var
memoryBitmap: TBitmap;
textBounds: TRect;
Format: UINT;
begin
textBounds := ClientRect;
Format := DT_SINGLELINE or DT_VCENTER;
case Alignment of
taLeftJustify:
Format := Format or DT_LEFT;
taCenter:
Format := Format or DT_CENTER;
taRightJustify:
Format := Format or DT_RIGHT;
end;

memoryBitmap := TBitmap.Create; // create memory-bitmap to draw flicker-free
try
memoryBitmap.Height := ClientRect.Bottom;
memoryBitmap.Width := ClientRect.Right;

// Draw Background
if FTransparent then
DrawParentImage(Self, memoryBitmap.Canvas)
else
begin
memoryBitmap.Canvas.Brush.Color := Self.Color;
memoryBitmap.Canvas.FillRect(ClientRect);
end;

// Draw Border
Frame3D(memoryBitmap.Canvas, textBounds, FColorHighlight, FColorShadow, 1);

// Draw Text
memoryBitmap.Canvas.Font := Self.Font;
memoryBitmap.Canvas.Brush.Style := bsClear;
if not Enabled then
begin
OffsetRect(textBounds, 1, 1);
memoryBitmap.Canvas.Font.Color := clBtnHighlight;
DrawText(memoryBitmap.Canvas.Handle, PChar(Caption), Length(Caption), textBounds, Format);
OffsetRect(textBounds, -1, -1);
memoryBitmap.Canvas.Font.Color := clBtnShadow;
DrawText(memoryBitmap.Canvas.Handle, PChar(Caption), Length(Caption), textBounds, Format);
end
else
DrawText(memoryBitmap.Canvas.Handle, PChar(Caption), Length(Caption), textBounds, Format);

// Copy memoryBitmap to screen
canvas.CopyRect(ClientRect, memoryBitmap.canvas, ClientRect);
finally
memoryBitmap.free; // delete the bitmap
end;
end;

procedure TFlatPanel.CMEnabledChanged(var Message: TMessage);
begin
inherited;
Invalidate;
end;

procedure TFlatPanel.CMTextChanged(var Message: TWmNoParams);
begin
inherited;
Invalidate;
end;

procedure TFlatPanel.SetTransparent(const Value: Boolean);
begin
FTransparent := Value;
Invalidate;
end;

end.

其中关键的DrawParentImage的实现:
procedure DrawParentImage(Control: TControl; Dest: TCanvas);
var
SaveIndex: Integer;
DC: HDC;
Position: TPoint;
begin
with Control do
begin
if Parent = nil then
Exit;
DC := Dest.Handle;
SaveIndex := SaveDC(DC);
{$IFDEF DFS_COMPILER_2}
GetViewportOrgEx(DC, @Position);
{$ELSE}
GetViewportOrgEx(DC, Position);
{$ENDIF}
SetViewportOrgEx(DC, Position.X - Left, Position.Y - Top, nil);
IntersectClipRect(DC, 0, 0, Parent.ClientWidth, Parent.ClientHeight);
Parent.Perform(WM_ERASEBKGND, DC, 0);
Parent.Perform(WM_PAINT, DC, 0);
RestoreDC(DC, SaveIndex);
end;
end;
 
透明的PANEL,太容易了,用CoolControls控件包就可以实现,它里面有一个
CoolPanel的控件,把TransParent设为TRUE就OK了,商业性的控件用起来比较稳定。
Bug也比较少,下载还是老地方。
 
多谢amo(阿毛??)兄弟,我曾下过一个flatstyle,不知怎么里面没有flatpanel,你的
是从哪里下的。
 
to cch_b :
我才上网不久,对delphi的站点知之甚少。能告之网址吗?多谢。
 
另外商业控件有收费的问题吗?
 
有哪位能告之到哪里下载CoolControls控件包吗?
 
不是说过了,老地方,看我上面的回答啊。
http://www.net-wing.net/kangwei/
祝下载愉快,哈哈哈
 
多人接受答案了。
 

Similar threads

D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
后退
顶部