Графика в Паскале
Предлагаю сюда скидывать и предлагать все про графику в паскале
Опять же, для графики здесь целый раздел - строкой ниже.
Если интересует что-то конкретное - спроси.
- Создать окно Windows. В заголовок окна записать свои данные: имя, фамилию и номер варианта.
- Используя функции из библиотеки ObjectWindows и GDI API Windows, разделить окно по диагонали на две части . Линии должны изменяться в соответствии с изменениями размеров окна.
- Написать процедуры для обработки нажатия на клавиши мыши по заданию в варианте. Геометрические фигуры должны иметь центр в точке нажатия «мыши.
- При перерисовке окна (например, во время изменения его размеров), созданные с помощью «мыши» изображения фигур и текстовые надписи должны сохраняться и обновляться.
Но я не могу заставить фигуры появлятся по сторонам диагонали, только по прямоугольнику они у меня появляются
[COLOR="Blue"]Program mousemove;
uses owindows, winprocs, wintypes, strings;
type
TMyApplication = object(TApplication)
procedure InitMainWindow; Virtual;
end;
TMyText = record
X, Y, tip: integer;
end;
PMyWindow = ^TMyWindow;
TMyWindow = object(TWindow)
NumRect:word;
MasRect: array [0..1000] of TPoint;
Constructor Init(ATitle: PChar);
Procedure Paint(PaintDC: HDC;var PaintInfo: TPaintStruct); virtual;
Procedure WMLButtonDown(Var Msg: TMessage);
Virtual wm_First + WM_LBUTTONDOWN;
end;
procedure TMyApplication.InitMainWindow;
begin
MainWindow := New(PMyWindow, Init('Rita Petuhova N18'));
end;
constructor TMyWindow.Init(ATitle: PChar);
begin
TWindow.Init(nil, ATitle);
numrect:=0;
end;
Procedure TMyWindow.Paint(PaintDC: HDC; Var PaintInfo: TPaintStruct);
var
NewBrush, OldBrush: HBrush;
TheRect: TRect;
font: HFont;
logfont: TLogFont;
i: integer;
begin
GetClientRect(HWindow, TheRect);
MoveTo(PaintDC, 0, TheRect.Bottom div 10000);
LineTo(PaintDC, TheRect.Right, TheRect.Bottom div 1);
PaintDC := GetDC(HWindow);
GetClientRect(HWindow,TheRect);
For i := 0 To numrect-1 Do Begin
if ((MasRect.Y < (TheRect.bottom div 1)) and (MasRect.X < ( TheRect.right div 1))) then begin
NewBrush:=CreateHatchBrush(HS_Cross,RGB(100,0,255));
OldBrush:=SelectObject(PaintDC, NewBrush);
Ellipse(PaintDC,MasRect.X-15,MasRect.Y-15,MasRect.X+15, MasRect.Y+15);
NewBrush:=SelectObject(PaintDC, OldBrush);
DeleteObject(NewBrush);
end;
if ((MasRect.Y > (TheRect.left div 1)) and (MasRect.X < (TheRect.right div 2))) then begin
NewBrush:=CreateHatchBrush(HS_FDiagonal,RGB(250,250,0));
OldBrush:=SelectObject(PaintDC, NewBrush);
Ellipse(PaintDC,MasRect.X-15,MasRect.Y-15,MasRect.X+15, MasRect.Y+15);
NewBrush:=SelectObject(PaintDC, OldBrush);
DeleteObject(NewBrush);
end;
end;
End;
procedure TMyWindow.WMLButtonDown(Var msg: TMessage);
var
PaintDC: HDC;
NewBrush, OldBrush: HBrush;
font: HFont;
logfont: TLogFont;
TheRect:TRect;
X, Y: integer;
begin
if numrect < 1000 then
begin
x := msg.LParamLo; y := msg.LParamHi;
PaintDC := GetDC(HWindow);
GetClientRect(HWindow,TheRect);
if ((y < (TheRect.bottom div 1)) and (x < (TheRect.right div 1))) then begin
NewBrush:=CreateHatchBrush(HS_Cross,RGB(100,0,255));
OldBrush:=SelectObject(PaintDC, NewBrush);
Ellipse(PaintDC,Msg.LParamLo-15,Msg.LParamHi-15, Msg.LParamLo+15, Msg.LParamHi+15);
NewBrush:=SelectObject(PaintDC, OldBrush);
DeleteObject(NewBrush);
MasRect[NumRect].X := Msg.LParamLo;
MasRect[NumRect].Y := Msg.LParamHi;
Inc(NumRect);
end;
if ((y > (TheRect.left div 1)) and (x < (TheRect.right div 2))) then begin
NewBrush:=CreateHatchBrush(HS_FDiagonal,RGB(250,250,0));
OldBrush:=SelectObject(PaintDC, NewBrush);
Ellipse(PaintDC,Msg.LParamLo-15,Msg.LParamHi-15, Msg.LParamLo+15, Msg.LParamHi+15);
NewBrush:=SelectObject(PaintDC, OldBrush);
DeleteObject(NewBrush);
MasRect[NumRect].X := Msg.LParamLo;
MasRect[NumRect].Y := Msg.LParamHi;
Inc(NumRect);
end;
end;
end;
var
MyApp: TMyApplication;
begin
MyApp.Init('Rita Petuhova N18');
MyApp.Run;
MyApp.Done;
end.[/COLOR]
Вот, что получается помогите пожалуйста разобраться.