请选择 进入手机版 | 继续访问电脑版

Lazarus中文社区

 找回密码
 立即注册

QQ登录

只需一步,快速开始

Lazarus IDE and 组件 下载地址版权申明
查看: 2131|回复: 4

常用的LAZARUS技巧

[复制链接]

该用户从未签到

发表于 2013-12-3 09:48:41 | 显示全部楼层 |阅读模式
本帖最后由 qqqqq 于 2013-12-3 09:52 编辑

专门开一贴,将本人编程用到的要点摘下来,一般也是到处抄的,作资料积累用,也为论坛增加点人气,
仅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;      
回复

使用道具 举报

该用户从未签到

 楼主 发表于 2013-12-4 09:12:16 | 显示全部楼层
本帖最后由 qqqqq 于 2013-12-4 09:13 编辑

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;
        
回复 支持 反对

使用道具 举报

  • TA的每日心情
    开心
    2020-9-18 14:51
  • 签到天数: 47 天

    [LV.5]常住居民I

    发表于 2013-12-8 15:38:03 | 显示全部楼层
    谢谢分享。
    回复 支持 反对

    使用道具 举报

    该用户从未签到

     楼主 发表于 2013-12-9 15:19:05 | 显示全部楼层
    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.                  
    回复 支持 反对

    使用道具 举报

    该用户从未签到

    发表于 2013-12-10 09:08:23 | 显示全部楼层
    不错,学习了
    回复 支持 反对

    使用道具 举报

    QQ|手机版|小黑屋|Lazarus中国|Lazarus中文社区 ( 鄂ICP备16006501号-1

    GMT+8, 2021-2-25 19:21 , Processed in 0.072959 second(s), 24 queries .

    Powered by Discuz! F1.0 Build 20160930

    © 2001-2021 Comsenz Inc. & Discuz! Fans

    快速回复 返回顶部 返回列表