Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 08.10.2014, 17:20   #1
synthetisch
 
Регистрация: 20.05.2013
Сообщений: 6
Восклицание Фрейм, динамический лист, не могу исправить ошибку

При удалении и создании одного и того же фрейма, выскакивает access violation, как я понял дело в том что переменной (связанной со списком, создаваемым динамически) присваиваю значение nil, а затем пытаюсь обратиться к ней...не могу исправить это...

Список создаю для того, чтобы при выделении записей в DBGrid, в него заносились значения ключевых полей таблицы, может кто нибудь подскажет более удобный код...если нет то помогите исправить кому не сложно...код представлен ниже...проблемная строка указана красным цветом

Дополнительная инфа: этот же код спокойно работает на форме, но вот на фрейме выдаёт ошибку в указанной строке

Код:
unit Unit3;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, sPageControl,
  sFrameAdapter, Vcl.Grids, Vcl.DBGrids, acDBGrid, Vcl.Buttons, sSpeedButton,
  Vcl.ExtCtrls, sPanel, RzDBGrid, Vcl.ImgList, acAlphaImageList, sStatusBar,
  Vcl.StdCtrls, sButton;

type
  TFrame3 = class(TFrame)
    sFrameAdapter1: TsFrameAdapter;
    sPanel1: TsPanel;
    sSpeedButton1: TsSpeedButton;
    sStatusBar1: TsStatusBar;
    sAlphaImageList1: TsAlphaImageList;
    sButton1: TsButton;
    RzDBGrid1: TRzDBGrid;
    procedure sButton1Click(Sender: TObject);
    procedure FrameEnter(Sender: TObject);
    procedure FrameExit(Sender: TObject);
    procedure RzDBGrid1CellClick(Column: TColumn);
    procedure RzDBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
  private
    { Private declarations }
  public
     ListSelect : TList;
  Procedure ShowStatusBar;
  end;

implementation
 uses unit1;
{$R *.dfm}
Type
   TColumnAction = (caCheck, caNone);    //необходимо для отрисовки картинки в поле чек бокса

Const
   ColumnName : array[TColumnAction] of String = ('Check',''); //необходимо для отрисовки картинки в поле чек бокса

   Function GetColumnAction( Value : String ): TColumnAction;
Var i : TColumnAction;
Begin
   Result:=caNone;
   FOR i:=Low(TColumnAction) TO High(TColumnAction) DO
   IF CompareText(Value , ColumnName[i]) = 0 Then Result:=i;
End;


procedure TFrame3.FrameEnter(Sender: TObject);
begin
TFrame3(CurrentFrame).ListSelect:=TList.Create;
end;

procedure TFrame3.FrameExit(Sender: TObject);
begin
TFrame3(CurrentFrame).ListSelect.Free;
end;

procedure TFrame3.RzDBGrid1CellClick(Column: TColumn);
var
value,i : integer;
p: pointer;
begin
 IF CompareText(Column.Field.FieldName , 'Check') = 0 Then
   Begin
        Value:=Column.Field.DataSet.FieldByName('ID').AsInteger;
        IF ListSelect.Count > 0 Then
            IF ListSelect.IndexOf(Pointer(Value)) >=0
            Then ListSelect.Delete(ListSelect.IndexOf(Pointer(Value)))
            Else Begin
                   ListSelect.Add(Pointer(Value));
            End
            Else Begin
                   ListSelect.Add(Pointer(Value));
            End
   End;
    Column.Grid.Refresh;
    ShowStatusBar;
end;

procedure TFrame3.RzDBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
Var CheckIt : Boolean;
    Style   : Integer;
    ColumnAction : TColumnAction;
begin

    ColumnAction := GetColumnAction(Column.FieldName);


    CheckIt := ListSelect.IndexOf(Pointer(TDBGrid(Sender).DataSource.DataSet.FieldByName('ID').AsInteger))>=0;

    IF CheckIt
    Then TDBGrid(Sender).Canvas.Font.Color:=RGB($FF,$00,$00);

        IF TDBGrid(Sender).DataSource.DataSet.RecNo mod 2 = 1
        Then TDBGrid(Sender).Canvas.Brush.Color:=RGB($CC,$CC,$99);

    IF  gdSelected   IN State
    Then Begin
             TDBGrid(Sender).Canvas.Brush.Color:= clHighLight;
             TDBGrid(Sender).Canvas.Font.Color := clHighLightText;
         End;

    TDBGrid(Sender).DefaultDrawColumnCell(Rect,DataCol,Column,State);

    Case ColumnAction Of

       caCheck  :
                  IF CheckIt
                  Then sAlphaImageList1.Draw(TDBGrid(Sender).Canvas,Rect.Left,Rect.Top, ORD(ColumnAction) )


    End;
end;

procedure TFrame3.sButton1Click(Sender: TObject);
begin
ListSelect:=TList.Create;
ShowStatusBar;
end;


Procedure TFrame3.ShowStatusBar;
Begin
sStatusBar1.Panels[0].Text:='Выбрано строк: ' + IntToStr(ListSelect.Count) ;
End;

end.

Последний раз редактировалось synthetisch; 08.10.2014 в 17:26.
synthetisch вне форума Ответить с цитированием
Старый 08.10.2014, 17:59   #2
min@y™
Цифровой кот
Старожил
 
