⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unitconverter.pas

📁 Metric Converter is an useful tool for metric conversion, weight conversion, area conversion, mass c
💻 PAS
字号:
unit UnitConverter;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ToolWin, StdCtrls, ExtCtrls, Buttons, ImgList, Grids, ValEdit;

type
  TForm1 = class(TForm)
    Panel2: TPanel;
    Panel4: TPanel;
    ToolBar3: TToolBar;
    ToolButton7: TToolButton;
    Panel1: TPanel;
    L1: TLabel;
    L2: TLabel;
    bCalc: TSpeedButton;
    ev1: TEdit;
    ev2: TEdit;
    ImageList1: TImageList;
    ToolButton1: TToolButton;
    UpDown1: TUpDown;
    AddFunPanel: TPanel;
    ListBox1: TListBox;
    VLE1: TValueListEditor;
    ToolButton2: TToolButton;
    cbCat: TComboBox;
    tbInv: TToolButton;
    UpDown2: TUpDown;
    Label4: TLabel;
    ToolBar1: TToolBar;
    tbAdd: TToolButton;
    tbSave: TToolButton;
    Panel3: TPanel;
    Label2: TLabel;
    Label3: TLabel;
    Label1: TLabel;
    ED1: TEdit;
    ED2: TEdit;
    ED3: TEdit;
    Panel5: TPanel;
    eSearch: TEdit;
    Label5: TLabel;
    ToolButton4: TToolButton;
    ToolButton3: TToolButton;
    cbEdit: TCheckBox;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    procedure bCalcClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ToolButton7Click(Sender: TObject);
    procedure VLE1Click(Sender: TObject);
    procedure ToolButton8Click(Sender: TObject);
    procedure ToolButton2Click(Sender: TObject);
    procedure cbEditClick(Sender: TObject);
    procedure tbSortListClick(Sender: TObject);
    procedure tbInvClick(Sender: TObject);
    procedure UpDown2ChangingEx(Sender: TObject; var AllowChange: Boolean;
      NewValue: Smallint; Direction: TUpDownDirection);
    procedure UpDown1ChangingEx(Sender: TObject; var AllowChange: Boolean;
      NewValue: Smallint; Direction: TUpDownDirection);
    procedure tbAddClick(Sender: TObject);
    procedure tbSaveClick(Sender: TObject);
    procedure eSearchChange(Sender: TObject);
    procedure ToolButton4Click(Sender: TObject);
    procedure ToolButton6Click(Sender: TObject);
    procedure cbCatSelect(Sender: TObject);
  private
    { Private declarations }
    Factor1, Value1, Result1: Extended;
    Inv: Boolean;
    LB1s, ExeDir, DataDir: string;
    pod1, pod2: Integer;
    procedure LoadCategories(Sender: TObject);
    procedure SaveCat(Sender: TObject);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.cbCatSelect(Sender: TObject);
begin
  LoadCategories(Sender);
  bCalcClick(Sender);
  eSearch.Text := '';
  if Panel5.Visible then
    eSearch.SetFocus;
end;

procedure TForm1.cbEditClick(Sender: TObject);
begin
  if cbEdit.Checked then
  begin
    VLE1.Options := VLE1.Options - [goRowSelect];
    VLE1.Color := $00A283FE;
  end
  else
  begin
    VLE1.Options := VLE1.Options + [goRowSelect];
    VLE1.Color := clWindow;
  end;
  SaveCat(Sender);
end;

procedure TForm1.eSearchChange(Sender: TObject);
var
  rowx, i, l: integer;
  s, s1: string;
begin
  s := eSearch.Text;
  if s = '' then
    exit;
  l := length(s);
  s1 := '';
  for i := 0 to VLE1.RowCount - 1 do
  begin
    if pos(uppercase(s[l]), uppercase(VLE1.Strings[i])[l]) = 1 then
    begin
      s1 := VLE1.Keys[i];
      Break;
    end;
  end;
  if s1 <> '' then
    if VLE1.FindRow(s1, rowx) then
      VLE1.Row := rowx;
end;

procedure TForm1.LoadCategories(Sender: TObject);
var
  FN1, FCat: string;
begin
  VLE1.Strings.Clear;
  VLE1.Row := 0;
  FCat := Trim(cbCat.Items[cbCat.ItemIndex]);
  FN1 := DataDir + 'cc' + FCat + '.txt';
  if FileExists(FN1) then
    VLE1.Strings.LoadFromFile(FN1)
  else
  begin
     // showmessage('No Items yet for this category, you can add your ');
    exit;
  end;

  ev1.Text := FloatToStrF(StrToFloat(EV1.Text), fffixed, 14, pod1);
  if VLE1.RowCount > 0 then
  begin
    VLE1.Col := 0;
    VLE1Click(Sender);
  end;
end;

procedure TForm1.SaveCat(Sender: TObject);
var
  FN1, FCat: string;
