trect ile caption'a yazı yazma sorunu.

[Shou]

Merhaba arkadaşlar trect ile caption'a yazıyı yazıp sabitleyebiliyorum şöyle bir sorunum var diyelim,

Kod: Tümünü seç

DENEME YAZIDIR

diye caption'da sabit bir yazı yazdık koyduk ve bu yazıyı yenilemek istiyoruz.

Kod: Tümünü seç

YENİLE

diye yazı yazıp update edince şöyle bir sonuç çıkıyor,

Kod: Tümünü seç

YENİLE YAZIDIR

Yani ilk yazdığımız değer kalıyor ancak şöyle siliniyor pencereyi aşşağı indir kaldır veya X kapatma tuşuna gidip gelirsek felan siliniyor bu sorunu nasıl çözebilirim kodlarım aşşağıda.

Kod: Tümünü seç

procedure yazdir;
  var prochwnd:hwnd; canvas: TCanvas; rec:trect;
    begin try
    canvas := TCanvas.Create; try
    getwindowrect(findwindow('TForm1',nil),rec);
      canvas.Handle := GetWindowDC(getdesktopwindow);
      with canvas do
      begin
        //Brush.Style := bsSolid;
        brush.Color:=clred;
        //Font.Color := clred;
        font.Name := ('Trebuchet MS');
        font.size := (8);
        font.Style:=[fsbold];
        if GetForegroundWindow=findwindow('TForm1',nil) then
        TextOut(rec.Left+350, rec.Top+6, Form1.Edit1.Text);
        updatewindow(getdesktopwindow);
      end;
finally
      ReleaseDC(getdesktopwindow, canvas.Handle);
      canvas.Free;
end;
except
halt;
end;
end;

1 adet edit1 koyuyoruz ve içine yazdığımız yazıyı caption'da sabit olarak ortada kalıyor.

2- c#'da bir uygulamada gördüm caption'da sabit şekilde simgenin yanına 3 adet statusbar koyulmuş 100/100 değer kontrolu var.

statusbar.jpg (3.67 KiB) 3261 kere görüntülendi

70 ila 100 arası => YEŞİL.
40 ila 70 arası => SARI.
0 ila 40 arası => KIRMIZI.

renk olarak gösteriyor değerleri.

Bunu nasıl yapmış çözemedim bunu delphide yapabilirmiyim ve bunu nasıl sabit yaparım caption'a simgenin yanına koyarım?

[m_yaprakci]

http://www.delphibasics.co.uk/RTL.asp?Name=bounds

Kod: Tümünü seç

 function bounds ( const Top, Left, Width, Height : Integer ) : TRect;

Burada örnekle açıklanan bounds ve boundsrect fonksiyonları işine yarayacaktır.

Bounds ile TRect'in boyutunu ve konumunu ayarlayacaksın. genişliği de formun widthine gore 100-200px küçülterek verirsen olur sanırım.

[Shou]

Hocam teşekkür ederim cevabın için şöyle bir sorun var diyelim bir yazıyı yazdık diğer yeni yazı yazınca eskisi kalıyor ve üstüne yazıyor.

Eğer form'u aşağı indirip yeniden ekrana getirirsek eskisi siliniyor ve tek yenisi kalıyor bunun için eskisini nasıl sileriz?

[ertank]

Merhaba,

Öncelikle bir konu altında birden fazla soru sormamaya özen göstermekte fayda var. Bu anlamda ikinci sorunu ayrı bir konuda açmanı önerebilirim.

İlk soruna gelince. Aslında m_yaprakci tarafından önerilen çözümü uyguladığın zaman sorun kalmaması gerekli. Tahmin ediyorum bu çözümü hiç uygulamadan cevap yazmış oldun.

Şöyle ki. Senin ilk yazdığın Caption uzunluğu ikinci yazdığından uzun ise ilk yazdığının ikinci yazdığından arta kalan kısmı ekranda gözükecektir. Dolayısı ile senin form genişliğine çok yakın bir bölümün üzerine yazman gerekli. Farklı bir ifade iler Caption alanının uzunluğunca boş alanlar dahil o bölümü yenilemelisin.

TLabel gibi bileşenler yukarıda anlatılanları bileşen içinde arka planda otomatik yaptıkları için bizim ekstra bir uğraş göstermemize gerek kalmaz. Ancak TRect kullanarak yapılacak işlemlerin yazı yazılacak alanın tamamı düşünülerek yapılması gerekiyor.

Özetle, eski veriyi silmen ve yeni veriyi yazman gerekli ki eski veriden arta kalanlar ekranda gözükmesin. Örnek olarak gönderdiğin kod yanlış anlamadı isem eski veriyi silmeden direk yeni veriyi yazıyor.

[Shou]

Hocam denemeden demişsiniz denedim ama bir çözüm bulamadım eski veriyi silmeden yeni veri yazıyor evet ama eski veriyi silmeyi başaramadım zaten sorunum bu bunu nasıl yapabilirim kodları paylaştım siz test eder misiniz kodları alıp bir çözüm üretebilirseniz sevinirim, teşekkürler.

[ertank]

Test etme imkanım olmadı. Aşağıdaki şekilde bir deneyin.

Kodun yapmaya çalıştığı; yazılabilecek alana kaç adet boşluk karakteri sığacağını hesaplamaya çalışıyor. Sonra önce o adette boşluk karakterini yazıyor. Ardından yazılması istenilen yeni değeri yazıyor.

Prosedür kullanımı biraz değişti. Yazılmasını istediğiniz ifadeyi string parametre olarak göndermeniz gerekli.

Kod: Tümünü seç

