Помощь - Поиск - Пользователи - Календарь
Полная версия: как сделать чтобы график автоматически масштабировался?
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
So Slow
Программа моделирует нормальное распределение и строит график, но как сделать, чтобы график автоматом маштабировался?

Мой код (Показать/Скрыть)
So Slow
так...уже не надо, лучше скажите как принтскрин графика сделать?
volvo
Цитата
как принтскрин графика сделать?

В поиск заглянуть...

Вот что нашлось: Скриншоты
So Slow
Цитата(volvo @ 23.01.2008 22:04) *

В поиск заглянуть...

Вот что нашлось: Скриншоты


модуль подключил, ток вот сохраняет ток черный экран mega_chok.gif

uses graph, crt,bmp_plus;

const
  n1 = 2000;
  n = 20;
  h = 400;
  w = 500;
  dx = 0.0001;
  y0 = 450;

var
  m, sigma, mu : real;
  r, x : real;
  max, min : real;
  massX : array [1..n+1] of real;
  massY : array [1..n] of integer;

Function g(x : real) : real;
begin
  if(x >= 0) then
    g := mu*exp(-mu*x);
end;

Function f(x: real): real;
begin
  f := 1/(sigma*sqrt(2*pi))*exp(-sqr(x-m)/(2*sqr(sigma)));
end;

Procedure printF;
var
  y1, y2, x, temp, mx, my : real;
begin
  y1 := f(min);
  y2 := f(min);
  x := min;
  repeat
    temp := f(x);
    if temp < y1 then y1 := temp;
    if temp > y2 then y2 := temp;
    x := x + dx;
  until (x >= max);

  my := h / abs(y2) ;
  mx := w / abs(max - min);

  x := min;
  repeat
    temp := f(x);
    putpixel(40 + Round((x-min) * mx), y0 - Round(temp * my), green);
    x := x + dx;
  until (x >= (max));
  save_bmp(0,0,getmaxx,getmaxy,'1.bmp',0);
  readkey;
  closegraph;
end;

Procedure printG;
var
  y1, y2, x, temp, mx, my : real;
begin
  y1 := g(min);
  y2 := g(min);
  x := min;
  repeat
    temp := g(x);
    if temp < y1 then y1 := temp;
    if temp > y2 then y2 := temp;
    x := x + dx;
  until (x >= max);

  my := h / abs(y2) ;
  mx := w / abs(max - min);

  x := min;
  repeat
    temp := g(x);
    putpixel(40 + Round((x-min) * mx), y0 - Round(temp * my), green);
    x := x + dx;
  until (x >= (max));
   save_bmp(0,0,getmaxx,getmaxy,'2.bmp',0);
  readkey;

  closegraph;
end;

Procedure gistogram;
var
  maxY : real;
  x1: integer;
  x : real;
  y: integer;
  e, d : integer;
  i : integer;
  mx, my: real;
  x0: integer;
  s : string;

begin
  d := Detect;
  initgraph(d, e, '');

  maxY := massY[1];
  for i := 2 to n do
    if maxY < massY[i] then
      maxY := massY[i];

  my := h / maxY;
  mx := w / abs(max - min);

  setFillStyle(11, blue);
  setColor(blue);

  for i := 1 to n do
    begin
      if i = 1 then
        x1 := 40
      else
        x1 := x1+Round(r*mx);
      setColor(blue);
      bar(x1, y0 - Round(massY[i]*my), x1+Round(r*mx), y0);
      rectangle(x1, y0 - Round(massY[i]*my), x1+Round(r*mx), y0);
      setColor(white);
      Line(x1, y0-3, x1, y0+3);
    end;

  setColor(white);

  str(min:2:2, s);
  y := 40;
  Line(y, y0-3, y, y0+3);
  outTextXY(y, y0+5, s);

  str(max:2:2, s);
  y := 40 + n*Round(r * mx);
  Line(y, y0-3, y, y0+3);
  outTextXY(y, y0+5, s);

  if (min <= 0) AND (max >= 0) then
    begin
      x0 := 40 + Round(mx*abs(min));
      outTextXY(x0-10, y0+5, '0')
    end
  else
    if min > 0 then
      begin
        x0 := 30;
        outTextXY(x0-10, y0+5, '0');
      end
    else
      begin
        x0 := 40+w+50;
        outTextXY(x0+10, y0+5, '0');
      end;

  MoveTo(x0, y0+20);      {os Y}
  LineTo(x0, y0-h-20);
  MoveTo(20, y0);     {os X}
  LineTo(40+w+60, y0);
 save_bmp(0,0,getmaxx,getmaxy,'3.bmp',0);
  readkey;
