Treeview / Plano de contas

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, DB, IBCustomDataSet, IBQuery, IBDatabase, ComCtrls, StdCtrls, StrUtils,
  DBClient, Provider, Grids, DBGrids, DBCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    BD: TIBDatabase;
    TransBD: TIBTransaction;
    Qry_PlanoContas: TIBQuery;
    Qry_PlanoContasID_PLANO: TIntegerField;
    Qry_PlanoContasDESCRICAO: TIBStringField;
    TreeView1: TTreeView;
    btAbreDados: TButton;
    btVerID: TButton;
    DBGrid1: TDBGrid;
    Label1: TLabel;
    DataSource1: TDataSource;
    qry_Lancamentos: TIBQuery;
    dspLancamentos: TDataSetProvider;
    cdsLancamentos: TClientDataSet;
    cdsLancamentosID_LANCAMENTO: TIntegerField;
    cdsLancamentosID_PLANO: TIntegerField;
    cdsLancamentosDESCRICAO: TStringField;
    cdsLancamentosDATA: TDateField;
    cdsLancamentosVALOR: TBCDField;
    cdsLancamentosTIPO_LANCAMENTO: TStringField;
    Panel1: TPanel;
    Label2: TLabel;
    TransConsultas: TIBTransaction;
    Qry_Saldo: TIBQuery;
    lbSaldo: TLabel;
    Button1: TButton;
    Qry_Insere: TIBQuery;
    procedure btAbreDadosClick(Sender: TObject);
    procedure btVerIDClick(Sender: TObject);
    procedure TreeView1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Unit2;

{$R *.dfm}
function AnsiReplaceSTr( Str, Procurar, Substituir:String ):String;
begin
Result := Str;
While Pos( Procurar , Result )>0 do 
Delete(Result , Pos( Procurar , Result ) , Length(Procurar) );
end;

function AchaPosicao( S:String ) : Integer;
begin
  Result := 1;
  while Trim(Copy(S,1,Result)) = ´´ do
    Result := Result + 1;
end;

procedure TForm1.btAbreDadosClick(Sender: TObject);
var
  TVS :TTreeNode;
  S : String;
  Posicao, UltPosicao, I : Integer;
  P : ^Integer;
begin
  Qry_PlanoContas.Open;
  Qry_PlanoContas.First;

  TreeView1.Items.BeginUpdate;
  Qry_PlanoContas.DisableControls;

  TreeView1.Items.Clear;
  UltPosicao := 0;

  while not Qry_PlanoContas.Eof do begin

    S := Qry_PlanoContasDESCRICAO.AsString;
    Posicao := AchaPosicao(S);
    S := Trim(S);

    if Posicao = 1 then
      TVS:=TreeView1.Items.Add( Nil, S )
    else if Posicao > 1 then begin
      if Posicao = UltPosicao+1 then
        TVS := TreeView1.Items.AddChild( TVS , S )
      else if Posicao < UltPosicao then begin
        for I := Posicao to UltPosicao do
          TVS := TVS.Parent;
        TVS := TreeView1.Items.AddChild( TVS , S )
      end
      else begin
        TVS := TVS.Parent;
        TVS := TreeView1.Items.AddChild( TVS , S )
      end;
    end;

    P := GetMemory(SizeOf(Integer));
    P^ := Qry_PlanoContasID_PLANO.AsInteger;
    TVS.Data := P;

    UltPosicao := Posicao;
    Qry_PlanoContas.Next;

  end;

  Qry_PlanoContas.EnableControls;
  TreeView1.Items.EndUpdate;

  TransBD.Rollback;

end;

procedure TForm1.btVerIDClick(Sender: TObject);
var
  P : Pointer;
begin
  if TreeView1.Selected = Nil then
    Exit;
  P := TreeView1.Selected.Data;
  if P = Nil then
    Exit;
  Showmessage( ´O ID é ´+IntToStr( Integer(P^) ) );
end;

procedure TForm1.TreeView1Click(Sender: TObject);
var
  P : Pointer;
  ID:Integer;
