谁能帮我看看这个控件(源代码)为什么不能显示?把c++builder程序转换成Delphi的。 (100分)

  • 主题发起人 kelvin-lee
  • 开始时间
K

kelvin-lee

Unregistered / Unconfirmed
GUEST, unregistred user!
unit CsPipeLine;

interface

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

type

TCsPipeLine = class(TGraphicControl)
private
{ Private declarations }
FIndex:Integer ;
FNumber:Integer;
FDirection:TDirection;
FIncrease:TYesNo ;
FRuning:TYesNo ;
FSpeed:Integer;
FfColor:TColor ;
FbColor:TColor ;
Ftimer1:TTimer;

procedure SetfColor(Value:TColor);
procedure SetbColor(Value:TColor);
procedure SetIncrease(Value:TYesNo );
procedure SetRuning(Value:TYesNo );
procedure SetDirection(Value:TDirection );
procedure SetSpeed(Value:Integer );
procedure SetNumber(Value:Integer);
procedure PaintBackground(var AnImage:TBitmap);
procedure PaintAsBar(var AnImage:TBitmap; const PaintRect:TRect);

protected
procedure Paint; //virtual;

public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure StyleChanged(Sender:TObject);


published
property DragCursor;
property DragMode;
property OnDragOver;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property PopupMenu ;
property ShowHint ;
property Color ;
property Visible ;
property Height;
property Width;
property Direction:TDirection read FDirection write SetDirection nodefault;
property Increase:TYesNo read FIncrease write SetIncrease nodefault;
property Runing:TYesNo read FRuning write SetRuning nodefault;
property Number:Integer read FNumber write SetNumber nodefault;
property Speed:Integer read FSpeed write SetSpeed nodefault;
property ForeColor:TColor read FfColor write SetfColor nodefault;
property BackColor:TColor read FbColor write SetbColor nodefault;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('CS Controls', [TCsPipeLine]);
end;

constructor TCsPipeLine.Create(AOwner: TComponent);
begin
// TGraphicControl
inherited Create(AOwner);
ControlStyle := ControlStyle+[csOpaque,csFramed ,csReplicatable]; {???}
FIndex:=0;
FDirection:=Horizontal;
FIncrease:=Yes;
FRuning:=No;
FNumber:=3;
FSpeed:=100;
FfColor:=clBlue;
FbColor:=clGreen;
Width:=165;
Height:=65;
Ftimer1:=TTimer.create(AOwner) ;
Ftimer1.Enabled:=false;
Ftimer1.Interval:=FSpeed;
Ftimer1.OnTimer:=StyleChanged;
end;

destructor TCsPipeLine.Destroy;
begin
Ftimer1.Free;
inherited Destroy;
end;

procedure TCsPipeLine.StyleChanged(Sender:TObject);
begin
if FIncrease=Yes then
begin
inc(FIndex);
if FDirection=Horizontal then
if FIndex>Width/FNumber then
FIndex:=0;
if FDirection=Vertical then
if FIndex>Height/FNumber then
FIndex:=0;
end;
if FIncrease=No then
begin
dec(FIndex);
if (FDirection=Horizontal) then
if (FIndex<0) then
FIndex:=Width div FNumber;
if (FDirection=Vertical) then
if (FIndex<0) then
FIndex:=Height div FNumber;
end;
Invalidate;
end;
//-----------------------------------------------------
procedure TCsPipeLine.SetDirection(Value:TDirection );
begin
if (FDirection<>Value) then
begin
FDirection:=Value;
Invalidate;
end;
end;
//-----------------------------------------------------
procedure TCsPipeLine.SetIncrease( Value:TYesNo);
begin
if (FIncrease<>Value) then
begin
FIncrease:=Value;
end;
Invalidate;
end;
//-----------------------------------------------------
procedure TCsPipeLine.SetRuning(Value:TYesNo ) ;
begin
if (FRuning<>Value) then
begin
FRuning:=Value;
if (FRuning=Yes) then
Ftimer1.Enabled:=true
else
Ftimer1.Enabled:=false;
end;
end;
//-----------------------------------------------------
procedure TCsPipeLine.SetNumber(Value:Integer) ;
begin
if (FNumber<>Value) then
begin
FNumber:=Value;
Invalidate;
end;
end;
//-----------------------------------------------------
procedure TCsPipeLine.SetSpeed(Value:Integer ) ;
var aa :boolean;
begin
if (FSpeed<>Value) then
begin
FSpeed:=Value;
aa:=Ftimer1.Enabled;
Ftimer1.Enabled:=false;
Ftimer1.Interval:=FSpeed;
Ftimer1.Enabled:=aa;
end;
end;
//-----------------------------------------------------
procedure TCsPipeLine.SetfColor(Value:TColor ) ;
begin
if (Value <> FfColor) then
begin
FfColor := Value;
Invalidate;
end;
end;
//-----------------------------------------------------
procedure TCsPipeLine.SetbColor(Value:TColor ) ;
begin
if (Value <> FbColor) then
begin
FbColor := Value;
Invalidate;
end;
end;
//-----------------------------------------------------
procedure TCsPipeLine.Paint;
var TheImage:TBitmap ;
OverlayImage :TBltBitmap;
PaintTRect:TRect;
begin
TheImage:=TBitmap.Create;
OverlayImage:=TBltBitmap.Create;
TheImage.Height := Height;
TheImage.Width := Width;
PaintBackground(TheImage);
PaintTRect := ClientRect;
OverlayImage.MakeLike(TheImage);
PaintBackground(Tbitmap(OverlayImage));
PaintAsBar(TBitmap(OverlayImage), PaintTRect);
TheImage.Canvas.CopyMode := cmSrcInvert;
TheImage.Canvas.Draw(0, 0, OverlayImage);
TheImage.Canvas.CopyMode := cmSrcCopy;
Canvas.CopyMode := cmSrcCopy;
Canvas.Draw(0, 0, TheImage);
end;
//---------------------------------------------------------------------------
procedure TCsPipeLine.PaintBackground(var AnImage:TBitmap ) ;
var ARect: TRect;
begin
AnImage.Canvas.CopyMode:= cmBlackness;
ARect := Rect(0, 0, Width, Height);
AnImage.Canvas.CopyRect(ARect, AnImage.Canvas, ARect);
AnImage.Canvas.CopyMode := cmSrcCopy;
end;
//-----------------------------------------------------------------------
procedure TCsPipeLine.PaintAsBar(var AnImage:TBitmap; const PaintRect :TRect) ;
var PRect: TRect;
i,x1,x2,y1,y2,W,H:integer;
begin
W:=PaintRect.Right-PaintRect.Left;
H:=PaintRect.Bottom-PaintRect.Top;
AnImage.Canvas.Brush.Color:=FbColor;
AnImage.Canvas.FillRect(PaintRect);
if (FDirection=Horizontal) then
begin
AnImage.Canvas.Brush.Color:=FfColor;
for i:=0 to FNumber-1 do
begin
x1:=FIndex+2*i*(W) div (2*FNumber);
y1:=(H) div 3;
x2:=x1+(W)div(2*FNumber);
y2:=(H)*2 div 3;
PRect.Left:=x1;
PRect.Top:=y1;
PRect.Right:=x2;
PRect.Bottom:=y2;
AnImage.Canvas.FillRect(PRect);
if (x2>W) then
begin
PRect.Left:=0;
PRect.Top:=y1;
PRect.Right:=x2-W;
PRect.Bottom:=y2;
AnImage.Canvas.FillRect(PRect);
end;
end;
end
else
begin
AnImage.Canvas.Brush.Color:=FfColor;
for i:=0 to FNumber-1 do
begin
y1:=FIndex+2*i*(H) div(2*FNumber);
x1:=(W)div 3;
y2:=y1+(H)div(2*FNumber);
x2:=(W)*2 div 3;
PRect.Left:=x1;
PRect.Top:=y1;
PRect.Right:=x2;
PRect.Bottom:=y2;
AnImage.Canvas.FillRect(PRect);
if (y2>H) then
begin
PRect.Left:=x1;
PRect.Top:=0;
PRect.Right:=x2;
PRect.Bottom:=y2-H;
AnImage.Canvas.FillRect(PRect);
end;
end;
end;
end;

end.
 
上面的代码是不是太多了,那就简单点,哪位大哥能帮我下面的C++builder 程序
改成Delphi程序,小弟先谢谢了。
...
void __fastcall TBltBitmap::MakeLike(Graphics::TBitmap* ATemplate)
{
Width = ATemplate->Width;
Height = ATemplate->Height;
Canvas->Brush->Color = TColor(clWindowFrame);
Canvas->Brush->Style = bsSolid;
Canvas->FillRect(Rect(0, 0, Width, Height));
}
...
void __fastcall TSiren::paint(void)
{
std::auto_ptr<Graphics::TBitmap> TheImage(new Graphics::TBitmap());
std::auto_ptr<TBltBitmap> OverlayImage(new TBltBitmap());
TRect PaintTRect;

TheImage->Height = Height;
TheImage->Width = Width;
PaintBackground(TheImage.get());
PaintTRect = ClientRect;
OverlayImage->MakeLike(TheImage.get());
PaintBackground(OverlayImage.get());
PaintAsBar(OverlayImage.get(), PaintTRect);
TheImage->Canvas->CopyMode = cmSrcInvert;
TheImage->Canvas->Draw(0, 0, OverlayImage.get());
TheImage->Canvas->CopyMode = cmSrcCopy;
Canvas->CopyMode = cmSrcCopy;
Canvas->Draw(0, 0, TheImage.get());
}
//---------------------------------------------------------------------------
void __fastcall TSiren::paintBackground(Graphics::TBitmap* AnImage)
{
TRect ARect;
AnImage->Canvas->CopyMode = cmBlackness;
ARect = Rect(0, 0, Width, Height);
AnImage->Canvas->CopyRect(ARect, AnImage->Canvas, ARect);
AnImage->Canvas->CopyMode = cmSrcCopy;

}
//-----------------------------------------------------------------------
void __fastcall TSiren::paintAsBar(Graphics::TBitmap* AnImage, const TRect& PaintRect)
{
int x2,y2;
AnImage->Canvas->Brush->Color=Color;
AnImage->Canvas->FillRect(PaintRect);
AnImage->Canvas->Font=Font;
x2=PaintRect.Width();
y2=PaintRect.Height();
if (FSiren==Yes)
{
if (FIndex==0)
{
AnImage->Canvas->Pen->Color=FAColor;
AnImage->Canvas->Brush->Color=FAColor;
AnImage->Canvas->Ellipse(0,0,x2,y2);
}
}
else
{
AnImage->Canvas->Pen->Color=FNColor;
AnImage->Canvas->Brush->Color=FNColor;
AnImage->Canvas->Ellipse(0,0,x2,y2);
}
}
....
 
只是有点麻烦巴,应该不会有什么技术障碍
 
Graphics::TBitmap* AnImage
这行代码对应的delphi代码是什么?
可以定义指向TBitmap的指针吗?可以的话,如何定义?
 
AnImage : ^Graphics.TBitmap
 
谢谢expect兄的回答,小弟的C++水平实在太差。
可是 void __fastcall TPipeLine::paintBackground(Graphics::TBitmap* AnImage)
变成procedure TPipeLine.PaintBackground(AnImage : ^Graphics.TBitmap ) ;通不过。
麻烦你帮我把这几句代码变成delphi的。先谢谢了。
void __fastcall TSiren::paint(void)
{
std::auto_ptr<Graphics::TBitmap> TheImage(new Graphics::TBitmap());
..
PaintBackground(TheImage.get());
...
}
void __fastcall TPipeLine::paintBackground(Graphics::TBitmap* AnImage)
{
...}
 
我发到你的邮箱了!
 
DELPHI中一般不需要显形的使用对象指针。我晚上看看帮你改一下。
 
谢谢大家了,尤其是爱峥提供的源代码。
 
Object Passcal 不支持 模板,不能直接翻译
 
多人接受答案了。
 
顶部