在DBGrid上面放一个image控件,在image上画一个直径为40像素的蓝色实心圆,除这个实心圆外其它地方可否实现透明?(50分)

  • 主题发起人 主题发起人 SP229
  • 开始时间 开始时间
S

SP229

Unregistered / Unconfirmed
GUEST, unregistred user!
如韪.
image控件画实心圆,除实心圆外其它地方透明.
 
可以继承一个 dbgrid 重写 wmpaint 在里面画
dc:=GetDC(dbGrid1.Handle);
Ellipse(dc,10,10,100,100);
rgn:=CreateEllipticRgn(10, 10,100,100);
SelectClipRgn(dc,rgn);
FillRect(dc,dbGrid1.ClientRect,GetStockObject(GRAY_BRUSH));
否则用上面过程画,关键要处理重绘的动作
 
不知image控件可不可以实现透明?
 
TO 总有爱:
我编译好象通不过?
能否贴完整点?
 
to 总有爱
画了以后如何清除,更新?
 
如果要在画的圆上写字,如何做?
画刷的颜色,字体的颜色怎么设置?
 
不用IMAGE,好象可以自己DRAW上去吧。。。
 
to 总有爱
你的方法可以,
如果要在画的圆上写字,如何做?
画刷的颜色,字体的颜色怎么设置?
 
procedure TFrmYC.Button1Click(Sender: TObject);
var
i,J: integer;
T,L,R: Integer;
KX: Integer;//空隙
begin
L:=20;
T:=50;
R:=34;
KX:=6;
DC:=GetDC(dbGrid1.Handle);
for i := 0 to 1 do
begin
for j := 0 to 4 do
begin
Ellipse(dc,L+R*J+KX*J,T+KX*I+R*I,L+R*J+KX*J+R,T+KX*I+R*I+R);

rgn:=CreateEllipticRgn(L+R*J+KX*J,T+KX*I+R*I,L+R*J+KX*J+R,T+KX*I+R*I+R);
SelectClipRgn(dc,rgn);
FillRect(dc,dbGrid1.ClientRect,GetStockObject($000000ff));//这里设置成蓝色画出来还是白色的
end;
end;
end;
 
FillRect(dc,dbGrid1.ClientRect,GetStockObject($000000ff));//
GetStockObject 替换成--->CreateSolidBrush (COLOR clr)
 
to 总有爱
如果要在画的圆上写字,如何做?
字体的颜色怎么设置?
 
写字.textout(dc,x,y,text,length);
创建一个 savePen,NewPen,TPen
newPen.color:=cl...
newPen.width:=
savePen:= SelectObject(fdc,newPen.handle)
画完后
selectObject(fdc,savePen);
 
to 总有爱
fdc是哪个句柄,如果把你上面的放在下面应如何做.
procedure TFrmYC.Button1Click(Sender: TObject);
var
i,J: integer;
T,L,R: Integer;
KX: Integer;//空隙
begin
L:=20;
T:=50;
R:=34;
KX:=6;
DC:=GetDC(dbGrid1.Handle);
for i := 0 to 1 do
begin
for j := 0 to 4 do
begin
Ellipse(dc,L+R*J+KX*J,T+KX*I+R*I,L+R*J+KX*J+R,T+KX*I+R*I+R);
//写在这儿怎么做,单独可以写出字了.我设newpen.color:=clblue,但字体是黑色的
rgn:=CreateEllipticRgn(L+R*J+KX*J,T+KX*I+R*I,L+R*J+KX*J+R,T+KX*I+R*I+R);
SelectClipRgn(dc,rgn);
FillRect(dc,dbGrid1.ClientRect,GetStockObject($000000ff));
end;
end;
end;
 
fdc:=GetDC(dbgrid1.handle)
 
你究竟是想实现什么效果,如果只是特别标识一下,让用户注意,你直接动态创建一个TShape控件放在那里不就完了,更方便。
 
to 娃娃
tstrings中有一组号码是通过一些公式得到.比如
05 06 28 19
33 24 08 17 29 44
我就临时创建10 个圆.在这些圆上分别写上这些数字.我窗体上已经很满了,又不想把它放到另外的窗口上.因此就想放在DBGRID上,用完刷新一下就可以了.经过一下午试验,还有点问题没解决.我想字体的颜色为白色(现在字体为黑色,底为白色)底色同圆的颜色.不知这样说有没有说清楚? 把下面的代码贴过去就可以试
dc: hdc;
rgn: hrgn;
implementation
const
X_BB1='01 02 07 08 12 13 18 19 23 24 29 30 34 35 40 45 46';
X_BB2='03 04 09 10 14 15 20 25 26 31 36 37 41 42 47 48';
X_BB3='05 06 11 16 17 21 22 27 28 32 33 38 39 43 44 49';

{$R *.dfm}
//返回字符串是否是正确的数字表达
function IsNumber(mStr: string): Boolean; stdcall;
var
I: Real;
E: Integer;
begin
Val(mStr, I, E);
Result := E = 0;
E := Trunc(I);
end;

//在字符前面加增加指定字符
function Add_Space(str,AddStr:string;Size:integer):string;stdcall;
begin
result:=str;
if length(str)>=size then exit;
while length(result)<size do
result:=AddStr+result;
end;

function GetBS(NumStr:String):TColor;//波色
begin
Result:=clBtnFace;
if IsNumber(NumStr) then
NumStr:=Add_Space(NumStr,'0',2);
if AnsiContainsText(X_BB1,NumStr) then
result:=clRed;
if AnsiContainsText(X_BB2,NumStr) then
result:=clBlue;
if AnsiContainsText(X_BB3,NumStr) then
result:=clGreen;
end;

{
memo中的内容
05 06 28 19
33 24 08 17 29 44
}
procedure TForm1.Button2Click(Sender: TObject);
var
i,J: integer;
T,L,R: Integer;
KX: Integer;//空隙

aColor: TColor;
NewPen: TPen;
SavePen: HGDIOBJ;
tmpL: TStrings;
s: string;
begin
L:=20;
T:=50;
R:=34;
KX:=6;
NewPen:=TPen.Create;
tmpL:=TStringList.Create;
DC:=GetDC(dbGrid1.Handle);
for i := 0 to memo1.Lines.Count-1 do
begin
s:=memo1.Lines.Strings;
tmpL.Clear;
tmpL.Text:=StringReplace(s, ' ', #13#10, [rfReplaceAll]);

for j := 0 to tmpL.Count-1 do
begin
aColor:=GetBS(tmpL.Strings[J]);
Ellipse(dc,L+R*J+KX*J,T+KX*I+R*I,L+R*J+KX*J+R,T+KX*I+R*I+R);
rgn:=CreateEllipticRgn(L+R*J+KX*J,T+KX*I+R*I,L+R*J+KX*J+R,T+KX*I+R*I+R);
SelectClipRgn(dc,rgn);
FillRect(dc,dbGrid1.ClientRect,CreateSolidBrush(aColor));
//************************
{
font.Name:='宋体';
Font.Color:=clWhite;
font.Size:=R-20;
}

textout(dc,L+R*J+KX*J+8,T+KX*I+R*I+8,pchar(tmpL.strings[j]),2);
newPen.color:=aColor;
newPen.width:=4;
savePen:= SelectObject(dc,newPen.handle);
selectObject(dc,savePen);
//************************
end;
end;
end;
 
或者你把你想要的效果画个示意图发过来给我看看了。
computer@deruntex.com
 
to 娃娃
效果图已发过去了.
 

Similar threads

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