200分，简单问题，请你出招，通过200分就是你的了。 (200分)

请教如何做一个gauge控件,使backcolor为透明色，显示外观为圆形？急！急！急！
还有如何创建文件夹？zhaohai9@163.net

up

CreateDirectory API函数创建目录

用一个TShape来做Guage控件，其它的可以看看TGuage的源代码，用填充就行了

嘿嘿，200分，请给出源代码，admil大侠。

虽然简单，但并不是三句话就能打发的。

关注

透明基本上就是说将控件后面的颜色重新画到控件上,再进行一定的处理,
就可以显示出半透明或者透明的效果.至于圆形的控件,可以使用api函数,
可以创建出任意形状的控件.你自己查书看看好了,不难的.你应该可以搞定

to bbbboy:您说的我都懂。

没人会吗？

这还需要做么?
TSHAPE设置shape为stcircle,设置BRUSH.STYLE为BSCLEAR
这样就是一个透明的园
我相信你的水平不需要说更多了吧,自己要有其他功能,直接从TSHAPE继承就可以了

我可以拿分么?不知道理解得对不对

我要的是gauge,继承tgauge.（delphi的sample版面中），你用shape构造gauge外观，
外观出来了,那progress的圆形填充怎么做？

gauge难道不更简单么?
从TSHAPE继承,设定MIN,MAX,PROCESS,可以用到TCANVAS来画画
例如当前进程数字用TEXTOUT,用ARC可以画出进度

当然,我对你的圆形填充更觉得怪异,你既然是透明的,谈何填充呢?
填充和透明正好是对立的,简单实现就是设置BRUSH.STYLE为BSSOLID或者BSCLEAR

即使你一定要用填充的,那你就先用PIE来画进度,然后再TEXTOUT出进度的数字

你见过球罐装水吗？我的填充progress就是水位，明白吗？我对控件不是很懂，还是麻烦你
贴出代码吧，ths

这还算简单嘛?200分?2000RMB还差不多.

刚才现写一个,今天简直是疯了,不睡觉做好事.
你只要设置FLCOLOR为填充颜色,POSITION就是进度,进度为0-1之间的实数,
例如0.25则会显示25%并且会填充园25%的指定FLCOLOR的颜色,颜色默认为篮色

unit drawShap;

interface

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

type
TdrawShap = class(TShape)
private
FPosition: Real;
FFlColor:TColor;
procedure SetPosition(const Value: Real);
{ Private declarations }
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner:TComponent); override;
property Position:Real read FPosition write SetPosition;
property FlColor:TColor read FFlColor write FFlColor;

published
{ Published declarations }
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('WENYUE', [TdrawShap]);
end;

{ TdrawShap }

constructor TdrawShap.Create(AOwner: TComponent);
begin
FFlColor:=clBlue;
inherited;
self.Brush.Style:=bsClear;
self.Shape:=stCircle;
end;

procedure TdrawShap.SetPosition(const Value: Real);
Var ARect:TRect;
X1,X2,X3,x4,Y1,Y2,Y3,Y4:Integer;
NumStr:String;
DX,DY:Integer;
begin
If (Value>1) then exit;
If Value<0 Then exit;
Refresh;
{ Canvas.Brush.Style:=bsClear;
Canvas.Ellipse(ClientRect);}
FPosition := Value;
ARect:=ClientRect;
X1:=ARect.Left;
X2:=ARect.Right;
Y1:=ARect.Top;
Y2:=ARect.Bottom;
Y3:=Round(ARect.Bottom-(ARect.Bottom-ARect.Top)*Value);
X3:=ARect.Left;
Y4:=Y3;
X4:=ARect.Right;

Canvas.Brush.Style:=bsSolid;
Canvas.Brush.Color:=FFlColor;
Canvas.Chord(X1,Y1,X2,Y2,X3,Y3,X4,Y4);
Canvas.Brush.Style:=bsClear;
NumStr:=IntToStr(Round(Value*100))+'%';
DX:=(ARect.Left+ARect.Right-Canvas.TextWidth(NumStr)) div 2;
DY:=(ARect.Top+ARect.Bottom-Canvas.TextHeight(NumStr)) div 2;
Canvas.TextRect(ARect,DX,DY,NumStr);
end;

end.

以上代码完全测试通过,当然有稍许BUG,例如你用其他窗口去覆盖这个东东,他会被搽除掉

测试代码如下:
unit Unit1;

interface

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

type
TForm1 = class(TForm)
drawShap1: TdrawShap;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
DrawShap1.Position:=DrawShap1.Position+0.03; //加3%
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
DrawShap1.Position:=DrawShap1.Position-0.03; //减少3%
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
drawShap1.FlColor:=clBlue;
end;

end.

你的填充不是圆啊。再修改。

怎么会不是园?
KICK,可以DFW没法贴上图片来
不是一个园里的水平面升高么?
我已经测试运行了,结果很正确啊

原来clientrect没设成正方形，兄弟辛苦了，我想从tgauge继承，该怎么修改gauges.pas?

继续无聊一下,又写一个,以下程序已经通过测试,请记得把WIDTH和HEIGHT设置成一样
请给我的招商银行帐号打2000RMB
帐号为075551881688

unit CircleGauge;

interface

uses
Windows, Messages, SysUtils, Classes, Controls, Gauges,graphics,math;

type
TCircleGauge = class(TGauge)
private
{ Private declarations }
FWenyueCircle: Boolean;
FBitMap:TBitMap;
FFirst:Boolean;
procedure SetwenyueCircle(const Value: Boolean);
procedure newpaint;
procedure paintfromshape;
procedure paintfrommydrawshap;
protected
{ Protected declarations }
procedure paint; override;
public
{ Public declarations }
Constructor Create(AOnwer:TComponent); override;
Destructor Destroy; override;
published
{ Published declarations }
property wenyueCircle:Boolean read FWenyueCircle write SetwenyueCircle;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('WENYUE', [TCircleGauge]);
end;

{ TCircleGauge }

constructor TCircleGauge.Create(AOnwer: TComponent);
begin
FFirst:=True;
inherited;

FWenyueCircle:=True;

end;

destructor TCircleGauge.Destroy;
begin

inherited;
FBitmap.Free;
end;

procedure TCircleGauge.newpaint;
begin
paintfromshape;
paintfromMyDrawShap;
end;

procedure TCircleGauge.paint;
begin
If Not wenyueCircle Then
inherited
else
begin
If FFirst Then
begin
FBitMap:=TBitmap.create;
FBitMap.Width:=Width;
FBitMap.Height:=Height;
FBitmap.Canvas.Brush.Color:=clBlack;
FBitmap.Canvas.FillRect(ClientRect);
FBitMap.Canvas.CopyRect(ClientRect,Canvas,ClientRect);
end
else
Canvas.CopyRect(ClientRect,FBitmap.Canvas,ClientRect);
FFIrst:=false;
NewPaint;
end;
end;

procedure TCircleGauge.paintfrommydrawshap;
Var ARect:TRect;
X1,X2,X3,x4,Y1,Y2,Y3,Y4:Integer;
NumStr:String;
DX,DY:Integer;
BitMap:TBitMap;
begin
if progress-minvalue=0 then exit;
{ Canvas.Brush.Style:=bsClear;
Canvas.Ellipse(ClientRect);}
BitMap:=TBitMap.Create;
Bitmap.Width:=Width;
Bitmap.Height:=Height;

BitMap.Canvas.Brush.Color:=clBlack;
BitMap.Canvas.FillRect(Rect(0,0,FBitmap.width,FBitmap.Height));
ARect:=ClientRect;
X1:=ARect.Left;
X2:=ARect.Right;
Y1:=ARect.Top;
Y2:=ARect.Bottom;
Y3:=Round(ARect.Bottom-(ARect.Bottom-ARect.Top)*((progress-MinValue)/(MaxValue-MinValue)));
X3:=Round(ARect.Right/2+Power(Power(ARect.Bottom/2,2)-Power(Y3-(ARect.Bottom/2),2),0.5));
Y4:=Y3;
X4:=Round(ARect.Right/2-Power(Power(ARect.Bottom/2,2)-Power(Y3-(ARect.Bottom/2),2),0.5));

With Bitmap do
begin
Canvas.Brush.Style:=bsSolid;
Canvas.Brush.Color:=clYellow;
Canvas.Chord(X1,Y1,X2,Y2,X4,Y3,X3,Y4);
Canvas.Brush.Style:=bsClear;
Canvas.Font.Color:=clWhite;
NumStr:=IntToStr(Round((progress/MaxValue)*100))+'%';
DX:=(ARect.Left+ARect.Right-Canvas.TextWidth(NumStr)) div 2;
DY:=(ARect.Top+ARect.Bottom-Canvas.TextHeight(NumStr)) div 2;
Canvas.TextRect(ARect,DX,DY,NumStr);
end;
Canvas.CopyMode:=cmSrcInvert;
Canvas.CopyRect(ARect,BitMap.Canvas,ARect);
Canvas.CopyMode:=cmSrcCopy;
Bitmap.free;
end;

procedure TCircleGauge.paintfromshape;
var
X, Y, W, H, S: Integer;
begin
with Canvas do
begin
//Pen := FPen;
//Brush := FBrush;
Brush.Style:=bsClear;

X := Pen.Width div 2;
Y := X;
W := Width - Pen.Width + 1;
H := Height - Pen.Width + 1;
if Pen.Width = 0 then
begin
Dec(W);
Dec(H);
end;
if W < H then S := W else S := H;
// if FShape in [stSquare, stRoundSquare, stCircle] then
begin
Inc(X, (W - S) div 2);
Inc(Y, (H - S) div 2);
W := S;
H := S;
end;
// case FShape of
// stRectangle, stSquare:
// Rectangle(X, Y, X + W, Y + H);
// stRoundRect, stRoundSquare:
// RoundRect(X, Y, X + W, Y + H, S div 4, S div 4);
// stCircle, stEllipse:
Ellipse(X, Y, X + W, Y + H);
// end;
end;
end;

procedure TCircleGauge.SetwenyueCircle(const Value: Boolean);
begin
if FWenyueCircle = Value Then exit;
FWenyueCircle := Value;
refresh;
end;

end.