mirror of
http://gitlab.expertsoft.com.ua/git/expertcad
synced 2026-01-12 00:45:40 +02:00
158 lines
4.3 KiB
ObjectPascal
158 lines
4.3 KiB
ObjectPascal
unit U_RaiseHeight;
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, U_LNG, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
|
Dialogs, StdCtrls, cxLookAndFeelPainters, cxButtons, cxControls,
|
|
cxContainer, cxEdit, cxTextEdit, cxMaskEdit, siComp, siLngLnk, Mask,
|
|
RzEdit, cxGraphics, cxLookAndFeels, Menus, RzButton, RzRadChk;
|
|
|
|
type
|
|
TF_RaiseHeight = class(TForm)
|
|
lbMessage: TLabel;
|
|
edRaiseHeight: TcxMaskEdit;
|
|
bOK: TcxButton;
|
|
bCancel: TcxButton;
|
|
Label2: TLabel;
|
|
lng_Forms: TsiLangLinked;
|
|
cbApplyToAll: TRzCheckBox;
|
|
procedure bCancelClick(Sender: TObject);
|
|
procedure edRaiseHeightKeyPress(Sender: TObject; var Key: Char);
|
|
procedure FormShow(Sender: TObject);
|
|
procedure edRaiseHeightExit(Sender: TObject);
|
|
procedure bOKClick(Sender: TObject);
|
|
procedure FormCreate(Sender: TObject);
|
|
private
|
|
FValSetted: Boolean;
|
|
public
|
|
{ Public declarations }
|
|
CurrentRaiseHeight: string;
|
|
|
|
procedure SetVal(aVal: Double);
|
|
end;
|
|
|
|
var
|
|
F_RaiseHeight: TF_RaiseHeight;
|
|
// \d?\d?\d?,\d?\d?
|
|
|
|
|
|
implementation
|
|
uses USCS_Main, U_CAD, U_Common, U_ESCadClasess, DrawObjects, U_Constants, U_BaseCommon;
|
|
|
|
{$R *.dfm}
|
|
|
|
procedure TF_RaiseHeight.bCancelClick(Sender: TObject);
|
|
begin
|
|
try
|
|
Close;
|
|
except
|
|
on E: Exception do AddExceptionToLogEx('TF_RaiseHeight.bCancelClick', E.Message);
|
|
end;
|
|
end;
|
|
|
|
procedure TF_RaiseHeight.edRaiseHeightKeyPress(Sender: TObject;
|
|
var Key: Char);
|
|
begin
|
|
try
|
|
{//23.08.2012
|
|
if (Key = '.') or (Key = ',') then
|
|
if Key <> DecimalSeparator then
|
|
Key := #0;}
|
|
CorrectMaskKeyPress(Key);
|
|
|
|
if Key = #13 then
|
|
begin
|
|
bOK.SetFocus;
|
|
bOK.Click;
|
|
end;
|
|
except
|
|
on E: Exception do AddExceptionToLogEx('TF_RaiseHeight.edRaiseHeightKeyPress', E.Message);
|
|
end;
|
|
end;
|
|
|
|
procedure TF_RaiseHeight.FormShow(Sender: TObject);
|
|
var
|
|
Val: double;
|
|
begin
|
|
try
|
|
//Tolik 04/02/2022 --
|
|
// ñèñòåìà èçìåðåíèé
|
|
{
|
|
if GCurrProjUnitOfMeasure = umSM then
|
|
Label2.Caption := cMetric_sm;
|
|
if GCurrProjUnitOfMeasure = umM then
|
|
Label2.Caption := cMetric_m;
|
|
if GCurrProjUnitOfMeasure = umIn then
|
|
Label2.Caption := cWhitworth_in;
|
|
if GCurrProjUnitOfMeasure = umFt then
|
|
Label2.Caption := cWhitworth_ft;
|
|
}
|
|
Label2.Caption := GetNormalSTRUom;
|
|
//
|
|
// EditMask
|
|
if Not FValSetted then // Åñëè çíà÷åíèå óñòàíîâèëè ïåðåä ïîêàçîì ôîðìû
|
|
begin
|
|
edRaiseHeight.Properties.EditMask := GetFloatMask; //22.08.2012 '\d?\d?\d?' + DecimalSeparator + '\d?\d?';
|
|
Val := GCadForm.FConnHeight;
|
|
if GPopupFigure <> nil then
|
|
begin
|
|
if CheckFigureByClassName(GPopupFigure, cTOrthoLine) then
|
|
Val := TOrthoLine(GPopupFigure).ActualZOrder[1]
|
|
else
|
|
if CheckFigureByClassName(GPopupFigure, cTConnectorObject) then
|
|
Val := TConnectorObject(GPopupFigure).ActualZOrder[1];
|
|
end;
|
|
{//12.03.2012
|
|
Val := MetreToUOM(Val);
|
|
edRaiseHeight.Text := FormatFloat(ffMask, Val);
|
|
CurrentRaiseHeight := edRaiseHeight.Text;
|
|
edRaiseHeight.SetFocus;
|
|
edRaiseHeight.SelStart := 0;
|
|
edRaiseHeight.SelLength := Length(edRaiseHeight.Text) + 1;}
|
|
SetVal(Val);
|
|
end;
|
|
FValSetted := false;
|
|
edRaiseHeight.SetFocus;
|
|
except
|
|
on E: Exception do AddExceptionToLogEx('TF_RaiseHeight.FormShow', E.Message);
|
|
end;
|
|
end;
|
|
|
|
procedure TF_RaiseHeight.edRaiseHeightExit(Sender: TObject);
|
|
begin
|
|
try
|
|
if edRaiseHeight.Text = '' then
|
|
edRaiseHeight.Text := CurrentRaiseHeight;
|
|
except
|
|
on E: Exception do AddExceptionToLogEx('TF_RaiseHeight.edRaiseHeightExit', E.Message);
|
|
end;
|
|
end;
|
|
|
|
procedure TF_RaiseHeight.bOKClick(Sender: TObject);
|
|
begin
|
|
try
|
|
if not GProjectChanged then // Tolik 28/08/2019 --
|
|
SetProjectChanged(True);
|
|
except
|
|
on E: Exception do AddExceptionToLogEx('TF_RaiseHeight.bOKClick', E.Message);
|
|
end;
|
|
end;
|
|
|
|
procedure TF_RaiseHeight.SetVal(aVal: Double);
|
|
begin
|
|
aVal := MetreToUOM(aVal);
|
|
edRaiseHeight.Text := FormatFloat(ffMask, aVal);
|
|
CurrentRaiseHeight := edRaiseHeight.Text;
|
|
edRaiseHeight.SelStart := 0;
|
|
edRaiseHeight.SelLength := Length(edRaiseHeight.Text) + 1;
|
|
FValSetted := true;
|
|
end;
|
|
|
|
procedure TF_RaiseHeight.FormCreate(Sender: TObject);
|
|
begin
|
|
FValSetted := false;
|
|
end;
|
|
|
|
end.
|