?? unit1.pas
字號:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ToolWin, ComCtrls, Menus, ImgList, StdCtrls, OleCtrls, SHDocVw,
ExtCtrls, MSCommLib_TLB;
// Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
// ExtCtrls, LMDCustomScrollBox, LMDScrollBox, lmdsplt, LMDCustomControl,
// LMDCustomPanel, LMDCustomBevelPanel, StdCtrls, Grids, DBGrids, Db,
// DAODataset, DAOQuery, DAODatabase, LMDControl, LMDBaseControl,
// LMDBaseGraphicControl, LMDGraphicControl, LMDLEDCustomLabel, LMDLEDLabel,
// ColorBtns, ClrPanel, IniFiles, MyComm0, PubUnit, MPlayer,
// LMDCustomParentPanel, LMDCustomPanelFill, LMDPanelFill;
type
TForm1 = class(TForm)
StatusBar1: TStatusBar;
MainMenu1: TMainMenu;
miFile: TMenuItem;
miFileOpen: TMenuItem;
miSaveAs: TMenuItem;
N1: TMenuItem;
miPrint: TMenuItem;
N2: TMenuItem;
miClose: TMenuItem;
miEdit: TMenuItem;
miCut: TMenuItem;
miCopy: TMenuItem;
miPaste: TMenuItem;
N3: TMenuItem;
miSelectAll: TMenuItem;
N4: TMenuItem;
miFind: TMenuItem;
miView: TMenuItem;
miViewToolBar: TMenuItem;
miViewStateBar: TMenuItem;
N5: TMenuItem;
miTurnTo: TMenuItem;
miStop: TMenuItem;
miRefresh: TMenuItem;
miHelp: TMenuItem;
miAbout: TMenuItem;
miViewStandardButton: TMenuItem;
miViewAddressBar: TMenuItem;
miBack: TMenuItem;
miForward: TMenuItem;
miBlank: TMenuItem;
tbMainMenu: TToolBar;
ImageListNormal: TImageList;
ImageListHot: TImageList;
tbCmdButton: TToolBar;
tButtonBack: TToolButton;
tButtonForward: TToolButton;
tButtonHome: TToolButton;
tButtonRefresh: TToolButton;
tButtonStop: TToolButton;
CmbBoxAddress: TComboBox;
CoolBar1: TCoolBar;
Panel1: TPanel;
WebBrowser1: TWebBrowser;
PopupMenu1: TPopupMenu;
miLabelBotton: TMenuItem;
miLabelRight: TMenuItem;
miNoLabel: TMenuItem;
OpenDialog1: TOpenDialog;
ReBoot: TMenuItem;
OffPc: TMenuItem;
MSComm1: TMSComm;
Memo1: TMemo;
Button1: TButton;
Label1: TLabel;
Label2: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Button2: TButton;
Button3: TButton;
Memo2: TMemo;
Label3: TLabel;
Edit3: TEdit;
Button4: TButton;
Edit4: TEdit;
Button5: TButton;
Button6: TButton;
Label4: TLabel;
Label5: TLabel;
procedure miCloseClick(Sender: TObject);
procedure CmbBoxAddressClick(Sender: TObject);
procedure CmbBoxAddressKeyPress(Sender: TObject; var Key: Char);
procedure FormCreate(Sender: TObject);
procedure miLabelBottonClick(Sender: TObject);
procedure miLabelRightClick(Sender: TObject);
procedure miNoLabelClick(Sender: TObject);
procedure tButtonBackClick(Sender: TObject);
procedure tButtonForwardClick(Sender: TObject);
procedure tButtonHomeClick(Sender: TObject);
procedure tButtonRefreshClick(Sender: TObject);
procedure tButtonStopClick(Sender: TObject);
procedure miAboutClick(Sender: TObject);
procedure miFileOpenClick(Sender: TObject);
procedure miSaveAsClick(Sender: TObject);
procedure miBlankClick(Sender: TObject);
procedure miViewStandardButtonClick(Sender: TObject);
procedure miViewAddressBarClick(Sender: TObject);
procedure OffPcClick(Sender: TObject);
procedure ReBootClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure MSComm1Comm(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure Button4Click(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure Button6Click(Sender: TObject);
private //只能在類的內部使用，不能被外部訪問
{ Private declarations }
protected
{ protected declarations }
public
procedure MyShowHint(Sender: TObject);
{ Public declarations }
end;
var
Form1: TForm1;
senddata:array[1..20] of char;
reData:array of Variant;
sendstr:string;
restr:string;
Rgt: integer;
Btm: integer;
implementation
uses Unit2;
var
add_times: integer;
temp1:integer;
{$R *.dfm}
function Small2Big(SourceMoney:Currency):string;
var
//strSourceMoney保存未轉換的小寫字符串，strSourceMoney保存已轉換的大寫字符串
strSourceMoney,strObjectMoney:string;
//ThisWei為當前位的大寫，ThisPos為當前位的人民幣單位
ThisWei,ThisPos:string[2];
//iWei為當前位置,posPoint為小數點的位置
iWei,posPoint:integer;
begin
strSourceMoney :=formatfloat('0.00',SourceMoney);//將浮點數轉換成指定格式字符串
posPoint:= pos('.', strSourceMoney); // 小數點的位置
//循環小寫貨幣的每一位，從小寫的右邊位置到左邊
for iWei :=length(strSourceMoney) downto 1 do
begin
case strSourceMoney[iWei] of //轉換當前數字
'.':Continue; //如果是小數點，則不進行轉換操作
'1':ThisWei:='壹'; '2': ThisWei:='貳';
'3': ThisWei:='叁'; '4': ThisWei:='肆';
'5': ThisWei:='伍'; '6': ThisWei:='陸';
'7': ThisWei:='柒'; '8': ThisWei:='捌';
'9': ThisWei:='玖'; '0': ThisWei:='零';
end;
case PosPoint-iWei of //獲得當前人民幣單位
-3:ThisPos:='厘';-2:ThisPos:='分';
-1:ThisPos:='角';1 :ThisPos:='元';
2 :ThisPos:='拾';3 :ThisPos:='佰';
4 :ThisPos:='千';5 :ThisPos:='萬';
6 :ThisPos:='拾';7:ThisPos:='佰';
8 :ThisPos:='千';9 :ThisPos:='億';
10 :ThisPos:='十';11:ThisPos:='佰';
12:ThisPos:='千';
end;
strObjectMoney :=ThisWei+ThisPos+strObjectMoney;//組合成大寫金額
end;
Small2Big:=strObjectMoney; //
end;
procedure TForm1.miCloseClick(Sender: TObject);
begin
Close;
end;
procedure TForm1.CmbBoxAddressClick(Sender: TObject);
begin
WebBrowser1.Navigate(cmbBoxAddress.Text);
end;
procedure TForm1.CmbBoxAddressKeyPress(Sender: TObject; var Key: Char);
begin
if Key =#13 then
WebBrowser1.Navigate(cmbBoxAddress.Text);
end;
procedure TForm1.MyShowHint(Sender: TObject);
begin
StatusBar1.SimplePanel :=True;
StatusBar1.SimpleText :=Application.Hint ;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnHint :=MyShowHint;
WebBrowser1.Navigate('about:blank');
MSComm1.PortOpen :=true;
// mscomm1.CommPort := 1;//指定端口
// mscomm1.Settings := '4800,o,8,1';//其它參數
// mscomm1.InBufferSize := 1024; //接收緩沖區
// mscomm1.OutBufferSize := 1024; //發送緩沖區
// mscomm1.InputMode := comInputModeBinary; //接收模式
// mscomm1.InputLen := 0; //一次讀取所有數據
// mscomm1.SThreshold := 0; //一次發送所有數據
// mscomm1.InBufferCount := 0; //清空讀取緩沖區
// mscomm1.OutBufferCount := 0; //清空發送緩沖區
// mscomm1.PortOpen:=true; //打開端口
// MSComm1.RThreshold := 6;
// MSComm1.RThreshold := 1;
end;
procedure TForm1.miLabelBottonClick(Sender: TObject);
begin
tbCmdButton.Align:=alNone;
tbCmdButton.ShowCaptions :=True;
tbCmdButton.List :=False;
tbCmdButton.Align :=alClient;
miLabelBotton.Checked :=True;
end;
procedure TForm1.miLabelRightClick(Sender: TObject);
begin
tbCmdButton.Align:=alNone;
tbCmdButton.ShowCaptions :=True;
tbCmdButton.List :=True;
tbCmdButton.Align :=alClient;
miLabelBotton.Checked :=True;
end;
procedure TForm1.miNoLabelClick(Sender: TObject);
begin
tbCmdButton.Align:=alNone;
tbCmdButton.List :=False;
tbCmdButton.ShowCaptions :=False;
tbCmdButton.Align :=alClient;
miLabelBotton.Checked :=True;
end;
procedure TForm1.tButtonBackClick(Sender: TObject);
begin
WebBrowser1.GoBack;
end;
procedure TForm1.tButtonForwardClick(Sender: TObject);
begin
WebBrowser1.GoForward;
end;
procedure TForm1.tButtonHomeClick(Sender: TObject);
begin
WebBrowser1.GoHome;
end;
procedure TForm1.tButtonRefreshClick(Sender: TObject);
begin
WebBrowser1.Refresh;
end;
procedure TForm1.tButtonStopClick(Sender: TObject);
begin
WebBrowser1.Stop ;
end;
procedure TForm1.miAboutClick(Sender: TObject);
begin
FmAbout.ShowModal ;
end;
procedure TForm1.miFileOpenClick(Sender: TObject);
begin
if OpenDialog1.Execute then
WebBrowser1.Navigate(OpenDialog1.FileName );
end;
procedure TForm1.miSaveAsClick(Sender: TObject);
begin
WebBrowser1.ExecWB(OLECMDID_SAVEAS,2);
end;
procedure TForm1.miBlankClick(Sender: TObject);
begin
WebBrowser1.Navigate('about:blank');
end;
procedure TForm1.miViewStandardButtonClick(Sender: TObject);
begin
miViewStandardButton.Checked := not miViewStandardButton.Checked;
CoolBar1.Bands[1].Visible := miViewStandardButton.Checked;
end;
procedure TForm1.miViewAddressBarClick(Sender: TObject);
begin
miViewAddressBar.Checked := not miViewAddressBar.Checked;
CoolBar1.Bands[2].Visible := miViewAddressBar.Checked;
end;
procedure TForm1.OffPcClick(Sender: TObject);
var
// st:SYSTEMTIME;
hToken:THANDLE;
tkp:TOKEN_PRIVILEGES;
rr:Dword;
begin
OpenProcessToken(GetCurrentProcess(),TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,hToken);
LookupPrivilegeValue(nil,'SeShutdownPrivilege',tkp.Privileges[0].Luid );
tkp.PrivilegeCount:=1;
tkp.Privileges[0].Attributes:=SE_PRIVILEGE_ENABLED;
AdjustTokenPrivileges(hToken,FALSE,tkp,0,nil,rr);
// ExitWindowsEx(EWX_SHUTDOWN OR EWX_POWEROFF,0);
ExitWindowsEx(EWX_SHUTDOWN OR EWX_POWEROFF,0);
end;
procedure TForm1.ReBootClick(Sender: TObject);
var
// st:SYSTEMTIME;
hToken:THANDLE;
tkp:TOKEN_PRIVILEGES;
rr:Dword;
begin
OpenProcessToken(GetCurrentProcess(),TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,hToken);
LookupPrivilegeValue(nil,'SeShutdownPrivilege',tkp.Privileges[0].Luid );
tkp.PrivilegeCount:=1;
tkp.Privileges[0].Attributes:=SE_PRIVILEGE_ENABLED;
AdjustTokenPrivileges(hToken,FALSE,tkp,0,nil,rr);
// ExitWindowsEx(EWX_REBOOT OR EWX_POWEROFF,0);
ExitWindowsEx(EWX_REBOOT,0);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
MSComm1.PortOpen:=false;
MSComm1.Destroy;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
file1: TextFile;
s1 : string;
begin
Memo1.Clear ;
s1:=ExtractFilePath(Application.ExeName);
s1:=s1+'zhou.dat';
AssignFile(file1,s1);
Rewrite(file1);
Write(file1,'Enter a line of text: ');
Writeln(file1,'You typed: 01 ');
Writeln(file1,'You typed: 02 ');
Writeln(file1,'You typed: 03 ');
CloseFile(file1);
end;
procedure TForm1.MSComm1Comm(Sender: TObject);
//type
// IArr = ^integer;
// var
// buffer:string;
// CommRevStr : String;
// RevP : array [1..10] of byte;
// i,bufferLength: byte;
//begin
// bufferLength:=2;
// buffer:=MsComm1.Input;
// Move(IArr(buffer)^,Revp,bufferLength);
// For i:=1 to BufferLength do
// begin
// CommrevStr :=CommrevStr+ inttohex(Revp[i],2)+' ';
// end;
var
i:longint;
begin
redata:=mscomm1.Input; //接收數據
restr:='';
for i:=0 to vararrayhighbound(redata,1) do
restr:=restr + inttohex(redata[i],2)+' ';
// mscomm1.PortOpen:=false;
// memo1.Text:=restr;
case MSComm1.CommEvent of
comEvReceive:
Memo1.Lines.Add(restr);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
i,j,k:integer;
s:string;
MyArray:array[1..5,1..5]of integer;
begin
i:=StrToInt(Edit1.Text);
Edit2.Text :=IntToHex(i,2);
s:=IntToHex(i,2);
Memo1.Lines.Add(s);
// Label2.Caption :=IntToStr(i);
// Label2.Caption := IntToStr(StrToInt(Edit1.Text) * StrToInt(Edit2.Text));
k:=0;
for i:=1 to 5 do
for j:=1 to 5 do
inc(k,MyArray[i,j]);
Edit1.Text:=IntToStr(k);
end;
procedure TForm1.Button3Click(Sender: TObject);
var
S,T :string;
label someplace;
begin
add_times:=add_times+1;
ShowMessage(Format('%d',[add_times]));
ShowMessage(Application.ExeName);
ShowMessage(ExtractFileName(Application.ExeName));
ShowMessage(ExtractFilePath(Application.ExeName));
// ShowMessage(ExtractFile(Application.ExeName));
Application.MessageBox('abcdefg','測試',MB_OK);
temp1:=Application.MessageBox('abcdefg','測試',3);
Application.MessageBox('abcdefg','測試',3);
if temp1=1 then
goto someplace;
Str(11.48:2:1,T);
edit1.Text :=T;
someplace:
s:=T+'Truncs to'+IntToStr(Trunc(1.4))+#13#10;
s:=s+'abcdefg';
memo2.Text :=s;
MessageDlg(s,mtInformation,[mbOk],0);
end;
procedure TForm1.Button5Click(Sender: TObject);
var
AppPath : String;
begin
AppPath:=ExtractFilePath(ParamStr(0));
edit4.Text :=AppPath;
ShowCursor(false);
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if(Key=VK_F4) and ([ssAlt]=shift) then //屏蔽Alt+F4鍵讓程序不能被關閉
begin
Key:=0;
ShowCursor(True);
end;
end;
procedure TForm1.Button4Click(Sender: TObject);
var
ThisMoney:Currency;
begin
try
ThisMoney:=StrToFloat(Edit3.Text);
except
ShowMessage('Please input correct number');
exit;
end;
Label3.Caption:= Small2Big(ThisMoney);
end;
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
ShowCursor(True);
end;
procedure TForm1.Button6Click(Sender: TObject);
var
Rect: TRect;
s:string;
begin
s:=edit4.Text;
Label5.Caption :=S[1]+S[6];
MessageBeep(0); //讓計算機蜂鳴
MessageBeep(0); //讓計算機蜂鳴
SendMessage(Memo1.Handle, EM_GETRECT, 0, LongInt(@Rect)); //獲取Memo1的矩形邊界
Rgt:= Rect.Right; //保存原始矩形邊界寬度
Btm:= Rect.Bottom; //保存原始矩形邊界高度
if Edit1.Text<> '' then
Rect.Left:= StrToInt(Edit1.Text) //更改Rect邊界值
else ShowMessage('請填入左邊距');
if Edit2.Text<>'' then
Rect.Top:= StrToInt(Edit2.Text)
else ShowMessage('請填入上邊距');
Rect.Right:= Rect.Right- StrToInt(Edit1.Text)+ 1;
Rect.Bottom:= Rect.Bottom- StrToInt(Edit2.Text)+ 1;
SendMessage(Memo1.Handle, EM_SETRECT, 0, LongInt(@Rect)); //重繪Memo1的矩形邊界
Memo1.Refresh;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -