tank doluluk chart?

Delphi'de kod yazma ile ilgili sorularınızı bu foruma yazabilirsiniz.
Cevapla
Kullanıcı avatarı
skyking
Üye
Mesajlar: 136
Kayıt: 09 Kas 2005 12:52
Konum: Antalya

tank doluluk chart?

Mesaj gönderen skyking »

Resim

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

serkan
Üye
Mesajlar: 666
Kayıt: 10 Tem 2003 12:08
Konum: bursa

Mesaj gönderen serkan »

birebir aynısını bulabilirmisin bilmiyorum ama internetten gauge componentlerini bir araştır derim..Çok güzel bir gauge paket componenti vardı ama adını hatırlayamadım..

davut
Üye
Mesajlar: 137
Kayıt: 01 Nis 2006 10:54

Mesaj gönderen davut »

3 tane elips var, birde line ile çizilmiş bölümler
bunları TImage üzerine çizebilirsin, sadece gradient i nasıl yapılır onu araştırmak lazım.

ulu coder
Üye
Mesajlar: 838
Kayıt: 01 Nis 2006 06:46
Konum: Ankara

Mesaj gönderen ulu coder »

Gradient şöyle yapılabilir:

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
Kolay gelsin...

(Not: Daha sağlıklı / hızlı / güzel gradient fonksiyonları mutaka vardır, bunu şimdi, birkaç dakikada yazdım.)

Kullanıcı avatarı
mrmarman
Üye
Mesajlar: 4731
Kayıt: 09 Ara 2003 08:13
Konum: Ankara
İletişim:

Mesaj gönderen mrmarman »

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... :o

Resim

- 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. :wink:

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;
// Kullanımı aşağıdaki şekilde..

Kod: Tümünü seç

procedure TForm1.Button1Click(Sender: TObject);
begin
  TankDoluluk( Image1.Canvas, clSilver, 0, 0, Image1.Width, Image1.Height, 30 );
end;
- Afiyet olsun. Benim için de bu gece için bir temrin çalışması oldu... Başarılar..
En son mrmarman tarafından 25 Eyl 2007 07:19 tarihinde düzenlendi, toplamda 2 kere düzenlendi.
Resim Resim

deltas
Üye
Mesajlar: 358
Kayıt: 06 Mar 2004 01:08
Konum: Malatya...
İletişim:

Mesaj gönderen deltas »

Aynı şekilde bende bayağı bi uğraştım. Ama beceremedim. Hocam süpersiniz. Ellerinize sağlık..
Nice İnsanlar gördüm üstünde elbise yok;
Nice elbiseler gördüm içinde insan yok.

Kullanıcı avatarı
undefined
Moderator
Mesajlar: 565
Kayıt: 06 Eki 2003 12:01
Konum: Bursa
İletişim:

Mesaj gönderen undefined »

Çok güzel gözüküyor, eline sağlık Muharrem hocam. Bence sen bunu component yapıp Torry sitesine koy.

Kullanıcı avatarı
sabanakman
Kıdemli Üye
Mesajlar: 3057
Kayıt: 17 Nis 2006 08:11
Konum: Ah bi Antalya olaydı keşke (Ankara)

Mesaj gönderen sabanakman »

undefined yazdı:Çok güzel gözüküyor, eline sağlık Muharrem hocam. Bence sen bunu component yapıp Torry sitesine koy.
Resim
Şaban Şahin AKMAN
_________________
Derin olan kuyu değil kısa olan iptir. - .

bgoktas
Kıdemli Üye
Mesajlar: 769
Kayıt: 27 Nis 2004 10:32
Konum: istanbul

Mesaj gönderen bgoktas »

çok orjinal olmuş
bravo :bravo:

Kullanıcı avatarı
fahrettin
Admin
Mesajlar: 2619
Kayıt: 11 Haz 2003 10:38
Konum: İstanbul
İletişim:

Mesaj gönderen fahrettin »

Hocam tebrikler....
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... 8)

Kullanıcı avatarı
lazio
Moderator
Mesajlar: 1526
Kayıt: 11 Tem 2003 04:55
Konum: İstanbul
İletişim:

Mesaj gönderen lazio »

Sen bi kaç akşam daha nöbet e kalırsan baya bi komponent seti çıkacak abi :)
eline sağlık :)
Resim

..::|YeşilMavi|::..

Kullanıcı avatarı
haydarxxx
Üye
Mesajlar: 668
Kayıt: 09 May 2005 11:31
Konum: izmir

Mesaj gönderen haydarxxx »

Bebek bekereketiyle gelmiş vallahi.Süpersin

Kullanıcı avatarı
Lost Soul
Üye
Mesajlar: 1061
Kayıt: 01 Nis 2007 02:55
Konum: mekan ANKARA toprak ELAZIĞ
İletişim:

Mesaj gönderen Lost Soul »

gerçekten güzel olmuş. bi kaç kişi daha bölesoular sorsun da bi component seti çıksın ortaya :) eline sağlık.

Cevapla