Arşivbank Tasarımı

[cemaliozan]

Arşivbank son sürat olmasa da biçimlenmeye devam ediyor. Şimdi aşağıda ki Editör sınıfla uğraşıyorum. Delphici olupta sınıf tasarımı konusunda ister amatör ister profesyonel olsun herkesin ilgisini çekecek bu sınıf arşivbank'da kullanacağımız editor için ana sınıf olacak. Geliştirdikçe sınıfın teferruatı ile ilgili bilgiler vereceğim.

unit EditorClass;

interface
uses
  //sınıf içerisinden şimdilik test için kullanılan lüzumsuz unitlerde oldugu için kafanız  
  //karışmasın, zamanı gelince ayıtlayacağım. 
 Windows,SysUtils, StdCtrls,ImgList, Controls, Classes, ExtCtrls, ComCtrls,Graphics,
  SynEditSearch,uHighlighterProcs,cxControls, cxContainer, cxListBox,
  SynHighlighterPas, SynHighlighterIni,SynHighlighterGWS, SynHighlighterM3,   
  SynHighlighterHtml, SynHighlighterModelica, SynHighlighterGeneral, 
  SynHighlighterAsm, SynHighlighterIDL, SynHighlighterVB, SynHighlighterDml,
  SynHighlighterSml, SynHighlighterTclTk, SynHighlighterGalaxy,
  SynHighlighterFoxpro, SynHighlighterFortran, SynHighlighterSQL,
  SynEditPythonBehaviour, SynHighlighterPython, SynHighlighterDfm,
  SynHighlighterCSS, SynHighlighterProgress, SynHighlighterPHP,
  SynHighlighterCAC, SynHighlighterPerl, SynHighlighterCache,
  SynHighlighterCpp, SynHighlighterBat, SynHighlighterST,
  SynHighlighterVBScript, SynHighlighterBaan, SynHighlighterXML,
  SynHighlighterKix, SynHighlighterAWK, SynHighlighterUnreal,
  SynHighlighterJScript, SynHighlighterADSP21xx, SynHighlighterHC11,
  SynHighlighterJava, SynHighlighterMsg, SynHighlighterSDD,
  SynHighlighterInno, SynEditHighlighter, SynHighlighterCPM,
  SynCompletionProposal, SynExportRTF, SynEditExport, SynExportHTML,
  Dialogs, SynEdit,SynEditKeyCmdsEditor, SynEditKeyCmds, RsRuler,Variants, cxPC;

type
  //Editor ana sınıfı
  TArsivEditor  = Class(TSynEdit)
    procedure SetRulerFlat(const AFlat: Boolean);
    procedure SetRulerUnits(Const UnitIndex : Integer);
    procedure SetRulerHairLineStyle(Const StyleIndex : Integer);
  private
    FSagUstKoseKorner: TRsRulerCorner;
    FSolUstKoseKorner: TRsRulerCorner;
    FSagAltKoseKorner: TRsRulerCorner;
    FSolAltKoseKorner: TRsRulerCorner;
    FCetvelSag: TRsRuler;
    FCetvelUst: TRsRuler;
    FCetvelSol: TRsRuler;
    FCetvelAlt: TRsRuler;
    FTabSheet: TcxTabSheet;
    FMouseOlaylariniIzle: Boolean;
    FOlayListBox: TcxListBox;
    FKlavyeOlaylariniIzle: Boolean;
    FDigerOlaylariIzle: Boolean;
    FSuruklemeOlaylariniIzle: Boolean;
    procedure LogEvent(AEvent: string);
    procedure MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure KeyPress(Sender: TObject; var Key: Char);
    procedure KeyUp(Sender: TObject; var Key: Word;Shift: TShiftState);
    procedure MouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
    procedure MouseUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
    procedure Paint(Sender: TObject; ACanvas: TCanvas);
    procedure ProcessCommand(Sender: TObject; var Command: TSynEditorCommand; var AChar: Char; Data: Pointer);
    procedure ProcessUserCommand(Sender: TObject; var Command: TSynEditorCommand; var AChar: Char; Data: Pointer);
    procedure ReplaceText(Sender: TObject; const ASearch, AReplace: String;Line, Column: Integer; var Action: TSynReplaceAction);
    procedure StartDrag(Sender: TObject; var DragObject: TDragObject);
    procedure EditorDblClick(Sender: TObject);
    procedure EditorDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure EditorDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure EditorDropFiles(Sender: TObject; X, Y: Integer;
      AFiles: TStrings);
    procedure EditorEndDrag(Sender, Target: TObject; X, Y: Integer);
    procedure EditorEnter(Sender: TObject);
    procedure EditorExit(Sender: TObject);
  published
    property SolUstKoseKorner           : TRsRulerCorner Read FSolUstKoseKorner;
    property SagUstKoseKorner           : TRsRulerCorner Read FSagUstKoseKorner;
    property SolAltKoseKorner           : TRsRulerCorner Read FSolAltKoseKorner;
    property SagAltKoseKorner           : TRsRulerCorner Read FSagAltKoseKorner;
    property CetvelUst                  : TRsRuler       Read FCetvelUst;
    property CetvelAlt                  : TRsRuler       Read FCetvelAlt;
    property CetvelSol                  : TRsRuler       Read FCetvelSol;
    property CetvelSag                  : TRsRuler       Read FCetvelSag;
    property TabSheet                   : TcxTabSheet    Read FTabSheet;
    property MouseOlaylariniIzle        : Boolean        Read FMouseOlaylariniIzle Write FMouseOlaylariniIzle;
    property KlavyeOlaylariniIzle       : Boolean        Read FKlavyeOlaylariniIzle Write FKlavyeOlaylariniIzle;
    property SuruklemeOlaylariniIzle    : Boolean        Read FSuruklemeOlaylariniIzle Write FSuruklemeOlaylariniIzle;
    property DigerOlaylariIzle          : Boolean        Read FDigerOlaylariIzle Write FDigerOlaylariIzle;
    property OlayListBox                : TcxListBox     Read FOlayListBox Write FOlayListBox;
  public
    constructor Create(AOwner:TComponent);Override;
    destructor  Destroy;Override;
  published
end;

//Tüm editörler bir sekme içerisinde görünecek, Editör ve  bağlı nesneler için ana parent // aşağıdaki sınıfta tanımalanan TabSheet olacaktır.   
type
 TArsivEditorTabSheet = Class(TcxTabSheet)
   ArsivEditor : TArsivEditor;
   TabanPanel,
   SolPanel,
   SagPanel,
   UstPanel,
   AltPanel : TPanel;
   SolCetvel,
   SagCetvel,
   UstCetvel,
   AltCetvel : TRsRuler;
   SolUstKose,
   SagUstKose,
   SolAltKose,
   SagAltKose : TRsRulerCorner;
  private
    FEditorKenarlikGenisligi: Integer;
    procedure CreatePanels;
    procedure CreateRulers;
    procedure CreateRulerKorners;
 public
   constructor Create(AOwner:TComponent);Override;
   destructor  Destroy;Override;
 published
   property EditorKenarlikGenisligi  : Integer Read FEditorKenarlikGenisligi;
