📄 main.~pas
字号:
//Designer: Jiang Xiangang 2005.8
unit MAIN;
interface
uses Windows, SysUtils, Classes, Graphics, Forms, Controls, Menus,
StdCtrls, Dialogs, Buttons, Messages, ExtCtrls, ComCtrls, StdActns,
ActnList, ToolWin, ImgList, ExtDlgs,mmsystem;
type
TMainForm = class(TForm)
MainMenu1: TMainMenu;
File1: TMenuItem;
FileOpenItem: TMenuItem;
FileCloseItem: TMenuItem;
Window1: TMenuItem;
Help1: TMenuItem;
N1: TMenuItem;
FileExitItem: TMenuItem;
WindowCascadeItem: TMenuItem;
WindowTileItem: TMenuItem;
WindowArrangeItem: TMenuItem;
HelpAboutItem: TMenuItem;
OpenDialog: TOpenDialog;
FileSaveItem: TMenuItem;
Edit1: TMenuItem;
CutItem: TMenuItem;
CopyItem: TMenuItem;
PasteItem: TMenuItem;
WindowMinimizeItem: TMenuItem;
WindowTileItem2: TMenuItem;
ToolBar2: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
ToolButton6: TToolButton;
ToolButton7: TToolButton;
ToolButton8: TToolButton;
ToolButton10: TToolButton;
ToolButton11: TToolButton;
ImageList1: TImageList;
SavePictureDialog1: TSavePictureDialog;
StatusBar1: TStatusBar;
help: TMenuItem;
calculator: TMenuItem;
ActionList1: TActionList;
FileNew1: TAction;
FileOpen1: TAction;
FileClose1: TWindowClose;
FileSave1: TAction;
FileSaveAs1: TAction;
FileExit1: TAction;
EditCut1: TEditCut;
EditCopy1: TEditCopy;
EditPaste1: TEditPaste;
WindowCascade1: TWindowCascade;
WindowTileHorizontal1: TWindowTileHorizontal;
WindowTileVertical1: TWindowTileVertical;
WindowMinimizeAll1: TWindowMinimizeAll;
WindowArrangeAll1: TWindowArrange;
HelpAbout1: TAction;
Label1: TLabel;
ToolButton9: TToolButton;
ToolButton12: TToolButton;
ToolButton13: TToolButton;
Label2: TLabel;
Action1: TAction;
procedure FileNew1Execute(Sender: TObject);
procedure FileOpen1Execute(Sender: TObject);
procedure HelpAbout1Execute(Sender: TObject);
procedure FileExit1Execute(Sender: TObject);
procedure FileCloseItemClick(Sender: TObject);
procedure calculatorClick(Sender: TObject);
procedure helpClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FileSaveItemClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
function GraphicToBitmap(P:TPicture):TBitmap;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
procedure CreateMDIChild(const Name: string);
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
uses CHILDWIN, about,datamodule, HSL,GrayCurrenceMatrix;
procedure TMainForm.CreateMDIChild(const Name: string);
var
Child: TMDIChild;
Pathstring:string;
begin
{ create a new MDI child window }
Child := TMDIChild.Create(Application);
Child.Caption := Name;
if FileExists(Name) then begin
Child.Liverimage.Picture.LoadFromFile(Name);
GraphicToBitmap(Child.Liverimage.Picture);
child.Width :=child.liverimage.picture.width+1;
child.height:=child.liverImage.picture.height+1;
datamodule.loaderbmp := TBitmap.Create;
datamodule.loaderBmp.Assign(Child.liverImage.Picture.Bitmap);
datamodule.withdrawbmp:= TBitmap.Create;
datamodule.withdrawbmp.Assign(Child.liverImage.Picture.Bitmap);
end;
// GrayCurrenceMatrix.OpenPatternFile();
// GrayCurrenceMatrix.ClusterCenterCompare();
end;
procedure TMainForm.FileNew1Execute(Sender: TObject);
begin
CreateMDIChild('NONAME' + IntToStr(MDIChildCount + 1));
end;
procedure TMainForm.FileOpen1Execute(Sender: TObject);
begin
if OpenDialog.Execute then
CreateMDIChild(OpenDialog.FileName);
end;
procedure TMainForm.HelpAbout1Execute(Sender: TObject);
begin
AboutBox.Show;
end;
procedure TMainForm.FileExit1Execute(Sender: TObject);
begin
Close;
end;
procedure TMainForm.FileCloseItemClick(Sender: TObject);
begin
close;
end;
procedure TMainForm.calculatorClick(Sender: TObject);
begin
winexec('calculator\calc.exe',sw_showdefault);
end;
procedure TMainForm.helpClick(Sender: TObject);
var
pathstring:string;
begin
pathstring:=ExtractFilePath(Application.ExeName);
Application.HelpFile:=PathString+'help\RedCellSum.HLP' ;
Application.HelpCommand(Help_Finder,0);
end;
procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if application.MessageBox(' 确认要退出吗?','系统询问',MB_YESNO)=IDYES THEN
canclose:=true
else
canclose:=false;
end;
procedure TMainForm.FileSaveItemClick(Sender: TObject);
begin
SavePictureDialog1.Filter := '*.bmp|*.bmp';
if mainform.SavePictureDialog1.Execute then
begin
TMDIChild(self.MDIChildren[self.MDIChildCount-1]).liverImage.Picture.Bitmap.SaveToFile(SavePictureDialog1.FileName + '.bmp');
end;
end;
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
animatewindow(handle,400,aw_blend or aw_hide);
end;
function TMainForm.GraphicToBitmap(P:TPicture):TBitmap;//把任意格式图象转化为RGB位图
var
i:integer;
begin
Result:=TBitmap.Create;
Result.PixelFormat:=pf24bit;//转换为24位格式
with Result do
begin
Width:=P.Width;
Height:=P.Height;
Canvas.Draw(0,0,P.Graphic);
end;
p.Bitmap:=Result;
Result.Free;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
GrayCurrenceMatrix.OpenPatternFile();
GrayCurrenceMatrix.NormalizeTexture();
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -