delphi控件改成bcb控件的一些小问题(100分)

  • 主题发起人 主题发起人 Town
  • 开始时间 开始时间
T

Town

Unregistered / Unconfirmed
GUEST, unregistred user!
第一次练习写BCB控件,准备把一个有源码的Delphi扑克控件Tomcard改写
到BCB中去.但是遇到了很多问题,请各位帮帮忙.
1.原来的控件使用dll文件,图片都放在dll里面.我现在想不用dll,
而是直接 从资源文件CardImg.res中调用图片,不知可否?
如果可以的话,是不是每做一个程序都要把这个资源文
件CardImg.res放到当前目录下呢?
2.如下两个函数:
constructor TCard.Create(AOwner: TComponent);
destructor TCard.Destroy;
与BCB中的如下两个函数是对应的吗?
__fastcall TCard::TCard(TComponent* Owner)
: TGraphicControl(Owner)
__fastcall TCard::~TCard(void)

3.ControlStyle := ControlStyle + [csOpaque];怎么改成CBuilder的
语言?

4.我改完的东东根本不工作的说,我快放弃了.sigh!哪位大虾
愿意帮俺改成BCB下用资源文件的形式,俺回头再加100分,
虽然少了点,可是已经是俺一半家产了.)

以下部分是控件TTomCard的源代码,懒得给俺帮忙的就不用看了,呵呵 :)

unit TomCard;
interface

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

type
TDirect = (dDown,dRight,dTop,dLeft);
TCardSuit = (csDiamonds,csClubs,csSpades,csHearts);
TCardState = (ctFront,ctBack);
TCardBacks = (cbPatternGray, cbPatternInterleave, cbPatternPerpendicular,
cbRobot, cbRoses,
cbAcornsBlack, cbAcornBlue,
cbFishFour, cbFishThree,
cbSeaShell, cbCastle, cbBeach, cbSleeve,
{cbNothing,} // invalid - there is an id "missing" in the DLL
cbCross, cbCircle); // place holders
TTransparencyModes = (tmCopy, tmEdit, tmNone);
{ tmCopy = uses BrushCopy to replace all white in the picture (actually, it
finds the colour of the pixel at 0,0) with the parent.brush.color
tmEdit = paints 3 pixels in each of the four corners with the parent.brush.color
tmNone = fastest (does a straight copy) }

const
Err1 = 'Unable to load %s ';
Err2 = 'Resource #%d not found (%s)';
Err3 = 'Bitmap #%d hasn''t been stored properly';
DefaultFN = 'CARDS32.DLL';
SuitSize = 13;
NumSuits = 4;
DeckSize = SuitSize*NumSuits;
TCardBackIDs : array[1..15] of Byte = (53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, {miss one} 67, 68);
AboutStr = 'TCARDS Version 1.1 '+
'Version 1.0 written by Tom Lee (Taiwan, tom@libra.aaa.hinet.net, http://www.aaa.hinet.net/delphi). '+
'Version 2.0 written by Ian Hickson (UK, exxieh@bath.ac.uk, http://www.bath.ac.uk/~exxieh). '+
'?copyright 1996 by Ian Hickson. FREEWARE: Distribute at will.';


type
TCard = class(TGraphicControl)
private
{ Private declarations }
FPicture: TPicture; // from ExtCtrls
FState:TCardState;
FCardBackStyle:TCardBacks;
FValue:integer;
FUp:Boolean;
FSuit:TCardSuit;
FFileName : String;
FTransparent : TTransparencyModes;
FDirect : TDirect;
procedure LoadDLLBmp(BmpId:Integer; Dest:TBitmap);
procedure SetState(value:TCardState);
procedure SetCardBackStyle(value:TCardBacks);
procedure SetValue(value:integer);
procedure SetAbout(value:string);
function GetAbout : string;
procedure SetFileName(value:String);
procedure SetSuit(value:TCardSuit);
procedure SetTransparent(Value:TTransparencyModes);
procedure SetDirect(value:TDirect);
procedure DisplayCard;
procedure SetID(Value:integer);
procedure SetUp(value:Boolean);
function GetCanvas: TCanvas; // from ExtCtrls
procedure PictureChanged(Sender: TObject); // from ExtCtrls
protected
{ Protected declarations }
function GetPalette: HPALETTE; override; // from ExtCtrls
procedure Paint; override; // from ExtCtrls
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Canvas: TCanvas read GetCanvas; // from ExtCtrls
published
{ Published declarations }
procedure GoUp;
Procedure GoDown;
property Up :Boolean read FUp write SetUp;
property About : String read GetAbout write SetAbout stored False;
property State:TCardState read Fstate write SetState default ctFront;
property CardBackStyle : TCardBacks read FCardBackStyle write SetCardBackStyle default cbRoses;
property Value:integer read FValue write SetValue default 1;
property Suit:TCardSuit read FSuit write SetSuit default csHearts;
property FileName : String read FFileName write SetFileName;
property id : integer write SetID stored false;
property Direct : TDirect read FDirect write SetDirect default dDown;
property TransparencyMode : TTransparencyModes read FTransparent write SetTransparent default tmEdit;

