Программирование
Главная » FAQ |
Рисование по пикселям Рисовать на канве можно разными способами. Первый вариант - рисовать по пикселям. Для этого используется свойство канвы Pixels. Это свойство представляет собой двумерный массив, который отвечает за цвета канвы. Например Canvas.Pixels[10,20] - соответствует цвету пикселя с координатами (10,20). С массивом пикселей можно обращаться, как с любым свойством: изменять цвет, задавая пикселю новое значение, или определять его цвет, по хранящемуся в нем значению. На примере ниже мы зададим черный цвет пикселю с координатами (10,20): Canvas.Pixels[10,20]:=clBlack; Теперь мы попробуем нарисовать график функции F(x), если известен диапазон ее изменений Ymax и Ymin, и диапазон изменения аргумента Xmax и Xmin. Для этого мы напишем пользовательскую функцию, которая будет вычислять значение функции F в точке x, а также будет возвращать максимум и минимум функции и ее аргумента. function Tform1.F(x:real; var Xmax,Xmin,Ymax,Ymin:real):real; begin F:=Sin(x); Xmax:=4*pi; Xmin:=0; Ymax:=1; Ymin:=-1; end; Не забудьте также указать заголовок этой функциии в разделе Public: public { public declarations } function F(x:real; var Xmax,Xmin,Ymax,Ymin:real):real; Здесь для ясности мы просто указали диапазон изменения функции Sin(x) и ее аргумента, ниже эта функция будет описана целиком. Параметры Xmax, Xmin, Ymax, Ymin - описаны со словом Var потому что они являются входными-выходными, т.е. через них функция будет возвращать значения вычислений этих данных в основную программу. Поэтому надо объявить Xmax, Xmin, Ymax, Ymin как глобальные переменные в разделе Implementation: implementation var Xmax,Xmin,Ymax,Ymin:real; Теперь поставим на форму кнопку и в ее обработчике события OnClick напишем следующий код: procedure TForm1.Button1Click(Sender: TObject); var x,y:real; PX,PY:longInt; begin for PX:=0 to Image1.Width do begin x:=Xmin+PX*(Xmax-Xmin)/Image1.Width; y:=F(x,Xmax,Xmin,Ymax,Ymin); PY:=trunc(Image1.Height-(y-Ymin)*Image1.height/(Ymax-Ymin)); image1.Canvas.Pixels[PX,PY]:=clBlack; end; end; В этом коде вводятся переменные x и y, являющиеся значениями аргумента и функции, а также переменные PX и PY, являющиеся координатами пикселей, соответствующих x и y. Сама процедура состоит из цикла по всем значениям горизонтальной координаты пикселей PX компонента Image1. Сначала выбранное значение PX пересчитывается в соответствующее значение x. Затем производится вызов функции F(x) и определяется ее значение Y. Это значение пересчитывается в вертикальную координату пикселя PY. Рисование с помощью пера Pen У канвы имеется свойство Pen - перо. Это объект, в свою очередь имеющий ряд свойств. Одно из них - свойство Color - цвет, которым наносится рисунок. Второе свойство - Width - ширина линии, задается в пикселах (по умолчанию 1). Свойство Style определяет вид линии и может принимать следующие значения:psSolid Сплошная линия psDash Штриховая линия psDot Пунктирная линия psDashDot Штрих-пунктирная линия psDashDotDot Линия, чередующая штрих и два пунктира psClear Отсутствие линии psInsideFrame Сплошная линия, но при Width > 1 допускающая цвета, отличные от палитры Windows Все стили со штрихами и пунктирами доступны только при толщине линий равной 1. Иначе эти линии рисуются как сплошные. У канвы имеется свойство PenPos, типа TPoint. Это свойство определяет в координатах канвы текущую позицию пера. Перемещение пера без прорисовки осуществляется методом MoveTo(x,y). После вызова этого метода канвы точка с координатами (x,y) становится исходной, от которой методом LineTo(x,y) можно провести линию в любую точку с координатами (x,y). Давайте теперь попробуем нарисовать график синуса пером. Для этого добавим перед циклом оператор: Image1.Canvas.MoveTo(0,Image1.height div 2); А перед заключительным end цикла добавим следующий оператор: Image1.Canvas.LineTo(PX,PY); Таким образом у Вас должен получиться такой код: procedure TForm1.Button1Click(Sender: TObject); var x,y:real; PX,PY:longInt; begin Image1.Canvas.MoveTo(0,Image1.height div 2); for PX:=0 to Image1.Width do begin x:=Xmin+PX*(Xmax-Xmin)/Image1.Width; y:=F(x,Xmax,Xmin,Ymax,Ymin); PY:=trunc(Image1.Height-(y-Ymin)*Image1.height/(Ymax-Ymin)); image1.Canvas.Pixels[PX,PY]:=clBlack; Image1.Canvas.LineTo(PX,PY); end; end; Как Вы уже успели заметить, если запустили программу, качество рисования графика пером, намного лучше, чем рисования по пикселям. Как обещал сейчас напишу пример программы которая находит максимум и минимум функции. Я маленько изменил структуру процедур и функций, чтобы было яснее. Вот готовый код программы: ... type TForm1 = class(TForm) Button1: TButton; Image1: TImage; procedure Button1Click(Sender: TObject); private { private declarations } public function F(x:real):real; procedure Extrem1(Xmax,Xmin:real; var Ymin:real); procedure Extrem2(Xmax,Xmin:real; var Ymax:real); { public declarations } end; var Form1: TForm1; implementation Const e=1e-4;//точность одна тысячная var Xmax,Xmin,Ymax,Ymin:real; {$R *.DFM} function Tform1.F(x:real):real; begin F:=Sin(x); end; //поиск минимума функции procedure TForm1.Extrem1(Xmax,Xmin:real; var Ymin:real); var x,h:real; j,n:integer; begin n:=10; repeat x:=Xmin; n:=n*2; h:=(Xmax-Xmin)/n; Ymin:=F(Xmin); for j:=1 to n do begin if f(x)<Ymin then Ymin:=f(x); x:=x+h; end; until abs(f(Ymin)-f(Ymin+h))<e; end; //поиск максимума функции procedure TForm1.Extrem2(Xmax,Xmin:real; var Ymax:real); var x,h:real; j,n:integer; begin n:=10; repeat x:=Xmin; n:=n*2; h:=(Xmax-Xmin)/n; Ymax:=F(Xmin); for j:=1 to n do begin if f(x)>=Ymax then Ymax:=f(x); x:=x+h; end; until abs(f(Ymax)-f(Ymax+h))<e; end; procedure TForm1.Button1Click(Sender: TObject); var x,y:real; PX,PY:longInt; begin //здесь необходимо указать диапазон изменения x Xmax:=8*pi; Xmin:=0; //вычисляем экстремумы функции Extrem1(Xmax,Xmin,Ymin); Extrem2(Xmax,Xmin,Ymax); //рисуем график функции Image1.Canvas.MoveTo(0,Image1.height div 2); for PX:=0 to Image1.Width do begin x:=Xmin+PX*(Xmax-Xmin)/Image1.Width; y:=F(x); PY:=trunc(Image1.Height-(y-Ymin)*Image1.height/(Ymax-Ymin)); image1.Canvas.Pixels[PX,PY]:=clBlack; Image1.Canvas.LineTo(PX,PY); end; end; end. (источник www.delphid.dax.ru) |
Разместите и настройте необходимые компоненты для работы с Вашей БД и в обработчике нужного вам события напишите: var i, j, value_width, t: integer; koef: byte; begin //Отключаем автопрорисовку DBGrig DBGrid1.DefaultDrawing:=false; //Задаем коэффициент длины koef:=10; //Обрабатываем все колонки for i:=0 to DBGrid1.Columns.Count-1 do begin //Задаем начальную длину value_width:=0; //Пока не проверили все записи while not (ADOTable1.Eof) do begin //Получаем длину очередной записи t:=Length(ADOTable1.Fields[i].Value); //Если полученная длина больше чем самая большая, то меняем значение value_width if value_width<t then value_width:=t; //Переходим к следующей записи ADOTable1.Next; end; //Устанавливаем для колонки длину, равную самой длинной записи, помноженный на заданный коэффициент DBGrid1.Columns[i].Width:=value_width*koef; //Возвращаемся к первой записи ADOTable1.First; end; //Включаем автопрорисовку DBGrid DBGrid1.DefaultDrawing:=true; end; |
Разместите на форме необходимые компоненты для работы с БД и настройте их. В свойстве компонента TDBGrid DefaultDrawing установите false, дальше в обработчике событий OnDrawColumnCell напишите: procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); begin //Определяем, каким цветом будем закрашивать if TDBGrid(Sender).DataSource.DataSet.RecNo mod 2 = 1 then TDBGrid(Sender).Canvas.Brush.Color:=clBlue else TDBGrid(Sender).Canvas.Brush.Color:=clGreen; //Если это выбранная запись, то ее будем рисовать другим цветом if (gdSelected in State) then begin TDBGrid(Sender).Canvas.Brush.Color:= clHighLight; TDBGrid(Sender).Canvas.Font.Color := clHighLightText; end; with TDBGrid(Sender).Canvas do begin //Рисуем FillRect(Rect); //Выводим текст TextOut(Rect.Left+2,Rect.Top+2,Column.Field.Text); end; end; |
Ставим запрет на нужно Вам поле: var i: integer; begin for i:=0 to DBGrid1.DataSource.DataSet.Fields.Count-1 do if DBGrid1.DataSource.DataSet.Fields[i].DisplayName='НАЗВАНИЕ ПОЛЯ ДЛЯ ЗАПРЕТА' then DBGrid1.DataSource.DataSet.Fields[i].ReadOnly:=TRUE; end; |
Модифицируем стандартный компонент. Далее выберите пункт Component| Install Component и установите новый компонент. Код нового модуля: unit ScrollGrid; interface uses Math, Windows, Messages, SysUtils, Classes, Controls, Grids, DBGrids; type //Создаем потомка от стандартного компонента DBGrid TScrollGrid = class(TDBGrid) private procedure WMWheel(var Msg:TWMMouseWheel); message WM_MOUSEWHEEL; { Private declarations } end; procedure Register; implementation //Регистрируем новый компонент в палитре Delphi procedure Register; begin RegisterComponents('Samples', [TScrollGrid]); end; procedure TScrollGrid.WMWheel(var Msg: TWMMouseWheel); begin DataSource.DataSet.MoveBy(-sign(Msg.WheelDelta)); end; end. |