end;
implementation

uses SynEditMiscClasses;

{ TArsivEditor }
Procedure TArsivEditor.SetRulerFlat(Const AFlat : Boolean);
begin
  CetvelSol.Flat         := AFlat;
  CetvelSag.Flat        := AFlat;
  CetvelUst.Flat         := AFlat;
  CetvelAlt.Flat         := AFlat;
  SolUstKoseKorner.Flat := AFlat;
  SagUstKoseKorner.Flat := AFlat;
  SolAltKoseKorner.Flat := AFlat;
  SagAltKoseKorner.Flat := AFlat;
end;

procedure TArsivEditor.LogEvent(AEvent: string);
begin
  if (Assigned(FOlayListBox)) then
    FOlayListBox.Items.Insert(0, TimeToStr(Now) + ' ' + AEvent);
end;

procedure TArsivEditor.KeyDown(Sender: TObject; var Key: Word;Shift: TShiftState);
begin
  if KlavyeOlaylariniIzle then LogEvent('OnKeyDown');
end;

procedure TArsivEditor.KeyPress(Sender: TObject; var Key: Char);
begin
  if KlavyeOlaylariniIzle then LogEvent('OnKeyPress');
end;

procedure TArsivEditor.KeyUp(Sender: TObject; var Key: Word;Shift: TShiftState);
begin
  if KlavyeOlaylariniIzle then LogEvent('OnKeyUp');
end;

procedure TArsivEditor.MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if KlavyeOlaylariniIzle then  LogEvent('OnMouseDown');
end;

