objects под TMT

С graph'ом ясно - бери TMT!
А вот с объектами под TMT - не ясно!
Испоьзовал Constructor, virtual, наследование - не хочет рисовать
Прорисовка-то как раз и virtual.
Без object рисует, а с ними нет! Что такое?
TMT 390d

Подробнее, пожалуйста. С примерами.

Вот и пример - примивная прорисовка кнопки в 4-х состояниях :

uses graph;
type TWinObj = object
      selected : boolean;
      X,Y : Integer;
      public
       Constructor  Init(iX,iY:integer);
       procedure    Draw; virtual;
         end;
 
     TButton = object(TWinObj)
      pressed       : boolean;
      Constructor Init(iX,iY:integer);
      procedure Press_UnP;
      procedure Select_UnS;
      procedure Draw; virtual;
      procedure setcolors(c1,c2,c3,cp1,cp2,cp3,tc:word);
      procedure RetDefColors;
      procedure ButtonClear;
      private
       _c1,_cp1     : word;
       _c2,_cp2     : word;
       _c3,_cp3     : word;
       _sc,_scp     : word;
      public
       _label       : string;
       _tc,_tcp     : word;
      end;
 
var button1   : TButton;
    strlength : byte;
  Constructor TWinObj.Init(iX,iY:integer);
  begin
   x:=iX;
   y:=iY;
  end;
 
  Procedure   TWinObj.Draw;  begin end;
 
  Constructor TButton.Init(iX,iY:integer);
 begin
 Inherited Init(iX,iY);
 pressed:=false;
 selected:= false;
 RetDefColors;
 end;
 
 procedure TButton.Draw;
 var strlength : word;
 begin
 case pressed of
 false : begin
          strlength:=length(_label)*8;
          setcolor(_c1);
          rectangle(x,y,x+strlength+16+1,y+8+16+1);
          setcolor(_c2);
          rectangle(x+1,y+1,x+strlength+16,y+8+16);
          setfillstyle(1,_c3);
          bar(x+2,y+2,x+strlength+16-1,y+8+16-1);
          setcolor(_tc);
          OutTextXY(x+8,y+8,_label);
          if selected then
          begin
           setcolor(_sc);
           rectangle(x+5,y+5,x+strlength+16-5,y+8+16-5);
          end;
          setcolor(0);
         end;
 true  : begin
          strlength:=length(_label)*8;
          setcolor(_cp1);
          rectangle(x,y,x+strlength+16+1,y+8+16+1);
          setcolor(_cp2);
          rectangle(x+1,y+1,x+strlength+16,y+8+16);
          setfillstyle(1,_cp3);
          bar(x+2,y+2,x+strlength+16-1,y+8+16-1);
          setcolor(_tcp);
          OutTextXY(x+8,y+8,_label);
          if selected then
          begin
           setcolor(_scp);
           rectangle(x+5,y+5,x+strlength+16-5,y+8+16-5);
          end;
          setcolor(0);
         end;
 end;
 end;
 
 Procedure TButton.SetColors(c1,c2,c3,cp1,cp2,cp3,tc:word);
 begin
 _c1:=c1;   _c2:=c2;   _c3:=c3;
 _cp1:=cp1; _cp2:=cp2; _cp3:=cp3;
 _tc:=tc;
 end;
 
 Procedure TButton.RetDefColors;
 begin
 _c1:=clred;        _cp1:=clblue;
 _c2:=clWhite;      _cp2:=_c2;
 _c3:=clDarkGray;   _cp3:=clLightGreen;
 _tc:=clLightGreen; _tcp:=clLightBlue;
 _sc:=clWhite;      _scp:=clWhite;
 
 end;
 
 procedure TButton.Press_UnP;
 begin
 pressed:= not pressed;
 Draw;
 end;
 
 procedure TButton.Select_UnS;
 begin
 selected:= not selected;
 Draw;
 end;
 
 Procedure TButton.ButtonClear;
 begin
 setcolor(0);
 setfillstyle(1,0);
 bar(x,y,x+length(_label)*8+16+1,y+8+16+1);
 end;
 
