常用的LAZARUS技巧

qqqqq

专门开一贴，将本人编程用到的要点摘下来，一般也是到处抄的，作资料积累用，也为论坛增加点人气，
仅windows下：
1.在表格上双击单元格，避免空白区响应。
现象：在单元格内双击，触发某事件，但只要单元格有焦点，在空白区内双击，也会触发事件，为此作的一个判断。

procedure TFrmmain.SGrid1DblClick(Sender: TObject);
var
  point:tpoint;
  k,m1,m2,n1,n2:integer;
begin
  with sgrid1 do
  begin
    point:=ScreenToClient(Mouse.CursorPos);
    m1:=0;
    m2:=0;
    for k:=0 to colcount-1 do
    begin
      if k<fixedcols then
      m2:=m2+colwidths[k];
      m1:=m1+colwidths[k];
    end;
    n1:=0;
    n2:=0;
    for k:=0 to rowcount-1 do
    begin
      if k<fixedrows then
      n2:=n2+RowHeights[k];
      n1:=n1+RowHeights[k];
    end;
    if (point.y>n1) or (point.y<n2) then exit;
    if (point.x>m1) or (point.x<m2) then exit;
   Sbtn_modi.Click ;
  end;
end;      

qqqqq

2.在桌面和开始菜单上建立快捷方式
uses shlobj;
function MakeLink(filename, linkname, programname: string): Boolean;
var
  tmpObject: IUnknown;
  tmpSLink: IShellLink;
  tmpPFile: IPersistFile;
  PIDL: PItemIDList;
  StartupDirectory: array[0..MAX_PATH] of Char;
  StartupFilename: string;
  LinkFilename,directory: wideString;
  s2,s1:string;
begin
   result:=false;
   StartupFilename:=filename;
   if not FileExists(utf8toansi(StartupFilename)) then Exit;
   tmpObject := CreateComObject(CLSID_ShellLink);
   tmpSLink := tmpObject as IShellLink;
   tmpPFile := tmpObject as IPersistFile;

   with tmpSLink do
   begin
      SetArguments('') ;    //设置命令行参数
      SetDescription('');   //描述提示
      SetPath(pChar(StartupFilename));//设置程序全路径
      SetWorkingDirectory(pChar(ExtractFilePath(StartupFilename))); //设置工作目录
   end;
   if Trim(programname)='' then
   begin
     //CSIDL_DESKTOP  C:\Documents and Settings\Administrator\桌面
     SHGetSpecialFolderLocation(0,CSIDL_DESKTOP,PIDL);
     SHGetPathFromIDList(PIDL,StartupDirectory);
     directory:=StartupDirectory;
   end
   else
   begin
   //CSIDL_PROGRAMS  C:\Documents and Settings\Administrator\「开始」菜单\程序
     SHGetSpecialFolderLocation(0,CSIDL_PROGRAMS,PIDL);
     SHGetPathFromIDList(PIDL,StartupDirectory);
     s1:='\'+ utf8toansi(programname) ;
     directory:=StartupDirectory+s1;
   
     if not DirectoryExists(WideString(directory)) then
     CreateDir(WideString(directory));
   end;

   s2 :='\'+utf8toansi(Linkname)+'.lnk' ;
   LinkFilename := directory+s2 ;
   if FileExists(LinkFileName) then
   DeleteFile(LinkFilename);  // 快捷方式己存在,不能重复建立'
   tmppfile.Save(pwchar(LinkFilename),false);
   result:=true;  //  快捷方式己建立','提示
end;
        

lhxzui

谢谢分享。

qqqqq

3.只运行一次。
其实都是从DELPHI转换过来的，略有差别。
program Cccccc;  
var
HWindow: THandle;
begin
   HWindow := FindWindow(nil,pchar(Utf8toansi('**系统'))); // 查找 Application 的 Title
   if HWindow <> 0 then
   begin
     if IsIconic(HWindow) then   //最小化
     SendMessage(HWindow,WM_SYSCOMMAND,SC_RESTORE,0);
     SetForeGroundWindow(HWindow);
     Application.Terminate;
     Exit;
   end;


  RequireDerivedFormResource := True;
  Application.Initialize;
  SplashScreen := TSplashScreen.Create(nil) ;
  SplashScreen.Show;
  SplashScreen.Update;
  Application.ProcessMessages;
  Application.CreateForm(TFrmsmain, Frmsmain);
  application.Title:='**系统';
  SplashScreen.Hide;
  SplashScreen.Free;
  Application.Run;
end.                  

zyx7742

不错，学习了