⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.pas

📁 ToolBar工具栏控件的使用,动态建立主菜单选项,窗口界面的动态分隔条
💻 PAS
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, shellapi,Menus, Grids, ExtDlgs, Buttons, StdCtrls,inifiles;

type
re=record
name:string;
time:integer;
end;
  TForm1 = class(TForm)
    Image1: TImage;
    StringGrid1: TStringGrid;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    Panel1: TPanel;
    Image2: TImage;
    SpeedButton2: TSpeedButton;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    SpeedButton3: TSpeedButton;
    N7: TMenuItem;
    SpeedButton5: TSpeedButton;
    SpeedButton1: TSpeedButton;
    OpenPictureDialog1: TOpenPictureDialog;
    N3: TMenuItem;
    Label1: TLabel;
    ColorDialog1: TColorDialog;
    Timer1: TTimer;
    Label3: TLabel;
    N8: TMenuItem;
    SpeedButton4: TSpeedButton;
    procedure SpeedButton2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure N4Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure Label1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure N8Click(Sender: TObject);
  private
    { Private declarations }
  public
  function pd(i,j:integer):boolean;
  procedure changit(i,j:integer);
  function winit:boolean;
  procedure dl;
  procedure resetit;
  procedure uprecord(name:string;time:integer);
  procedure readrecord;
  procedure writerecord;
      { Public declarations }
  end;

var
  Form1: TForm1;
  count:integer;
  arr:array [1..11] of re;

implementation

uses Unit2, Unit3;

{$R *.DFM}
procedure tform1.readrecord;
var i:integer;
fi:tinifile;
begin
fi:=tinifile.Create(extractfilepath(paramstr(0))+'\wzpt.ini');
for i:=1 to 10 do
begin
arr[i].name:=fi.ReadString('record','name'+inttostr(i),'未名');
arr[i].time:=fi.ReadInteger('record','time'+inttostr(i),1999);
end;
fi.Free;
end;

procedure tform1.writerecord;
var i:integer;
   fi:tinifile;
begin
fi:=tinifile.Create(extractfilepath(paramstr(0))+'\wzpt.ini');
for i:=1 to 10 do
begin
   fi.writestring('record','name'+inttostr(i),arr[i].name);
   fi.writeInteger('record','time'+inttostr(i),arr[i].time);
end;
fi.Free;
end;


procedure tform1.uprecord(name:string;time:integer);
var i,temp,j:integer;
tm:re;
begin
arr[11].name:=name;
arr[11].time:=time;

for i:=1 to 11 do
begin
temp:=i;

for j:=i to 11 do
begin
if (arr[j].time<arr[temp].time) then temp:=j;
end;

tm:=arr[i];
arr[i]:=arr[temp];
arr[temp]:=tm;

end;

end;

procedure tform1.resetit;
var i,j:integer;
begin
count:=0;
for j:=1 to 3 do
for i:=1 to 6 do
stringgrid1.cells[i-1,j-1]:=inttostr(i+(j-1)*6);
stringgrid1.cells[6,0]:='0';
stringgrid1.refresh;
end;

procedure tform1.dl;
var
i,a,b:integer;
begin
for i:=1 to 1000 do
begin
a:=random(6);
b:=random(3);
changit(a,b);
end;
end;

function tform1.winit:boolean;
var i,j:integer;
go:boolean;
begin
go:=true;
for i:=0 to 2 do
for j:=0 to 5 do
if strtoint(stringgrid1.Cells[j,i])<>i*6+j+1 then go:=false;
result:=go;
end;

procedure tform1.changit(i,j:integer);
var temp:string;
begin
if ((i>=0) and (i<6) and (j>=0) and (j<3)) or ((i=6)and(j=0)) then
begin

