Эксперт
Профиль
Группа: Завсегдатай
Сообщений: 1121
Регистрация: 19.11.2005
Где: Планета земля
Репутация: нет
Всего: 12
|
А почему я и здесь несмог прекрепить фаил  Тогда вот код но там ещё ресурс нужен и мама форма. Основная программа | Код |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, XPMan;
type
TForm1 = class(TForm)
FNImage1: TImage;
FNImage2: TImage;
FNButton: TButton;
FNCBC: TComboBox;
FNCBLR: TComboBox;
FNCBFc: TComboBox;
FNC: TLabeledEdit;
FNLR: TLabeledEdit;
FNFc: TLabeledEdit;
FNGB1: TGroupBox;
FNRG2: TRadioGroup;
FNRG1: TRadioGroup;
procedure FNCBKeyPress(Sender: TObject; var Key: Char);
procedure FNButtonClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FNChange(Sender: TObject);
procedure FNKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FN;
procedure FNRGClick(Sender: TObject);
procedure FNCBSelect(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
const
ArL : array[0..2] of String =('мкГн','мГн','Гн');
ArR : array[0..3] of String =('Ом','кОм','мОм','гОм');
var
C,LR,Fc,CCB,LRCB,FcCB:Real;
K,KLR,A,B:Byte;
Form1: TForm1;
implementation
{$R *.dfm}
{$R Pics.res}
procedure TForm1.FormCreate(Sender: TObject);
begin
Top:=0;
Left:=(Screen.Width-Width) div 2;
FNImage2.Picture.Bitmap.LoadFromResourceName(hInstance, 'PIC1');
end;
procedure TForm1.FNCBKeyPress(Sender: TObject; var Key: Char);
begin
Key:=#13;
end;
procedure TForm1.FNChange(Sender: TObject);
const WrongSepArr : array[0..1] of char =('.',','); //создаём константу - массив для хранения символов, которые надо преобразовать в разделитель
Var
CurStr: String;
Counter,SelPos,SeparatorPos :Integer;
begin
SelPos:=TLabeledEdit(Sender).SelStart; //положение курсора
CurStr:=PChar(TLabeledEdit(Sender).Text);//Текст из эдита, который изменён
if length(curStr)<1 then Exit; //Проверка длины
for counter := 0 to 1 do //Перечисление по массиву
if WrongSepArr[counter]<> DecimalSeparator then
While Pos(WrongSepArr[counter],CurStr)>0 do //ищем данный элемент масива в тексте
CurStr[Pos(WrongSepArr[counter],CurStr)]:=DecimalSeparator;//Заменяем на сепаратор
SeparatorPos:=Pos(DecimalSeparator,CurStr); //Ищем первый сепаратор
for Counter:= Length(CurStr) downto 2 do //Перечисление по строке от конца до 2 элемента (обратный, т.к. может быть удалены символы и как следствие - уменьшина длина)
Begin
if (curStr[Counter] in [DecimalSeparator])and(Counter=SeparatorPos) then //если сепаратор и он не первый
curStr[Counter] := DecimalSeparator //удаляем
else
if not (curStr[Counter] in ['0'..'9','E','e','-','+']) then //иначе ели не разрешённый символ
Begin
Delete(CurStr,counter,1); //удаляем
dec(SelPos); //Уменьшить на 1
End;
End;
if (curStr[1] in [DecimalSeparator])and(SeparatorPos=1) then //Если первый знак . или , то поставить 0,
Begin
curStr[1]:=DecimalSeparator;
insert('0',curStr,0);
inc(SelPos); //Увеличить на 1
End;
if (curStr[length(curStr)]='E')or(curStr[length(curStr)]='e') then
Delete(CurStr,length(curStr),1); //Если последний символ E то удаляем его
if (curStr[length(curStr)]='-')or(curStr[length(curStr)]='+') then
Delete(CurStr,length(curStr),1); //Если последний символ знак то удаляем его
if length(curStr)>=2 then //Если длина больше 1
if (curStr[1] in ['+','-'])and(curStr[2] in [DecimalSeparator]) then //Если первый символ знак
Begin
insert('0',curStr,2); //Вставить 0 вторым символом
inc(SelPos); //Увеличить на 1
End;
if not (curStr[1] in ['0'..'9','+','-']) then //Если первый сивол запрещён
Delete(CurStr,1,1); //Удалить
While (length(curStr)>=2)and(curStr[1]='0')and(curStr[2]<>DecimalSeparator)do //удалить нули в начале числа
delete(CurStr,1,1); //Удалить
While (length(curStr)>=3)and(curStr[1]in['+','-'])and(curStr[2]='0')and(curStr[3]<>DecimalSeparator)do //удалить нули в начале числа, если первый символ - знак
delete(CurStr,2,1); //Удалить
TLabeledEdit(Sender).Text:=CurStr;
TLabeledEdit(Sender).SelStart:=SelPos;
end;
procedure TForm1.FNKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
FN;
end;
procedure TForm1.FNRGClick(Sender: TObject);
begin
FN;
end;
procedure TForm1.FNCBSelect(Sender: TObject);
var
Name:String;
begin
Name:=TComboBox(Sender).Name;
if Name='FNCBC'then
Case FNCBC.ItemIndex of
0:FNCBC.Hint:='ПикоФарад';
1:FNCBC.Hint:='Нанофарад';
2:FNCBC.Hint:='Микрофарад';
3:FNCBC.Hint:='Фарад';
end;
if Name='FNCBLR'then
Case FNRG2.ItemIndex of
0:Case FNCBLR.ItemIndex of
0:FNCBLR.Hint:='Микрогенри';
1:FNCBLR.Hint:='Милигенри';
2:FNCBLR.Hint:='Генри';
end;
1:Case FNCBLR.ItemIndex of
0:FNCBLR.Hint:='Ом';
1:FNCBLR.Hint:='Кило Ом';
2:FNCBLR.Hint:='Мега Ом';
3:FNCBLR.Hint:='Гига Ом';
end;
end;
if Name='FNCBFc'then
Case FNCBFc.ItemIndex of
0:FNCBFc.Hint:='Герц';
1:FNCBFc.Hint:='Келогерц';
2:FNCBFc.Hint:='Мегагерц';
3:FNCBFc.Hint:='Гигагерц';
end;
FN;
end;
Procedure TForm1.FN;
var
I:Byte;
begin
if (FNC.Text='')or(K=1) then FNC.Text:='0';
if (FNLR.Text='')or(K=2) then FNLR.Text:='0';
if (FNFc.Text='')or(K=3) then FNFc.Text:='0';
Case FNRG1.ItemIndex of
0: begin
A:=1;
B:=1;
Case FNRG2.ItemIndex of
0: FNImage2.Picture.Bitmap.LoadFromResourceName(hInstance, 'PIC1');
1: FNImage2.Picture.Bitmap.LoadFromResourceName(hInstance, 'PIC4');
end;
end;
1: begin
A:=2;
B:=1;
Case FNRG2.ItemIndex of
0:FNImage2.Picture.Bitmap.LoadFromResourceName(hInstance, 'PIC2');
1:FNImage2.Picture.Bitmap.LoadFromResourceName(hInstance, 'PIC5');
end;
end;
2: begin
A:=1;
B:=2;
Case FNRG2.ItemIndex of
0:FNImage2.Picture.Bitmap.LoadFromResourceName(hInstance, 'PIC3');
1:FNImage2.Picture.Bitmap.LoadFromResourceName(hInstance, 'PIC6');
end;
end;
end;
Case FNRG2.ItemIndex of
0: begin
if KLR=1 then
begin
FNLR.EditLabel.Caption:='Индуктивность L';
FNCBLR.Clear;
for I:=0 to 2 do FNCBLR.Items.Add(ArL[I]);
FNCBLR.ItemIndex:=0;
FNCBLR.Hint:='Микрогенри';
KLR:=0;
end;
Case FNCBLR.ItemIndex of
0:LRCB:=0.000001;
1:LRCB:=0.001;
2:LRCB:=1;
end;
end;
1: begin
if KLR=0 then
begin
FNLR.EditLabel.Caption:='Сопротивление R';
FNCBLR.Clear;
for I:=0 to 3 do FNCBLR.Items.Add(ArR[I]);
FNCBLR.ItemIndex:=0;
FNCBLR.Hint:='Ом';
KLR:=1;
end;
Case FNCBLR.ItemIndex of
0:LRCB:=1;
1:LRCB:=1000;
2:LRCB:=1000000;
3:LRCB:=1000000000;
end;
end;
end;
Case FNCBC.ItemIndex of
0:CCB:=0.000000000001;
1:CCB:=0.000000001;
2:CCB:=0.000001;
3:CCB:=1;
end;
Case FNCBFc.ItemIndex of
0:FcCB:=1;
1:FcCB:=1000;
2:FcCB:=1000000;
3:FcCB:=1000000000;
end;
C:=StrToFloat(FNC.Text)*B*CCB;
LR:=StrToFloat(FNLR.Text)*A*LRCB;
Fc:=StrToFloat(FNFc.Text)*FcCB;
if C=0 then
if (LR<=0)or(Fc<=0)then Exit
else
begin
K:=1;
Case FNRG2.ItemIndex of
0: C:=1/(Sqr(Pi*Fc)*LR);
1: C:=1/(2*Pi*Fc*LR);
end;
FNC.Color:=clYellow;
FNC.Text:=FloatToStr(C/(B*CCB));
end;
if LR=0 then
if (C<=0)or(Fc<=0)then Exit
else
begin
K:=2;
Case FNRG2.ItemIndex of
0: LR:=1/(Sqr(Pi*Fc)*C);
1: LR:=1/(2*Pi*Fc*C);
end;
FNLR.Color:=clYellow;
FNLR.Text:=FloatToStr(LR/(A*LRCB));
end;
if Fc=0 then
if (C<=0)or(LR<=0)then Exit
else
begin
K:=3;
Case FNRG2.ItemIndex of
0: Fc:=1/(Pi*Sqrt(LR*C));
1: Fc:=1/(2*Pi*Lr*C);
end;
FNFc.Color:=clYellow;
FNFc.Text:=FloatToStr(Fc/FcCB);
end;
end;
procedure TForm1.FNButtonClick(Sender: TObject);
begin
FNC.Text:='0';
FNLR.Text:='0';
FNFc.Text:='0';
FNC.Color:=clWindow;
FNLR.Color:=clWindow;
FNFc.Color:=clWindow;
FNCBC.ItemIndex:=0;
FNCBLR.ItemIndex:=0;
FNCBFc.ItemIndex:=2;
FNRG1.ItemIndex:=0;
FNRG2.ItemIndex:=0;
FNCBC.Hint:='ПикоФарад';
FNCBLR.Hint:='Микрогенри';
FNCBFc.Hint:='Мегагерц';
K:=0;
end;
end.
|
А тут можно взять исходники http://calculator2006.narod.ru/NC.rar |
Испытание моеё программы, Может можно зделать лучше??? 
т.е. може там можено что улучшить и чтоб она работала быстрее или ещё что 
Дата 11.6.2006, 01:39 (
Загрузка ...