procedure TArsivEditor.MouseUp(Sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if MouseOlaylariniIzle then LogEvent('OnMouseUp');
end;

procedure TArsivEditor.Paint(Sender: TObject; ACanvas: TCanvas);
begin
  if DigerOlaylariIzle then  LogEvent('OnPaint');
end;

procedure TArsivEditor.ProcessCommand(Sender: TObject; var Command: TSynEditorCommand; var AChar: Char; Data: Pointer);
begin
  if KlavyeOlaylariniIzle then LogEvent('OnProcessCommand');
end;

procedure TArsivEditor.ProcessUserCommand(Sender: TObject; var Command: TSynEditorCommand; var AChar: Char; Data: Pointer);
begin
  if KlavyeOlaylariniIzle then  LogEvent('OnProcessUserCommand');
end;

procedure TArsivEditor.ReplaceText(Sender: TObject; const ASearch,AReplace: String; Line, Column: Integer; var Action: TSynReplaceAction);
begin
  if DigerOlaylariIzle then  LogEvent('OnReplaceText');
end;

procedure TArsivEditor.StartDrag(Sender: TObject; var DragObject: TDragObject);
begin
  if SuruklemeOlaylariniIzle then  LogEvent('OnStartDrag');
end;

procedure TArsivEditor.MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  CetvelUst.HairLinePos := X;
  CetvelAlt.HairLinePos := X;
  CetvelSol.HairLinePos := Y;
  CetvelSag.HairLinePos := Y;
  //FTabSheet.Caption := Format('(%.3g; %.3g)', [RsRuler1.Pos2Unit(X), RsRuler3.Pos2Unit(Y)]);
  if (MouseOlaylariniIzle) then LogEvent('OnMouseMove');
end;

procedure TArsivEditor.EditorDblClick(Sender: TObject);
begin
  if MouseOlaylariniIzle then LogEvent('OnDblClick');
end;

procedure TArsivEditor.EditorDragDrop(Sender, Source: TObject; X,Y: Integer);
begin
  if SuruklemeOlaylariniIzle then LogEvent('OnDragDrop');
end;

procedure TArsivEditor.EditorDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
begin
  if SuruklemeOlaylariniIzle then LogEvent('OnDragOver');
end;

procedure TArsivEditor.EditorDropFiles(Sender: TObject; X, Y: Integer; AFiles: TStrings);
begin
  if DigerOlaylariIzle then  LogEvent('OnDropFiles');
  if AFiles.Count >= 1 then  Lines.LoadFromFile(AFiles[0]);
end;

procedure TArsivEditor.EditorEndDrag(Sender, Target: TObject; X, Y: Integer);
begin
  if SuruklemeOlaylariniIzle then LogEvent('OnEndDrag');
end;

procedure TArsivEditor.EditorEnter(Sender: TObject);
begin
  if DigerOlaylariIzle then  LogEvent('OnEnter');
end;

procedure TArsivEditor.EditorExit(Sender: TObject);
begin
  if DigerOlaylariIzle then  LogEvent('OnExit');
end;

constructor TArsivEditor.Create(AOwner: TComponent);
begin
  inherited;
  //intializes a search engine
  SearchEngine          := TSynEditSearch.Create(Self);
  MouseOlaylariniIzle   := False;
  KlavyeOlaylariniIzle  := False;
  DigerOlaylariIzle     := False;
  OnMouseMove           := MouseMove;
  OnMouseDown           := MouseDown;
  OnMouseUp             := MouseUp;
  OnPaint               := Paint;
  OnKeyPress            := KeyPress;
  OnKeyDown             := KeyDown;
  OnKeyUp               := KeyUp;
  OnStartDrag           := StartDrag;
  OnReplaceText         := ReplaceText;
  OnProcessCommand      := ProcessCommand;
  OnProcessUserCommand  := ProcessUserCommand;
  OnDblClick            := EditorDblClick;
  OnDragDrop            := EditorDragDrop;
  OnDragOver            := EditorDragOver;
  OnDropFiles           := EditorDropFiles;
  OnEndDrag             := EditorEndDrag;
  OnEnter               := EditorEnter;
  OnExit                := EditorExit;
  Options               := [eoAutoIndent,eoDragDropEditing,eoDropFiles,eoScrollPastEOL,eoShowScrollHint,eoSmartTabs,eoTabsToSpaces];
  ScrollBars            := ssBoth;
  With BookMarkOptions do
  begin
    DrawBookmarksFirst  := True;
    EnableKeys          := True;
    GlyphsVisible       := True;
    LeftMargin          := 2;
    Xoffset             := 12;
  end;

end;

destructor TArsivEditor.Destroy;
begin
  SearchEngine.Free;
  inherited;
end;

procedure TArsivEditor.SetRulerUnits(const UnitIndex: Integer);
 Var
   AUnits : TRulerUnit;
begin
  Case UnitIndex of
    0 : AUnits := ruPixel;
    1 : AUnits := ruInch;
    2 : AUnits := ruMilli;
    3 : AUnits := ruCenti;
    4 : AUnits := ruMeter;
    5 : AUnits := ruKilo;
   else
    AUnits := ruNone;
  end;
  CetvelSol.Units        := AUnits;
  CetvelSag.Units        := AUnits;
  CetvelUst.Units        := AUnits;
  CetvelAlt.Units        := AUnits;
  SolUstKoseKorner.Units := AUnits;
  SagUstKoseKorner.Units := AUnits;
  SolAltKoseKorner.Units := AUnits;
  SagAltKoseKorner.Units := AUnits;
end;

procedure TArsivEditor.SetRulerHairLineStyle(const StyleIndex: Integer);
 Var
  AStyle : THairLineStyle;
begin
  Case StyleIndex of
    0 : AStyle := hlsLine;
    1 : AStyle := hlsRect;
  end;
  CetvelSol.HairLineStyle := AStyle;
  CetvelSag.HairLineStyle := AStyle;
  CetvelUst.HairLineStyle := AStyle;
  CetvelAlt.HairLineStyle := AStyle;
end;

{ TArsivEditorTabSheet }
Procedure TArsivEditorTabSheet.CreatePanels;
Begin
  //* Panel *//
  TabanPanel                    := TPanel.Create(Self);
  TabanPanel.Parent             := Self;
  TabanPanel.Align              := alClient;
  TabanPanel.Caption            := '';
  TabanPanel.BevelInner         := bvNone;
  TabanPanel.BevelOuter         := bvNone;
  TabanPanel.BorderStyle        := bsNone;

  SolPanel                      := TPanel.Create(Self);
  SolPanel.Parent               := TabanPanel;
  SolPanel.Align                := alLeft;
  SolPanel.Caption              := '';
  SolPanel.Width                := 25;
  SolPanel.BevelInner           := bvNone;
  SolPanel.BevelOuter           := bvNone;
  SolPanel.BorderStyle          := bsNone;

  SagPanel                      := TPanel.Create(Self);
  SagPanel.Parent               := TabanPanel;
  SagPanel.Align                := alRight;
  SagPanel.Caption              := '';
  SagPanel.Width                := 25;
  SagPanel.BevelInner           := bvNone;
  SagPanel.BevelOuter           := bvNone;
  SagPanel.BorderStyle          := bsNone;

  UstPanel                      := TPanel.Create(Self);
  UstPanel.Parent               := TabanPanel;
  UstPanel.Height               := 25;
  UstPanel.Align                := alTop;
  UstPanel.Caption              := '';
  UstPanel.BevelInner           := bvNone;
  UstPanel.BevelOuter           := bvNone;
  UstPanel.BorderStyle          := bsNone;

  AltPanel                      := TPanel.Create(Self);
  AltPanel.Parent               := TabanPanel;
  AltPanel.Height               := 25;
  AltPanel.Align                := alBottom;
  AltPanel.Caption              := '';
  AltPanel.BevelInner           := bvNone;
  AltPanel.BevelOuter           := bvNone;
  AltPanel.BorderStyle          := bsNone;
end;

Procedure TArsivEditorTabSheet.CreateRulers;
Begin
  //* Ruler *//
  SolCetvel                     := TRsRuler.Create(Self);
  With SolCetvel do
  begin
    parent                      := SolPanel;
    Units                       := ruCenti;
    Align                       := alClient;
    Flat                        := true;
    Offset                      := 0;
    Width                       := 25;
    Direction                   := rdLeft;
    HairLineStyle               := hlsLine;
    HairLine                    := True;
  end;

  SagCetvel                     := TRsRuler.Create(Self);
  With SagCetvel do
  begin
    parent                      := SagPanel;
    Units                       := ruCenti;
    Align                       := alClient;
    Flat                        := true;
    Offset                      := 0;
    Width                       := 25;
    Direction                   := rdRight;
    HairLineStyle               := hlsLine;
    HairLine                    := True;
  end;

  UstCetvel                     := TRsRuler.Create(Self);
  With UstCetvel do
  begin
    parent                      := UstPanel;
    Units                       := ruCenti;
    Align                       := alClient;
    Flat                        := true;
    Offset                      := 0;
    Height                      := 25;
    HairLineStyle               := hlsLine;
    HairLine                    := True;
  end;

  AltCetvel                     := TRsRuler.Create(Self);
  With AltCetvel do
  begin
    parent                      := AltPanel;
    Units                       := ruCenti;
    Align                       := alClient;
    Flat                        := true;
    Offset                      := 0;
    Height                      := 25;
    Direction                   := rdBottom;
    HairLineStyle               := hlsLine;
    HairLine                    := True;
 end;
end;

Procedure TArsivEditorTabSheet.CreateRulerKorners;
Begin
  //* Ruler Corner *//
  SolUstKose                    := TRsRulerCorner.Create(Self);
  With SolUstKose do
  begin
    parent                      := UstPanel;
    Position                    := cpLeftTop;
    Units                       := ruCenti;
    Flat                        := True;
    Align                       := alLeft;
    Height                      := 25;
    Width                       := EditorKenarlikGenisligi+25;
  end;

  SagUstKose                    := TRsRulerCorner.Create(Self);
  With SagUstKose do
  begin
    parent                      := UstPanel;
    Position                    := cpRightTop;
    Units                       := ruCenti;
    Flat                        := True;
    Align                       := alRight;
    Height                      := 25;
    Width                       := 22;
  end;

  SolAltKose                    := TRsRulerCorner.Create(Self);
  With SolAltKose do
  begin
    parent                      := AltPanel;
    Position                    := cpLeftBottom;
    Units                       := ruCenti;
    Flat                        := True;
    Align                       := alLeft;
    Height                      := 25;
    Width                       := EditorKenarlikGenisligi +25;
  end;

  SagAltKose                    := TRsRulerCorner.Create(Self);
  With SagAltKose do
  begin
    parent                      := AltPanel;
    Position                    := cpRightBottom;
    Units                       := ruCenti;
    Flat                        := True;
    Align                       := alRight;
    Height                      := 25;
    Width                       := 22;
  end;
End;

//Aşağıdaki yöntem bir editör bileşeni  ile, 4 adet cetvel,  4 adet köşe  ve bunların yer
//üzerine yerleştirilecek 4 adet paneli ve tüm bunları üzerinde barındıracak sekmeyi
//yaratır.
constructor TArsivEditorTabSheet.Create(AOwner: TComponent);
begin
  inherited;
  FEditorKenarlikGenisligi := 30;
  CreatePanels;
  CreateRulerKorners;
  CreateRulers;
  //* Editör *//
  ArsivEditor              := TArsivEditor.Create(Self);
  With ArsivEditor do
  begin
    parent                 := TabanPanel;
    Align                  := alClient;
    BorderStyle            := bsNone;
    FSolUstKoseKorner      := SolUstKose;
    FSagUstKoseKorner      := SagUstKose;
    FSolAltKoseKorner      := SolAltKose;
    FSagAltKoseKorner      := SagAltKose;
    FCetvelSol             := SolCetvel;
    FCetvelSag             := SagCetvel;
    FCetvelAlt             := AltCetvel;
    FCetvelUst             := UstCetvel;
    FTabSheet              := Self;
  end;
end;

destructor TArsivEditorTabSheet.Destroy;
begin
  ArsivEditor.Free;
  SolCetvel.Free;
  SagCetvel.Free;
  UstCetvel.Free;
  AltCetvel.Free;
  SolUstKose.Free;
  SagUstKose.Free;
  SolAltKose.Free;
  SagAltKose.Free;
  SolPanel.Free;
  SagPanel.Free;
  UstPanel.Free;
  AltPanel.Free;
  inherited;
end;
end.

Dikkat ettiyseniz editörün bir çok olayı, sınıf tanımında dinamik olarak deklare ediliyor. Editörle birlikte kullanılan başka nesnelerde var. Bunlar ReplaceTextEngine, HighLighter gibi nesneler... Siz biraz daha göz gezdirin...

[burhanmt]

Evet inceleyeceğiz. Takip ediyoruz hocam sizi.
Bu arada uses'tan sonra ne kadar unit deklara etmişiniz. Sanırım her dilin sentaksı için ayrı bir unitte ele alındı. Böyleyse çok modüler. Yani güzel. Geliştirmesi daha kolay olur. Aslında projenin şu anki yarım yuvarlak hali ile mailime yollarsanız inceleme fırsatı bulacağım.

[cemaliozan]

Böyleyse çok modüler. Yani güzel. Geliştirmesi daha kolay olur. Aslında projenin şu anki yarım yuvarlak hali ile mailime yollarsanız inceleme fırsatı bulacağım.

Evet burhan hocam, uses da Syn ile baslayanlar birden fazla dili destekleyecek unitler. SynEdit bileseniyle beraber geliyorlar ve Highlighter nesnesinde soz dizimi islemleri icin kullaniliyorlar. Bunlar ait olduklari dilin syntax'ini otomatikk takip ettikleri gibi hepsi ozellestirilebiliyorlar. Ayrica genel kullanim icin bir Highlighter sinifida mevcut. Dedigim gibi kodlar elimizde oldugu icin sınıflarla istediğimiz gibi çalışabiliriz.

Mail işi için bazı sorunlarım var hocam. Ancak hafta sonu gönderebilirim. Hem biraz daha şeklen bir şeylere benzemeye başlar editor sınıfı ve kategori düzenleme modülü.

Şimdilik kolay gelsin.

[Övünç Mete]

Selamlar, ceviz`in iyi bir kullanicisi degilim ama acik kaynak kodlu bu projenize destek vermek istiyorum. Cok kisitli zamanima ragmen corbada tuzum olsun istiyorum. Kod parcalarini goruyorum ama en son halini nereden indirecegim ?

Projede coder olarak: veri yapilari, kayit, optimizasyon vb konularda yardimci olmayi deniyecegim...

Tesekkurler,
Ovunc Mete

[cemaliozan]

Övünç Hocam, destek için teşekkür ederim. Şu ana kadar yazılımsal olarak derlemeye çalıştığım yapıyı şablon olarak veriyorum. Eğer bu şablonun editör sınıfı üzerinde birlikte çalışmak isterseniz haberleşelim. Veya kategori düzenleme modülü üzerindede tek başınıza çalılabilirsiniz. Yada arşive ekleme işlemleri için veri tabanı tasarımını yapabilirsiniz. Siz seçin.

Ekte'ki klasör ve dosyalarla ilgili soracağınız bir şey olursa bana burdan sorabilirsiniz.
Kolay gelsin. Express Quantum Grid 5.3 yaklasik 150 mb. ve Sui Pack 11 Mb. boyutunda oldugu için buradan gönderemiyorum. Sorun olursa haberleşelim. Buradan verdigim bileşenler GNU lisanlıdır.

Kolay gelsin.

[Övünç Mete]

Kodlari incelemek icin simdi indiriyorum...

[cemaliozan]

Editor ile ugraşırken belki merak edipde yüklemek isteyen olur diyerekten gönderdiğim bileşenlerin VCL'ye yüklenmesinden kısaca bashetmek istiyorum. Hatta bu konuda makale bile yazmak lazım olabilir ama zaman dar.

Delphide bileşen paletine bileşen yüklemenin bir kaç yolu var. Bunlardan birini Delphi ile Dosya ve Kaynak yönetimi başlıklı makalemde anlattım. Delphi ile bileşen geliştirenler genelde aşağıdaki yöntemleri kullanarak bileşenlerini isimlendirirler.

bileşen dosyası/paketinin unit adı+Desing Time/Runtime İşareti+Delphi Sürümü

Böylelikle örneğin S403_d70.dpk ismine bakınca bu paketin bir designtime delphi7 paketi olduğunu anlarız.

Bir bileşen paketini yüklemek için eğer windows dosya ilişkisini elle değiştirmediyseniz üzerine çift tıklayarak delphi'yi install component package diyalogu ile başlatabiliriz.
daha sonra olası compiler hatalarını görmek için COMPILE düğmesiyle bileşen kaynak kodunu derleriz. Bileşeni VCL ekleyip bileşen paletinde göstermek için INSTALL düğmesine tıklarız.

Ekte verdiğim editör sınıfımızın ebeveyn bileşeni SynEdit. Bu bileşeni yüklemek için delphi-> Component -> install Componenet -> Into New Package sekmesinde browse ile SynEdit paketinin kayıtlı olduğu klasörün altında source dizini altında SynEditReg.pas dosyasını açarız. SynEditReg.pas dosyası bu bileşen paketi
içinde yer alan tüm bileşenlerin kayıt yöntemini (Register) bulundurmaktadır. Dosyanın derlenmesi sonucu oluşturulacak paket için Package File Name kutusuna uygun bir yol ve dosya ismi gireriz. (Dosya uzantısı DPK olacak). Bileşen paketimiz için bir görüntü ismini Package description olarak girip. OK. tıklarız. Bileşen paketinin derlenip yüklenmesiyle ilgili soruya YES dersek bileşenlerimiz VCL üzerinde Register yönteminde gösterilen sekmeye yüklenir.

SynEdit bileşen paketini kayıtlı olduğu dizinin altından Packages klasörü içinden uygun delphi versiyonlu paketi çift tıklayarak açılan install component diyalogundanda yükleyebilirsiniz. Delphi6 için paket SynEdit_D6.dpk ' dir.

Diğer bileşenleride aynı yöntemlerle yükleyebilirsiniz. Karşılaşacağınız sorunları buraya yazarsanız cevaplayabilirim.

Kolay gelsin.

[cemaliozan]

İhtiyaca binaen dbTreeview bileşenine iki olay ekledim. Bu olaylardan ilki OnBeforePost. Bu olayı bir DataSet nesnesinin kaydetme yönteminden önce çağırdığımızı hatırlayacaksınız. İkincisi AfterPost olayı. Bu olayıda herhangi bir DataSet nesnesinin kaydetme işlemi bittikten sonra çağırdığımızı hatırlayacaksınız. Bu iki olay dbtreeview bileşenin de yoktu. Benim kategoriler üzerinde yapacağım hassas işlemler nedeniyle ekledim.

Elinizdeki dbtreeview.pas dosyasını aşağıdaki kodlarla değiştirabilirsiniz. Ya da daha iyisi bu iki olayın ekleniş biçimini inceleyip kendi olaylarınızıda ekleyebilirsiniz.

Kullanacağımız olayları sınıf olayı olarak deklare ediyoruz.

TOnBeforePost = procedure (DataSet:TDataSet) of Object;
TOnAfterPost = procedure (DataSet:TDataSet) of Object;

Eklediğimiz olayların tetiklenmesi için ilgili sınıf bildiriminin published alaninda aşağıdaki satırlarla yeni olaylarımızı sınıfımıza ekliyoruz istiyoruz

property OnBeforePost : TOnBeforePost Read FOnBeforePost Write FOnBeforePost;
property OnAfterPost : TOnAfterPost Read FOnAfterPost Write FOnAfterPost;

Published deklare ettiğimiz sınıf olaylarını aşağıdaki yöntemlerle tetikliyoruz.

procedure TDBTreeView.DoAfterPost(DataSet: TDataSet);
begin
if Assigned(FOnAfterPost) then FOnAfterPost(DataSet);
end;

procedure TDBTreeView.DoBeforePost(DataSet: TDataSet);
begin
if Assigned(FOnBeforePost) then FOnBeforePost(DataSet);
end;

Sınıf içinde DataSet nesnesinin POST yöntemini çağıran satırdan önce DoBeforePost, POST çağrısının hemen ardından DoAfterPost yöntemlerini çağırarak olayları tetikletiyoruz.


Sınıfın Tüm kodu aşağıdaki gibidir.

 unit DBTreeView;

{

    TDBTreeView is intened to provide the data representation as the tree.

}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, CommCtrl, Forms, Dialogs,
  ComCtrls, DB;

type

    TDBTreeView = class;

  {
    Bu iki sınıf olayı düzenleme ve ekleme işlemlerinde çağrılıyor
    Bize BeforPost ve AfterPost olaylarıda lazım onlarıda ekleyeceğiz.
  }
  TOnEditingNodeEvent   = procedure (Sender: TObject; var Allow: Boolean) of object;
  TOnInsertingNodeEvent = procedure (Sender: TObject; var NewCaption: String; var Allow: Boolean) of object;
  TOnBeforePost         = procedure (DataSet:TDataSet) of Object;
  TOnAfterPost          = procedure (DataSet:TDataSet) of Object;

  TTreeDataLink = class(TDataLink)
  private
    FTreeView: TDBTreeView;
  protected
     procedure DataSetChanged; override;
     procedure RecordChanged(Field: TField); override;
     procedure ActiveChanged; override;
  public
      constructor Create(ATreeView: TDBTreeView);
  end;

  TFieldDataItem = class(TCollectionItem)
  public
      Values: TStringList;
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
  end;

  TBuildMethod = (bmFilter, bmRaw);

  TDBTreeView = class(TCustomTreeView)
  private
    FChanging: Boolean;
    FDataLink: TTreeDataLink;
    FRootID: Integer;
    FIDField : String;
    FParentIDField: String;
    FDisplayField: String;
    FBuildMethod : TBuildMethod;
    FStoredFieldsList : TStringList;
    FStoredFieldsData : TCollection;
    FOnEditingNode     : TOnEditingNodeEvent;
    FOnInsertingNode   : TOnInsertingNodeEvent;
    FOnDeletingNode    : TOnEditingNodeEvent;
    FOnEditNode        : TNotifyEvent;
    FOnRebuildTree     : TNotifyEvent;
    FOnAfterPost: TOnAfterPost;
    FOnBeforePost: TOnBeforePost;
    procedure SetSource(Src: TDataSource);
    function  GetSource: TDataSource;
    procedure SetRootID(Value: Integer);
    procedure SetIDField(Value: String);
    procedure SetParentIDField(Value: String);
    procedure SetDisplayField(Value: String);
    procedure SetBuildMethod(Value: TBuildMethod);
    function  ValidDataSet: Boolean;
    function  ValidFields: Boolean;
    procedure StoredFieldsListChanged(Sender: TObject);
    procedure UpdateByDataSet;
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure DataSetChanged;
    procedure RecordChanged(Field: TField);
    procedure Change(Node: TTreeNode); override;
    procedure Edit(const Item: TTVItem); override;
    procedure WndProc(var Message: TMessage); override;
    procedure InsertNew(Node: TTreeNode);
    procedure DeleteNode(Node: TTreeNode);
    procedure EditNode(Node: TTreeNode);
    //* Bizim eklediğimiz yöntemlerin tetikçileri *//
   procedure DoBeforePost(DataSet : TDataSet);
   procedure DoAfterPost(DataSet:TDataSet);
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    procedure   RebuildTree(KeepCurrentID: Boolean);
    function    GetStoredField(Node: TTreeNode; Field: String): String;
    property    Changing: Boolean read FChanging write FChanging;
    property    Items;
  published
    property DataSource: TDataSource read GetSource write SetSource;
    property RootID : Integer read FRootID write SetRootID;
    property IDField: String read FIDField write SetIDField;
    property ParentIDField: String read FParentIDField write SetParentIDField;
    property DisplayField: String read FDisplayField write SetDisplayField;
    property StoredFieldsList: TStringList read FStoredFieldsList write FStoredFieldsList;
    property BuildMethod: TBuildMethod read FBuildMethod write SetBuildMethod;
    property Align;
    property Color;
    property Font;
    property BorderStyle;
    property Tag;
    property TabStop;
    property TabOrder;
    property AutoExpand;
    property RightClickSelect;
    property Visible;
    property Enabled;
    property HideSelection;
    property HotTrack;
    property ReadOnly;
    property Indent;
    property Images;
    property StateImages;
    property ShowButtons;
    property ShowRoot;
    property ShowLines;
    property SortType;
    property OnChange;
    property OnChanging;
    property OnCollapsed;
    property OnCollapsing;
    property OnCompare;
    property OnDeletion;
    property OnEdited;
    property OnEditing;
    property OnExpanded;
    property OnExpanding;
    property OnGetImageIndex;
    property OnCustomDrawItem;
    property OnExit;
    property OnEnter;
    property OnMouseDown;
    property OnMouseUp;
    property OnEditingNode: TOnEditingNodeEvent read FOnEditingNode write FOnEditingNode;
    property OnInsertingNode: TOnInsertingNodeEvent read FOnInsertingNode write FOnInsertingNode;
    property OnDeletingNode: TOnEditingNodeEvent read FOnDeletingNode write FOnDeletingNode;
    property OnEditNode: TNotifyEvent read FOnEditNode write FOnEditNode;
    property OnRebuildTree: TNotifyEvent read FOnRebuildTree write FOnRebuildTree;
    //* Eklediğimiz olayların object inspectorda görünmesini istiyoruz *//
    property OnBeforePost  :  TOnBeforePost Read FOnBeforePost Write FOnBeforePost;
    property OnAfterPost   : TOnAfterPost Read FOnAfterPost Write FOnAfterPost;
  end;

implementation

const
    ValidIDTypes : set of TFieldType = [ftLargeInt, ftSmallInt, ftInteger, ftWord, ftAutoInc];
  MaxSubtreeItems = 100;

// TFieldDataItem

constructor TFieldDataItem.Create(Collection: TCollection);
begin
    inherited Create(Collection);
  Values := TStringList.Create;
end;

destructor TFieldDataItem.Destroy;
begin
    Values.Free;
  inherited Destroy;
end;

// TTreeDataLink

constructor TTreeDataLink.Create(ATreeView: TDBTreeView);
begin
    inherited Create;
  FTreeView := ATreeView;
  VisualControl := True;
end;

procedure TTreeDataLink.DataSetChanged;
begin
    FTreeView.DataSetChanged;
end;

procedure TTreeDataLink.RecordChanged(Field: TField);
begin
  FTreeView.RecordChanged(Field);
end;

procedure TTreeDataLink.ActiveChanged;
begin
    if Active then FTreeView.RebuildTree(False) else FTreeView.Items.Clear;
end;

// TDBTreeView

constructor TDBTreeView.Create(AOwner: TComponent);
begin
    inherited Create(AOwner);
  FChanging := False;
  FDataLink := TTreeDataLink.Create(Self);
  FDataLink.DataSource := nil;
  FRootID := 0;
  FStoredFieldsList := TStringList.Create;
  FStoredFieldsList.OnChange := StoredFieldsListChanged;
  FStoredFieldsData := TCollection.Create(TFieldDataItem);
  FBuildMethod := bmFilter;
end;

destructor TDBTreeView.Destroy;
begin
    FDataLink.Free;
  FStoredFieldsList.Free;
  FStoredFieldsData.Free;
  inherited Destroy;
end;

procedure TDBTreeView.DataSetChanged;
begin
    if not HandleAllocated then Exit;
  if not FChanging then RebuildTree(True);
end;

procedure TDBTreeView.RecordChanged(Field: TField);
begin
    if not HandleAllocated then Exit;
  if not FChanging then RebuildTree(True);
end;

procedure TDBTreeView.SetSource(Src: TDataSource);
begin
    if Src = FDataLink.DataSource then Exit;
    FDataLink.DataSource := Src;
  if Src <> nil then Src.FreeNotification(Self);
end;

function TDBTreeView.GetSource: TDataSource;
begin
    Result := FDataLink.DataSource;
end;

procedure TDBTreeView.StoredFieldsListChanged(Sender: TObject);
begin
    if FDataLink.Active then RebuildTree(True);
end;

procedure TDBTreeView.UpdateByDataSet;

    function FindNodeByID(Node: TTreeNode; AID: Integer): TTreeNode;
  var
      Child: TTreeNode;
  begin
    if Node <> nil then Child := Node.GetFirstChild else Child := Items.GetFirstNode;
    while Child <> nil do
    begin
        if Integer(Child.Data) = AID then
      begin
          Result := Child;
        Exit;
      end;
      Result := FindNodeByID(Child, AID);
      if Result <> nil then Exit;
      Child := Child.GetNext;
    end;
    Result := nil;
  end;

var
    N : TTreeNode;
begin
  if FDataLink.Active then
  begin
      N := FindNodeByID(nil, FDataLink.DataSource.DataSet.FieldByName(IDField).AsInteger);
    if N <> nil then Selected := N;
  end;
end;

procedure TDBTreeView.RebuildTree(KeepCurrentID: Boolean);
var
    OldFiltered: Boolean;
  OldFilter,
  AppliedFilter  : String;
  CurID      : Integer;
  Tmp        : String;
  TmpI       : Integer;
  DataSet    : TDataSet;


  procedure ProcessID(Node: TTreeNode);
  var
      Child: TTreeNode;
    I   : Integer;
    Itm : TFieldDataItem;
    Add : Boolean;
  begin
      if Node = nil then Tmp := IntToStr(FRootID) else Tmp := IntToStr(Integer(Node.Data));
    TmpI := StrToInt(Tmp);
      if FBuildMethod = bmFilter then
        FDataLink.DataSet.Filter := AppliedFilter+'('+ParentIDField+' = '+Tmp+')';
    with DataSet do
    begin
        First;
      while not EOF do
      begin
          if FBuildMethod = bmFilter then Add := True
            else Add := (FieldByName(ParentIDField).AsInteger = TmpI);
        if Add then
        begin
          Items.AddChildObject(Node, FieldByName(DisplayField).AsString,
            Pointer(FieldByName(IDField).AsInteger));
          Itm := FStoredFieldsData.Add as TFieldDataItem;
          Itm.Values.Add(FieldByName(IDField).AsString);
          for I := 1 to FStoredFieldsList.Count do
            Itm.Values.Add(FieldByName(FStoredFieldsList[I-1]).AsString);
        end;
        Next;
      end;
    end;
    if Node = nil then Child := Items.GetFirstNode else Child := Node.GetFirstChild;
    while Child <> nil do
    begin
        ProcessID(Child);
      Child := Child.GetNextSibling;
    end;
  end;

begin
    if not ValidFields then Exit;
  FChanging := True;
  DataSet := FDataLink.DataSource.DataSet;
  if DataSet.RecordCount = 0 then Exit;
  if FBuildMethod = bmFilter then
  begin
      OldFiltered := DataSet.Filtered;
      OldFilter := DataSet.Filter;
      if OldFiltered and (OldFilter <> '') then
          AppliedFilter := '('+OldFilter+') AND ' else AppliedFilter := '';
  end;
  DataSet.DisableControls;
  if KeepCurrentID then
      if Items.Count > 0 then CurID := DataSet.FieldByName(IDField).AsInteger else CurID := FRootID;
  Items.BeginUpdate;
  Items.Clear;
  FStoredFieldsData.Clear;
  if FBuildMethod = bmFilter then DataSet.Filtered := True;
     ProcessID(nil);
  if Items.Count > 0 then Items[0].Expand(False);
  if FBuildMethod = bmFilter then
  begin
      DataSet.Filter := OldFilter;
      DataSet.Filtered := OldFiltered;
  end;
  if KeepCurrentID then
  begin
    if DataSet.Locate(IDField, CurID, []) then UpdateByDataSet else
      if Items.Count > 0 then Selected := Items[0];
  end else if Items.Count > 0 then Selected := Items[0];
  Items.EndUpdate;
  if Selected <> nil then
    DataSet.Locate(IDField, CurID, []);
  DataSet.EnableControls;
  FChanging := False;
  if Assigned(FOnRebuildTree) then FOnRebuildTree(Self);
end;

function TDBTreeView.GetStoredField(Node: TTreeNode; Field: String): String;
var
    FieldData: TFieldDataItem;
  I      : Integer;
  FldIdx : Integer;
begin
    FldIdx := FStoredFieldsList.IndexOf(Field);
  if FldIdx < 0 then
  begin
      Result := '';
    Exit;
  end;
  FieldData := nil;
  I := 0;
  while (FieldData = nil) and (I <= FStoredFieldsData.Count-1) do
  begin
      if TFieldDataItem(FStoredFieldsData.Items[i]).Values[0] = IntToStr(Integer(Node.Data)) then
        FieldData := FStoredFieldsData.Items[i] as TFieldDataItem;
    Inc(I);
  end;
  if FieldData <> nil then
    Result := FieldData.Values[FldIdx+1]
  else Result := '';  
end;

procedure TDBTreeView.WndProc(var Message: TMessage);
var
    M : TWMKey;
begin
  inherited WndProc(Message);
    if not (csDesigning in ComponentState) and Assigned(FDataLink) and FDataLink.Active and
      not ReadOnly then
  begin
      if Message.Msg = WM_KEYDOWN then
    begin
        case TWMKey(Message).CharCode of
            VK_INSERT : InsertNew(Selected);
        VK_DELETE : DeleteNode(Selected);
        VK_SPACE  : EditNode(Selected);
        VK_RETURN : Selected.Expanded := not Selected.Expanded;
      end;
    end;
    if Message.Msg = WM_LBUTTONDOWN then
    begin
        if Selected <> nil then Change(Selected);
    end;
  end;
end;

procedure TDBTreeView.Change(Node: TTreeNode);
begin
     if FChanging then Exit;
  inherited Change(Node);
  FChanging := True;
  if FDataLink.Active then
      if not FDataLink.DataSource.DataSet.Locate(IDField, Integer(Node.Data), []) then
        FDataLink.DataSource.DataSet.First;
  FChanging := False;
end;

procedure TDBTreeView.Edit(const Item: TTVItem);
begin
    inherited Edit(Item);
  if (not FDataLink.Active) or (Item.pszText = nil) then Exit;
  FChanging := True;
  with FDataLink.DataSource.DataSet do
  begin
      if not (State in [dsInsert, dsEdit]) then Edit;
    FieldByName(DisplayField).AsString := Item.pszText;
    //* Önce Before Post Olayını Tetikliyoruz *//
    DoBeforePost(Self.DataSource.DataSet);
    Post;
    //* Kayıt işleminden sonra AfterPost olayını tetikliyoruz *//
    DoAfterPost(Self.DataSource.DataSet);
  end;
  FChanging := False;
end;

procedure TDBTreeView.Notification(AComponent: TComponent; Operation: TOperation);
begin
    inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent =  DataSource) then DataSource := nil;
end;

function TDBTreeView.ValidDataSet: Boolean;
begin
  Result:= False;
  if (FDataLink <> nil ) And Assigned(FDataLink.DataSet) And FDataLink.DataSet.Active then
    Result:= True;
end;

procedure TDBTreeView.SetRootID(Value: Integer);
begin
    FRootID := Value;
  RebuildTree(False);
end;

procedure TDBTreeView.SetIDField(Value: String);
Var AField: TField;
        Old : String;
begin
    Old := FIDField;
  AField:= nil;
  if ValidDataSet and
    not (csLoading in ComponentState) and (Length(Value) > 0) then
      AField := FDataLink.DataSet.FindField(Value); { no exceptions }
  if ( AField <> nil ) and not (AField.DataType in ValidIDTypes) then begin
    MessageDlg(Name+': Incorrect field type', mtWarning, [mbOk], 0 );
    Value:= Old;
  end;
  if Value = FParentIDField then
  begin
      MessageDlg(Name+': IDField and ParendIDField cann''t refer to the same field!', mtWarning, [mbOk], 0 );
    Value := Old;
  end;
  FIDField:= Value;
  if FDataLink.Active then RebuildTree(False);
end;

procedure TDBTreeView.SetParentIDField(Value: String);
Var AField: TField;
        Old : String;
begin
  Old := FParentIDField;
  AField:= nil;
  if ValidDataSet and
    not (csLoading in ComponentState) and (Length(Value) > 0) then
      AField := FDataLink.DataSet.FindField(Value); { no exceptions }
  if ( AField <> nil ) and not (AField.DataType in ValidIDTypes) then begin
    MessageDlg(Name+': Incorrect field type', mtWarning, [mbOk], 0 );
    Value:= Old;
  end;
  if Value = FIDField then
  begin
      MessageDlg(Name+': IDField and ParendIDField cann''t refer to the same field!', mtWarning, [mbOk], 0 );
    Value := Old;
  end;
  FParentIDField:= Value;
  if FDataLink.Active then RebuildTree(False);
end;

procedure TDBTreeView.SetDisplayField(Value: String);
begin
  FDisplayField:= Value;
  if FDataLink.Active then RebuildTree(True);
end;

procedure TDBTreeView.SetBuildMethod(Value: TBuildMethod);
begin
    FBuildMethod := Value;
  if FDataLink.Active then RebuildTree(True);
end;


procedure TDBTreeView.InsertNew(Node: TTreeNode);
var
    Allow: Boolean;
  S    : String;
  NewID: Integer;
  Max  : Integer;
  ParentID : Integer;
  NewNode: TTreeNode;

  procedure FindMax(N: TTreeNode);
  begin
      if Max < Integer(N.Data) then Max := Integer(N.Data);
    if N.GetNext <> nil then FindMax(N.GetNext);
  end;

begin
    if ReadOnly then Exit;
  S := 'New item';
  Allow := True;
    if Assigned(FOnInsertingNode) then FOnInsertingNode(Self, S, Allow);
  if not Allow then Exit;
  FChanging := True;
  with FDataLink.DataSource.DataSet do
  begin
      Insert;
    FieldByName(DisplayField).AsString := S;
    if Node = nil then ParentID := RootID else ParentID := Integer(Node.Data);
    FieldByName(ParentIDField).AsInteger := ParentID;
    if FieldByName(IDField).DataType = ftAutoInc then
    begin
    //* Önce Before Post Olayını Tetikliyoruz *//
    DoBeforePost(Self.DataSource.DataSet);
    Post;
    //* Kayıt işleminden sonra AfterPost olayını tetikliyoruz *//
    DoAfterPost(Self.DataSource.DataSet);
      NewID := FieldByName(IDField).AsInteger;
    end
    else
    begin
      if Items.Count > 0 then
      begin
            Max := -2147483647;
          FindMax(Items[0]);
          NewID := Max + 1;
      end else NewID := 1;
      FieldByName(IDField).AsInteger := NewID;
    //* Önce Before Post Olayını Tetikliyoruz *//
    DoBeforePost(Self.DataSource.DataSet);
    Post;
    //* Kayıt işleminden sonra AfterPost olayını tetikliyoruz *//
    DoAfterPost(Self.DataSource.DataSet);
    end;
  end;
  NewNode := Items.AddChildObject(Node, S, Pointer(NewID));
  FChanging := False;
  Selected := NewNode;
  Selected.EditText;
end;

procedure TDBTreeView.DeleteNode(Node: TTreeNode);
var
    Allow: Boolean;
  GoRebuild: Boolean;

    procedure DelRecursive(N: TTreeNode);
  var Tmp: Integer;
  begin
    while N.Count > 0 do
        DelRecursive(N.GetFirstChild);
    with FDataLink.DataSource.DataSet do
    begin
        Locate(FIDField, Integer(N.Data), []);
      Tmp := FieldByName(FIDField).AsInteger;
      Delete;
      if FieldbyName(FIDField).AsInteger <> Tmp then N.Delete else GoRebuild := True;
    end;
  end;

begin
  if ReadOnly then Exit;
    Allow := True;
  if Assigned(FOnDeletingNode) then FOnDeletingNode(Self, Allow);
  if Allow then
  begin
      GoRebuild := False;
      FChanging := True;
    DelRecursive(Node);
    UpdateByDataSet;
    FChanging := False;
    if GoRebuild then RebuildTree(True);
  end;
end;

procedure TDBTreeView.EditNode(Node: TTreeNode); // User defined editing of CURRENT record
var
    Allow: Boolean;
  I    : Integer;
  Itm  : TFieldDataItem;
  BM   : TBookmark;
begin
    if ReadOnly or not Assigned(FOnEditNode) or (not FDataLink.Active) then Exit;
  FChanging := True;
  with FDataLink.DataSource.DataSet do
  begin
      BM := FDataLink.DataSource.DataSet.GetBookmark;
    if not Locate(FIDField, Integer(Node.Data), []) then
    begin
        FChanging := False;
      MessageDlg('Impossible to synchronize data tree: possibly dataset have been changed!', mtError, [mbOK], 0);
      Exit;
    end;
  end;
  Allow := True;
  if Assigned(FOnEditingNode) then FOnEditingNode(Self, Allow);
  if Allow then
  begin
    FOnEditNode(Self); // user changes made
    Itm := nil;
    for I := 1 to FStoredFieldsData.Count do // looking for corresponding stored fields
        if TFieldDataItem(FStoredFieldsData.Items[I-1]).Values[0] = IntToStr(Integer(Node.Data)) then
          Itm := FStoredFieldsData.Items[I-1] as TFieldDataItem;
    if Itm = nil then RebuildTree(True) // user did something stupid like inserting new record
    else with FDataLink.DataSource.DataSet do
    begin
      Itm.Values.Clear;
      Itm.Values.Add(FieldByName(IDField).AsString);
      for I := 1 to FStoredFieldsList.Count do
        Itm.Values.Add(FieldByName(FStoredFieldsList[I-1]).AsString);
    end;
    Node.Text := FDataLink.DataSource.DataSet.FieldByName(DisplayField).AsString;
  end;
  FDataLink.DataSource.DataSet.GotoBookmark(BM);
  FDataLink.DataSource.DataSet.FreeBookmark(BM);
  FChanging := False;
  Change(Node);
end;

function  TDBTreeView.ValidFields: Boolean;
var
    F : TField;
begin
    Result := False;
  if not FDataLink.Active then Exit;
  F := FDataLink.DataSet.FindField(FIDField);
  if (F = nil) or (not (F.DataType in ValidIDTypes)) then
  begin
      MessageDlg(Name+': IDField not defined or of incorrect type', mtWarning, [mbOK], 0);
    Exit;
  end;
  F := FDataLink.DataSet.FindField(FParentIDField);
  if (F = nil) or (not (F.DataType in ValidIDTypes)) then
  begin
      MessageDlg(Name+': ParentIDField not defined or of incorrect type', mtWarning, [mbOK], 0);
    Exit;
  end;
  F := FDataLink.DataSet.FindField(FDisplayField);
  if (F = nil) then
  begin
      MessageDlg(Name+': DisplayField not defined', mtWarning, [mbOK], 0);
    Exit;
  end;

  if UpperCase(FIDField) = UpperCase(FParentIDField) then
  begin
      MessageDlg(Name+': IDField and ParendIDField cann''t refer to the same field!', mtWarning, [mbOK], 0);
    Exit;
  end;

  Result := True;
end;

//* Sonradan eklediğimiz olayların tetikleyicisi  *//
procedure TDBTreeView.DoAfterPost(DataSet: TDataSet);
begin
  if Assigned(FOnAfterPost) then FOnAfterPost(DataSet);
end;

procedure TDBTreeView.DoBeforePost(DataSet: TDataSet);
begin
  if Assigned(FOnBeforePost) then FOnBeforePost(DataSet);
end;

end. 
  

KOlay gelsin.

[cemaliozan]

Yukarıda verdiğim OnBeforePost ve OnAfterPost olaylarına ilave olarak select edilen Node parametre olarak eklendi. Yontemler ve paramtereleri :

procedure TDBTreeView.DoAfterPost(DataSet: TDataSet;Const Node : TTreeNode);
begin
if Assigned(FOnAfterPost) then FOnAfterPost(DataSet,Node);
end;

procedure TDBTreeView.DoBeforePost(DataSet: TDataSet;Const Node : TTreeNode);
begin
if Assigned(FOnBeforePost) then FOnBeforePost(DataSet,Node);
end;

oldu.

[cemaliozan]

Hani bittiği için değilde, işin durumu hakkında fikir vermesi için arşivbank'ın derlenmiş halini İleriki aşamalarda karşılaştırma yapabilmek için bir görün istedim.
Derlenmiş arşivbank'ı indirmek için tıklayınız...