procedure Yazdir(const YeniMetin: string);

  function SpaceCount(const aCanvas: TCanvas; const aRect: TRect): Cardinal;
  begin
    Result := 1;
    while aCanvas.TextWidth(StringOfChar(#32, Result)) < aRect.Width do
      Inc(Result);
  end;

var
  Canvas: TCanvas;
  Rec: TRect;
begin
  try
    Canvas := TCanvas.Create;
    try
      GetWindowRect(FindWindow('TForm15', nil), Rec);
      Canvas.Handle := GetWindowDC(GetDesktopWindow);
      //Canvas.Brush.Style := bsSolid;
      Canvas.Brush.Color := clRed;
      //Canvas.Font.Color := clred;
      Canvas.Font.Name  := 'Trebuchet MS';
      Canvas.Font.Size  := 8;
      Canvas.Font.Style := [fsBold];

      if GetForegroundWindow = FindWindow('TForm15',nil) then
      begin
        Canvas.TextOut(Rec.Left + 350, Rec.Top + 6, StringOfChar(#32, SpaceCount(Canvas, Rec)));
        UpdateWindow(GetDesktopWindow);
        Canvas.TextOut(Rec.Left + 350, Rec.Top + 6, YeniMetin);
        UpdateWindow(GetDesktopWindow);
      end;
    finally
      ReleaseDC(GetDesktopWindow, Canvas.Handle);
      Canvas.Free();
    end;
  except
    Halt;
  end;
end;

[Shou]

Merhaba hocam test ettim ama bir hata alıyorum,

Kod: Tümünü seç

while aCanvas.TextWidth(StringOfChar(#32, Result)) < aRect.Width do

Olan Kısım'da,

Kod: Tümünü seç

aRect.Width

Width olan kısım hata veriyor hata,

Kod: Tümünü seç

[DCC Error] Unit1.pas(75): E2003 Undeclared identifier: 'Width'

Hocam zaten mesele boşluk burakmak değil pencereyi yenilemek yani X tuşu kapatma tuşuna gidince ekrandaki kayboluyor ve yenisi yazıyor test ederseniz anlıcaksınız ve şöyle bir olay var pencereyi aşağı indririp yukarı çıkarıncada silinip yenisi yazıyor ben silip yenisini yazmak istiyorum boşluk ile sıkıntı oluyor.

Yardımcı olursanız sevinirim, teşekkürler.

[ertank]

Örnek kod Delphi 10.1 ile compile edilebiliyor. Siz hangi Delphi sürümünü kullanıyorsunuz?

[Shou]

Ben delphi 2010 kullanıyorum.

[ertank]

Şunu deneyebilir misiniz?

Kod: Tümünü seç

procedure Yazdir(const YeniMetin: string);

  function SpaceCount(const aCanvas: TCanvas; const aRect: TRect): Cardinal;
  var
    Width: Cardinal;
  begin
    Width := aRect.Right - aRect.Left;
    Result := 1;
    while aCanvas.TextWidth(StringOfChar(#32, Result)) < Width do
      Inc(Result);
  end;

var
  Canvas: TCanvas;
  Rec: TRect;
begin
  try
    Canvas := TCanvas.Create;
    try
      GetWindowRect(FindWindow('TForm15', nil), Rec);
      Canvas.Handle := GetWindowDC(GetDesktopWindow);
      //Canvas.Brush.Style := bsSolid;
      Canvas.Brush.Color := clRed;
      //Canvas.Font.Color := clred;
      Canvas.Font.Name  := 'Trebuchet MS';
      Canvas.Font.Size  := 8;
      Canvas.Font.Style := [fsBold];

      if GetForegroundWindow = FindWindow('TForm15',nil) then
      begin
        Canvas.TextOut(Rec.Left + 350, Rec.Top + 6, StringOfChar(#32, SpaceCount(Canvas, Rec)));
        UpdateWindow(GetDesktopWindow);
        Canvas.TextOut(Rec.Left + 350, Rec.Top + 6, YeniMetin);
        UpdateWindow(GetDesktopWindow);
      end;
    finally
      ReleaseDC(GetDesktopWindow, Canvas.Handle);
      Canvas.Free();
    end;
  except
    Halt;
  end;
end;

[Shou]

Hocam bunu test ettim hata vermedi çalışıyor ama şöyle bir sorun var boşluk bırakınca o kısım ileriye doğru hep kırmızı arka plan oluyor yani sorun yaratıyor benim yapmak istediğim ekranı aşşağı indirip yukarı çıkarınca eskisi kayboluyor yenisi geliyor bunu nasıl yapabilirim?

[ertank]

Ekran görüntüsü ile istediğini anlatmanız mümkün mü acaba? Anlatmaya çalıştığınızı kendi adıma net olarak anlayamıyorum. Olması istenilen nedir? Olmayan nedir?

[Shou]

Hocam Bakın şimdi görüntü koyuyorum,



Burada kırmızı ile çizdiğim yer,

1- ekranı büyütüp/küçültme.
2- ekranı aşşağı indirme.
3- ekranı kapatma tuşu (X).

Bu tuşlara fare ile üstüne gelince o kırmızı alan komple siliniyor ve 1 saniye sonra yenisi yazıyor benim yapmak istediğim eskisini silmek ve yenisini yazmak sizin yaptığınız şey'de boşluk bırakarak o alanı kırmızı yapıyor komple.

Umarım anlatabilmişimdir, teşekkürler.

[ertank]

Olması gereken nedir?

[Shou]

Olması gereken Boşluk yanlış oluyor.

Eskisini silip yenisini yazmak olması gereken Örnek Veriyim,

İlk veri,

Kod: Tümünü seç

AHMET MEHMET HASAN HUSEYIN

Yeni veri yazıcaz diyelim,

Kod: Tümünü seç

MEHMET

Yapalım onu tek,

Kod: Tümünü seç

MEHMETMEHMET HASAN HUSEYIN

Çıkan sonuç üstteki gibi oluyor.

Yani eskisini silmek istiyorum ekranı aşşağı indirince siliyor bunu otomatik sildiremezmiyiz yenisini yazmadan?