1 Востаннє редагувалося Torbins (29.10.2014 22:08:48)

Тема: Access Violation та зависання

Думаю немає чого пояснювати. Вилазить вікно "Програма перестала відповідати"
І є ще одна, яка також періодично з'являється. Зробив скрін. Вибачте, якщо картинку неправильно прикріпив. Не знаю як це зробити правильно.

Post's attachments

2014-10-26_211921.jpg 325.26 kb, 248 downloads since 2014-10-26 

2 Востаннє редагувалося 0xDADA11C7 (26.10.2014 22:37:17)

Re: Access Violation та зависання

Ваш хендл або вказівник вказує не туди, куди треба. А взагалі, викладайте джерельний код.

Подякували: vanekulykov1

3

Re: Access Violation та зависання

Про Access Violation у деталях. Ну й взагалі про Проблеми з пам'яттю.
Щоб порадити щось конкретне, треба бачити код.

4

Re: Access Violation та зависання

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Button1: TButton;
    Button2: TButton;
    BitBtn1: TBitBtn;
    SpeedButton1: TSpeedButton;
    Label5: TLabel;
    Edit5: TEdit;
    Label6: TLabel;
    SpeedButton2: TSpeedButton;
    RE: TRichEdit;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Unit2, Unit1_o;

{$R *.dfm}


procedure TForm1.Button1Click(Sender: TObject);
var s:string;
begin
RE.Lines.Add('ПІБ учня  '+Edit2.Text);
RE.Lines.Add('Дата народження  '+Edit3.Text);
RE.Lines.Add('Обов"язки  '+Edit4.Text);
RE.Lines.Add('Номер телефону  '+Edit5.Text);
Edit2.Clear;
Edit3.Clear;
Edit4.Clear;
Edit5.Clear;

end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
RE.Lines.SaveToFile('Information.rtf');
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
RE.Lines.LoadFromFile('Information.rtf');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
RE.Enabled:=true;
RE.SetFocus;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
RE.Clear;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
Form1_o.ShowModal;
end;

end.

5 Востаннє редагувалося vanekulykov (28.10.2014 15:20:32)

Re: Access Violation та зависання

unit Unit1_o;

interface

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

type
  TForm1_o = class(TForm)
    Image1: TImage;
    RadioGroup1: TRadioGroup;
    Button1: TButton;
    Button2: TButton;
    ColorDialog1: TColorDialog;
    ColorDialog2: TColorDialog;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Edit1: TEdit;
    UpDown1: TUpDown;
    Edit2: TEdit;
    Image2: TImage;
    RadioGroup2_style_brash: TRadioGroup;
    RadioGroup2_Style_line: TRadioGroup;
    Label1: TLabel;
    SpeedButton1: TSpeedButton;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    Panel1: TPanel;
    Panel2: TPanel;
    OpenPictureDialog1: TOpenPictureDialog;
    SavePictureDialog1: TSavePictureDialog;
    Button6: TButton;
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure RadioGroup1Click(Sender: TObject);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure SpeedButton1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);

   

    


  private
    { Private declarations }
    isEraser, UseEraser: Boolean;
  public
    { Public declarations }
  end;

var
  Form1_o: TForm1_o;

implementation
uses Unit1;





{$R *.dfm}


var x1,y1,x2,y2:integer;
procedure ris(xs, ys, X, Y: Integer; cv: TCanvas);
var
   a, b: Integer;
   pts : array of TPoint;
begin
     a := (x - xs) div 2;
     b := a div 2;
 
     SetLength(pts, 18);
with cv do
          begin
               pts[ 0] := Point(X - a - b, Y - b);
               pts[ 1] := Point(X - b, Y - b);
               pts[ 2] := Point(X - b, Y - a - b);
               pts[ 3] := Point(X - a, Y - a - b);
               pts[ 4] := Point(X, Y - 2 * a - b);
               pts[ 5] := Point(X + a, Y - a - b);
               pts[ 6] := Point(X + b, Y - a - b);
               pts[ 7] := Point(X + b, Y - b);
               pts[ 8] := Point(X + a + b, Y - b);
               pts[ 9] := Point(X + a + b, Y - a);
               pts[10] := Point(X + 2 * a + b, Y);
               pts[11] := Point(X + a + b, Y + a);
               pts[12] := Point(X + a + b, Y + b);
               pts[13] := Point(X - a - b, Y + b);
               pts[14] := Point(X - a - b, Y + a);
               pts[15] := Point(X - 2 * a - b, Y);
               pts[16] := Point(X - a - b, Y - a);
               pts[17] := pts[0];
    Polygon(pts);
          end;
    SetLength(pts, 0);
end;
procedure linia(x,y:integer;cv:TCanvas);
var dx,dy:integer;
begin
with cv do
          begin
               moveto(x1,y1);
               lineto(x,y);
          end;
end;

procedure p_liniya(X, Y: Integer; cv: TCanvas);
var
   x1, y1, x2, y2 : Integer;
function CreatePen(wid: Integer; Color: TColor) : THandle;
var
   User_Style: array [0 .. 3] of Integer;
var
   Log_Brush: TLogBrush;
begin
     User_Style[0] := wid div 2;
     User_Style[1] := wid * 2;
     User_Style[2] := wid * 4;
     User_Style[3] := wid * 2;
 
     Log_Brush.lbColor := Color;
     Log_Brush.lbStyle := BS_SOLID;
     Log_Brush.lbHatch := 0;
     Result := ExtCreatePen(PS_GEOMETRIC or PS_USERSTYLE, wid, Log_Brush,
      4, @User_Style);
end;
begin
     x1 := X ;
     y1 := Y ;
     x2 := X ;
     y2 := Y ;
with cv do
          begin
               cv.Pen.Handle:= CreatePen(StrToInt(Form1_o.Edit2.Text), Form1_o.ColorDialog1.Color);
          try
               MoveTo(x1, y1);
               LineTo(x2, y2);
          finally
               DeleteObject(cv.Pen.Handle);
          end;
end;
end;

procedure TForm1_o.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
     if isEraser
     then
         begin
              Image1.Canvas.Brush.Color:=clWhite;
              Image1.Canvas.Brush.Style:=bsSolid;
              UseEraser:=True;
         end
     else
         begin
              x1:=x;
              y1:=y;
with Image1, Image2, Canvas do
                              begin
                                   rectangle(0,0, width,height)
                              end;
         end;
end;
procedure TForm1_o.RadioGroup1Click(Sender: TObject);
begin
     if   RadioGroup1.ItemIndex=4
     then Edit1.Enabled:=true
     else Edit1.Enabled:=false;
end;

procedure TForm1_o.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
  
const bs : array[0 .. 3] of TBrushStyle = (bsSolid, bsBDiagonal, bsVertical, bsHorizontal);
  
function CreatePen(wid: Integer; Color: TColor): THandle;
var  User_Style: array [0 .. 3] of Integer;
     Log_Brush: TLogBrush;
begin
     User_Style[0] := wid div 2;
     User_Style[1] := wid * 2;
     User_Style[2] := wid * 4;
     User_Style[3] := wid * 2;
 
     Log_Brush.lbColor := Color;
     Log_Brush.lbStyle := BS_SOLID;
     Log_Brush.lbHatch := 0;
     Result := ExtCreatePen(PS_GEOMETRIC or PS_USERSTYLE, wid, Log_Brush, 4,
      @User_Style);
end;

begin
     if UseEraser then
     begin
          UseEraser := false;
          Exit;
     end;
with (Sender as TImage).Canvas do
     begin
          Pen.width := StrToInt(Edit2.Text);
         
          if RadioGroup2_Style_line.ItemIndex = 0
          then Pen.Style := psSolid
          else Pen.Handle := CreatePen(StrToInt(Edit2.Text), ColorDialog1.Color);
 
    // Стиль заливки
    Brush.Style := bs[RadioGroup2_style_brash.ItemIndex];

    case RadioGroup1.ItemIndex of
      0: linia(X, Y, Image1.Canvas);
      1: rectangle(x1, y1, X, Y);
      2: Ellipse(x1, y1, X, Y);
      3: ris(x1, y1, x, y, Image1.Canvas);
      4: Begin
           Font.Size := StrToInt(Edit2.Text);
           TextOut(X, Y, '' + Edit1.Text);
         end;
    end;
 
    
    if RadioGroup2_Style_line.ItemIndex = 1 then
      DeleteObject(Pen.Handle);
  end;
end;

procedure TForm1_o.Button1Click(Sender: TObject);
begin
     if ColorDialog1.Execute then
     begin
         
          Image1.Canvas.Font.Color:=ColorDialog1.Color;
          Panel1.Color:=ColorDialog1.Color;
          Image1.Canvas.Pen.Color:=ColorDialog1.Color;
          Panel1.Color:=ColorDialog1.Color;
     end;