// from ExtCtrls
property DragCursor;
property DragMode;
property Enabled;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Visible;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDrag;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Games', [TCard]);
end;

constructor TCard.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FPicture := TPicture.Create; // from ExtCtrls.pas
FPicture.OnChange := PictureChanged; // from ExtCtrls.pas
ControlStyle := ControlStyle + [csOpaque];
FState := ctFront;
FCardBackStyle := cbRoses;
FValue := 1;
FSuit := csHearts;
FFileName := DefaultFN;
FTransparent := tmEdit;
FUp:=False;
DisplayCard;
end;

destructor TCard.Destroy; // from ExtCtrls.pas
begin
FPicture.Free;
inherited Destroy;
end;

function TCard.GetPalette: HPALETTE; // modified from ExtCtrls.pas
begin
Result := TBitmap(FPicture.Graphic).Palette;
end;

procedure TCard.SetUp(Value:boolean);
begin
if value<>FUp then
begin
FUp:=Value;
if value then GoUp else GoDown;
end;
end;

procedure TCard.GoUp;
const
Step=15;
begin
Hide;
case FDirect of
dDown:Top:=Top-step;
dLeft:Left:=Left+Step;
dTop:Top:=Top+Step;
dRight:Left:=Left-Step;
end;
Show;
end;

procedure Tcard.GoDown;
const
Step=15;
begin
Hide;
case FDirect of
dDown:Top:=Top+step;
dLeft:Left:=Left-Step;
dTop:Top:=Top-Step;
dRight:Left:=Left+Step;
end;
Show;
end;

