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

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

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

Восстановить пароль

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

Ответ
 
Опции темы Поиск в этой теме
Старый 13.04.2012, 17:59   #1
ihotdog
Новичок
Джуниор
 
Регистрация: 05.04.2012
Сообщений: 1
По умолчанию Как отмасштабировать диаграмму (Delphi)

Не могу разобраться как отмасштабировать диаграмму. Еще нужно сделать так чтобы отрицательные значения росли вниз, а не наверх



Цитата:
unit Unit1;

interface

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

type
TForm1 = class(TForm)
PB: TPaintBox;
procedure FormActivate(Sender: TObject);
procedure PBPaint(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
var
num:array[1..62] of real;
month:array[1..30] of string;
sort:array[1..2] of string;
min,max:real;
title:string;
procedure TForm1.FormActivate(Sender: TObject);
var
res:textfile;
i,j:integer;
begin
AssignFile(res,'temper.txt');
reset(res);
readln(res,title);
for i:=0 to 30 do
begin
readln(res,month[i+1]);
for j:=1 to 2 do
begin
readln(res,sort[j]);
readln(res,num[j+i*2]);
end;
end;
closefile(res);
min:=0;
max:=1000;
for i:=0 to 30 do
begin
for j:=1 to 2 do
begin
if num[j+i*2]<min then
min:=num[j+i*2];
if num[j+i*2]>max then
max:=num[j+i*2];
end;
end;
for i:=0 to 30 do
begin
for j:=1 to 2 do
begin
num[j+i*2]:=Round((num[j+i*2]-min)*100);
end;
end;
min:=Round(min*100);
max:=Round(max*100);
end;

procedure TForm1.PBPaint(Sender: TObject);
var
i,j:integer;
percoloumn,perspace,peronepercent,x ,y,n:real;
begin
percoloumn:=150/13;
perspace:=percoloumn/2;
peronepercent:=(PB.Height-150)/((max-min)/100);
x:=0;
y:=Round(PB.Height/20); {Начало легенды}
for i:=0 to 30 do
begin
Pb.Canvas.Font.Name:='Verdana';
PB.Canvas.Font.Size:=8;
PB.Canvas.Brush.Color:=clBtnFace;
PB.Canvas.TextOut(190,20,title);
PB.Canvas.TextOut(Round(x+percoloum n),PB.Height-170,month[i+1]); {Подписи месяцев}
for j:=1 to 2 do
begin
case j of
1: PB.Canvas.Brush.Color:=clRed;

2: PB.Canvas.Brush.Color:=clGreen;

end;
n:=Round((num[j+i*2]/100)*peronepercent);
PB.Canvas.Rectangle(Round(x),Round( Abs(n-(PB.Height-220))),Round(x+percoloumn),PB.Heigh t-180);
if i=0 then
begin
Pb.Canvas.Rectangle(500,Round(y),Ro und(500+percoloumn),Round(y+percolo umn));
PB.Canvas.Brush.Color:=clBtnFace;
PB.Canvas.Font.Size:=12;
Pb.Canvas.TextOut(Round(500+percolo umn)+5,Round(y+5),sort[j]);
end;
x:=x+percoloumn;
y:=y+percoloumn+perspace;
PB.Canvas.Brush.Color:=clBtnFace;
PB.Canvas.Font.Size:=5;
PB.Canvas.TextOut(Round(x-percoloumn+1),Round(Abs(n-(PB.Height-230))),FloatToStr(((num[j+i*4]+min))/100));
end;
x:=x+perspace;
end;

end;
end.
ihotdog вне форума Ответить с цитированием
Старый 13.04.2012, 19:02   #2
Rin
Негодник
Форумчанин
 
Аватар для Rin
 
Регистрация: 10.11.2009
Сообщений: 880
По умолчанию

На счёт масштабирования мой индусский код в этом топике.
На счёт диаграмм с отрицательными показателями самым простым, думаю, будет проверка на отрицательное значение и прибавление к Y, отвечающему за высоту, модуля этого отрицательного значения, умноженного на 2.
Заняться было не нечем, и написал на индусском.
Код:
....................
var
num:array[1..2] of integer=(9,-8); // температура
zoom:integer=1;
push:boolean=false;
my_x,my_y,dx,dy:integer;

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
if (key='+')and (zoom<3) then zoom:=zoom+1;
if (key='-')and (zoom>1) then zoom:=zoom-1;
dx:=0;
dy:=0;
pb.Repaint;
end;

procedure TForm1.PBMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if button=mbleft then
  begin
    push:=true;
    my_x:=x-dx;
    my_y:=y-dy;
  end;
end;

procedure TForm1.PBMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if (push) then
  begin
    if (dx<0)and(dx>-(pb.width*zoom div 2)) then dx:=x-my_x else
    if (dx<0)and(dx<=-(pb.width*zoom div 2)) then  dx:=-(pb.width*zoom div 2)+1;

    if (dy<0)and(dy>-(pb.height*zoom div 2)) then dy:=y-my_y else
    if (dy<0)and(dy<=-(pb.height*zoom div 2)) then dy:=-(pb.height*zoom div 2)+1;

    if (dx>=0)and(dx<pb.width*zoom div 2) then dx:=x-my_x else
    if (dx>=0)and(dx>=pb.width*zoom div 2) then dx:=(pb.width*zoom div 2)-1;

    if (dy>=0)and(dy<pb.height*zoom div 2) then dy:=y-my_y else
    if (dy>=0)and(dy>=pb.height*zoom div 2) then dy:=(pb.height*zoom div 2)-1;
    pb.Repaint;
  end;
end;

procedure TForm1.PBMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
push:=false;
end;

procedure TForm1.PBPaint(Sender: TObject);
begin
 PB.Canvas.Brush.Color:=clRed;
 Pb.Canvas.Rectangle(zoom*(pb.width div 2 - 20)+dx,zoom*(pb.height div 2 -num[1]*4)+dy,
                     zoom*(pb.width div 2 - 5)+dx,zoom*(pb.height div 2)+dy);
 PB.Canvas.Brush.Color:=clGreen;
 Pb.Canvas.Rectangle(zoom*(pb.width div 2 + 5)+dx,zoom*(pb.height div 2 -num[2]*4)+dy,
                     zoom*(pb.width div 2 + 20)+dx,zoom*(pb.height div 2)+dy);
end;

end.
Если помог, проси поставить минус. Будь оригинален!

Последний раз редактировалось Rin; 14.04.2012 в 06:44.
Rin вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Как правильно составить ER-диаграмму? Cat 1988_88 Помощь студентам 0 16.10.2010 17:20
Delphi и Visio. как разобрать диаграмму по элементам? mau89 Помощь студентам 0 04.08.2010 19:44
Delphi.TCHART.Не могу построить диаграмму Mazyrik Помощь студентам 0 23.05.2010 22:01
Как правильно построить ER диаграмму dymych Помощь студентам 1 29.01.2010 10:43
Как отмасштабировать форму приложения со всеми её компонентами? zmey31313 Общие вопросы Delphi 5 11.12.2009 16:23