Аватар для min@y™
 
Регистрация: 29.08.2014
Сообщений: 7,629
По умолчанию

Ой-ёй-ёй! Вот этот кусок гнилой совсем.
Код:
procedure TFrame3.FrameEnter(Sender: TObject);
begin
TFrame3(CurrentFrame).ListSelect:=TList.Create;
end;

procedure TFrame3.FrameExit(Sender: TObject);
begin
TFrame3(CurrentFrame).ListSelect.Free;
end;
Замени на конструктор и деструктор.
Код:
constructor TFrame3.Create(AOwner: TComponent);
begin
  inherited;
  ListSelect:= TList.Create();
end;

destructor TFrame3.Destroy;
begin
  ListSelect.Free();
  inherited;
end;
И ещё:
Код:
procedure TFrame3.sButton1Click(Sender: TObject);
begin
ListSelect:=TList.Create; // выбрось эту строку
ShowStatusBar;
end;
Расскажу я вам, дружочки, как выращивать грибочки: нужно в поле утром рано сдвинуть два куска урана...

Последний раз редактировалось min@y™; 08.10.2014 в 18:13.
min@y™ вне форума Ответить с цитированием
Старый 08.10.2014, 18:10   #3
synthetisch
 
Регистрация: 20.05.2013
Сообщений: 6
По умолчанию

Хорошо, учёл, это конечно проблемы не решило, но всё же спасибо )

Последний раз редактировалось synthetisch; 08.10.2014 в 18:25.
synthetisch вне форума Ответить с цитированием
Старый 09.10.2014, 13:42   #4
synthetisch
 
Регистрация: 20.05.2013
Сообщений: 6
По умолчанию

Проблема решена!
Дело в том, что я пытался создать список на ещё не существующем фрейме.

Решением было создание процедур AfterConstruction и BeforeDestruction:

Код:
 procedure AfterConstruction; override;
  procedure BeforeDestruction; override;
Код:
{это событие возникает перед созданием фрейма}
procedure TFrame3.AfterConstruction;
begin
  inherited;
  ListSelect:=TList.Create();
end;

{это событие возникает перед закрытием}
procedure TFrame3.BeforeDestruction;
begin
  inherited;
  ListSelect.Free();
end;
synthetisch вне форума Ответить с цитированием
Старый 09.10.2014, 14:32   #5
min@y™
Цифровой кот
Старожил
 
Аватар для min@y™
 
Регистрация: 29.08.2014
Сообщений: 7,629
По умолчанию

Ну пипец, блин! Найдите 10 отличий. Чем мой-то вариант не подошёл?
Расскажу я вам, дружочки, как выращивать грибочки: нужно в поле утром рано сдвинуть два куска урана...
min@y™ вне форума Ответить с цитированием
Старый 09.10.2014, 15:04   #6
synthetisch
 
Регистрация: 20.05.2013
Сообщений: 6
По умолчанию

Я и нашёл решение благодаря Вашему варианту, как видите оно слегка отличается, Ваш вариант к сожалению не работал как нужно, но за решение проблемы спасибо Вам )
synthetisch вне форума Ответить с цитированием
Старый 09.10.2014, 15:07   #7
min@y™
Цифровой кот
Старожил
 
Аватар для min@y™
 
Регистрация: 29.08.2014
Сообщений: 7,629
По умолчанию

Цитата:
Ваш вариант к сожалению не работал как нужно
ёёёёёёёПочему?
Расскажу я вам, дружочки, как выращивать грибочки: нужно в поле утром рано сдвинуть два куска урана...
min@y™ вне форума Ответить с цитированием
Старый 09.10.2014, 20:33   #8
synthetisch
 
Регистрация: 20.05.2013
Сообщений: 6
По умолчанию

Ну код просто не работал, даже после коррекции
synthetisch вне форума Ответить с цитированием
Старый 09.10.2014, 21:21   #9
min@y™
Цифровой кот
Старожил
 
Аватар для min@y™
 
Регистрация: 29.08.2014
Сообщений: 7,629
По умолчанию

я спросил "почему?"...
Ответ типа "ах...егознает" принимается.
так действительно бывает, и я даже причину знаю.
Расскажу я вам, дружочки, как выращивать грибочки: нужно в поле утром рано сдвинуть два куска урана...
min@y™ вне форума Ответить с цитированием
Старый 09.10.2014, 22:11   #10
synthetisch
 
Регистрация: 20.05.2013
Сообщений: 6
По умолчанию

Но я же благодарен за твою помощь, на форуме один ты отозвался, спасибо ещё раз, и если бы не ты, я бы искал решение проблемы не в том месте )
synthetisch вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Не могу исправить ошибку в коде TUberwer Общие вопросы Delphi 6 10.07.2013 17:57
Не могу исправить ошибку onliner PHP 1 18.04.2013 15:23
Не могу исправить ошибку ((( Юлия- Общие вопросы C/C++ 7 11.12.2012 11:35
не могу исправить ошибку serzav5 Общие вопросы C/C++ 3 22.01.2012 13:46
Никак не могу исправить ошибку. Kulikcha Visual C++ 5 17.06.2011 00:05