procedure TCard.LoadDLLBmp(BmpId:Integer; Dest:TBitmap);
{ Based on palette-preserving code in Lloyd's LDELPHI.HLP }
var
Lib,rInfo,hMemory: THandle;
rSize: Longint;
pData: PByte;
BmpHdr: TBitmapFileHeader;
stream: TMemoryStream;
begin
Lib := LoadLibrary(PCHar(FFileName));
if Lib < HINSTANCE_ERROR then raise Exception.CreateFmt(Err1,[FFileName]); // ['Cards32.DLL']
{ locate bitmap within library }
rInfo := FindResource(Lib, MakeIntResource(BmpId), rt_Bitmap);
if rInfo = 0 then raise Exception.CreateFmt(Err2,[BmpId,'FindResource']);
{ load bitmap into global memory }
hMemory := LoadResource(Lib,rInfo);
try
if hMemory = 0 then raise Exception.CreateFmt(Err2,[BmpId,'LoadResource']);
{ pin down the global memory to a specific address }
pData := LockResource(hMemory);
try
{ find upperbound of bitmap library usage }
rSize := SizeofResource(Lib,rInfo);
if rSize = 0 then raise Exception.CreateFmt(Err3,[BmpId]);
{ write to a stream so we can use TBitmap.LoadFromStream }
stream := TMemoryStream.Create;
try
{ fake a BM header to keep LoadFromStream happy }
BmpHdr.bfType := $4D42;
stream.SetSize(sizeof(BmpHdr)+rSize);
stream.Write(BmpHdr,sizeof(BmpHdr));
stream.Write(pData^,rSize);
stream.Seek(0,0);
Dest.LoadFromStream(stream);
finally
stream.Free;
end;
finally
UnlockResource(hMemory);
end;
finally
FreeResource(hMemory);
end;
end;

procedure TCard.SetDirect(Value:TDirect);
begin
if Value<>FDirect then
begin
FDirect:=value;
DisplayCard;
end;
end;
procedure TCard.SetState(value:TCardState);
begin
if value<>FState then
begin
FState:=value;
DisplayCard;
end;
end;

procedure TCard.SetFileName(value:String);
begin
if value<>'' then
begin
FFileName:=value;
DisplayCard;
end;
end;

procedure TCard.SetCardBackStyle(value:TCardBacks);
begin
if value<>FCardBackStyle then
begin
FCardBackStyle:=value;
if state=ctBack then DisplayCard;
end;
end;

procedure TCard.SetID(Value:integer);
begin
if (value>DeckSize) or (value<0) then exit;
Case Value of
0 : FState := ctBack;
1..13: FSuit := csSpades;
14..26: FSuit := csDiamonds;
27..39: FSuit := csClubs;
40..52: FSuit := csHearts;
end;
FValue := Value - (SuitSize*((Value-1) div SuitSize)); // this works. I don't understand why, and I don't want to know. - exxieh
DisplayCard;
end;

procedure TCard.SetValue(value:integer);
begin
if (value>SuitSize) or (value<1) then exit;
if value<>FValue then
begin
FValue:=value;
DisplayCard;
end;
end;

procedure TCard.SetSuit(value:TCardSuit);
begin
if value<>FSuit then
begin
FSuit:=value;
DisplayCard;
end;
end;

procedure TCard.SetTransparent(Value:TTransparencyModes);
begin
if Value<>FTransparent then
begin
FTransparent := Value;
DisplayCard;
end;
end;

procedure TCard.SetAbout(value:string);
begin
end;

function TCard.GetAbout : string;
begin
Result := AboutStr;
end;

//----------------------------------------------------------------------//

Procedure TCard.DisplayCard;
Type
RGB=record r,g,b:byte;end;
TBuf1=array[0..95,0..70]of RGB;{BMP}
TBuf2=array[0..70,0..95]of RGB;{FPicture}
RGBArray=array[0..100]of RGB;
PRGBArray=^RGBArray;
PBuf=^TBuf1;
var
Id:integer;
X,Y:integer;
Bmp:TBitmap;
P1:PRGBArray;
Buf2:TBuf2;
oldpf:TPixelFormat;
begin
Bmp:=TBitmap.Create;
if FState=ctFront then
ID:=FValue+Ord(FSuit)*SuitSize
else
begin
ID:=TCardBackIDs[Byte(FCardBackStyle)+1];
end;
FPicture.Bitmap.Monochrome:=false;
Bmp.Canvas.CopyMode:=cmSrcCopy;
LoadDLLBmp(ID,Bmp);
Fpicture.Bitmap:=Bmp;
case FDirect of
dTop:begin
FPicture.Bitmap.Monochrome:=false;
with FPicture.Bitmap do
Canvas.CopyRect(Rect(Width-1,Height-1,0,0),Bmp.Canvas,
Rect(0,0,Width-1,Height-1));
end;
dRight:begin
oldpf:=Bmp.PixelFormat;
Bmp.PixelFormat:=pf24bit;
for x:=0 to 95 do
begin
p1:=Bmp.scanLine[95-x];
for y:=0 to 70 do
Buf2[y,95-x]:=P1^[y];
end;
FPicture.Bitmap.Width:=96;
Fpicture.Bitmap.Height:=71;
FPicture.Bitmap.PixelFormat:=pf24bit;
p1:=Fpicture.Bitmap.ScanLine[70];
Move(Buf2,p1^,SizeOf(Buf2));
FPicture.Bitmap.PixelFormat:=oldpf;
end;
dLeft:begin
oldpf:=Bmp.PixelFormat;
Bmp.PixelFormat:=pf24bit;
for x:=0 to 95 do
begin
p1:=Bmp.scanLine[95-x];
for y:=0 to 70 do
Buf2[70-y,x]:=P1^[y];
end;
FPicture.Bitmap.Width:=96;
Fpicture.Bitmap.Height:=71;
FPicture.Bitmap.PixelFormat:=pf24bit;
p1:=Fpicture.Bitmap.ScanLine[70];
Move(Buf2,p1^,SizeOf(Buf2));
FPicture.Bitmap.PixelFormat:=oldpf;
end;
end;
Bmp.Free;
end;

// Needed so that the pictures are TRANSPARENT.
procedure TCard.Paint; // Modifed from ExtCtrls.pas
var
Dest: TRect;
begin
Dest := Rect(0, 0, FPicture.Width, FPicture.Height);
inherited Canvas.Brush := Parent.Brush; // this could be tricky.
with inherited Canvas do
begin
If TransparencyMode = tmCopy then
begin
BrushCopy (Dest, TBitmap(FPicture.Graphic), Dest, TBitmap(FPicture.Graphic).Canvas.Pixels[0,0]);
end
else
If TransparencyMode = tmEdit then // basically this is hard coded for my version of CARDS32.DLL so watch out...
begin
Draw (0, 0, TBitmap(FPicture.Graphic));
Pixels[ 0, 0] := Brush.Color;
Pixels[ 1, 0] := Brush.Color;
Pixels[ 0, 1] := Brush.Color;
Pixels[Self.Width-1, 0] := Brush.Color;
Pixels[Self.Width-2, 0] := Brush.Color;
Pixels[Self.Width-1, 1] := Brush.Color;
Pixels[ 0, Self.Height-1] := Brush.Color;
Pixels[ 1, Self.Height-1] := Brush.Color;
Pixels[ 0, Self.Height-2] := Brush.Color;
Pixels[Self.Width-1, Self.Height-1] := Brush.Color;
Pixels[Self.Width-2, Self.Height-1] := Brush.Color;
Pixels[Self.Width-1, Self.Height-2] := Brush.Color;
{
* * ?* *
* 1 ?2 * Overwrites 3 pixels in each corner
----+---- with the parent's brush colour.
* 3 ?4 *
* * ?* *
}
end
else
begin
Draw (0, 0, TBitmap(FPicture.Graphic));
end;
end;
end;

function TCard.GetCanvas: TCanvas; // modified from ExtCtrls.pas
var
Bitmap: TBitmap;
begin
if FPicture.Graphic = nil then
begin
Bitmap := TBitmap.Create;
try
Bitmap.Width := Width;
Bitmap.Height := Height;
FPicture.Graphic := Bitmap;
finally
Bitmap.Free;
end;
end;
Result := TBitmap(FPicture.Graphic).Canvas;
end;

procedure TCard.PictureChanged(Sender: TObject); // lightly modified from ExtCtrls.pas
begin
if (FPicture.Width > 0) and (FPicture.Height > 0) then
SetBounds(Left, Top, FPicture.Width, FPicture.Height);
Invalidate;
end;


end.


 
2。你的函数是对的。
3。应是TCard.ControlStyle =TCard.ControlStyle + csOpaque;
也有可能是TCard.ControlStyle =TCard.ControlStyle | csOpaque;
 
1.不必要,只要这个资源文件在库的路径上就可以了.就是那个
$(BCB)/Lib;$(BCB)/Lib/Obj中加上这个资源文件的路径:
$(BCB)/Lib;$(BCB)/Lib/Obj;YourCtlPath

2.基本上可以这么说.注意PASCAL要程序员自己调用基类的
构造函数,而C++会帮您完成这个工作.这就是说,构造函数中
的这一行:
inherited Create(AOwner);
在C++中是不需要的,析构函数中的
inherited Destory;
在C++中也是不需要的.但其它函数的
inherited XXX;
是需要的.

3.好象应该是
ControlStyle << csOpaque;

4.有何反映?这么大的控件,您耐心真不错!
 
经过两位帮助,并参考CGauges的源码,经过不懈地努力,现在已经似懂非懂了,
进步挺大,呵呵.现在还有一个问题,即俺的控件一托到Form上,就说俺的控件
没有Parent,因此不工作的说 :(.我看了前面有人问的关于控件不显示的问题,
好象是要在构造函数中写入
Parent:=TWinControl(Owner) {Delphi 的语句}
俺在CBuilder中不知道怎样写 :(
我写成
Parent=&TWinControl(Owner)
编译通过,但是还是说俺没Parent Window .请问该怎样写呢?(贻笑大方了,呵呵)
提示没有Parent Window,还可能是什么原因造成的呢?
 
是不是要我把自己改写的东东贴出来,大虾才肯指教呢?
我实在不好意思的说,呵呵。
 
没人理我了?
 
多人接受答案了。
 

Similar threads

后退
顶部