begin
  FCat := Trim(cbCat.Items[cbCat.ItemIndex]);
  FN1 := DataDir + 'cc' + FCat + '.txt';
 // if FileExists(FN1) then
  VLE1.Strings.SaveToFile(FN1);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ExeDir := ExtractFilePath(Application.ExeName);
  DataDir := ExeDir + 'ccData\';
  if not SysUtils.DirectoryExists(DataDir) then
    CreateDir(DataDir);

  Inv := False;
  pod1 := 2;
  Pod2 := 2;

  cbCat.Items.LoadFromFile(DataDir + 'Categories.txt');
  cbCat.ItemIndex := 0;

  LoadCategories(Sender);

end;

procedure TForm1.ToolButton2Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.ToolButton4Click(Sender: TObject);
begin
  Panel5.Visible := not Panel5.Visible;
  eSearch.Text := '';
  if Panel5.Visible then
    eSearch.SetFocus;
end;

procedure TForm1.ToolButton6Click(Sender: TObject);
begin
  Showmessage('Custom Converter'#13#10 + #13#10 +
  'Fancy Delphi Application Contest 2008' + #13#10 + 'PWalker, complied in Delphi 7 Personal                     ');
end;

procedure TForm1.tbAddClick(Sender: TObject);
var
  s: string;
begin
  s := ED1.Text + ' To ' + ED2.Text + ' ' + ED3.Text;
  VLE1.InsertRow(ED1.Text + ' To ' + ED2.Text, ED3.Text, False);
end;

procedure TForm1.tbSaveClick(Sender: TObject);
begin
  SaveCat(Sender);
end;

procedure TForm1.tbInvClick(Sender: TObject);
begin
  Inv := not Inv;
  if Inv then
    Label4.Font.Style := Label4.Font.Style + [fsBold]
  else
    Label4.Font.Style := Label4.Font.Style - [fsBold];

  VLE1Click(Sender);
  bCalcClick(Sender);
end;

procedure TForm1.tbSortListClick(Sender: TObject);
var
  SL: TStringList;
begin
  SL := TStringList.Create;
  try
    SL.Assign(VLE1.Strings);
    SL.Sort;
    VLE1.Strings := SL;
  finally
    SL.Free;
    SaveCat(Sender);
  end;
end;

procedure TForm1.ToolButton7Click(Sender: TObject);
begin
  AddFunPanel.Visible := not AddFunPanel.Visible;
  if AddFunPanel.Visible then
    VLE1.DisplayOptions := VLE1.DisplayOptions + [doColumnTitles]
  else
    VLE1.DisplayOptions := VLE1.DisplayOptions - [doColumnTitles];
end;

procedure TForm1.ToolButton8Click(Sender: TObject);
begin
  if MessageDlg('Delete selected item?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
    VLE1.DeleteRow(VLE1.Row);
end;

procedure TForm1.UpDown1ChangingEx(Sender: TObject; var AllowChange: Boolean;
  NewValue: Smallint; Direction: TUpDownDirection);
begin
  if Direction = updUp then
    pod1 := pod1 + 1;

  if Direction = updDown then
    pod1 := pod1 - 1;

  ev1.Text := FloatToStrF(Value1, fffixed, 14, pod1);

end;

procedure TForm1.UpDown2ChangingEx(Sender: TObject; var AllowChange: Boolean;
  NewValue: Smallint; Direction: TUpDownDirection);
begin
  if Direction = updUp then
    pod2 := pod2 + 1;

  if Direction = updDown then
    pod2 := pod2 - 1;

  ev2.Text := FloatToStrF(Result1, fffixed, 14, pod2);
end;

procedure TForm1.VLE1Click(Sender: TObject);
var
  s: string;
begin
  try
    //Feet To Metres 0.3048

    LB1s := VLE1.Keys[VLE1.Row]; //LB1.Items[LB1.ItemIndex];
   // remove double spaces
    S := LB1s;

    if s = '' then
    begin
      L1.Caption := 'nil';
      L2.Caption := 'nil';
      Factor1 := 1;
      Value1 := 1;
      Result1 := 1;
      exit;
    end;

  //  S := S + '=' ;


    if Inv then
    begin
      L2.Caption := copy(S, 1, pos(' To ', S));
      delete(S, 1, pos(' To ', S) + 3);
      L1.Caption := S;
      S := Trim(S);
      Factor1 := StrToFloat(VLE1.Values[VLE1.Keys[VLE1.Row]]);
    //  if Factor1 <> 0 then
      Factor1 := 1 / Factor1;
  //  EV1.Text := '';
    end
    else
    begin
      L1.Caption := copy(S, 1, pos(' To ', S));
      delete(S, 1, pos(' To ', S) + 3);
      L2.Caption := S;
      S := Trim(S);
      Factor1 := StrToFloat(VLE1.Values[VLE1.Keys[VLE1.Row]]);

   // EV2.Text := '';
    end;


    bCalcClick(Sender);
  except
     //
  end;

end;

procedure TForm1.bCalcClick(Sender: TObject);
begin
  try
    Value1 := StrToFloat(EV1.Text);

    Result1 := Value1 * Factor1;

    ev2.Text := FloatToStrF(Result1, fffixed, 14, pod2);
  except
    //
  end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -