印刷开版计算器

object FrmCal: TFrmCal
  Left = 428
  Top = 235
  BorderIcons = [biSystemMenu, biMinimize]
  BorderStyle = bsSingle
  Caption = #21360#21047#24320#29256#35745#31639#22120
  ClientHeight = 417
  ClientWidth = 516
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  Position = poDesktopCenter
  OnShow = FormShow
  PixelsPerInch = 96
  TextHeight = 13
  object Label21: TLabel
    Left = 16
    Top = 392
    Width = 281
    Height = 13
    Cursor = crHandPoint
    AutoSize = False
    Caption = #20061#26131#31185#25216' '#29256#26435#25152#26377' http://www.joiny.net'/
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clBlue
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = [fsUnderline]
    ParentFont = False
    OnClick = Label21Click
  end
  object PageControl1: TPageControl
    Left = 0
    Top = 0
    Width = 516
    Height = 377
    ActivePage = TabSheet1
    Align = alTop
    TabOrder = 0
    object TabSheet1: TTabSheet
      Caption = #21360#21047#24320#29256
      object MShape: TShape
        Left = 336
        Top = 128
        Width = 89
        Height = 81
        Brush.Color = clMoneyGreen
      end
      object Label1: TLabel
        Left = 144
        Top = 316
        Width = 361
        Height = 18
        AutoSize = False
        Caption = #32467#26524#65306
        Font.Charset = DEFAULT_CHARSET
        Font.Color = clBlue
        Font.Height = -11
        Font.Name = 'MS Sans Serif'
        Font.Style = [fsBold]
        ParentFont = False
      end
      object Button1: TButton
        Left = 40
        Top = 310
        Width = 75
        Height = 25
        Caption = #35745#31639
        TabOrder = 0
        OnClick = Button1Click
      end
      object Panel1: TPanel
        Left = 227
        Top = 17
        Width = 277
        Height = 281
        BevelInner = bvRaised
        BevelOuter = bvLowered
        TabOrder = 1
      end
      object GroupBox1: TGroupBox
        Left = 8
        Top = 13
        Width = 207
        Height = 82
        Caption = #19978#26426#32440#24352#65306
        TabOrder = 2
        object Label2: TLabel
          Left = 16
          Top = 26
          Width = 24
          Height = 13
          Caption = #38271#65306
        end
        object Label3: TLabel
          Left = 16
          Top = 53
          Width = 24
          Height = 13
          Caption = #23485#65306
        end
        object Edit1: TEdit
          Left = 48
          Top = 22
          Width = 102
          Height = 21
          TabOrder = 0
          Text = '1,194'
          OnChange = Edit1Change
        end
        object Edit2: TEdit
          Left = 48
          Top = 49
          Width = 102
          Height = 21
          TabOrder = 1
          Text = '889'
          OnChange = Edit1Change
        end
        object UpDown2: TUpDown
          Left = 150
          Top = 22
          Width = 15
          Height = 21
          Associate = Edit1
          Min = 1
          Max = 10000
          Position = 1194
          TabOrder = 2
        end
        object UpDown3: TUpDown
          Left = 150
          Top = 49
          Width = 15
          Height = 21
          Associate = Edit2
          Min = 1
          Max = 10000
          Position = 889
          TabOrder = 3
        end
      end
      object GroupBox2: TGroupBox
        Left = 8
        Top = 104
        Width = 208
        Height = 81
        Caption = #21360#21697#22823#23567#65306
        TabOrder = 3
        object Label4: TLabel
          Left = 16
          Top = 27
          Width = 24
          Height = 13
          Caption = #38271#65306
        end
        object Label5: TLabel
          Left = 16
          Top = 54
          Width = 24
          Height = 13
          Caption = #23485#65306
        end
        object Edit3: TEdit
          Left = 48
          Top = 23
          Width = 102
          Height = 21
          TabOrder = 0
          Text = '285'
          OnChange = Edit1Change
        end
        object Edit4: TEdit
          Left = 48
          Top = 50
          Width = 102
          Height = 21
          TabOrder = 1
          Text = '210'
          OnChange = Edit1Change
        end
        object UpDown4: TUpDown
          Left = 150
          Top = 23
          Width = 15
          Height = 21
          Associate = Edit3
          Min = 1
          Max = 10000
          Position = 285
          TabOrder = 2
        end
        object UpDown5: TUpDown
          Left = 150
          Top = 50
          Width = 15
          Height = 21
          Associate = Edit4
          Min = 1
          Max = 10000
          Position = 210
          TabOrder = 3
        end
      end
      object GroupBox3: TGroupBox
        Left = 8
        Top = 192
        Width = 209
        Height = 107
        Caption = #21442#25968#65306
        TabOrder = 4
        object Label6: TLabel
          Left = 16
          Top = 26
          Width = 60
          Height = 13
          Caption = #20986#12288#12288#34880#65306
        end
        object Label7: TLabel
          Left = 16
          Top = 54
          Width = 60
          Height = 13
          Caption = #32437#21521#21676#21475#65306
        end
        object Label8: TLabel
          Left = 16
          Top = 82
          Width = 60
          Height = 13
          Caption = #27178#21521#21676#21475#65306
        end
        object UpDown1: TUpDown
          Left = 184
          Top = 22
          Width = 15
          Height = 21
          Associate = Edit5
          Max = 1000
          TabOrder = 0
        end
        object Edit5: TEdit
          Left = 82
          Top = 22
          Width = 102
          Height = 21
          TabOrder = 1
          Text = '0'
          OnChange = Edit1Change
        end
        object Edit6: TEdit
          Left = 82
          Top = 50
          Width = 102
          Height = 21
          TabOrder = 2
          Text = '0'
          OnChange = Edit1Change
        end
        object UpDown6: TUpDown
          Left = 184
          Top = 50
          Width = 15
          Height = 21
          Associate = Edit6
          Max = 1000
          TabOrder = 3
        end
        object Edit7: TEdit
          Left = 81
          Top = 78
          Width = 102
          Height = 21
          TabOrder = 4
          Text = '0'
          OnChange = Edit1Change
        end
        object UpDown7: TUpDown
          Left = 183
          Top = 78
          Width = 15
          Height = 21
          Associate = Edit7
          Max = 1000
          TabOrder = 5
        end
      end
    end
    object TabSheet2: TTabSheet
      Caption = #32440#24352#21333#20215
      ImageIndex = 1
      object Label14: TLabel
        Left = 16
        Top = 130
        Width = 300
        Height = 16
        AutoSize = False
        Caption = #20196#37325#65306
        Font.Charset = DEFAULT_CHARSET
        Font.Color = clBlue
        Font.Height = -13
        Font.Name = 'MS Sans Serif'
        Font.Style = [fsBold]
        ParentFont = False
      end
      object Label15: TLabel
        Left = 16
        Top = 164
        Width = 300
        Height = 16
        AutoSize = False
        Caption = #20196#25968#65306
        Font.Charset = DEFAULT_CHARSET
        Font.Color = clBlue
        Font.Height = -13
        Font.Name = 'MS Sans Serif'
        Font.Style = [fsBold]
        ParentFont = False
      end
      object Label16: TLabel
        Left = 16
        Top = 199
        Width = 300
        Height = 16
        AutoSize = False
        Caption = #21544#20215#65306
        Font.Charset = DEFAULT_CHARSET
        Font.Color = clBlue
        Font.Height = -13
        Font.Name = 'MS Sans Serif'
        Font.Style = [fsBold]
        ParentFont = False
      end
      object Label17: TLabel
        Left = 16
        Top = 234
        Width = 300
        Height = 16
        AutoSize = False
        Caption = #20196#20215#65306
        Font.Charset = DEFAULT_CHARSET
        Font.Color = clBlue
        Font.Height = -13
        Font.Name = 'MS Sans Serif'
        Font.Style = [fsBold]
        ParentFont = False
      end
      object Label18: TLabel
        Left = 16
        Top = 304
        Width = 300
        Height = 16
        AutoSize = False
        Caption = #24352#20215#65306
        Font.Charset = DEFAULT_CHARSET
        Font.Color = clBlue
        Font.Height = -13
        Font.Name = 'MS Sans Serif'
        Font.Style = [fsBold]
        ParentFont = False
      end
      object Label19: TLabel
        Left = 16
        Top = 269
        Width = 300
        Height = 16
        AutoSize = False
        Caption = #24179#26041#20215#65306
        Font.Charset = DEFAULT_CHARSET
        Font.Color = clBlue
        Font.Height = -13
        Font.Name = 'MS Sans Serif'
        Font.Style = [fsBold]
        ParentFont = False
      end
      object GroupBox4: TGroupBox
        Left = 8
        Top = 5
        Width = 489
        Height = 108
        Caption = #32440#24352#21442#25968#65306
        TabOrder = 0
        object Label9: TLabel
          Left = 33
          Top = 26
          Width = 24
          Height = 13
          Caption = #38271#65306
        end
        object Label10: TLabel
          Left = 33
          Top = 53
          Width = 24
          Height = 13
          Caption = #23485#65306
        end
        object Label11: TLabel
          Left = 21
          Top = 81
          Width = 36
          Height = 13
          Caption = #20811#37325#65306
        end
        object Label12: TLabel
          Left = 264
          Top = 26
          Width = 36
          Height = 13
          Caption = #21544#20215#65306
        end
        object Label13: TLabel
          Left = 264
          Top = 53
          Width = 36
          Height = 13
          Caption = #20196#20215#65306
        end
        object Edit8: TEdit
          Left = 60
          Top = 22
          Width = 102
          Height = 21
          TabOrder = 0
          Text = '1194'
          OnChange = Button2Click
        end
        object Edit9: TEdit
          Left = 60
          Top = 49
          Width = 102
          Height = 21
          TabOrder = 1
          Text = '889'
          OnChange = Button2Click
        end
        object UpDown8: TUpDown
          Left = 162
          Top = 22
          Width = 15
          Height = 21
          Associate = Edit8
          Min = 1
          Max = 10000
          Position = 1194
          TabOrder = 2
        end
        object UpDown9: TUpDown
          Left = 162
          Top = 49
          Width = 15
          Height = 21
          Associate = Edit9
          Min = 1
          Max = 10000
          Position = 889
          TabOrder = 3
        end
        object Edit10: TEdit
          Left = 60
          Top = 77
          Width = 117
          Height = 21
          TabOrder = 4
          Text = '157'
          OnChange = Button2Click
        end
        object Edit11: TEdit
          Left = 305
          Top = 22
          Width = 102
          Height = 21
          TabOrder = 5
          OnChange = Edit11Change
        end
        object Edit12: TEdit
          Left = 305
          Top = 49
          Width = 102
          Height = 21
          TabOrder = 6
          OnChange = Edit12Change
        end
      end
      object Button2: TButton
        Left = 424
        Top = 320
        Width = 75
        Height = 25
        Caption = #35745#31639
        TabOrder = 1
        OnClick = Button2Click
      end
    end
    object TabSheet3: TTabSheet
      Caption = #20070#33034#21402#24230
      ImageIndex = 2
      object Label20: TLabel
        Left = 16
        Top = 130
        Width = 300
        Height = 16
        AutoSize = False
        Caption = #21402#24230#65306
        Font.Charset = DEFAULT_CHARSET
        Font.Color = clBlue
        Font.Height = -13
        Font.Name = 'MS Sans Serif'
        Font.Style = [fsBold]
        ParentFont = False
      end
      object GroupBox5: TGroupBox
        Left = 8
        Top = 5
        Width = 489
        Height = 68
        Caption = #20070#31821#21442#25968#65306
        TabOrder = 0
        object Label22: TLabel
          Left = 21
          Top = 33
          Width = 36
          Height = 13
          Caption = #20811#37325#65306
        end
        object Label23: TLabel
          Left = 264
          Top = 33
          Width = 36
          Height = 13
          Caption = #65328#25968#65306
        end
        object Edit15: TEdit
          Left = 60
          Top = 29
          Width = 117
          Height = 21
          TabOrder = 0
          Text = '157'
          OnChange = Button3Click
        end
        object Edit16: TEdit
          Left = 305
          Top = 29
          Width = 102
          Height = 21
          TabOrder = 1
          OnChange = Button3Click
        end
      end
      object Button3: TButton
        Left = 424
        Top = 320
        Width = 75
        Height = 25
        Caption = #35745#31639
        TabOrder = 1
        OnClick = Button3Click
      end
    end
  end
  object BitBtn1: TBitBtn
    Left = 408
    Top = 384
    Width = 75
    Height = 25
    Caption = #36864#20986
    TabOrder = 1
    Kind = bkClose
  end