end;


procedure TForm1_o.Button2Click(Sender: TObject);
begin
     if ColorDialog2.Execute then
     begin
          image1.Canvas.Brush.Color:=ColorDialog2.Color;
          panel2.Color:=ColorDialog2.Color;
     end;
end;


procedure TForm1_o.Button5Click(Sender: TObject);
var    Bitmap: TBitmap;
begin
       Bitmap:=nil;
try
       Bitmap:=Tbitmap.Create;
       Bitmap.Width:=833;
       Bitmap.Height:=609;
       Image1.Picture.Graphic:=Bitmap;
finally
       Bitmap.Free;
       end;
end;


procedure TForm1_o.FormCreate(Sender: TObject);
begin
     Screen.Cursors[5] := LoadCursorFromFile('Eraser.cur');
end;

procedure TForm1_o.SpeedButton1Click(Sender: TObject);
begin
     if   isEraser
     then Image1.Cursor := 1
     else Image1.Cursor := 5;
          isEraser := not isEraser
end;

procedure TForm1_o.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var wid: Integer;
begin
     if UseEraser
     then  
     begin
          wid:=StrToInt(Edit2.Text) div 2;
        
          Image1.Canvas.FillRect(Rect(X-wid, Y-wid, X+wid, Y+wid));
     end;
end;


procedure TForm1_o.Button3Click(Sender: TObject);
begin
    if OpenPictureDialog1.Execute then
    Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
end;

procedure TForm1_o.Button4Click(Sender: TObject);
begin
    if SavePictureDialog1.Execute then
  begin
    Image1.Picture.SaveToFile(SavePictureDialog1.FileName+'.bmp');
  end
end;
end.

6

Re: Access Violation та зависання

Начебто має працювати, якщо обидві форми є у властивостях проекту у списку Auto Create Forms. Доберуся до Делфі, гляну іще.

7

Re: Access Violation та зависання

Добре.

8 Востаннє редагувалося vanekulykov (28.10.2014 17:37:54)

Re: Access Violation та зависання

І ще одне питання. Чому в цей проект не можу додати About Box? Він наче додається в проект, але при прописуванні процедури для кнопки, яка його буде відкривати, його не бачить. Пишу так:

AboutBox.Show

або так:

AboutBox.ShowModal

і ось ці Show, ShowModal просто не вилазять після написання крапки.

9

Re: Access Violation та зависання

Додайте ваш файл з AboutBox в uses.

10

Re: Access Violation та зависання

koala написав:

Додайте ваш файл з AboutBox в uses.

WARNING. Duplicate resource(s)

11

Re: Access Violation та зависання

Моя телепатія на цьому скінчилася.

12

Re: Access Violation та зависання

Прикріпити проект?

13 Востаннє редагувалося vanekulykov (28.10.2014 18:14:18)

Re: Access Violation та зависання

Не по темі: Я б оце годинник на форумі перевів на зимовий час, якби мав можливість

14

Re: Access Violation та зависання

https://cloud.сайт-злодій/public/6ced0 … ect5-6.rar

15

Re: Access Violation та зависання

В жодному з файлів Unit1.pas, Unit1_o.pas немає жодної згадки про AboutBox.
Подальші питання - до телепатів.

16 Востаннє редагувалося Torbins (28.10.2014 22:59:30)

Re: Access Violation та зависання

vanekulykov
У тій версії, яку ви виклали в архіві, ви вилазите за межі масиву pts. Причому ви могли це легко виявити самі, якби правильно налаштували проект: Налаштування проектів в Delphi з точки зору пошуку помилок.
І повністю погоджуюсь з koala, перш ніж звертатися до коду у сусідньому модулі, треба цей модуль занести в uses.

P.S. І раджу туди ж додати модуль XPMan, щоб кнопки красивіше виглядали.

Подякували: 0xDADA11C7, vanekulykov2

17

Re: Access Violation та зависання

Torbins написав:

vanekulykov
P.S. І раджу туди ж додати модуль XPMan, щоб кнопки красивіше виглядали.

За стиль дякую. Працює.

18

Re: Access Violation та зависання

Щодо налаштування кнопок, я додав в код

{$R WindowsXP.res}

і в мене на панелях перестало виводити вибраний колір. Як попередити це?