📄 unitconverter.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 + -