Платные хостинги     Раскрутка сайта     Книги по программированию

Проблема в рисовании прямоугольника, наверное все дело в Handle.

- Здравствуйте.Опять я прошу вас мне помочь. Моя проблема в том, что у меня нет большого опыта в программировании визуальных компонентов. И так, в чем же проблема? А проблема в том, что этот код не работает. Его цель, нарисовать прямоугольник для выделения контролов внутри TScrollBox'а. Это немного переделанный вариант из FAQ'а по Delphi нашего форума (огромное спасибо Vit'у). Я догадываюсь, что проблема тут в Handle (дело в том, что если я все обработчики событий и строку   "SelfDC := GetDC(FlowChartContainer1.Handle);" пишу в модуле формы, то все работает, а если в модуле компонента, то нет). Ниже приведен код, я извиняюсь за громоздкость, но я решил вложить все функции относящиеся к делу. Cоответственно, бОльшая часть компонента опущена.type  TFlowChartContainer = class(TScrollBox) //Это класс  private                    FirstPoint: TPoint;                // Начало, от куда рисуется прямоугольник    Selecting: Boolean;                // Флаг, процесса рисования прямоугольника    SelRect: TRect;                    // Координаты прямоугольника    SelfDC: HDC;                       // Контекстное устройство класса  (* ОПИСАНИЯ ФУНКЦИЙ СМОТРИТЕ ДО ИХ ИМПЛЕМЕНТАЦИЙ *)    procedure DrawRect(Action: Boolean);    procedure NormalRect(p1, p2: TPoint);    procedure MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);    procedure MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);    procedure MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);  public    constructor Create(AOwner: TComponent); override;    destructor Destroy; override;  end;implementation(* Функция рисует прямоугольник точками. Если в параметре TRUE - черным цветом, FALSE - белым (т.е. стирает) *)procedure TFlowChartContainer.DrawRect(Action: Boolean);begin  if Action then  // Если нужно рисовать ...    SelectObject(SelfDC, CreatePen(PS_DOT, 1, clBlack)) // Ручка черного цвета  else            // Иначе нужно стереть ...    SelectObject(SelfDC, CreatePen(PS_DOT, 1, clWhite));// Ручка белого цвета  // Нарисовать прямоугольник  Rectangle(SelfDC, SelRect.Left, SelRect.Top, SelRect.Right, SelRect.Bottom);end;(* Чтобы нормально отрабатывался случай, когда высота или ширина прямоугольника отрицательная (это произойдет, если увести мышь левее или выше начальной точки), создана эта функция *)procedure TFlowChartContainer.NormalRect(p1, p2: TPoint);begin  if p1.x < p2.x then begin // Если вторая вершина левее ...    SelRect.Left := p1.x;   // ... поменять местами значения    SelRect.Right := p2.x;  // по оси Х  end else begin            // Иначе ...    SelRect.Left := p2.x;   // ... восстановить старые    SelRect.Right := p1.x;  // значения по Х  end;  if p1.y < p2.y then begin // Если вторая вершина выше ...    SelRect.Top := p1.y;    // ... поменять местами значения    SelRect.Bottom := p2.y; // по оси У  end else begin            // Иначе ...    SelRect.Top := p2.y;    // ... восстановить старые    SelRect.Bottom := p1.y; // значения по Х  end;end;(* Событие на нажатие кнопки мыши. *)procedure TFlowChartContainer.MouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);begin  if (Button = mbLeft) and (not Selecting) then // Если кнопка левая и прямоугольник не рисуется ...  begin    Selecting := True;                          // Флаг рисования = правда. Разрешить рисовать.    FirstPoint := Point(X, Y);                  // Определение первой вершины прямоугольника      SelRect := Bounds(X, Y, 0, 0);              // Записать ее (вершину) в координаты прямоугольника  end;end;(* Событие на движение мыши. *)procedure TFlowChartContainer.MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);begin  if Selecting then                     // Если разрешено рисовать ...  begin    DrawRect(False);                    // Стереть старый прямоугольник    NormalRect(FirstPoint, Point(X, Y));// Расчитать новые координаты    Application.ProcessMessages;        // Дать приложению обработать сообщения    DrawRect(True);                     // Нарисовать новый прямоугольник  end;end;(* Событие на отжатие кнопки мыши.*)procedure TFlowChartContainer.MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);begin  NormalRect(FirstPoint, Point(X, Y)); // Расчитать новые координаты  DrawRect(False);                     // Стереть последний прямоугольник  Selecting := false;                  // Запретить рисоватьend;(* Конструктор *)constructor TFlowChartContainer.Create(AOwner: TComponent);begin  inherited Create(AOwner);                  // Вызвать старый конструктор  OnMouseDown := MouseDown;                  // Назначить Обработчики событий  OnMouseUp := MouseUp;                      // ......  OnMouseMove := MouseMove;                  // ......  SelfDC := GetDC(Handle);                   // Получить контекст по Handle  Selecting := False;                        // Запретить рисовать  Parent := TWinControl(AOwner); //<--here the dog digged!!!end;(* Деструктор *)destructor TFlowChartContainer.Destroy;begin  inherited; // Вызвать старый деструкторend;Буду благодарен за любую помощь.

- Попробовала твой код, у меня все работает. Единственное, что добавила в коструктор, - это инициализацию родителя: Parent := TWinControl(AOwner). Иначе возникает AV при попытке обращения к Handle. Да и не отображается компонента без родителя... А в остальном все работает.

- Хорошо, попробую дома это вписать. А в чем все таки проблема?

- В том-то и дело, что я не вижу проблемы... Родитель в любом случае должен быть, иначе форма не будет его отображать. Ты не показал весь код... возможно ошибка где-то в другом месте... Попробуй исполнить только этот кусок кода, который показал здесь, отдельно. Может будет работать?!

- Посмотри, первым делом, что возвращает GetLastError.И что значит не работает? Не рисует?

- Боже! Вот что получается: такое впечатление, что DC определяется случайно, у меня он рисует этот прямоугольник в других компонентах! Я вставил ту строку, что Dayana написала, все работает! Я изменю код в вопросе на работаюший, может кому пригодится. Всем огромное спасибо за ответы.P.S.  

Интернет казино     Онлайн игры     Увеличение члена     Купить DVD