begin
  if TreeView1.Selected = Nil then
    Exit;
  P := TreeView1.Selected.Data;
  if P = Nil then
    Exit;
  ID := Integer(P^);
  cdsLancamentos.Close;
  cdsLancamentos.Params[0].AsInteger := ID;
  cdsLancamentos.Open;
  Qry_Saldo.Params[0].AsInteger := ID;
  Qry_Saldo.Open;
  lbSaldo.Caption := FormatCurr( ´R$ 0.00´ , Qry_Saldo.Fields[0].AsCurrency );
  Qry_Saldo.Close;
  if TransConsultas.InTransaction then
    TransConsultas.Rollback;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if TreeView1.Selected <> Nil then
    Form2.Descricao := TreeView1.Selected.Text
  else
    Form2.Descricao := ´´;
  Form2.ShowModal;
end;

end.

unit Unit2;

interface

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

type
  TForm2 = class(TForm)
    chkVinculo: TCheckBox;
    edDescricao: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    edCodigo: TEdit;
    Label3: TLabel;
    rgStatus: TRadioGroup;
    btGravar: TButton;
    Label4: TLabel;
    redInformacoes: TRichEdit;
    lbSuperior: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure btGravarClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure edDescricaoExit(Sender: TObject);
  private
    { Private declarations }
    fDescricao:String;
    fGravouDados:Boolean;
    procedure LimpaDados;
  public
    { Public declarations }
    property Descricao: string read fDescricao write fDescricao;
  end;

var
  Form2: TForm2;

implementation

uses Unit1, IBQuery, IBCustomDataSet;

{$R *.dfm}
function letras(x:string):string;
var
y:string;
i:integer;
begin
for i := 1 to length(x) do
begin
if x[i-1] = ´ ´ then y:= y +uppercase(x[i])
else
y:=y+x[i];
end;
y:=uppercase(copy(x,0,1)) + y;
delete(y,2,1);
result:=y;
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  redInformacoes.Lines.LoadFromFile(´documento.rtf´);
  fDescricao := ´´;
end;

procedure TForm2.FormShow(Sender: TObject);
begin
  fGravouDados := False;
  lbSuperior.Caption := ´Item Selecionado: ´+Descricao;
  LimpaDados;
end;

procedure TForm2.LimpaDados;
begin
  chkVinculo.Checked := False;
  edCodigo.Clear;
  edDescricao.Clear;
  rgStatus.ItemIndex := 0;
end;

procedure TForm2.btGravarClick(Sender: TObject);
var
  P : Pointer;
  ID:Integer;
const
  Status = ´AI´;
begin
  ID := 0;

  if edDescricao.Text = ´´ then
    raise Exception.Create(´É necessário digitar a descrição da conta´);
  if not chkVinculo.Checked then begin
    if (Form1.TreeView1.Selected = Nil) then
      raise Exception.Create(´Não existe ítem selecionado na Árvore´);
    P := Form1.TreeView1.Selected.Data;
    if P = Nil then
      raise Exception.Create(´Não existe dados vinculados ao ítem selecionado na árvore´);
    ID := Integer(P^);
  end;

  with Form1.Qry_Insere do begin
    Close;
    SQL.Clear;
    if edCodigo.Text <> ´´ then
      SQL.Text := ´INSERT INTO PLANO (ID_SUPERIOR, CODIGO, DESCRICAO, STATUS) values (:ID_SUPERIOR, :CODIGO, :DESCRICAO, :STATUS)´
    else
      SQL.Text := ´INSERT INTO PLANO (ID_SUPERIOR, DESCRICAO, STATUS) values (:ID_SUPERIOR, :DESCRICAO, :STATUS)´;
    ParamByName(´ID_SUPERIOR´).AsInteger := ID;
    ParamByName(´DESCRICAO´).AsString := edDescricao.Text;
    ParamByName(´STATUS´).AsString := Copy( Status, rgStatus.ItemIndex+1 , 1 );
    if edCodigo.Text <> ´´ then
      ParamByName(´CODIGO´).AsString := edCodigo.Text;
    try
      ExecSQL;
      Transaction.Commit;
      fGravouDados := True;
      ShowMessage(´Dados Gravados Com Sucesso!´);
      LimpaDados;
    except
      On E:Exception do begin
        Transaction.Rollback;
        Showmessage(´Falha na Gravação dos Dados!´#1310´Mensagem: ´+E.Message);
      end;
    end;
  end;

end;

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if fGravouDados then
    Form1.btAbreDados.Click;
end;

procedure TForm2.edDescricaoExit(Sender: TObject);
begin
edDescricao.Text:=Letras(EdDescricao.Text);
end;

end.