На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS
msm.ru
! ПРАВИЛА РАЗДЕЛА · FAQ раздела Delphi · Книги по Delphi
Пожалуйста, выделяйте текст программы тегом [сode=pas] ... [/сode]. Для этого используйте кнопку [code=pas] в форме ответа или комбобокс, если нужно вставить код на языке, отличном от Дельфи/Паскаля.
Следующие вопросы задаются очень часто, подробно разобраны в FAQ и, поэтому, будут безжалостно удаляться:
1. Преобразовать переменную типа String в тип PChar (PAnsiChar)
2. Как "свернуть" программу в трей.
3. Как "скрыться" от Ctrl + Alt + Del (заблокировать их и т.п.)
4. Как прочитать список файлов, поддиректорий в директории?
5. Как запустить программу/файл?
... (продолжение следует) ...

Вопросы, подробно описанные во встроенной справочной системе Delphi, не несут полезной тематической нагрузки, поэтому будут удаляться.
Запрещается создавать темы с просьбой выполнить какую-то работу за автора темы. Форум является средством общения и общего поиска решения. Вашу работу за Вас никто выполнять не будет.


Внимание
Попытки открытия обсуждений реализации вредоносного ПО, включая различные интерпретации спам-ботов, наказывается предупреждением на 30 дней.
Повторная попытка - 60 дней. Последующие попытки бан.
Мат в разделе - бан на три месяца...
Модераторы: jack128, D[u]fa, Shaggy, Rouse_
  