begin
SetGraphMode(DetectSVGAMode(1024, 768, 8, LfbOrBanked));
button1.Init((GetMaxX div 2)-100,(GetMaxY div 2)-100);
button1._label:='testing creating button';
button1.draw;
readln;
button1.Select_UnS;
readln;
button1.Press_UnP;
readln;
button1.Select_UnS;
readln;
button1.ButtonClear;
readln;
end.

Сообщение отредактировано: romtek - 14.04.04, 19:47

Всё у тебя работает.
Ты просто перемудрил с цветами.
(да, и не запускай из-под IDE !)

Вот твой пример в упрощенном и работающем виде:

program noname;
uses
  graph,crt;
type
  TWinObj = object
    selected : boolean;
    X,Y : Integer;
  public
    Constructor  Init(iX,iY:integer);
    procedure    Draw; virtual;
  end;
 
  TButton = object(TWinObj)
    pressed       : boolean;
   {selected      : boolean;}
    Constructor Init(iX,iY:integer);
    procedure Press_UnP;
    procedure Select_UnS;
    procedure Draw; virtual;
    procedure setcolors(c1,c2,c3,cp1,cp2,cp3,tc:word);
    procedure RetDefColors;
    procedure ButtonClear;
  private
    _c1,_cp1     : word;
    _c2,_cp2     : word;
    _c3,_cp3     : word;
    _sc,_scp     : word;
  public
    _label       : string;
    _tc,_tcp     : word;
  end;
 
 
Constructor TWinObj.Init(iX,iY:integer);
begin
  OutTextxy(0,20,'TWinObj.Init');
  x:=iX;
  y:=iY;
end;
 
Procedure   TWinObj.Draw;
begin
end;
 
Constructor TButton.Init(iX,iY:integer);
begin
  Inherited Init(iX,iY);
  OutTextxy(0,40,'TButton.Init');
end;
 
procedure TButton.Draw;
var
  strlength : word;
begin
  OutTextXY(0,60,'TButton.Draw');
  ButtonClear;
  OutTextXY(x+8,y+8,_label);
end;
 
Procedure TButton.SetColors(c1,c2,c3,cp1,cp2,cp3,tc:word);
begin
  _c1:=c1;   _c2:=c2;   _c3:=c3;
  _cp1:=cp1; _cp2:=cp2; _cp3:=cp3;
  _tc:=tc;
end;
 
Procedure TButton.RetDefColors;
begin
  _c1:=clred;        _cp1:=clblue;
  _c2:=clWhite;      _cp2:=_c2;
  _c3:=clDarkGray;   _cp3:=clLightGreen;
  _tc:=clLightGreen; _tcp:=clLightBlue;
  _sc:=clWhite;      _scp:=clWhite;
end;
 
procedure TButton.Press_UnP;
begin
  pressed:= not pressed;
  _label:='TButton.Pree_UnP';
  Draw;
end;
 
procedure TButton.Select_UnS;
begin
  selected:= not selected;
  _label:='TButton.Select_UnS';
  Draw;
end;
 
Procedure TButton.ButtonClear;
var
  oldcolor:dword;
begin
  oldcolor:=GetColor;
  setcolor(0);
  setfillstyle(1,0);
  bar(x,y,x+length(_label)*8+16+1,y+8+16+1);
  setcolor(oldcolor);
end;
 
var
  button1   : TButton;
  strlength : byte;
 
begin
  SetSVGAMode(800, 600, 15, LfbOrBanked);
  OutTextxy(0,0,'GraphMode');
  button1.Init((GetMaxX div 2)-100,(GetMaxY div 2)-100);
  button1._label:='TButton.Init';
  button1.draw;
  readln;
 
  button1.Select_UnS;
  readln;
 
  button1.Press_UnP;
  readln;
 
  button1.Select_UnS;
  readln;
 
  button1.ButtonClear;
  readln;
 
  closeGraph;
end.

Сообщение отредактировано: romtek - 14.04.04, 19:48

Может оно и так, но вот что я обнаружил :

конструкция

<br>case <bool var> of <br>true  : begin end;<br>false : begin end;<br>end;<br>

не работает вообще!
Заменил на

<br>if <bool var> then begin<br>                         end<br>                  else  begin<br>                         end;<br>

И все заработало!!!

