Konuyu Oyla:
  • Derecelendirme: 1/5 - 1 oy
  • 1
  • 2
  • 3
  • 4
  • 5
Butonlarla Kategori ve AltKategori Yapma
#31
Anladim hocam tesekkurler
Cevapla
#32
(09-11-2018, Saat: 00:19)mrmarman Adlı Kullanıcıdan Alıntı: Linkleri Görebilmeniz İçin Üye Olmanız Gerekiyor. Üye Olabilmek İçin Lütfen Buraya Tıklayınız.Merhaba.

Değerlendirmem odur ki, kategori / alt kategori konusunda mantık kurma aşamasında takıldınız
Boyutlandırmada olduğunu sanmıyorum. 

Idea Bu nedenle hem yeniden boyutlandırma, TScrollBox içinde dinamik dağıtma, her tıklamada yeni dinamik alt kategori butonu türetme vs.
 tümünü içeren bir örnek hazırladım. 

Arrow Proje ve DB mesaj ekinde indirilebilir şekilde yer alıyor.


n4r5pulrcqxuovdyvgxh.gif
Kaynak Kodlar Aşağıda...

Var
  xAdoConnection : TAdoConnection;
  xDataSource    : TDataSource;
  xAdoQuery      : TAdoQuery;

  xDataUrunSource: TDataSource;
  xAdoUrunQuery  : TAdoQuery;

Const
  xADO  = 'Provider=Microsoft.Jet.OLEDB.4.0;'
          + 'Data Source=%s;'
          + 'Mode=Share Deny None;'
          + 'Persist Security Info=False;'
          + 'Jet OLEDBBig Grinatabase Password=%s;'
          ;

procedure TForm1.FormCreate(Sender: TObject);
Var
  strData : String;
begin
  ReportMemoryLeaksOnShutdown := True;

  strData := ExcludeTrailingPathDelimiter( ExtractFilePath(ParamStr(0)) ) + '\DATA\filmdb.mdb';

  xAdoConnection := TAdoConnection.Create(nil);

  With xADOConnection do begin
    Connected          := False;
    LoginPrompt        := False;
    ConnectionString   := Format( xAdo, [ strData, '' ] );
  end;

  xDataSource              := TDataSource.Create(nil);
  xAdoQuery                := TAdoQuery.Create(nil);
  xDataSource.DataSet      := xADOQuery;

  xDataUrunSource          := TDataSource.Create(nil);
  xAdoUrunQuery            := TAdoQuery.Create(nil);
  xDataUrunSource.DataSet  := xAdoUrunQuery;

  DBGrid1.DataSource := xDataSource;
  DBGrid2.DataSource := xDataUrunSource;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  ButonaBasildi(nil);
end;

Var
  xButonlar: Array of TButton;
  xKategori: String = 'M_Year';
  xKatSira : Word   = 1; // 1: M_Year, 2: M_Runtime, 3:M_Lang
  xWhere   : String = '';
  xGroupBy : String = '';

procedure TForm1.KategoriButtonOlustur( strAlanAdi: String; aScrollBox:TScrollBox; boolSadeceTazele:Boolean = False );
Const
  Boy         = 200;
  Yukseklik   = 30;
  SolMargin   = 10;
  TepeMargin  = 10;
  Aralik      = 05;
var
  i, Satir, Sutun: Integer;
begin
  // -1,0
  if boolSadeceTazele AND ( NOT xAdoQuery.Active ) then
  begin
    EXIT; // ilk çalışma anı
  end;

  if NOT boolSadeceTazele then begin
    With xADOQuery do begin
      Connection := xADOConnection;
      SQL.Clear;
      if strAlanAdi = '!!!ButonTemizle' then begin
        SQL.Add('SELECT 1 as [Boşalttık] FROM Movies');
        SQL.Add('WHERE 1=0'); // Sonuç boş dönsün istediğimizde FIELD adı '!!!ButonTemizle' yaz yeter...
      end else
      begin
        SQL.Add('SELECT '+strAlanAdi+', Count(*) as [Adet] FROM Movies');
        SQL.Add('WHERE 1=1');
        SQL.Add( xWhere   );
        SQL.Add( xGroupBy );
        SQL.Add('ORDER BY '+ strAlanAdi );
      end;
      Active := True;
    end;
  end;

  // Önce mevcut butonları silelim...
  if High( xButonlar ) >=  Low( xButonlar )
  then for i := Low( xButonlar ) to High( xButonlar )
       do xButonlar[i].Free;

  Application.ProcessMessages;
  SetLength( xButonlar, 0 );

  i     := 0;
  Satir := 0;
  Sutun := -1;
  xAdoQuery.First;
  while NOT xAdoQuery.EOF do
  begin
    inc(i);
    SetLength( xButonlar, i );
    xButonlar[i-1] := TButton.Create(nil);
    With xButonlar[i-1] do begin
      Width   := Boy;
      Height  := Yukseklik;
      Caption := xAdoQuery.Fields[0].AsString + ': ( ' + xAdoQuery.Fields[1].AsString + ' )' ;
      Parent  := aScrollBox;
      OnClick := ButonaBasildi;

      inc(sutun);
      if aScrollBox.Width < ( SolMargin + ( Sutun * (Width + Aralik) ) + (Width + Aralik))then
      begin
        inc( Satir );
        Sutun := 0;
      end;

      Left    := SolMargin  + (Sutun * (Width  + Aralik));
      Top     := TepeMargin + (Satir * (Height + Aralik));
    end;
    xAdoQuery.Next;
  end;

end;

procedure TForm1.ButonaBasildi( aButton:TObject );
var
  strCaption : String;
begin
  if aButton = nil then
  begin
     xKatSira := 1;
     xWhere   := '';
     xGroupBy := 'GROUP BY M_Year';
  end else
  begin
    strCaption := StringReplace( TButton(aButton).Caption, '&', '', [rfReplaceAll] );
    strCaption := Trim( Copy( strCaption, 1, Pos(': (', strCaption )-1) );

    inc( xKatSira );
    if xKatSira > 4 then xKatSira := 1;
  end;

  case xKatSira of
  1: begin
       xWhere   := '';
       xGroupBy := 'GROUP BY M_Year';
       KategoriButtonOlustur( 'M_Year',    ScrollBox1 );
       UrunListele();
     end;
  2: begin
       xWhere := xWhere + ' AND M_Year = ' + QuotedStr( strCaption );
       xGroupBy := 'GROUP BY M_Runtime';
       KategoriButtonOlustur( 'M_RunTime', ScrollBox1 );
       UrunListele();
     end;
  3: begin
       xWhere := xWhere + ' AND M_Runtime = ' + QuotedStr( strCaption );
       xGroupBy := 'GROUP BY M_Lang';
       KategoriButtonOlustur( 'M_Lang',    ScrollBox1 );
       UrunListele();
     end;
  4: begin
       xWhere := xWhere + ' AND M_Lang = ' + QuotedStr( strCaption );
       KategoriButtonOlustur( '!!!ButonTemizle',    ScrollBox1 );
       UrunListele();
     end;
  end;
end;

procedure TForm1.UrunListele;
begin
  With xAdoUrunQuery do begin
    Connection := xADOConnection;
    SQL.Clear;
    SQL.Add('SELECT * FROM Movies');
    SQL.Add('WHERE 1=1');
    SQL.Add( xWhere   );
    Active := True;
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  xAdoConnection.Connected := False;

  xAdoConnection.Free;
  xAdoQuery.Free;
  xAdoUrunQuery.Free;

  xDataSource.Free;
  xDataUrunSource.Free;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  KategoriButtonOlustur( '', ScrollBox1, True ); // Sadece butonları tazele
end;


Güzel paylaşım, emeğinize sağlık
Cevapla
#33
teşekkürler mrmarman hocam  Blush
Cevapla
#34
Konuyla pek alakası yok ama arkadaş hangi butona basıldığı nasıl anlaşılır minvalinde bir soru yöneltmiş, vaktiyle çok zorladığım bir konu aklıma geldi. 

Barkod okuyucu ile 8-10 farklı ürünü aynı formda çeşitli kriterlere göre alt alta sıraladığım TEdit'lara girmem gerekiyordu  (aslında olay çok daha karışık),  bazı markaların kare kodları 1 den fazla enter tuşu gönderiyordu ve dolayısı ile sıra atlama oluyordu. Hangi TEdit'a focuslanmam gerektiğini anlamak için nereden çıktığımı bulmam lazımdı. Birilerinin bir gün ihtiyacı olur ise ÇÖZÜM


unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, ExtCtrls;

type
 TForm1 = class(TForm)
   Edit1: TEdit;
   Edit2: TEdit;
   Edit3: TEdit;
   Edit4: TEdit;
   lblFrom: TLabel;
   lblFocus: TLabel;
   procedure Edit1Enter(Sender: TObject);
 private
   { Private declarations }
 public
   procedure CMDialogKey(var Msg: TCMDialogKey); message cm_DialogKey;
   procedure CMDialogChar(var Msg: TCMDialogChar); message cm_DialogChar;
   procedure CmFocusChanged (var Msg: TCmFocusChanged); message cm_FocusChanged;
 end;

var
 Form1: TForm1;
 glob : string;
implementation

{$R *.DFM}

{ TForm1 }

procedure TForm1.CMDialogChar(var Msg: TCMDialogChar);
begin
 lblFrom.Caption := lblFrom.Caption + Char (Msg.CharCode);
 inherited;
end;

procedure TForm1.CMDialogKey(var Msg: TCMDialogKey);
begin
 if (Msg.CharCode = VK_RETURN) then
 begin
   Perform (CM_DialogKey, VK_TAB, 0);
   Msg.Result := 1;
 end
 else
   inherited;
end;

procedure TForm1.CmFocusChanged(var Msg: TCmFocusChanged);
begin
 lblFocus.Caption := Msg.Sender.Name;
 glob := lblFocus.Caption;  // focus olan TEdit
end;

procedure TForm1.Edit1Enter(Sender: TObject);
begin
 (sender as (TEdit)).setfocus;
 lblFrom.Caption := glob +' den geldi';  // en son çıkılan TEdit
end;

end.
Cevapla


Konu ile Alakalı Benzer Konular
Konular Yazar Yorumlar Okunma Son Yorum
  edit1 change işlem yapma erdogan 10 392 23-08-2019, Saat: 10:25
Son Yorum: erdogan
  Dosya Adı ve İçeriğinde Arama Yapma dkadir 3 450 23-06-2019, Saat: 06:53
Son Yorum: dkadir
  Excelden den import sırasında mükerrer kaydı konrol edip farklı işlem yapma musdi42 1 831 14-11-2017, Saat: 12:21
Son Yorum: uparlayan



Konuyu Okuyanlar: 1 Ziyaretçi