> Почему появляется ошибка Access violation at address?
    При вызове вот этого класса.
    ExpandedWrap disabled
      mvt:=MoveTo1.Create(x, y);

    в функции
    ExpandedWrap disabled
      function TGraphics1.moveTo(x, y:Integer):TGraphics1;
       var t2:TGraphics1;
      begin
          t2:=TGraphics1.Create;
          mvt:=MoveTo1.Create(x, y);
          result:=t2.append3481(mvt,true);
      end;

    Появляется ошибка.
    Прикреплённый файлПрикреплённый файлerr1.jpg (35,69 Кбайт, скачиваний: 10)
    Сам код запускается, и вроде все нормально, но вот табличка с ошибкой. Как от нее избавиться?
    Код полностью.
    ExpandedWrap disabled
      unit Unit1;
       
      interface
       
      uses
        Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
        Dialogs;
       
      type
        TForm1 = class(TForm)
          procedure FormCreate(Sender: TObject);
        private
          { Private declarations }
        public
          { Public declarations }
        end;
        
        ClosePath = class
        private
       
        public
           constructor Create;
           Procedure exec (ctx:Integer);
        end;
       
         BeginPath = class
         private
       
         public
           constructor Create;
           Procedure exec (ctx:Integer);
         end;
       
         LineTo = class
         private
       
         public
           constructor Create (x, y:Integer);
           Procedure exec (ctx:Integer);
         end;
       
         MoveTo1 = class
         private
       
         public
           constructor Create (x, y:Integer);
           Procedure exec (ctx:Integer);
         end;
       
       
         Stroke = class
         private
       
         public
           constructor Create (style, ignoreScale:Integer);
           Procedure exec (ctx:Integer);
         end;
       
         Fill = class
         private
       
         public
           constructor Create (style, matrix:Integer);
           Procedure exec (ctx:Integer);
         end;
       
       
        TGraphics1 = class
        private
          _instructions : array of string;
          _activeInstructions : array of string;
          _strokeIgnoreScale : Boolean;
          _dirty : Boolean;
          _fill : Integer;
          alpha : Integer;
          moveto1: MoveTo1;
        public
          constructor Create;
          function append3481(command:MoveTo1; clean:Boolean):TGraphics1;
          Procedure _setStroke(stroke:Integer);
          Procedure _setFill3481(fill:Integer);
          Procedure _updateInstructions34811(commit, ctx:Integer);
          Procedure beginFill(color:String);
          Procedure beginStroke(color:String);
          function moveTo(x, y:Integer):TGraphics1;
          function lineTo(x, y:Integer):TGraphics1;
          Procedure draw3481(ctx, data:Integer);
        end;
       
         TShape1 = class
         private
           graphics1: TGraphics1;
         public
           constructor Create;
           Procedure  update(props:Integer);
           Procedure  getMatrix21(matrix:Integer);
           Procedure  updateContext5431(ctx:Integer);
           Procedure  draw222(ctx, ignoreCache:Integer);
           Procedure  draw111(ctx, ignoreCache:Integer);
           Procedure  addChild(child:Integer);
           Procedure  draw123(ctx, ignoreCache:Integer);
         end;
      var
        Form1: TForm1;
         mvt:MoveTo1;
          shape1 : TShape1;
      implementation
       
      {$R *.dfm}
       
      constructor TGraphics1.Create;
      begin
       
      end;
       
      function TGraphics1.append3481(command:MoveTo1; clean:Boolean):TGraphics1;
      var t1:TGraphics1;
      begin
        t1:= TGraphics1.Create;
        result:=t1;
      end;
       
      procedure TGraphics1._setStroke(stroke:Integer);
      begin
       
       
      end;
       
      procedure TGraphics1._setFill3481(fill:Integer);
      begin
       
      end;
       
      procedure TGraphics1._updateInstructions34811(commit, ctx:Integer);
      begin
       
      end;
       
      procedure TGraphics1.beginFill(color:String);
      begin
       
      end;
       
      procedure TGraphics1.beginStroke(color:String);
      begin
       
      end;
       
      function TGraphics1.moveTo(x, y:Integer):TGraphics1;
       var t2:TGraphics1;
      begin
          t2:=TGraphics1.Create;
          mvt:=MoveTo1.Create(x, y);
          result:=t2.append3481(mvt,true);
      end;
       
      function TGraphics1.lineTo(x, y:Integer):TGraphics1;
        var t2:TGraphics1;
      begin
        t2:=TGraphics1.Create;
        mvt:=MoveTo1.Create(x, y);
        result:=t2.append3481(mvt,true);
      end;
       
      procedure TGraphics1.draw3481(ctx, data:Integer);
      begin
       
      end;
       
      constructor ClosePath.Create;
      begin
       
      end;
       
      Procedure ClosePath.exec (ctx:Integer);
      begin
       
      end;
       
      constructor BeginPath.Create;
      begin
       
      end;
       
      Procedure BeginPath.exec (ctx:Integer);
      begin
       
      end;
       
      constructor LineTo.Create(x, y: Integer);
      begin
       
      end;
       
      Procedure LineTo.exec (ctx:Integer);
      begin
       
      end;
       
      constructor MoveTo1.Create(x, y: Integer);
      begin
       
      end;
       
      Procedure MoveTo1.exec (ctx:Integer);
      begin
       
      end;
       
      constructor Stroke.Create(style, ignoreScale: Integer);
      begin
       
      end;
       
      Procedure Stroke.exec (ctx:Integer);
      begin
       
      end;
       
       
      constructor Fill.Create(style, matrix: Integer);
      begin
       
      end;
       
      Procedure Fill.exec (ctx:Integer);
      begin
       
      end;
       
      constructor TShape1.Create;
      var graphics1 : TGraphics1;
      begin
         graphics1 := TGraphics1.Create;
      end;
       
      Procedure TShape1.update(props:Integer);
      begin
       
      end;
       
      Procedure TShape1.getMatrix21(matrix:Integer);
      begin
       
      end;
       
      Procedure TShape1.updateContext5431(ctx:Integer);
      begin
       
      end;
       
      Procedure TShape1.draw222(ctx, ignoreCache:Integer);
      begin
       
      end;
       
      Procedure TShape1.draw111(ctx, ignoreCache:Integer);
      begin
       
      end;
       
      Procedure TShape1.addChild(child:Integer);
      begin
       
      end;
       
      Procedure TShape1.draw123(ctx, ignoreCache:Integer);
      begin
       
      end;
       
      procedure TForm1.FormCreate(Sender: TObject);
      begin
        shape1 := TShape1.Create();
        shape1.graphics1.beginStroke('black');
        shape1.graphics1.beginFill('#cccccc');
        shape1.graphics1.moveTo(0, 0).lineTo(20,20);
      end;
       
      end.
    Сообщение отредактировано: Katerina1993 -
      Вам стоит удалить 232 строчку
      ExpandedWrap disabled
        var graphics1 : TGraphics1;
        Если отсюда из приватного раздела брать moveto1: MoveTo2
        ExpandedWrap disabled
          TGraphics1 = class
            private
              _instructions : array of string;
              _activeInstructions : array of string;
              _strokeIgnoreScale : Boolean;
              _dirty : Boolean;
              _fill : String;
              alpha : Integer;
              moveto1: MoveTo2;
              lineto1: LineTo2;
              command: String;
            public

        и записать вот так.
        ExpandedWrap disabled
          function TGraphics1.moveTo(x, y:Integer):TGraphics1;
           var t2:TGraphics1;
          begin
              t2:=TGraphics1.Create;
              moveto1:=MoveTo2.Create(x, y);
              result:=t2.append3481(moveto1,true);
          end;

        То показывает ошибку.
        Если обозначить переменную глобальной.
        ExpandedWrap disabled
          var
            Form1: TForm1;
             mvt:MoveTo2;
             shape1 : TShape1;
          implementation

        а потом записть вот так.
        ExpandedWrap disabled
          function TGraphics1.moveTo(x, y:Integer):TGraphics1;
           var t2:TGraphics1;
          begin
              t2:=TGraphics1.Create;
              mvt:=MoveTo2.Create(x, y);
              result:=t2.append3481(mvt,true);
          end;

        то ошибки нет. Так и не поняла почему нельзя вызвать из модификатор доступа private внутри класса, а работает только из глобальной переменной?
        Сообщение отредактировано: Katerina1993 -
          Для начала хотелось бы вообще понять что здесь происходит. За какое такое MoveTo отвечает MoveTo2 класс
            Уже не надо я сделала пример.
            Код:
            ExpandedWrap disabled
              unit Unit1;
               
              interface
               
              uses
                Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
                Dialogs, StdCtrls;
               
              type
                TVect=record x,y:Integer  ; end;
                TForm1 = class(TForm)
                  Button1: TButton;
                  Edit1: TEdit;
                  Edit2: TEdit;
                  Button2: TButton;
                  Memo1: TMemo;
                  procedure Button1Click(Sender: TObject);
                private
                  { Private declarations }
                public
                  { Public declarations }
                end;
               
               
               
                 LineTo2 = class
                 private
                  x0, y0 : Integer;
                 public
                   constructor Create (x, y:Integer);
                   Procedure exec (ctx:Integer);
                 end;
               
                 MoveTo2 = class
                 private
                    x0, y0 : Integer;
                 public
                   constructor Create (x, y:Integer; bool:Boolean);
                   function _coord1():TVect;
                   Procedure exec (ctx:Integer);
                 end;
               
               
               
                TGraphics1 = class
                private
               
                  _instructions2 : array of MoveTo2;
                  _instructions3 : array of LineTo2;
               
                public
                  constructor Create;
                  function append1(command:MoveTo2; clean:Boolean):TGraphics1;
                  function append2(command:LineTo2; clean:Boolean):TGraphics1;
                  Procedure _updateInstructions(commit, ctx:Integer);
                  Procedure beginFill(color:TColor);
                  Procedure beginStroke(color:TColor);
                  function moveTo(x, y:Integer):TGraphics1;
                  function lineTo(x, y:Integer):TGraphics1;
                  Procedure _draw(ctx, data:Integer);
                end;
               
                 TShape1 = class
                 private
                   graphics1: TGraphics1;
                   children: array of TShape1;
                 public
                   constructor Create;
                   Procedure  update();
                   Procedure  _draw2(ctx:Integer);
                   Procedure  _draw1(ctx:Integer);
                   function  addChild(child:TShape1):TShape1;
                   Procedure  _draw3(ctx:Integer; ignoreCache:Boolean);
                 end;
              var
                Form1: TForm1;
                 mvt:MoveTo2;
                 lint:LineTo2;
                  shape1 : TShape1;
                  t2:TGraphics1;
                  len: Integer;
                 mas: array of array of integer;//динамический массив
                 res1: Integer = 0;
                 res2: Integer = 0;
                 res3: Integer = 0;
                 res4: Integer = 0;
               
               
                 _activeInstructions2 : array of LineTo2;
                 _activeInstructions  : array of MoveTo2;
               
              implementation
               
              {$R *.dfm}
               
              constructor TGraphics1.Create;
              begin
               
              end;
               
              function MoveTo2._coord1():TVect;
              begin
                result.x := x0;
                result.y := y0;
              end;
               
              function TGraphics1.append1(command:MoveTo2; clean:Boolean):TGraphics1;
              begin
                res1:= Length(_activeInstructions);
                SetLength(_activeInstructions, res1+1);
                _activeInstructions[res1] := command;
               
               
                t2:= TGraphics1.Create;
                result:=t2;
              end;
              function TGraphics1.append2(command:LineTo2; clean:Boolean):TGraphics1;
               
              begin
                res2:= Length(_activeInstructions2);
                SetLength(_activeInstructions2, res2+1);
                _activeInstructions2[res2] := command;
                t2:= TGraphics1.Create;
               
                result:=t2;
              end;
               
               
              procedure TGraphics1._updateInstructions(commit, ctx:Integer);
              var i:Integer;
              begin
               
                 res4 := Length(_instructions2);
                 SetLength(_instructions2, res4+1);
                 _instructions2[res4]:=_activeInstructions[0];
               
                 SetLength(_instructions3, High(_activeInstructions2));
               
                 For i := 0 to High(_activeInstructions2) do
                 begin
                    _instructions3[i]:=_activeInstructions2[i];
                 end;
               
               
               
              end;
               
              procedure TGraphics1.beginFill(color:TColor);
              begin
               
              end;
               
              procedure TGraphics1.beginStroke(color:TColor);
              begin
              Form1.Canvas.Pen.Color := clRed;
              end;
               
              function TGraphics1.moveTo(x, y:Integer):TGraphics1;
              begin
                  t2:=TGraphics1.Create;
                  mvt:=MoveTo2.Create(x, y,false);
                  result:=t2.append1(mvt,true);
              end;
               
              function TGraphics1.lineTo(x, y:Integer):TGraphics1;
                var t2:TGraphics1;
              begin
                t2:=TGraphics1.Create;
                lint:=LineTo2.Create(x, y);
                result:=t2.append2(lint,true);
              end;
               
              procedure TGraphics1._draw(ctx, data:Integer);
              var i:Integer;
              begin
                _updateInstructions(1,1);
                _instructions2[0].exec(1);
               
                 For i := 0 to High(_activeInstructions2) do
                 begin
                    _instructions3[i].exec(1);
                 end;
               
               
              end;
               
               
               
               
              constructor LineTo2.Create(x, y: Integer);
              begin
                inherited Create;
                x0:=x;
                y0:=y;
              end;
               
              Procedure LineTo2.exec (ctx:Integer);
              begin
               Form1.Canvas.LineTo(x0, y0);
              end;
               
              constructor MoveTo2.Create(x, y: Integer;bool:Boolean);
              begin
                inherited Create;
                 x0:=x;
                 y0:=y;
               
              end;
               
              Procedure MoveTo2.exec (ctx:Integer);
              begin
                
               Form1.Canvas.MoveTo(x0, y0);
              end;
               
               
              constructor TShape1.Create;
              begin
               
              end;
               
               
              Procedure TShape1._draw3(ctx:Integer; ignoreCache:Boolean);
              var list,child:TShape1;
              begin
               list:=children[0];
               child:=list;
               child._draw2(1);
               
              end;
               
               
              Procedure TShape1._draw2(ctx:Integer);
              var list,child:TShape1;
              begin
               list:=children[0];
               child := list;
               child._draw1(ctx);
              end;
               
              Procedure TShape1._draw1(ctx:Integer);
              var gr:TGraphics1;
              begin
                 gr:=TGraphics1.Create;
                 gr._draw(1,1);
              end;
               
              function TShape1.addChild(child:TShape1):TShape1;
              begin
               
              res3 := Length(children);
              SetLength(children, res3+1);
              children[res3] := child;
              result:=child;
               
              end;
               
              Procedure TShape1.update();
              begin
                 _draw3(1,true);
              end;


            Вызов при нажатии кнопки и отрисовка фигуры.
            ExpandedWrap disabled
              procedure TForm1.Button1Click(Sender: TObject);
              begin
                shape1 := TShape1.Create();
                shape1.graphics1.beginStroke(clRed);
                shape1.graphics1.beginFill(clBlue);
                shape1.graphics1.moveTo(10,10).lineTo(33, 10).lineTo(33, 33).LineTo(10, 33).LineTo(10, 10);
               
                shape1.addChild(shape1);
                shape1.update();
              end;
              У меня конечно, не Delphi7. Кроме рисования красного квадрата, ничего не происходит.
              Прикреплённый файлПрикреплённый файлClassMove_kate.zip (18,73 Кбайт, скачиваний: 5)
                RusSun, в этом и заключается суть, чтобы рисовал квадрат. Дальше этот пример можно дорабатывать и написать новые функции и процедуры.

                На Delphi 7 исходник Прикреплённый файлПрикреплённый файлProjectExample.zip (9,24 Кбайт, скачиваний: 5)
                Сообщение отредактировано: Katerina1993 -
                0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
                0 пользователей:


                Рейтинг@Mail.ru
                [ Script execution time: 0,0390 ]   [ 21 queries used ]   [ Generated: 27.04.24, 09:27 GMT ]