end;

Procedure normalModeling;
var
  s : string;
  f : text;
  i, j : integer;
begin
  clrscr;
  assign(f, 'C:/1.txt');

  write('Input M(X) = ');
  readln(m);
  write('Input sigma = ');
  readln(sigma);

  rewrite(f);
  randomize;
  for i := 1 to n1 do
  begin
    x := 0;
    for j := 1 to 12 do
      begin
        r := random;
        x := x + r;
      end;
    x := x - 6;
    x := sigma*x + m;
    writeln(f, x:4:4);
  end;
  close(f);

  reset(f);
  readln(f, max);
  min := max;
  while(not EOLn(f)) do
    begin
      readln(f, x);
      if x > max then
        max := x;
      if x < min then
        min := x;
    end;
  close(f);
  writeln('max = ', max:4:4);
  writeln('min = ', min:4:4);

  readln;

  r := (max - min)/n;
  massX[1] := min;
  for i := 2 to n+1 do
    massX[i] := min + r*(i-1);

  for i := 1 to n do
    massY[i] := 0;

  for i := 2 to n+1 do
    begin
      reset(f);
      while not EOLn(f) do
        begin
          readln(f, x);
          if (massX[i-1] <= x) AND (x < massX[i]) then
            massY[i-1] := massY[i-1] + 1;
        end;
      close(f);
    end;

  reset(f);
  while not EOLn(f) do
    begin
      readln(f, x);
      if massX[n+1] = x then
        massY[n] := massY[n] + 1;
    end;
  close(f);

  rewrite(f);
  for i := 1 to n do
    begin
      str(massY[i], s);
      writeln(f, s);
    end;
  close(f);
end;

Procedure expModeling;
var
  s : string;
  f : text;
  i : integer;
begin
  clrscr;
  assign(f, 'C:/1.txt');

  write('Mu = ');
  readln(mu);

  rewrite(f);
  randomize;
  for i := 1 to n1 do
  begin
    r := random;
    x := (-1/mu)*ln(1-r);
    writeln(f, x:4:4);
  end;
  close(f);

  reset(f);
  readln(f, max);
  min := max;
  while(not EOLn(f)) do
    begin
      readln(f, x);
      if x > max then
        max := x;
      if x < min then
        min := x;
    end;
  close(f);
  writeln('max = ', max:4:4);
  writeln('min = ', min:4:4);

  readln;

  r := (max - min)/n;
  massX[1] := min;
  for i := 2 to n+1 do
    massX[i] := min + r*(i-1);

  for i := 1 to n do
    massY[i] := 0;

  for i := 2 to n+1 do
    begin
      reset(f);
      while not EOLn(f) do
        begin
          readln(f, x);
          if (massX[i-1] <= x) AND (x < massX[i]) then
            massY[i-1] := massY[i-1] + 1;
        end;
      close(f);
    end;

  reset(f);
  while not EOLn(f) do
    begin
      readln(f, x);
      if massX[n+1] = x then
        massY[n] := massY[n] + 1;
    end;
  close(f);

  rewrite(f);
  for i := 1 to n do
    begin
      str(massY[i], s);
      writeln(f, s);
    end;
  close(f);
end;

BEGIN
  normalModeling;
  gistogram;
  printF;
END.
volvo
save_bmp(0,0,getmaxx,getmaxy,'2.bmp', 1); { <--- Ноль поменяй на 1 !!! }

0 - это если ты инициализировал 256-цветный режим, а у тебя обычные 16 цветов...
So Slow
сохраняются только 1.bmp и 3.bmp(черные), а 2.bmp не сохраняется вовсе что при 0, что при 1 wacko.gif
volvo
Не знаю, что ты там творишь, у меня только что сохранились нормально и 1 и 3 файлы (если надо - могу прикрепить), а второй не сохраняется по банальной причине - процедура PrintG (в которой и должно происходить сохранение) не вызывается в программе...
So Slow
Цитата(volvo @ 24.01.2008 1:59) *

Не знаю, что ты там творишь, у меня только что сохранились нормально и 1 и 3 файлы (если надо - могу прикрепить), а второй не сохраняется по банальной причине - процедура PrintG (в которой и должно происходить сохранение) не вызывается в программе...

можт у меня bmp_plus.tpu криво компилируется...прикрепи тогда и его тоже...

Добавлено через 11 мин.
а все не надо...норм заработало...спасиб за все smile.gif
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.