end

 

 

 

 

unit UntCal;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, StrUtils, ExtCtrls, Buttons, ComCtrls, Menus, Math,ShellApi;

type
  TFrmCal = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    MShape: TShape;
    Label1: TLabel;
    Button1: TButton;
    Panel1: TPanel;
    GroupBox1: TGroupBox;
    Label2: TLabel;
    Label3: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    UpDown2: TUpDown;
    UpDown3: TUpDown;
    GroupBox2: TGroupBox;
    Label4: TLabel;
    Label5: TLabel;
    Edit3: TEdit;
    Edit4: TEdit;
    UpDown4: TUpDown;
    UpDown5: TUpDown;
    GroupBox3: TGroupBox;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    UpDown1: TUpDown;
    Edit5: TEdit;
    Edit6: TEdit;
    UpDown6: TUpDown;
    Edit7: TEdit;
    UpDown7: TUpDown;
    BitBtn1: TBitBtn;
    GroupBox4: TGroupBox;
    Label9: TLabel;
    Label10: TLabel;
    Edit8: TEdit;
    Edit9: TEdit;
    UpDown8: TUpDown;
    UpDown9: TUpDown;
    Label11: TLabel;
    Edit10: TEdit;
    Label12: TLabel;
    Edit11: TEdit;
    Label13: TLabel;
    Edit12: TEdit;
    Label14: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    Label17: TLabel;
    Label18: TLabel;
    Label19: TLabel;
    Button2: TButton;
    GroupBox5: TGroupBox;
    Label22: TLabel;
    Label23: TLabel;
    Edit15: TEdit;
    Edit16: TEdit;
    Label20: TLabel;
    Button3: TButton;
    Label21: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Edit11Change(Sender: TObject);
    procedure Edit12Change(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Label21Click(Sender: TObject);
  private
    procedure count(Total: integer; Blong, BWide, Slong, SWide: real);
    procedure DrawShape(mode: string; x, y: real; TotLeft, TotTop: integer);
    procedure ClearShape;
    function RoundEx(f: Real; QtyDecimal: Integer): Real;
  public
    max, MW, MH: integer;
    mode1: string;
    mode2: string;
    TBlong, TBWide, TSlong, TSWide: real;
  end;

var
  FrmCal: TFrmCal;

implementation

{$R *.dfm}

function TFrmCal.RoundEx(f: Real; QtyDecimal: Integer): Real;
var
  i: Integer;
  k, j: Real;
  function x10(i: Integer): Integer;
  var
    j: Integer;
  begin
    result := 1;
    for j := 1 to i do
    begin
      Result := Result * 10;
    end;
  end;
begin
  if f = 0 then
    Result := 0
  else
    if QtyDecimal = 0 then
      Result := Ceil(f)
    else
    begin
      i := Trunc(f);
      j := Frac(f);
      k := j * (x10(QtyDecimal));
      k := Ceil(k);
      k := k / (x10(QtyDecimal));
      Result := i + k;
    end;
end;

procedure TFrmCal.count(Total: integer; Blong, BWide, Slong, SWide: real);
begin
  //方式一
  if (Blong >= SWide) and (BWide >= Slong) then
  begin
    Total := total + trunc(Blong / SWide) * trunc(BWide / Slong);
    mode1 := mode1 + '1';
    count(total, Blong, BWide - trunc(BWide / Slong) * Slong, Slong, SWide);
    Total := total - trunc(Blong / SWide) * trunc(BWide / Slong);
    mode1 := leftstr(mode1, length(mode1) - 1);
  end
  else
    if max < total then
    begin
      max := total;
      mode2 := mode1;
    end;
  //方式二
  if (Blong >= Slong) and (BWide >= Swide) then
  begin
    total := total + trunc(Blong / Slong) * trunc(BWide / SWide);
    mode1 := mode1 + '2';
    count(total, Blong, BWide - trunc(BWide / SWide) * SWide, Slong, Swide);
    total := total - trunc(Blong / Slong) * trunc(BWide / SWide);
    mode1 := leftstr(mode1, length(mode1) - 1);
  end
  else
    if (max < total) then
    begin
      max := total;
      mode2 := mode1;
    end;
  // 方式三
  if (Blong >= Swide) and (BWide >= Slong) then
  begin
    total := total + trunc(BWide / Slong) * trunc(Blong / SWide);
    mode1 := mode1 + '3';
    count(total, Blong - trunc(Blong / SWide) * SWide, BWide, Slong, SWide);
    total := total - trunc(BWide / Slong) * trunc(Blong / SWide);
    mode1 := leftstr(mode1, length(mode1) - 1);
  end
  else
    if max < total then
    begin
      max := total;
      mode2 := mode1;
    end;
  //方式四
  if (BLong >= Slong) and (BWide >= SWide) then
  begin
    total := total + trunc(BWIde / SWide) * trunc(Blong / SLong);
    mode1 := mode1 + '4';
    count(total, Blong - trunc(Blong / SLong) * Slong, BWide, Slong, SWide);
    total := total - trunc(BWIde / SWide) * trunc(Blong / SLong);
    mode1 := leftstr(mode1, length(mode1) - 1);
  end
  else
    if max < total then
    begin
      max := total;
      mode2 := mode1;
    end;
end;

procedure TFrmCal.Button1Click(Sender: TObject);
var
  i, j: integer;
  M1, M2, func: string;
begin
  TBLong := UpDown2.Position - UpDown6.Position;
  TBWide := UpDown3.Position - UpDown7.Position;
  if UpDown4.Position > UpDown5.Position then
  begin
    TSlong := UpDown4.Position + UpDown1.Position * 2;
    TSWide := UpDown5.Position + UpDown1.Position * 2;
  end
  else
  begin
    TSWide := UpDown4.Position + UpDown1.Position * 2;
    TSlong := UpDown5.Position + UpDown1.Position * 2;
  end;
  if (TBLong * TBWide) / (TSLong * TSWide) > 500 then
    if Application.MessageBox('开版数较大,电脑计算速度较慢,是否继续计算?', '询问', MB_OKCANCEL + MB_ICONQUESTION + MB_DEFBUTTON1) = IDCANCEL then
      exit;
  ClearShape;
  MShape.Parent := Panel1;
  MShape.Left := 5;
  MShape.Top := 5;
  if UpDown2.Position >= UpDown3.Position then
  begin
    MShape.Width := Panel1.Width - 10;
    MShape.Height := trunc((MShape.Width) / (UpDown2.Position / UpDown3.Position))
  end
  else
  begin
    MShape.Height := Panel1.Height - 10;
    MShape.Width := trunc((MShape.Height) / (UpDown3.Position / UpDown2.Position))
  end;

  Max := 0;
  Mode2 := '';
  count(0, TBLong, TBWide, TSlong, TSWide);
  M1 := copy(mode2, 1, 1);
  M2 := Copy(mode2, 2, 1);
  MW := MShape.Width;
  MH := MShape.Height;
  if (M1 = '1') then
  begin
    DrawShape(M1, TBWide / TSlong, TBlong / TSWide, 0, trunc(MH / UpDown3.Position * UpDown7.Position));
    func := func + intTostr(trunc(TBWide / TSlong)) + '*' + intTostr(trunc(TBlong / TSWide));
  end;
  if (M1 = '2') then
  begin
    DrawShape(M1, TBWIde / TSWide, TBLong / TSLong, 0, trunc(MH / UpDown3.Position * UpDown7.Position));
    func := func + intTostr(trunc(TBWIde / TSWide)) + '*' + intTostr(trunc(TBLong / TSLong));
  end;
  if (M1 = '3') then
  begin
    DrawShape(M1, TBlong / TSWide, TBWide / TSlong, trunc(MW / UpDown2.Position * UpDown6.Position), 0);
    func := func + intTostr(trunc(TBWide / TSlong)) + '*' + intTostr(trunc(TBlong / TSWide));
  end;
  if (M1 = '4') then
  begin
    DrawShape(M1, TBWIde / TSWide, TBLong / TSLong, trunc(MW / UpDown2.Position * UpDown6.Position), 0);
    func := func + intTostr(trunc(TBWIde / TSWide)) + '*' + intTostr(trunc(TBLong / TSLong));
  end;
  if (M2 = '1') or (M2 = '3') then
  begin
    i := trunc(TBLong - (TSLong * trunc(TBlong / TSLong)));
    MW := trunc(MShape.Width / TBLong * i);
    DrawShape(M2, TBWide / TSlong, i / TSWide, trunc(MShape.Width / TBLong * (TSLong * trunc(TBlong / TSLong)) + MW / UpDown2.Position * UpDown6.Position), 0);
    func := func + '+' + intTostr(trunc(TBWide / TSlong)) + '*' + intTostr(trunc(i / TSWide))
  end;

  if (M2 = '2') or (M2 = '4') then
  begin
    j := trunc(TBWide - (TSLong * trunc(TBWide / TSLong)));
    MH := trunc(MShape.Height / TBWide * j);
    DrawShape(M2, j / TSWide, TBlong / TSLong, 0, trunc(MShape.Height / TBWide * (TSLong * trunc(TBWide / TSLong)) + MH / UpDown3.Position * UpDown7.Position));
    func := func + '+' + intTostr(trunc(j / TSWide)) + '*' + intTostr(trunc(TBlong / TSLong))
  end;
  //  Label1.Caption := '结果:' + func + '=' + intTostr(max) + '   算法:' + mode2;
  Label1.Caption := '结果:' + func + '=' + intTostr(max) + '   纸张利用率:' + floatTostr(RoundEx((TSLong * TSWide * max) / (TBLong * TBWide), 4) * 100) + '%'
end;

procedure TFrmCal.DrawShape(mode: string; x, y: real; TotLeft, TotTop: integer);
var
  Shape: TShape;
  i, j, TLeft, TTop: integer;
begin
  TLeft := TotLeft;
  TTop := TotTop;
  for i := 1 to trunc(x) do
  begin
    for j := 1 to trunc(y) do
    begin
      Shape := TShape.Create(nil);
      Shape.Pen.Color := Clblue;
      Shape.Parent := Panel1;
      Shape.Width := trunc(MW / y);
      Shape.Height := trunc(MH / x);
      if (mode = '1') or (mode = '2') then
        Shape.Pen.Width := trunc(UpDown1.Position * shape.Width / UpDown2.Position)
      else
        Shape.Pen.Width := trunc(UpDown1.Position * shape.Height / UpDown3.Position);
      Shape.Left := Mshape.Left + trunc(Totleft);
      Shape.Top := MShape.Top + trunc(TotTop);
      Totleft := TotLeft + Shape.Width;
      Shape.Name := 'Shape' + IntTostr(i) + intTostr(j);
    end;
    TotLeft := TLeft;
    TotTop := TotTop + Shape.Height;
  end;

end;

procedure TFrmCal.ClearShape;
var
  i: Integer;
begin
  for i := 1 to Panel1.ControlCount - 1 do
    if Panel1.Controls[1].Name <> 'MShape' then
      tShape(Panel1.Controls[1]).Free;
end;

procedure TFrmCal.FormShow(Sender: TObject);
begin
  MShape.Parent := Panel1;
  MShape.Left := 5;
  MShape.Top := 5;
  if UpDown2.Position >= UpDown3.Position then
  begin
    MShape.Width := Panel1.Width - 10;
    MShape.Height := trunc((MShape.Width) / (UpDown2.Position / UpDown3.Position))
  end
  else
  begin
    MShape.Height := Panel1.Height - 10;
    MShape.Width := trunc((MShape.Height) / (UpDown3.Position / UpDown2.Position))
  end;
end;

procedure TFrmCal.Edit1Change(Sender: TObject);
begin
  Button1.Click;
end;

procedure TFrmCal.Button2Click(Sender: TObject);
begin
  if Updown8.Position <= 0 then exit;
  if Updown9.Position <= 0 then exit;
  if strTofloat(Edit10.Text) <= 0 then exit;
  if (Edit11.Text = '') and (Edit12.Text = '') then exit;
  Label14.Caption := '令重:' + floatTostr(RoundEx((Updown8.Position / 1000) *
    (Updown9.Position / 1000) * strTofloat(Edit10.Text) / 1000 * 500, 2)) + '  千克/令';
  Label15.Caption := '令数:' + floatTostr(RoundEx(1000 / ((Updown8.Position / 1000) *
    (Updown9.Position / 1000) * strTofloat(Edit10.Text) / 1000 * 500), 2)) + '  令/吨';
  if Edit11.Text <> '' then
  begin
    Label17.Caption := '令价:' + floatTostr(RoundEx(((Updown8.Position / 1000) *
      (Updown9.Position / 1000)) / 2 * strTofloat(Edit10.Text) *
      strTofloat(Edit11.Text) / 1000, 4)) + '  元/令';
    Label18.Caption := '张价:' + floatTostr(RoundEx(((Updown8.Position / 1000) *
      (Updown9.Position / 1000)) / 2 * strTofloat(Edit10.Text) *
      strTofloat(Edit11.Text) / 1000 / 500, 4)) + '  元/张';
    Label19.Caption := '平方价:' + floatTostr(RoundEx(((Updown8.Position / 1000) *
      (Updown9.Position / 1000)) / 2 * strTofloat(Edit10.Text) *
      strTofloat(Edit11.Text) / 1000 / 500 / ((Updown8.Position / 1000) *
      (Updown9.Position / 1000)), 4)) + '  元/平方米';
    Label16.Caption := '吨价:' + Edit11.Text + '  元/吨';
  end;
  if Edit12.Text <> '' then
  begin
    Label17.Caption := '令价:' + Edit12.Text + '  元/令';
    Label18.Caption := '张价:' + floatTostr(RoundEx(strTofloat(Edit12.Text) / 500, 4)) + '  元/张';
    Label19.Caption := '平方价:' + floatTostr(RoundEx(strTofloat(Edit12.Text) / 500 / ((Updown8.Position / 1000) *
      (Updown9.Position / 1000)), 4)) + '  元/平方米';
    Label16.Caption := '吨价:' + floatTostr(RoundEx((1000 / ((Updown8.Position / 1000) *
      (Updown9.Position / 1000) * strTofloat(Edit10.Text) / 1000 * 500) * strTofloat(Edit12.Text)), 2)) + '  元/吨';
  end;
end;

procedure TFrmCal.Edit11Change(Sender: TObject);
begin
  if Edit11.Text <> '' then
    Edit12.Text := '';
  Button2.Click;
end;

procedure TFrmCal.Edit12Change(Sender: TObject);
begin
  if Edit12.Text <> '' then
    Edit11.Text := '';
  Button2.Click;
end;

procedure TFrmCal.Button3Click(Sender: TObject);
begin
  if Edit15.Text = '' then exit;
  if (Edit16.Text = '') then exit;
  Label20.Caption := '厚度:' + floatTostr(RoundEx(0.135 * strToFloat(Edit16.Text) / 2 * strToFloat(Edit15.Text) / 100, 2)) + '  MM'
end;

procedure TFrmCal.Label21Click(Sender: TObject);
begin
 ShellExecute(Handle, PChar('OPEN'), PChar('http://www.joiny.net'), nil, nil, SW_SHOWMAXIMIZED);
end;

end.

 

 

posted on 2010-08-19 13:58  jxgxy  阅读(841)  评论(0编辑  收藏  举报

导航