P.S.
| Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате |
| Форум программистов > Delphi: Общие вопросы > Проблема в рисовании прямоугольника |
| Автор: neutrino 13.10.2002, 20:33 |
| Здравствуйте. Опять я прошу вас мне помочь. Моя проблема в том, что у меня нет большого опыта в программировании визуальных компонентов. И так, в чем же проблема? А проблема в том, что этот код не работает. Его цель, нарисовать прямоугольник для выделения контролов внутри 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; Буду благодарен за любую помощь. |
| Автор: Dayana 13.10.2002, 23:41 |
| Попробовала твой код, у меня все работает. Единственное, что добавила в коструктор, - это инициализацию родителя: Parent := TWinControl(AOwner). Иначе возникает AV при попытке обращения к Handle. Да и не отображается компонента без родителя... А в остальном все работает. |
| Автор: neutrino 14.10.2002, 01:13 |
| Хорошо, попробую дома это вписать. А в чем все таки проблема? |
| Автор: Dayana 14.10.2002, 01:48 |
| В том-то и дело, что я не вижу проблемы... Родитель в любом случае должен быть, иначе форма не будет его отображать. Ты не показал весь код... возможно ошибка где-то в другом месте... Попробуй исполнить только этот кусок кода, который показал здесь, отдельно. Может будет работать?! |
| Автор: Fantasist 14.10.2002, 02:11 |
| Посмотри, первым делом, что возвращает GetLastError. И что значит не работает? Не рисует? |
| Автор: neutrino 14.10.2002, 19:04 |
| Боже! Вот что получается: такое впечатление, что DC определяется случайно, у меня он рисует этот прямоугольник в других компонентах! Я вставил ту строку, что Dayana написала, все работает! Я изменю код в вопросе на работаюший, может кому пригодится. Всем огромное спасибо за ответы. P.S.
|