tank doluluk chart?

[skyking]

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]

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]

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]

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.)

[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...



- 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;

// 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..

[deltas]

Aynı şekilde bende bayağı bi uğraştım. Ama beceremedim. Hocam süpersiniz. Ellerinize sağlık..

[undefined]

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

[sabanakman]

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

[bgoktas]

çok orjinal olmuş
bravo

[fahrettin]

Hocam tebrikler....
Yine bir Muharrem Arman klasiği olmuş...

[lazio]

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

[haydarxxx]

Bebek bekereketiyle gelmiş vallahi.Süpersin

[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.