cxformats.pas
来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 1,256 行 · 第 1/3 页
PAS
1,256 行
begin
S := S + '\' + C;
end;
var
I, J: Integer;
begin
Result := '';
if Length(AFormatInfo.Items) = 0 then
Exit;
if AMaskKind <> dtmkTime then
Result := '!';
for I := 0 to Length(AFormatInfo.Items) - 1 do
with AFormatInfo.Items[I] do
case Kind of
dtikString:
for J := 1 to Length(Data) do
AddChar(Result, Data[J]);
dtikYear:
if Length(Data) = 2 then
Result := Result + '99'
else
Result := Result + '9999';
dtikMonth:
if Length(Data) < 3 then
Result := Result + '99'
else
Result := Result + 'lll';
dtikDay:
if Length(Data) < 3 then
Result := Result + '99'
else
Result := Result + 'lll';
dtikHour, dtikMin, dtikSec:
if AMaskKind = dtmkTime then
Result := Result + '00'
else
Result := Result + '99';
// dtikMSec:
dtikTimeSuffix:
begin
if UpperCase(Data) = 'A/P' then
Result := Result + 'c'
else if UpperCase(Data) = 'AM/PM' then
Result := Result + 'cc'
else
begin
J := Length(TimeAMString);
if Length(TimePMString) > J then
J := Length(TimePMString);
Result := Result + GetCharString('c', J);
end;
end;
dtikDateSeparator:
Result := Result + '/';
dtikTimeSeparator:
Result := Result + ':';
end;
if AMaskKind = dtmkTime then
Result := Result + ';1;0'
else
Result := Result + ';1; ';
end;
function TcxFormatController.InternalGetMaskedDateEditFormat(
AFormatInfo: TcxDateTimeFormatInfo): string;
var
I: Integer;
begin
Result := '';
for I := 0 to Length(AFormatInfo.Items) - 1 do
with AFormatInfo.Items[I] do
case Kind of
dtikString:
Result := Result + '''' + Data + '''';
dtikYear:
Result := Result + LowerCase(Data);
dtikMonth:
if Length(Data) < 3 then
Result := Result + 'mm'
else
Result := Result + 'mmm';
dtikDay:
if Length(Data) < 3 then
Result := Result + 'dd'
else
Result := Result + 'ddd';
dtikHour:
Result := Result + 'hh';
dtikMin:
Result := Result + 'nn';
dtikSec:
Result := Result + 'ss';
// dtikMSec:
dtikTimeSuffix:
Result := Result + LowerCase(Data);
dtikDateSeparator:
Result := Result + '/';
dtikTimeSeparator:
Result := Result + ':';
end;
end;
procedure TcxFormatController.AddListener(
AListener: IcxFormatControllerListener);
begin
with FList do
if IndexOf(Pointer(AListener)) = -1 then
begin
if Count = 0 then
{$IFDEF DELPHI6}
FWindow := Classes.AllocateHWnd(MainWndProc);
{$ELSE}
FWindow := Forms.AllocateHWnd(MainWndProc);
{$ENDIF}
Add(Pointer(AListener));
end;
end;
procedure TcxFormatController.RemoveListener(
AListener: IcxFormatControllerListener);
begin
FList.Remove(Pointer(AListener));
if FList.Count = 0 then
begin
{$IFDEF DELPHI6}
Classes.DeallocateHWnd(FWindow);
{$ELSE}
Forms.DeallocateHWnd(FWindow);
{$ENDIF}
FWindow := 0;
end;
end;
procedure TcxFormatController.GetFormats;
begin
if FcxFormatController = nil then // to avoid stack overflow
FcxFormatController := Self;
if not FAssignedCurrencyFormat then
FCurrencyFormat := GetCurrencyFormat;
if not FAssignedStartOfWeek then
FStartOfWeek := GetStartOfWeek;
CalculateDateEditMasks(True);
FDateEditFormat := GetDateEditFormat(False);
end;
class function TcxFormatController.GetDateTimeFormatItemStandardMaskInfo(
const AFormatInfo: TcxDateTimeFormatInfo; APos: Integer;
out AItemInfo: TcxDateTimeFormatItemInfo): Boolean;
function GetTimeSuffixKind(const AFormatItemData: string): TcxTimeSuffixKind;
begin
if UpperCase(AFormatItemData) = 'A/P' then
Result := tskAP
else if UpperCase(AFormatItemData) = 'AM/PM' then
Result := tskAMPM
else
Result := tskAMPMString;
end;
var
AItemZoneStart, I: Integer;
AItemZoneStarts: array of Integer;
begin
Result := False;
if (APos < 1) or (Length(AFormatInfo.Items) = 0) then
Exit;
SetLength(AItemZoneStarts, Length(AFormatInfo.Items));
AItemZoneStart := 1;
for I := 0 to Length(AFormatInfo.Items) - 1 do
begin
AItemZoneStarts[I] := AItemZoneStart;
Inc(AItemZoneStart, GetDateTimeFormatItemStandardMaskZoneLength(AFormatInfo.Items[I]));
if APos < AItemZoneStart then
begin
AItemInfo.Kind := AFormatInfo.Items[I].Kind;
AItemInfo.ItemZoneStart := AItemZoneStarts[I];
AItemInfo.ItemZoneLength := AItemZoneStart - AItemZoneStarts[I];
if AItemInfo.Kind = dtikTimeSuffix then
AItemInfo.TimeSuffixKind := GetTimeSuffixKind(AFormatInfo.Items[I].Data);
Result := True;
Break;
end;
end;
end;
function TcxFormatController.GetDateTimeStandardMaskStringLength(
const AFormatInfo: TcxDateTimeFormatInfo): Integer;
var
I: Integer;
begin
Result := 0;
for I := 0 to Length(AFormatInfo.Items) - 1 do
Inc(Result, GetDateTimeFormatItemStandardMaskZoneLength(AFormatInfo.Items[I]));
end;
procedure TcxFormatController.NotifyListeners;
var
I: Integer;
begin
for I := 0 to FList.Count - 1 do
IcxFormatControllerListener(FList[I]).FormatChanged;
end;
procedure TcxFormatController.MainWndProc(var Message: TMessage);
begin
try
WndProc(Message);
except
Application.HandleException(Self);
end;
end;
procedure TcxFormatController.WndProc(var Message: TMessage);
begin
if (Message.Msg = WM_SETTINGCHANGE) and ((Message.WParam = 0) and
(PChar(Message.LParam) = 'intl')) and
Application.UpdateFormatSettings then
begin
SysUtils.GetFormatSettings;
GetFormats;
NotifyListeners;
Message.Result := 0;
Exit;
end;
if Message.Msg = WM_TIMECHANGE then
begin
TimeChanged;
Message.Result := 0;
Exit;
end;
with Message do Result := DefWindowProc(FWindow, Msg, wParam, lParam);
end;
procedure TcxFormatController.BeginUpdate;
begin
Inc(FLockCount);
end;
procedure TcxFormatController.EndUpdate;
begin
Dec(FLockCount);
if FLockCount = 0 then
NotifyListeners;
end;
procedure TcxFormatController.FormatChanged;
begin
if FLockCount = 0 then
begin
GetFormats;
NotifyListeners;
end;
end;
procedure TcxFormatController.TimeChanged;
var
I: Integer;
AIntf: IcxFormatControllerListener2;
begin
for I := 0 to FList.Count - 1 do
if Supports(IcxFormatControllerListener(FList[I]),
IcxFormatControllerListener2, AIntf) then
AIntf.TimeChanged;
end;
function cxFormatController: TcxFormatController;
begin
if FcxFormatController = nil then
FcxFormatController := TcxFormatController.Create;
Result := FcxFormatController;
end;
procedure TcxFormatController.SetAssignedCurrencyFormat(Value: Boolean);
begin
if FAssignedCurrencyFormat <> Value then
begin
FAssignedCurrencyFormat := Value;
FormatChanged;
end;
end;
procedure TcxFormatController.SetAssignedRegExprDateEditMask(Value: Boolean);
begin
if FAssignedRegExprDateEditMask <> Value then
begin
FAssignedRegExprDateEditMask := Value;
FormatChanged;
end;
end;
procedure TcxFormatController.SetAssignedRegExprDateTimeEditMask(Value: Boolean);
begin
if FAssignedRegExprDateTimeEditMask <> Value then
begin
FAssignedRegExprDateTimeEditMask := Value;
FormatChanged;
end;
end;
procedure TcxFormatController.SetAssignedStandardDateEditMask(Value: Boolean);
begin
if FAssignedStandardDateEditMask <> Value then
begin
FAssignedStandardDateEditMask := Value;
FormatChanged;
end;
end;
procedure TcxFormatController.SetAssignedStandardDateTimeEditMask(Value: Boolean);
begin
if FAssignedStandardDateTimeEditMask <> Value then
begin
FAssignedStandardDateTimeEditMask := Value;
FormatChanged;
end;
end;
procedure TcxFormatController.SetAssignedStartOfWeek(Value: Boolean);
begin
if FAssignedStartOfWeek <> Value then
begin
FAssignedStartOfWeek := Value;
FormatChanged;
end;
end;
procedure TcxFormatController.SetCurrencyFormat(const Value: string);
begin
FAssignedCurrencyFormat := True;
if FCurrencyFormat <> Value then
begin
FCurrencyFormat := Value;
FormatChanged;
end;
end;
procedure TcxFormatController.SetFirstWeekOfYear(Value: TcxFirstWeekOfYear);
begin
if Value <> FFirstWeekOfYear then
begin
FFirstWeekOfYear := Value;
FormatChanged;
end;
end;
procedure TcxFormatController.SetRegExprDateEditMask(const Value: string);
begin
FAssignedRegExprDateEditMask := True;
if FRegExprDateEditMask <> Value then
begin
FRegExprDateEditMask := Value;
FormatChanged;
end;
end;
procedure TcxFormatController.SetRegExprDateTimeEditMask(const Value: string);
begin
FAssignedRegExprDateTimeEditMask := True;
if FRegExprDateTimeEditMask <> Value then
begin
FRegExprDateTimeEditMask := Value;
FormatChanged;
end;
end;
procedure TcxFormatController.SetStandardDateEditMask(const Value: string);
begin
FAssignedStandardDateEditMask := True;
if FStandardDateEditMask <> Value then
begin
FStandardDateEditMask := Value;
FormatChanged;
end;
end;
procedure TcxFormatController.SetStandardDateTimeEditMask(const Value: string);
begin
FAssignedStandardDateTimeEditMask := True;
if FStandardDateTimeEditMask <> Value then
begin
FStandardDateTimeEditMask := Value;
FormatChanged;
end;
end;
procedure TcxFormatController.SetStartOfWeek(Value: TDayOfWeek);
begin
FAssignedStartOfWeek := True;
if FStartOfWeek <> Value then
begin
FStartOfWeek := Value;
FormatChanged;
end;
end;
procedure TcxFormatController.SetUseDelphiDateTimeFormats(Value: Boolean);
begin
if FUseDelphiDateTimeFormats <> Value then
begin
FUseDelphiDateTimeFormats := Value;
FormatChanged;
if Value then
MinYear := 1
else
MinYear := 100;
end;
end;
initialization
finalization
FcxFormatController.Free;
FcxFormatController := nil;
end.
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?