if pd(i+1,j) then
begin
temp:=stringgrid1.cells[i,j];
stringgrid1.cells[i,j]:=stringgrid1.cells[i+1,j];
stringgrid1.cells[i+1,j]:=temp;
end;
if pd(i-1,j) then
begin
temp:=stringgrid1.cells[i,j];
stringgrid1.cells[i,j]:=stringgrid1.cells[i-1,j];
stringgrid1.cells[i-1,j]:=temp;
end;
if pd(i,j-1) then
begin
temp:=stringgrid1.cells[i,j];
stringgrid1.cells[i,j]:=stringgrid1.cells[i,j-1];
stringgrid1.cells[i,j-1]:=temp;
end;
if pd(i,j+1) then
begin
temp:=stringgrid1.cells[i,j];
stringgrid1.cells[i,j]:=stringgrid1.cells[i,j+1];
stringgrid1.cells[i,j+1]:=temp;
end;
end;
end;

function tform1.pd(i,j:integer):boolean;
begin

if ((i>=0) and (i<6) and (j>=0) and (j<3)) or ((i=6)and(j=0)) then begin
if stringgrid1.Cells[i,j]='0' then result:=true else result:=false;
end
else result:=false;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
close;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
stringgrid1.Canvas.Font.color:=clFuchsia;
resetit;
image2.picture:=image1.picture;
end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin

if (acol<6) or (arow<1) then begin
stringgrid1.Canvas.Brush.Style:=bsDiagCross;
stringgrid1.canvas.brush.Color:=clblue;

stringgrid1.Canvas.fillrect(rect);
if stringgrid1.Cells[acol,arow]<>'0' then stringgrid1.Canvas.CopyRect(rect,image1.canvas,bounds(((strtoint(stringgrid1.cells[acol,arow])-1) mod 6)*60,((strtoint(stringgrid1.cells[acol,arow])-1) div 6)*60,60,60));
if speedbutton5.down then stringgrid1.Canvas.TextOut(rect.left+2,rect.top+2,stringgrid1.cells[acol,arow]);
end else begin
stringgrid1.Canvas.Brush.Style:=bsDiagCross;
stringgrid1.canvas.brush.Color:=clblue;
stringgrid1.Canvas.fillrect(rect);
end;

end;

procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
var st:string;
begin

if speedbutton3.Down then begin
changit(acol,arow);
if winit then
  begin
  speedbutton3.Down:=false;
  n4.checked:=false;
  timer1.Enabled:=false;
  messagebox(handle,pchar('您真是太棒了!'+#13+'共用了'+inttostr(count div 60)+'分'+inttostr(count mod 60)+'秒'),'智力拼图1.0',0);

  if InputQuery('请输入您的大名:','您的姓名:',st) then
  begin
  readrecord;
  if st='' then st:='未名';
  uprecord(st,count);
  writerecord;
  end;
  count:=0;
  label3.caption:='时间:0分0秒';
  end;

end;
end;

procedure TForm1.N4Click(Sender: TObject);
begin
speedbutton3.down:=not speedbutton3.down;
speedbutton3.click;
end;

procedure TForm1.N6Click(Sender: TObject);
begin
form2.showmodal;
end;

procedure TForm1.SpeedButton5Click(Sender: TObject);
begin
stringgrid1.Refresh;
end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
if speedbutton3.down then dl else resetit;
    n4.Checked:=not n4.checked;
    timer1.Enabled:=not timer1.enabled;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
if OpenPictureDialog1.execute then
  begin
     image1.Picture.LoadFromFile(OpenPictureDialog1.filename);
     image2.picture.loadfromfile(OpenPictureDialog1.filename);
     stringgrid1.Refresh;
  end;
end;

procedure TForm1.N3Click(Sender: TObject);
begin
close;
end;

procedure TForm1.N5Click(Sender: TObject);
begin
speedbutton1.click;
end;

procedure TForm1.Label1Click(Sender: TObject);
begin
if colordialog1.execute then begin
   stringgrid1.canvas.font.Color:=colordialog1.Color;
   label1.font.color:=colordialog1.color;
   stringgrid1.refresh;
end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
   count:=count+1;
   label3.caption:='时间:'+inttostr(count div 60)+'分'+inttostr(count mod 60)+'秒';
end;

procedure TForm1.SpeedButton4Click(Sender: TObject);
begin
form3.showmodal;
end;

procedure TForm1.N8Click(Sender: TObject);
begin
form3.showmodal;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -