大虾请进：Panel 控件如何加入Timage功能？(200分)

在用图像捕获的控件(mcicap)时，它在实时显示时需要一个panel (Twincontrol),
但我想让此panel同时传送图像到远程,想通过timage + timer + nmstream (fastnet)。

我先把该panel继承tpanel,然后将timage的 private,protected等定义照抄到后面,
但就是无法显示image,

自制控件如下：

unit mypanel;

interface
uses Messages, Windows, SysUtils, Classes, Controls, Forms, Menus, Graphics,
StdCtrls,ExtCtrls;

type
tmypanel=class(TPanel)
private
FCanvas: TCanvas;
FPicture: TPicture;
FOnProgress: TProgressEvent;
FStretch: Boolean;
FCenter: Boolean;
FIncrementalDisplay: Boolean;
FTransparent: Boolean;
FDrawing: Boolean;
procedure PictureChanged(Sender: TObject);
procedure SetCenter(Value: Boolean);
procedure SetPicture(Value: TPicture);
procedure SetStretch(Value: Boolean);
procedure SetTransparent(Value: Boolean);
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
protected
function GetCanvas: TCanvas;
function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
function DestRect: TRect;
function DoPaletteChange: Boolean;
function GetPalette: HPALETTE; override;
procedure Paint;
procedure Progress(Sender: TObject; Stage: TProgressStage;
PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string); dynamic;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Canvas: TCanvas read GetCanvas;
published

property Align;
property Anchors;
property AutoSize;
property Center: Boolean read FCenter write SetCenter default False;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property IncrementalDisplay: Boolean read FIncrementalDisplay write FIncrementalDisplay default False;
property ParentShowHint;
property Picture: TPicture read FPicture write SetPicture;
property PopupMenu;
property ShowHint;
property Stretch: Boolean read FStretch write SetStretch default False;
property Transparent: Boolean read FTransparent write SetTransparent default False;
property Visible;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnProgress: TProgressEvent read FOnProgress write FOnProgress;
property OnStartDock;
property OnStartDrag;
end;

procedure Register;


implementation
uses ActiveX, Math, Printers, Consts, CommCtrl, FlatSB, StdActns;

procedure Register;
begin
RegisterComponents('Standard',[Tmypanel]);
end;

constructor tmypanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csReplicatable];
FPicture := TPicture.Create;
FPicture.OnChange := PictureChanged;
FPicture.OnProgress := Progress;
Height := 105;
Width := 105;
end;

destructor tmypanel.Destroy;
begin
FPicture.Free;
inherited Destroy;
end;

function tmypanel.GetPalette: HPALETTE;
begin
Result := 0;
if FPicture.Graphic <> nil then
Result := FPicture.Graphic.Palette;
end;

function tmypanel.DestRect: TRect;
begin
if Stretch then
Result := ClientRect
else if Center then
Result := Bounds((Width - Picture.Width) div 2, (Height - Picture.Height) div 2,
Picture.Width, Picture.Height)
else
Result := Rect(0, 0, Picture.Width, Picture.Height);
end;

procedure tmypanel.Paint;
var
Save: Boolean;
begin
if csDesigning in ComponentState then
with inherited Canvas do
begin
Pen.Style := psDash;
Brush.Style := bsClear;
Rectangle(0, 0, Width, Height);
end;
Save := FDrawing;
FDrawing := True;
try
with inherited Canvas do
StretchDraw(DestRect, Picture.Graphic);
finally
FDrawing := Save;
end;
end;

function tmypanel.DoPaletteChange: Boolean;
var
ParentForm: TCustomForm;
Tmp: TGraphic;
begin
Result := False;
Tmp := Picture.Graphic;
if Visible and (not (csLoading in ComponentState)) and (Tmp <> nil) and
(Tmp.PaletteModified) then
begin
if (Tmp.Palette = 0) then
Tmp.PaletteModified := False
else
begin
ParentForm := GetParentForm(Self);
if Assigned(ParentForm) and ParentForm.Active and Parentform.HandleAllocated then
begin
if FDrawing then
ParentForm.Perform(wm_QueryNewPalette, 0, 0)
else
PostMessage(ParentForm.Handle, wm_QueryNewPalette, 0, 0);
Result := True;
Tmp.PaletteModified := False;
end;
end;
end;
end;

procedure tmypanel.Progress(Sender: TObject; Stage: TProgressStage;
PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string);
begin
if FIncrementalDisplay and RedrawNow then
begin
if DoPaletteChange then Update
else Paint;
end;
if Assigned(FOnProgress) then FOnProgress(Sender, Stage, PercentDone, RedrawNow, R, Msg);
end;

function tmypanel.GetCanvas: TCanvas;
var
Bitmap: TBitmap;
begin
if not assigned(picture.graphic) then
exit;
if Picture.Graphic = nil then
begin
Bitmap := TBitmap.Create;
try
Bitmap.Width := Width;
Bitmap.Height := Height;
Picture.Graphic := Bitmap;
finally
Bitmap.Free;
end;
end;
if Picture.Graphic is TBitmap then
Result := TBitmap(Picture.Graphic).Canvas
else
raise EInvalidOperation.Create(SImageCanvasNeedsBitmap);
end;

procedure tmypanel.SetCenter(Value: Boolean);
begin
if FCenter <> Value then
begin
FCenter := Value;
PictureChanged(Self);
end;
end;

procedure tmypanel.SetPicture(Value: TPicture);
begin
FPicture.Assign(Value);
end;

