Hi Winni,
There is a very old addage that states that if you give a man a fish you can feed him for a day but give him a Fishing Rod and you'll feed him for life
I thank you for the gift of a Rod!
I've spent the past 6 hours massaging the test project line by line with reference to your last posting which used
tmp.EllipseAntialias . . . . starting with a simple circle in a black square, moving to a white and then transparent square, adding other circles with differing body and outline colours and a transparent hole in the centre ! - I haven't yet discovered how you included the keyway
Determining the size of some circles and whether or not to include them was essentially a trivial matter.
The one thing I haven't managed though is to prevent 'clipping' at the right & bottom (see the attached image) - I've tried all manner of 'adjustments' to both the TImage and the BGRABitmap, all without success - adding 1 or 2 px to OD or Sq (in the following code) just adds a black line at right & bottom.
implementation
{$R *.lfm}
Const
DP : word = 20;
M : single = 25.4;
Hue : Record
one,
two,
three : TColor;
end = (one : $00A9C6A8;two : $00007500; three : $00756060);
Var
{ TForm1 }
OD,
PCD,
Root : word;
DM : single;
tmp : TBGRABitmap;
C : TPointF;
LS_Cen : TPointF;
T,X,Y,
Sq : word;
Fnt : ShortInt;
procedure TForm1.FormCreate(Sender: TObject);
begin
Width := 600;
Height := 600;
DM := 1 / DP;
LS_Cen.x:=400;
LS_Cen.y:=400;
end;
procedure TForm1.NoOfTeethEditingDone(Sender: TObject);
Var
R1,R2,R3,R4,R5 : word;
begin
T := StrToInt(NoOfTeeth.Caption);
If T<20 then
begin
ShowMessage('Tooth Count too small');
Exit;
end;
OD := Round(T * DM * M * 2);
OD := OD + OD Mod 2;
X := OD div 2;
Y := X;
R1 := X-4;
R2 := X-9;
R5 := 14;
Sq := OD;
If T<50 then
begin
Fnt := -13;
R3 := X-14; // Outer Land
R4 := 24; // Centre Land
end
else
begin
Fnt := -16;
R3 := X-22;
R4 := 30;
end;
tmp := TBGRABitmap.Create(OD,OD);
tmp.ReplaceTransparent(clWhite);
with Image1 do
begin
Width := Sq; // needed to overide the size set at Design time
Height := Sq;
Canvas.Brush.Color := clWhite; // set to colour being used as 'transparent'
Canvas.FillRect(0,0,Sq,Sq);
Picture.Clear;
Picture.Bitmap.SetSize(Sq,Sq);
Picture.Bitmap.TransparentColor:=clWhite;
Transparent:=True;
Top := Round(LS_Cen.y - Y);
Left := Round(LS_Cen.x - X);
end;
C := PointF(X,Y);
tmp.EllipseAntialias(C.x,C.y, X, X,clRed, 1,Hue.one); // OD
tmp.EllipseAntialias(C.x,C.y,R1,R1,clGray,1,Hue.three); // PCD
tmp.EllipseAntialias(C.x,C.y,R2,R2,clLime,1,clNone); // Root
If T > 35 then
begin
tmp.EllipseAntialias(C.x,C.y,R3,R3,clGray,1,Hue.two); // Outer Land
tmp.EllipseAntialias(C.x,C.y,R4,R4,clGray,1,Hue.three); // Centre Land
end;
tmp.EllipseAntialias(C.x,C.y,R5,R5,clGray,1,clWhite); // Bore
tmp.FontHeight := Fnt;
tmp.TextOut(C.x,C.y+R5,IntToStr(T),clSilver,taCenter);
tmp.Draw(Image1.Canvas,0,0,false);
tmp.free;
end;
end.
I still need to add the Tooth count as a Number which I may do using a TLabel with clNone as the body colour, but if there is some BGRA Text method which I've yet to discover which will do a better job I may switch to that.
I'd appreciate your opinion regarding how to stop the clipping - I'm sure it's a simple matter but is baffling me.
The BGRADefaultBitmap brings up "There is currently no text in this page." ??
[EDIT] (16:20)
I've now found the BGRADefaultBitmap Unit !!
It came to the fore when I was looking to add 'Text' in the form of the Tooth Count and 'TextSize' expected a 'string' ??? - I then found .FontHeight. (the code above has been edited to reflect the new knowledge)
It seems that adding images is not allowed when 'Editing' a post
Recent
