?? commonuse.pas
字號:
If (money[j] = '0') And (money[j + 1] = '0') Then
Begin
ch := ch + '整';
break;
End
Else If (money[j] = '0') And (money[j + 1] <> '') Then
ch := ch + '零'
Else If (money[j] = '0') And (money[j + 1] = '') Then
Else
ch := ch + a[StrToInt(money[j])] + c[zheng - j]
Else
ch := ch + '整';
Result := ch;
End;
Function SmallToBig1(Const rmbSmall: Currency): String;
Var
i: Integer;
s1, s2, Str, rmbBig: String;
Begin
Str := FormatFloat('0.00', rmbSmall);
If Str = '' Then Str := '0';
i := AnsiPos('.', Str);
If i <> 0 Then
Begin
s1 := LeftStr(Str, i - 1);
s2 := RightStr(Str, Length(Str) - i);
If Length(s2) < 1 Then s2 := s2 + '00';
If Length(s2) < 2 Then s2 := s2 + '0';
Str := s1 + s2;
End
Else
Str := Str + '00';
rmbBig := '';
For i := 1 To Length(Str) Do
Begin
Case Str[i] Of
'0': rmbBig := rmbBig + '0';
'1': rmbBig := rmbBig + '1';
'2': rmbBig := rmbBig + '2';
'3': rmbBig := rmbBig + '3';
'4': rmbBig := rmbBig + '4';
'5': rmbBig := rmbBig + '5';
'6': rmbBig := rmbBig + '6';
'7': rmbBig := rmbBig + '7';
'8': rmbBig := rmbBig + '8';
'9': rmbBig := rmbBig + '9';
End;
End;
rmbBig := '¥' + rmbBig;
Case Length(rmbBig) Of
2: rmbBig := ' ' + rmbBig;
4: rmbBig := ' ' + rmbBig;
6: rmbBig := ' ' + rmbBig;
8: rmbBig := ' ' + rmbBig;
10: rmbBig := ' ' + rmbBig;
12: rmbBig := ' ' + rmbBig;
14: rmbBig := ' ' + rmbBig;
End;
Result := rmbBig;
End;
Function SmallToBig2(Const rmbSmall: Currency): String;
Var
i: Integer;
str, s1, s2, rmbBig: String;
Begin
rmbBig := '';
str := FormatFloat('0.00', rmbSmall);
i := AnsiPos('.', Str);
If i <> 0 Then
Begin
s1 := LeftStr(Str, i - 1);
s2 := RightStr(Str, Length(Str) - i);
If Length(s2) < 1 Then s2 := s2 + '00';
If Length(s2) < 2 Then s2 := s2 + '0';
Str := s1 + s2;
End
Else
Str := Str + '00';
For i := Length(Str) Downto 1 Do
Begin
Case Str[i] Of
'0': rmbBig := '零' + rmbBig;
'1': rmbBig := '壹' + rmbBig;
'2': rmbBig := '貳' + rmbBig;
'3': rmbBig := '叁' + rmbBig;
'4': rmbBig := '肆' + rmbBig;
'5': rmbBig := '伍' + rmbBig;
'6': rmbBig := '陸' + rmbBig;
'7': rmbBig := '柒' + rmbBig;
'8': rmbBig := '捌' + rmbBig;
'9': rmbBig := '玖' + rmbBig;
End;
End;
Case Length(rmbBig) Of
2: rmbBig := '※※※※※※※' + rmbBig;
4: rmbBig := '※※※※※※' + rmbBig;
6: rmbBig := '※※※※※' + rmbBig;
8: rmbBig := '※※※※' + rmbBig;
10: rmbBig := '※※※' + rmbBig;
12: rmbBig := '※※' + rmbBig;
14: rmbBig := '※' + rmbBig;
End;
Result := rmbBig;
End;
Function isReadWriteDisk(Drive: Char): Bool;
Var
path: String;
Begin
Result := False;
If CreateDir(Drive + ':\Gui') Then
Begin
path := Drive + ':\nsdata';
RmDir(Drive + ':\Gui');
If Not DirectoryExists(Path) Then CreateDir(path);
Result := True;
End;
End;
Function FindFirstCDROMDrive: Char;
Var
drivemap, mask: DWORD;
i: Integer;
root: String;
Begin
Result := #0;
root := 'A:\';
drivemap := GetLogicalDrives;
mask := 1;
For i := 1 To 32 Do
Begin
If (mask And drivemap) <> 0 Then
If GetDriveType(PChar(root)) = DRIVE_CDROM Then
Begin
Result := root[1];
Break;
End;
mask := mask Shl 1;
Inc(root[1]);
End;
End;
Procedure ShowInformation(Const Msg: String);
Begin
Application.MessageBox(PChar(Msg), PChar(Application.Title), MB_ICONINFORMATION);
End;
Procedure ShowWarning(Const Msg: String);
Begin
Application.MessageBox(PChar(Msg), PChar(Application.Title), MB_ICONWARNING);
End;
Function YesNoDialogDef1(Const Msg: String): Boolean;
Begin
Result := True;
If Application.MessageBox(PChar(Msg), PChar(Application.Title),
MB_ICONQUESTION + MB_YESNO) = 7 Then
Result := False;
End;
Function YesNoDialogDef2(Const Msg: String): Boolean;
Begin
Result := True;
If Application.MessageBox(PChar(Msg), PChar(Application.Title),
MB_ICONQUESTION + MB_YESNO + MB_DEFBUTTON2) = 7 Then
Result := False;
End;
Function OkCancelDialogDef1(Const Msg: String): Boolean;
Begin
Result := True;
If Application.MessageBox(PChar(Msg), PChar(Application.Title),
MB_ICONQUESTION + MB_OKCANCEL + MB_DEFBUTTON1) = 2 Then
Result := False;
End;
Function FindFirstRemoveDrive: Char;
Var
drivemap, mask: DWORD;
i: Integer;
root: String;
Begin
Result := #0;
root := 'C:\';
drivemap := GetLogicalDrives;
mask := 1;
For i := 1 To 32 Do
Begin
If (mask And drivemap) <> 0 Then
If GetDriveType(PChar(root)) = DRIVE_REMOVABLE Then
Begin
Result := root[1];
Break;
End;
mask := mask Shl 1;
Inc(root[1]);
End;
End;
Procedure GetScreenPic(ZipScale: Word);
Var
bmpscreen: Tbitmap;
jpegscreen: Tjpegimage;
FullscreenCanvas: TCanvas;
dc: HDC;
sourceRect, destRect: TRect;
Begin
If (ZipScale <= 0) Or (ZipScale > 100) Then
Begin
ShowInformation('選擇的JPG壓縮比必須在1~100之間。');
Exit;
End;
If FileExists('c:\temp.jpg') Then DeleteFile('c:\temp.jpg');
dc := getdc(0);
fullscreencanvas := Tcanvas.Create;
fullscreencanvas.Handle := dc;
bmpscreen := Tbitmap.Create;
bmpscreen.Width := screen.Width;
bmpscreen.Height := screen.Height;
sourcerect := rect(0, 0, screen.Width, screen.Height);
destrect := rect(0, 0, screen.Width, screen.Height);
bmpscreen.Canvas.CopyRect(sourcerect, fullscreenCanvas, destrect);
jpegscreen := Tjpegimage.Create;
jpegscreen.Assign(bmpscreen);
jpegscreen.CompressionQuality := ZipScale;
jpegscreen.SaveToFile('c:\temp.jpg');
FullscreenCanvas.Free;
bmpscreen.Free;
jpegscreen.Free;
ReleaseDC(0, DC);
End;
Function GetMaskString(S, Mask: String; Position: Integer): String;
Var
str: String;
i, Len: Integer;
Begin
str := '';
For i := 0 To Position - 1 Do
Begin
If (Pos(Mask, S) <= 0) Then
Begin
Str := S;
Break;
End;
Str := Copy(S, 1, Pos(Mask, S) - 1);
Len := Length(Str);
S := Copy(S, Len + 2, Length(S) - Len - 1);
End;
Result := Str;
End;
Function DateStr(Const aDateTime: TDateTime): String;
Begin
Result := FormatDateTime('YYYY''年''M''月''D''日''', aDateTime);
End;
Function DateTimeStr(Const aDateTime: TDateTime): String;
Begin
Result := FormatDateTime('YYYY''年''M''月''D''日 ''h''點''mm''分''', aDateTime);
End;
Function TimeStr(Const aDateTime: TDateTime): String;
Begin
Result := FormatDateTime('h''點''mm''分''ss''秒''', aDateTime);
End;
Procedure ShowError(Const Msg: String);
Begin
Application.MessageBox(PChar(Msg), PChar(Application.Title), MB_ICONERROR);
End;
Function SuperQuestion(Msg: String; Title: String; Icon: Integer;
defButton: Integer): Boolean;
Var
str, str1: Integer;
Begin
str := 0;
str1 := 0;
Case icon Of
1: str := Mb_IconInformation;
2: str := Mb_IconQuestion;
3: str := MB_ICONWARNING;
4: str := MB_ICONSTOP;
End;
Case defbutton Of
1: str1 := MB_DEFBUTTON1;
2: str1 := MB_DEFBUTTON2;
End;
Result := True;
If application.MessageBox(PChar(Msg), PChar(title), mb_yesno + str + str1) = 7 Then
Result := False;
End;
Procedure SuperMsg(Text: String; Title: String; Icon: Integer);
Var
str: Integer;
Begin
str := 0;
Case icon Of
1: str := Mb_IconInformation;
2: str := Mb_IconQuestion;
3: str := MB_ICONWARNING;
4: str := MB_ICONSTOP;
End;
application.MessageBox(PChar(Text), PChar(title), str);
End;
Procedure BMPToJPG(Const BmpFileName, JPGFileName: String);
Var
jpeg: TJPEGImage;
bmp: TBitmap;
Begin
bmp := TBitmap.Create;
Try
bmp.LoadFromFile(BmpFileName);
jpeg := TJPEGImage.Create;
Try
jpeg.Assign(bmp);
jpeg.Compress;
jpeg.SaveToFile(JPGFileName);
Finally
jpeg.Free;
End;
Finally
bmp.Free;
End;
End;
Function AppIsRunning: Boolean;
Var
hSem: THandle;
AppTitle: String;
Begin
Result := False;
AppTitle := Application.Title;
hSem := CreateSemaphore(Nil, 0, 1, PChar(AppTitle));
If ((hSem <> 0) And (GetLastError() = ERROR_ALREADY_EXISTS)) Then
Begin
CloseHandle(hSem);
Result := True;
End;
If Result Then Application.Terminate;
End;
Function KillTask(ExeFileName: String): Integer;
Const
PROCESS_TERMINATE = $0001;
Var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
Begin
Result := 0;
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
While Integer(ContinueLoop) <> 0 Do
Begin
If ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = UpperCase(ExeFileName))
Or
(UpperCase(FProcessEntry32.szExeFile) = UpperCase(ExeFileName))) Then
Result := Integer(TerminateProcess(OpenProcess(PROCESS_TERMINATE,
BOOL(0), FProcessEntry32.th32ProcessID), 0));
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
End;
CloseHandle(FSnapshotHandle);
End;
Function GetApplicationPath: String;
Begin
Result := ExtractFilePath(Application.EXEName);
End;
Procedure RestoreDateType;
Begin
DateSeparator := '-';
ShortDateFormat := 'yyyy-mm-dd';
LongDateFormat := 'yyyy''年''m''月''d''日''';
TwoDigitYearCenturyWindow := 70;
End;
Procedure CopyFileWithProgressBar(Source, Destination: String; aGauge: TGauge);
Var
FromF, ToF: File Of Byte;
Buffer: Array[0..4096] Of Char;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -