tank doluluk chart?
Forum kuralları
Forum kurallarını okuyup, uyunuz!
Forum kurallarını okuyup, uyunuz!
tank doluluk chart?
arkadaslar bunu nasıl yapabilirim
bu bir chartmıdır?
tankın doluluk oranı gosteriyor
chartsa nasıl yapabilrim yardımcı olursanız cok sevinrim
Gradient şöyle yapılabilir:
Kolay gelsin...
(Not: Daha sağlıklı / hızlı / güzel gradient fonksiyonları mutaka vardır, bunu şimdi, birkaç dakikada yazdım.)
Kod: Tümünü seç
procedure ucGradient(ACanvas: TCanvas; Color1, Color2: TColor; X1, Y1, X2, Y2: Integer);
var
i: Integer;
R1, G1, B1,
R2, G2, B2: Byte;
R, G, B: Integer;
begin
R1 := GetRValue(Color1);
G1 := GetGValue(Color1);
B1 := GetBValue(Color1);
R2 := GetRValue(Color2);
G2 := GetGValue(Color2);
B2 := GetBValue(Color2);
R := Trunc((R2 - R1) / X2 - X1);
G := Trunc((G2 - G1) / X2 - X1);
B := Trunc((B2 - B1) / X2 - X1);
for i := X1 to X2 do
begin
ACanvas.Pen.Color := RGB(R1 + i * R, G1 + i * G, B1 + i * B);
ACanvas.Rectangle(i, Y1, i+1, Y2);
end;//for
end;//ucGradient
(Not: Daha sağlıklı / hızlı / güzel gradient fonksiyonları mutaka vardır, bunu şimdi, birkaç dakikada yazdım.)
Merhaba...
- Gece sabaha kadar bebek bakma nöbetim olduğundan kod üretme vaktim oldu...
- Şu şekil bir sonuç elde ettim. Umarım hoşuna gider...
- Formunda Canvas özelliği olan herhangi bir nesne üzerine çizilebilir. Ben bir tane TImage nesnesi koydum onunla denedim. Yukardaki resim aldığım sonuç.
- Procedure, canvas büyüklüğüne göre kendini adapte edecek şekilde tasarlandı. Yani sen resmin boyunu değiştirirsen çizilecek grafik kendiliğinden ona göre genişleyip - uzayıp - daralabilecek şekilde. Tabi verdiğin değere göre dolu alan da kendini ayarlıyor.
- Değer olarak 0 - 100 aralığını verdim. miktarı 0 ile 100 arasındaki bir integer değere dönüştürmen grafik için kafidir. Dilim aralığıyla da kilitledim. Yani 31, 32, 33 gibi ara değerler girersen 30'a çekilecek. 35 dediğinde dilimler 5'in katı olduğundan ilgili dilime atlanmış olacak.
- Enine göre gereğinden çok daraltmak istersen, procedure içinden ElipsBoyu değerini küçült ki git gide daireye dönüşmesin.
// Kullanımı aşağıdaki şekilde..
- Afiyet olsun. Benim için de bu gece için bir temrin çalışması oldu... Başarılar..
- Gece sabaha kadar bebek bakma nöbetim olduğundan kod üretme vaktim oldu...
- Şu şekil bir sonuç elde ettim. Umarım hoşuna gider...
- Formunda Canvas özelliği olan herhangi bir nesne üzerine çizilebilir. Ben bir tane TImage nesnesi koydum onunla denedim. Yukardaki resim aldığım sonuç.
- Procedure, canvas büyüklüğüne göre kendini adapte edecek şekilde tasarlandı. Yani sen resmin boyunu değiştirirsen çizilecek grafik kendiliğinden ona göre genişleyip - uzayıp - daralabilecek şekilde. Tabi verdiğin değere göre dolu alan da kendini ayarlıyor.
- Değer olarak 0 - 100 aralığını verdim. miktarı 0 ile 100 arasındaki bir integer değere dönüştürmen grafik için kafidir. Dilim aralığıyla da kilitledim. Yani 31, 32, 33 gibi ara değerler girersen 30'a çekilecek. 35 dediğinde dilimler 5'in katı olduğundan ilgili dilime atlanmış olacak.
- Enine göre gereğinden çok daraltmak istersen, procedure içinden ElipsBoyu değerini küçült ki git gide daireye dönüşmesin.
Kod: Tümünü seç
Procedure TankDoluluk( aCanvas:TCanvas; ArkaFon: tColor; x, y, en, boy, Oran:Integer );
procedure Gradient(Canvas:TCanvas;BColor, EColor : TColor; ATop, ALeft, AHeight, AWidth : integer);
function GetColor(N,H : integer) : TColor;
begin
Result := RGB(Trunc(GetRValue(BColor) + (GetRValue(EColor)-GetRValue(BColor)) * N / H),
Trunc(GetGValue(BColor) + (GetGValue(EColor)-GetGValue(BColor)) * N / H),
Trunc(GetBValue(BColor) + (GetBValue(EColor)-GetBValue(BColor)) * N / H));
end;
var
i :integer;
begin
for i := 0 to AWidth - 1-aLeft do begin
Canvas.Pen.Color := GetColor(i, AWidth);
Canvas.MoveTo(ALeft+i,ATop);
Canvas.LineTo(ALeft+i,ATop+AHeight);
end;
end;
Const
ElipsBoy = 24;
Var
yYuzdelik : Integer;
yCizgi : Integer;
yCizgiAralik: Integer;
DilimSay : Integer;
OransalBoy : Integer;
begin
// Alttaki taban elips'in sığması için boydan biraz kırpıyoruz.
Dec(Boy, ElipsBoy);
DilimSay := 20; // yüksekliği kaç dilime ayırmak istediğimizi bildiriyoruz...
yCizgi := y+ElipsBoy; // tepedeki ilk çizgi
yCizgiAralik := (Boy div DilimSay); // çizgiler arası aralık, otomatik hesaplanır.
aCanvas.Brush.Color := ArkaFon;
aCanvas.Pen.Color := ArkaFon;
aCanvas.Rectangle( x, y, x+En, yCizgi+Boy ); // Fon rengini veriyoruz..
If Oran > 100 then Oran := 100;
OransalBoy := (yCizgiAralik*((Oran*DilimSay) div 100));
yYuzdelik := (yCizgiAralik*DilimSay) - OransalBoy;
Gradient( aCanvas, clWhite, clBlue, yCizgi + yYuzdelik -(ElipsBoy div 2),
x, OransalBoy, x + En ); // beyazdan maviye renk verdik...
aCanvas.Pen.Color := clBlack;
aCanvas.Pen.Width := 1;
// Taban
aCanvas.Brush.Color := clBlue;
aCanvas.Ellipse( x, yCizgi+(yCizgiAralik * (DilimSay)), x+en, yCizgi+(yCizgiAralik * DilimSay) - ElipsBoy );
// Yan duvarlar
aCanvas.MoveTo( x , yCizgi - (ElipsBoy div 2) );
aCanvas.LineTo( x , yCizgi+(yCizgiAralik * DilimSay) - (ElipsBoy div 2));
aCanvas.MoveTo( x+En-1, yCizgi - (ElipsBoy div 2) );
aCanvas.LineTo( x+En-1, yCizgi+(yCizgiAralik * DilimSay) - (ElipsBoy div 2) );
// Doluluk
// Graident açık renginden bir örnek alarak daha açık renkli yüzey elde ediyoruz..
aCanvas.Brush.Color := aCanvas.Pixels[ x + (En div 4), yCizgi + yYuzdelik + 5];
aCanvas.Ellipse( x, yCizgi + yYuzdelik-ElipsBoy, x+En, yCizgi+yYuzdelik ); // Elips dış kenar çizgiye oturmalı...
// Tepe
aCanvas.Pen.Width := 1;
aCanvas.Brush.Color := clRed;
// Aşağıdaki satırın başındaki // silersen tepeye kırmızı renkli kapak olur.
aCanvas.Brush.Style := bsClear;
aCanvas.Ellipse( x, y, x+en, y + ElipsBoy );
// Ölçek Çizgileri
aCanvas.Pen.Width := 2;
While DilimSay >= 0 do begin
If DilimSay mod 4 = 0
then begin
aCanvas.MoveTo( x+(en div 2)-20, yCizgi );
aCanvas.LineTo( x+(en div 2), yCizgi );
aCanvas.Brush.Style := bsClear;
aCanvas.Font.Style := [fsBold];
aCanvas.Font.Color := clYellow;
aCanvas.TextOut( x+(en div 2)+10, yCizgi-8, FormatFloat('#,0', (DilimSay div 4) * 20000));
end else begin
aCanvas.MoveTo( x+(en div 2)-20, yCizgi );
aCanvas.LineTo( x+(en div 2)-10, yCizgi );
end;
Inc(yCizgi, yCizgiAralik);
Dec(DilimSay);
end; // While
end;
Kod: Tümünü seç
procedure TForm1.Button1Click(Sender: TObject);
begin
TankDoluluk( Image1.Canvas, clSilver, 0, 0, Image1.Width, Image1.Height, 30 );
end;
En son mrmarman tarafından 25 Eyl 2007 07:19 tarihinde düzenlendi, toplamda 2 kere düzenlendi.
- sabanakman
- Kıdemli Üye
- Mesajlar: 3079
- Kayıt: 17 Nis 2006 08:11
- Konum: Ah bi Antalya olaydı keşke (Ankara)
Hocam tebrikler....
Yine bir Muharrem Arman klasiği olmuş...
Yine bir Muharrem Arman klasiği olmuş...
* http://www.fahrettin.org Manzara Fotoğraflarım...
* http://delphiturkiye.gunduz.info Seminerler...
* http://www.hakmar.com.tr Kalite bir haktır...
* http://delphiturkiye.gunduz.info Seminerler...
* http://www.hakmar.com.tr Kalite bir haktır...