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

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

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

Восстановить пароль
Повторная активизация e-mail

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

Ответ
 
Опции темы Поиск в этой теме
Старый 01.12.2009, 23:11   #1
oD1k
Новичок
Джуниор
 
Регистрация: 01.12.2009
Сообщений: 2
По умолчанию Вывод на печать(((

Уважаемые программисты сиего форума!!!
Требуется помощь в решении поставленной задачи.

ИМЕЕТСЯ программа.

Код:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, jpeg, Printers;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Edit3: TEdit;
    Label4: TLabel;
    Label5: TLabel;
    Edit4: TEdit;
    Button4: TButton;
    Label6: TLabel;
    Label7: TLabel;
    procedure Button3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button3Click(Sender: TObject);
begin
application.Terminate;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  x1,x2,b:real;
  x3,x4,s,t,v:integer;

function funct(i,j:real):integer;
var f1,f2,f3,f4,f5,f6,f7,f8,f9,f10,D1,D2,D3:integer;

begin
if x2>=0 then f1:=1 else f1:=0;
if x1>=0 then f2:=1 else f2:=0;
if (x2-x1-1)<=0 then f3:=1 else f3:=0;
if (x1-1)>=0 then f4:=1 else f4:=0;
if (2*x2-x1-5)<=0 then f5:=1 else f5:=0;
if (2*x2+x1-11)<=0 then f6:=1 else f6:=0;
if (x1-5)<=0 then f7:=1 else f7:=0;
if (x1+x2-7)<=0 then f8:=1 else f8:=0;
if (x1-6)<=0 then f9:=1 else f9:=0;
if (sqr(x1-3)+sqr(x2-2)-1)>=0 then f10:=1 else f10:=0;

if f4*f5*f6*f7=1 then D2:=1 else D2:=0;
if f1*f2*f3*f8*f9=1 then D1:=1 else D1:=0;
if f10=1 then D3:=1 else D3:=0;
if (D1+D2=0) or (D3=0) then funct:=0 else funct:=1;
end;

begin
x1:=strtofloat(edit1.text);
x2:=strtofloat(edit2.text);
b:=strtofloat(edit3.text);
v:=funct(x1,x2);

if v=0 then label6.Caption:='Точка А НЕ ПРИНАДЛЕЖИТ детали D' else
label6.caption:='Точка А ПРИНАДЛЕЖИТ детали D';

t:=trunc(5/b)+1;
s:=trunc(7/b)+1;

x1:=0; x2:=0;
for x3:=0 to s do begin
for x4:=0 to t do
begin
v:=funct(x1,x2);
if v=1 then edit4.text:=edit4.text+'('+floattostr(x1)+';'+floattostr(x2)+') ';
x2:=x2+b;
end;
x1:=x1+b; x2:=0;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  x1,x2,b:real;
  x3,x4,l,c,v,s,t:integer;
  Printer : TextFile;

function funct(i,j:real):integer;
var f1,f2,f3,f4,f5,f6,f7,f8,f9,f10,D1,D2,D3:integer;
begin
if x2>=0 then f1:=1 else f1:=0;
if x1>=0 then f2:=1 else f2:=0;
if (x2-x1-1)<=0 then f3:=1 else f3:=0;
if (x1-1)>=0 then f4:=1 else f4:=0;
if (2*x2-x1-5)<=0 then f5:=1 else f5:=0;
if (2*x2+x1-11)<=0 then f6:=1 else f6:=0;
if (x1-5)<=0 then f7:=1 else f7:=0;
if (x1+x2-7)<=0 then f8:=1 else f8:=0;
if (x1-6)<=0 then f9:=1 else f9:=0;
if (sqr(x1-3)+sqr(x2-2)-1)>=0 then f10:=1 else f10:=0;

if f1*f2*f3*f8*f9=1 then D1:=1 else D1:=0;
if f4*f5*f6*f7=1 then D2:=1 else D2:=0;
if f10=1 then D3:=1 else D3:=0;
if (D1+D2=0) or (D3=0) then funct:=0 else funct:=1;
end;


begin
b:=strtofloat(edit3.text);
if b=1 then begin l:=1; c:=0 end
       else begin l:=1; c:=1 end;
AssignPrn(Printer);
Rewrite(Printer);
Writeln(Printer, 'Следующие точки принадлежат детали D:');

s:=Trunc(7/b)+1;
t:=Trunc(5/b)+1;
x1:=0; x2:=0;
for x3:=0 to s do
 begin
for x4:=0 to t do
begin
v:=funct(x1,x2);
if v=1 then write(Printer, x1:l:c,' ; ',x2:l:c,' ');
x2:=x2+b;
end;
x1:=x1+b;
x2:=0;
Writeln(Printer, 'x');
end;
CloseFile(Printer);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
Edit4.text:='';
end;
end.


Смысл ее действа таков - юзер забивает с клавы координаты x1,x2 (они real) и шаг b с которым система будет сканировать координаты х1 и х2 ( в простонародье х и у)- затем идет проверка принадлежит ли данная точка детали или нет.Ответ я вывел в label6. в поле edit4 выводятся все точки,которые принадлежат фигуре с заданным шагом.

ЭТО ПОЛУЧИЛОСЬ.

ТЕПЕРЬ САМЫЙ ВАЖНЫЙ ВОПРОС : как сделать так, чтобы при выводе на принтер печатались не сами координаты (как у меня сейчас в программе это осуществлено) а ИМЕННО точки (точки на графике ). Можно точку заменить на обычный Х. Соответственно,при уменьшении шага b - точек будет больше и больше и в конечном итоге принтер должен выдать просто НАПЕЧАТАННУЮ ФИГУРУ.

ЗАРАНЕЕ БЛАГОДАРЮ. бьюсь который день.

Последний раз редактировалось Stilet; 02.12.2009 в 10:24.
oD1k вне форума Ответить с цитированием
Старый 02.12.2009, 10:27   #2
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,097
По умолчанию

Тебе график нужно на печать вывести?
Кинь на форму TChart, в нем построй график и его выведи на печать.
У него должно быть что-тотипа Print
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 02.12.2009, 13:33   #3
Anatole
Форумчанин
 
Аватар для Anatole
 
Регистрация: 07.04.2009
Сообщений: 245
По умолчанию

Рисуйте на канве принтера линии от точки к точке. получите контур детали
Всякое безобразие должно быть единообразным. Тогда это называется порядком.
Anatole вне форума Ответить с цитированием
Старый 02.12.2009, 20:28   #4
oD1k
Новичок
Джуниор
 
Регистрация: 01.12.2009
Сообщений: 2
По умолчанию

БЛЬШОЕ СПАСИБО ЗА ОТВЕТЫ.Буду пробовать.
oD1k вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Вывод рисунка на печать -=<[Evklidd]>=- Мультимедиа в Delphi 10 09.07.2010 18:38
Вывод данных на печать ИВэТэшка Помощь студентам 5 19.05.2009 08:07
Вывод на печать sali_s Microsoft Office Excel 2 04.06.2008 12:05
Вывод на печать -=<[Evklidd]>=- Общие вопросы Delphi 6 22.02.2008 19:56
вывод на печать asembler udjal Assembler - Ассемблер (FASM, MASM, WASM, NASM, GoASM, Gas, RosAsm, HLA) и не рекомендуем TASM 0 10.11.2007 14:32