Recent

Author Topic: Did anyone read bug No.465?  (Read 6358 times)

p_evghenii

  • Guest
Did anyone read bug No.465?
« on: November 03, 2004, 02:35:15 pm »
Who has any ideas about it?
If it is necessary I can send the project with this problem.

P.S. I use Lazarus of 04 October (latest Win32 installation)

Lightning

  • Sr. Member
  • ****
  • Posts: 422
Did anyone read bug No.465?
« Reply #1 on: November 03, 2004, 03:28:40 pm »
Try upgrading your sources from cvs and recompile the IDE.
The future must be... Fast and OpenSource so...
Think Open and Lightning Fast!

Vincent Snijders

  • Administrator
  • Hero Member
  • *
  • Posts: 2661
    • My Lazarus wiki user page
Did anyone read bug No.465?
« Reply #2 on: November 03, 2004, 04:47:27 pm »
I did give it a quick look and saw nothing obviously wrong.

I didn't look very hard, after I saw the dependencies on some database components I have not installed. If you remove the dependency on jvuib, I am willing to take a look at the project. My guess is there is some error in the code, not in the compiler, but I could be wrong.

p_evghenii

  • Guest
Did anyone read bug No.465?
« Reply #3 on: November 04, 2004, 08:24:58 am »
OK, I removed all jvuib items and now the code looks litke this (it still doesn't work):

ubobject.pas:
---------------
unit ubobject;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Dialogs;

type
  TBObject = class(TPersistent)
  private
    FId: longint;
    RelTable: string;
    procedure FetchData();     //çàãíàòü äàííûå èç ÁÄ â ñâîéñòâà

    //ïîäãîòîâêà ê ôóíêöèÿì Find...
    procedure PrepareQueryForFinding(const Field: string);

    function ExecuteFinding(): boolean;  //çàâåðøåíèå ôóíêöèé Find...
  protected
  public
    Fields: TStringList;       //ñïèñîê ñîîòíîøåíèé ÑÂÎÉÑÒÂÎ=ÏÎËÅ
    constructor Create(); virtual;
    destructor Destroy(); override;
    procedure New(); virtual;      //íîâûé ýëåìåíò
    procedure ShowElement();          //îòêðûòü ôîðìó ýëåìåíòà
    function SelectAll(): boolean; virtual; //âûáðàòü âñå ýëåìåíòû

    //ïîëó÷èòü ñëåäóþùèé ýëåìåíò ïîñëå âûáîðêè
    function GetNext(): boolean; virtual;

    //íàéòè ýëåìåíò ïî ïîëþ è çíà÷åíèþ
    function FindByField(const Field, Value: string): boolean;
    function FindByField(const Field: string; const Value: longint): boolean;
    function FindByID(const TheID: longint): boolean;
    function Find(ABObject: TBObject): boolean;

    function Save(): boolean; virtual; //ñîõðàíèòü îáúåêò
    function IsNew(): boolean;            //true - åñëè íîâûé ýëåìåíò
  published
    property ID: longint read FId write FId;
  end;

  TBObjects = class of TBObject;

var
  BObject: TBObject;

implementation

uses Main, Inifiles, TypInfo, basic;

constructor TBObject.Create();
var
  i, count: integer;
  cbobject: TBObjects;
  fieldname: string;
begin
  inherited Create;
  RelTable:=Copy(ClassName, 2, Length(ClassName)-1);
  Fields:=TStringList.Create();
  with TInifile.Create(ExtractFilePath(ParamStr(0))+'Main.ini') do begin
    ReadSectionRaw(self.ClassName, Fields);
    Free;
  end;
  count:=Fields.Count-1;
  for i:=0 to count do begin
    fieldname:=Fields.Names;
    if PropType(self,FieldName)=tkClass then
      if GetObjectPropClass(Self, FieldName).InheritsFrom(TBObject) then begin
        cbobject:=TBObjects(GetObjectPropClass(self, FieldName));
        SetObjectProp(self, FieldName, cbObject.Create());
      end;
  end;
end;

destructor TBObject.Destroy();
var
  i, count: integer;
  fieldname: string;
begin
  count:=Fields.Count-1;
  for i:=0 to count do begin
    fieldname:=Fields.Names;
    if PropType(self,FieldName)=tkClass then
      if GetObjectPropClass(Self, FieldName).InheritsFrom(TBObject) then begin
        GetObjectProp(self, FieldName).Free;
      end;
  end;
  if Fields<> nil then Fields.Free;
  inherited;
end;

procedure TBObject.New();
var
  i, count: integer;
  FieldName: string;
  TypeKind: TTypeKind;
begin
  count:=Fields.Count-1;
  for i:=0 to count do begin
    FieldName:=Fields.Names;
    TypeKind:=PropType(self, FieldName);
    case TypeKind of
      tkInteger, tkInt64, tkQWord:
        SetInt64Prop(self, FieldName, 0);
      tkSString, tkLString, tkAString, tkWString:
        SetStrProp(self, FieldName,'sss');
    else
      Raise Exception.Create('Íåçíàêîìûé òèï äëÿ TBObject!');
    end;
  end;
end;

function TBObject.SelectAll(): boolean;
begin
  result:=true;
end;

function TBObject.GetNext(): boolean;
begin
  result:=true;
end;

procedure TBObject.FetchData();
begin
end;

procedure TBObject.PrepareQueryForFinding(const Field: string);
begin
end;

function TBObject.ExecuteFinding(): boolean;
begin
  result:=true;
end;

function TBObject.FindByField(const Field, Value: string): boolean;
begin
  result:=true;
end;

function TBObject.FindByField(const Field: string; const Value: longint): boolean;
begin
  result:=true;
end;

function TBObject.FindByID(const TheID: longint): boolean;
begin
  result:=true;
end;

function TBObject.Find(ABObject: TBObject): boolean;
begin
  result:=true;
end;

procedure TBObject.ShowElement();
begin
end;

function TBObject.Save(): boolean;
begin
  showmessage('RelTable='+RelTable);
  result:=false;
end;

function TBObject.IsNew(): boolean;
begin
  result:=FId=0;
end;

initialization
  {$I ubobject.lrs}

end.
===================================

umetadata.pas:
----------------
unit umetadata;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, ubobject;
 
type
  TResidence = class(TBObject)
  private
    FName: string;
  published
    property Name: string read FName write FName;
  end;

  TEmployee = class(TBObject)
  private
    FName: string;
    FResidence: TResidence;
  published
    property Name: string read FName write FName;
    property Residence: TResidence read FResidence write FResidence;
  end;

implementation

end.
======================================

Main.pas:
-----------
unit Main;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
  Buttons;

type
  TfmMain = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure fmMainShow(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  fmMain: TfmMain;

implementation

uses umetadata;
{ TfmMain }

procedure TfmMain.fmMainShow(Sender: TObject);
begin
  Top:=0;
  Left:=0;
  Width:=Screen.Width;
end;

procedure TfmMain.Button1Click(Sender: TObject);
var bob: TEmployee;
begin
  bob:=TEmployee.Create();
  bob.New();
  bob.Name:='Nothingx like the rain';
  ShowMessage(BoolToStr(bob.Save()));
  bob.Free();
end;

initialization
  {$I main.lrs}

end.
=========================================

Main.ini:
-----------
[TRESIDENCE]
Name=NAME

[TEMPLOYEE]
Id=ID_REF
Name=NAME

Vincent Snijders

  • Administrator
  • Hero Member
  • *
  • Posts: 2661
    • My Lazarus wiki user page
Did anyone read bug No.465?
« Reply #4 on: November 04, 2004, 09:40:34 am »
Can you mail me the files (zipped), please? <email removed>

p_evghenii

  • Guest
Did anyone read bug No.465?
« Reply #5 on: November 04, 2004, 09:53:10 am »
I sent the files zipped to 'vsnijders@quicknet.nl'.

Vincent Snijders

  • Administrator
  • Hero Member
  • *
  • Posts: 2661
    • My Lazarus wiki user page
Did anyone read bug No.465?
« Reply #6 on: November 04, 2004, 01:47:43 pm »

 

TinyPortal © 2005-2018