Мдааааааааа............. Вот это глюк!!!!!!!!!!!!!!
И вправду ведь case не работает!!!!!!!!

Сообщил о глюке разработчикам.

Решился таки проверить у себя:

это код

var mybool: boolean;<br>begin<br>  mybool := true;<br>  case mybool of<br>  true  : begin writeln('True') end;<br>  false : begin writeln('False')  end;<br>  end;<br>end.

работает нормально в версиях 3.90 и 4.0

Что именно у вас не работает???

Вот здесь и не работает :

 
 procedure TButton.Draw;
 var strlength : word;
 begin
 case pressed of
 false : begin
          strlength:=length(_label)*8;
          setcolor(_c1);
          rectangle(x,y,x+strlength+16+1,y+8+16+1);
          setcolor(_c2);
          rectangle(x+1,y+1,x+strlength+16,y+8+16);
          setfillstyle(1,_c3);
          bar(x+2,y+2,x+strlength+16-1,y+8+16-1);
          setcolor(_tc);
          OutTextXY(x+8,y+8,_label);
          if selected then
          begin
           setcolor(_sc);
           rectangle(x+5,y+5,x+strlength+16-5,y+8+16-5);
          end;
          setcolor(0);
         end;
 true  : begin
          strlength:=length(_label)*8;
          setcolor(_cp1);
          rectangle(x,y,x+strlength+16+1,y+8+16+1);
          setcolor(_cp2);
          rectangle(x+1,y+1,x+strlength+16,y+8+16);
          setfillstyle(1,_cp3);
          bar(x+2,y+2,x+strlength+16-1,y+8+16-1);
          setcolor(_tcp);
          OutTextXY(x+8,y+8,_label);
          if selected then
          begin
           setcolor(_scp);
           rectangle(x+5,y+5,x+strlength+16-5,y+8+16-5);
          end;
          setcolor(0);
         end;
 end;
 end;

А я заменил

 
case pressed of
 false : begin
          ...
           end;
 true  : begin
          end;
 end;

На

 
if pressed then begin
                     ...
                     end
              else begin
                     end;

И все заработало!

Сообщение отредактировано: romtek - 14.04.04, 19:50

И еще код, почему-то не работающий ,твой, причем, vot:

 
var mybool: boolean;
Procedure NotBool;
begin
mybool:= not mybool;
end;
 
procedure _CaseTest;
begin
case mybool of
  true  : begin writeln('True') end;
  false : begin writeln('False')  end;
  end;
end;
 
begin
  mybool := true;
  _CaseTest; {true}
  NotBool;
  _CaseTest; {false}
  {Ан не работает!!!!!!!!}
end.

Сообщение отредактировано: romtek - 14.04.04, 19:54

А этот работает!!!

var mybool: boolean;
Procedure NotBool;
begin
mybool:= not mybool;
end;
 
procedure _CaseTest(bool:boolean);
begin
case bool of
  true  : begin writeln('True') end;
  false : begin writeln('False')  end;
  end;
end;
 
begin
  mybool := true;
  _CaseTest(mybool); {true}
  NotBool;
  _CaseTest(mybool); {false}
  {Ан РАБОТАЕТ!!!!!!!!}
end.

Так, что CASE неверно работает с глобальными переменными - это факт!

Сообщение отредактировано: romtek - 14.04.04, 19:55

Проверил
Не работает ни в в3.90, ни в 4.0

Переслал разработчикам...

Хотите чистую магию ????
Получайте!!!!
Замените в самом первом исходнике в объекте TButton строчку

<br>pressed : boolean;

на

<br>pressed : bool;

и все заработает!!!
странно.... что это за тип такой - bool ????? ???

Цитата vot, 04.11.02, 12:04:41

Решился таки проверить у себя:

это код

var mybool: boolean;
begin
  mybool := true;
  case mybool of
  true  : begin writeln('True') end;
  false : begin writeln('False')  end;
  end;
end.

работает нормально в версиях 3.90 и 4.0

Что именно у вас не работает???

Вот именно это у меня (под 3.90) не работает....
Компилируется, запускается, но ничего не выводит на экран!

Сообщение отредактировано: romtek - 14.04.04, 19:59

Используйте вместо

 boolean

BOOL

И все будет работать, как часы!