procedure tmypanel.SetStretch(Value: Boolean);
begin
if Value <> FStretch then
begin
FStretch := Value;
PictureChanged(Self);
end;
end;

procedure tmypanel.SetTransparent(Value: Boolean);
begin
if Value <> FTransparent then
begin
FTransparent := Value;
PictureChanged(Self);
end;
end;

procedure tmypanel.PictureChanged(Sender: TObject);
var
G: TGraphic;
begin
if AutoSize and (Picture.Width > 0) and (Picture.Height > 0) then
SetBounds(Left, Top, Picture.Width, Picture.Height);
G := Picture.Graphic;
if G <> nil then
begin
if not ((G is TMetaFile) or (G is TIcon)) then
G.Transparent := FTransparent;
if (not G.Transparent) and (Stretch or (G.Width >= Width)
and (G.Height >= Height)) then
ControlStyle := ControlStyle + [csOpaque]
else
ControlStyle := ControlStyle - [csOpaque];
if DoPaletteChange and FDrawing then Update;
end
else ControlStyle := ControlStyle - [csOpaque];
if not FDrawing then Invalidate;
end;

function tmypanel.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
begin
Result := True;
if not (csDesigning in ComponentState) or (Picture.Width > 0) and
(Picture.Height > 0) then
begin
if Align in [alNone, alLeft, alRight] then
NewWidth := Picture.Width;
if Align in [alNone, alTop, alBottom] then
NewHeight := Picture.Height;
end;
end;

procedure tmypanel.WMPaint(var Message: TWMPaint);
begin
if Message.DC <> 0 then
begin
Canvas.Lock;
try
Canvas.Handle := Message.DC;
try
Paint;
finally
Canvas.Handle := 0;
end;
finally
Canvas.Unlock;
end;
end;
end;


end.

试一下,把timage作为一个属性,加到制作的控件的property去.

兄弟，你为什么定义的是TPicture而不是TImage？试一试再给分吧！

不知道你到底想要干什么？
想把TPanel上的图像拷贝下来，或者写入图像
只需要定义一个TControlCanvas对象，并 override TPanel的
Paint方法，就可以把面板当PaintBox。
拷贝Panel上的图像方法如下：
1.对象定义
var
bmp:TBitmap; MyCanvas:TControlCanvas;
2.代码实现
MyCanvas:=TControlCanvas.Create;//有无参数，记不得了
MyCanvas.Control:=Panel1;//Panel1为要操作的Panel
bmp:=TBitmap.Create;
bmp.Width:=Panel1.Width;
bmp.Height:=Panel.Height;
bmp.Canvas.CopyRect(Rect(0,0,bmp.Width,bmp.Height),
MyCanvas,Rect(0,0,bmp.Width,bmp.Height),SRC_COPY);//抓图
bmp.SaveToFile('Panel1.bmp'); //存盘
bmp.Free;
MyCanvas.Free; //释放对象
//完毕。

dedman
吕雪松：
Timage 可以放进去，但是如何读写该属性呢？请详细说明；

绿草茵茵：
先让我试一下，但是我想将单帧图像压缩为JPEG格式后再发送出去，timage是没问题的，
但我不想先捕捉单帧后再保存为timage, 这样太慢。

绿草茵茵：
MyCanvas:=TControlCanvas.Create;//有无参数，记不得了
<font color="red"> MyCanvas.Control:=mypanel;//Panel1为要操作的Panel
</font> // 错误: 未定义mypanel

Kaylix:在组件板上拿一个Panel放在窗体上，取名mypanel不就行了！
还有:ID为314370的贴子是我发出的，你就别问绿草茵茵了，
(奇怪：我的贴子怎么署着绿草茵茵的大名？)

>>

问题估计出在你类中的Canvas上
看你的代码:
rocedure tmypanel.WMPaint(var Message: TWMPaint);
begin
if Message.DC <> 0 then
begin
........
end;
end;

注意: 屏幕刷新时WM_Paint消息是windows(而不是Delphi)发给你的控件的, 此时Message.DC永远=0;
因此你的panel永远不会执行任何刷新动作.
你的代码只有在某个程序调用xxx(比如form).PaintTo(DC)时才会调用到.
另外该段程序中可能还存在问题:
Canvas.Handle := Message.DC;
此句执行的是GetCanvas.Handle := Message.DC,
也就是TBitmap(Picture.Graphic).Handle := Message.DC.
我估计会出问题. 即使通过, 我想达到的效果也绝对不是你所希望的那样.

其实如果你继承自TPanel, 完全不必理会什么WM_PAINT消息, 只要override Paint方法
就可以了, 如果不想调用panel原来的刷新程序, 那么在Paint方法中不要inherited就
达到目的了.
如果要自己处理WM_PAINT消息, 标准写法如下:
procedure xxxx.WMPaint(var Message: TWMPaint);
var
DC: HDC;
ps: TPaintStruct;
begin
DC := Message.DC;
if DC = 0 then
Message.DC := BeginPaint(Handle, ps);
// ...... 一些额外操作
ControlState := ControlState + [csCustomPaint];
inherited; // 或者自己的画屏幕程序
ControlState := ControlState - [csCustomPaint];
if DC = 0 then
EndPaint(Handle, ps);
Message.DC := DC;
Message.Result := 0;
end;

g

好像FCavans没有初始化。这应该是个错误吧。
加个Image就行了吧。？

接受答案了.