メインメニューの位置調整(Ver.1.6.x)

1. [ツール(T)]→[オプション...]を選択します
2. IDEオプションダイアログから[環境]→[ウィンドウ]の[Automatically adjust IDE main window height]のチェックマークを外し、 [OK(O)]ボタンをクリックします
3. メインメニューのウィンドウを調節します
4. 再度、IDEオプションダイアログから[環境]→[ウィンドウ]の[Automatically adjust IDE main window height]のチェックマークをつけ、 [OK(O)]ボタンをクリックします

旧バージョンのLazarusをインストールした際、アップデートの除外を指定

$ echo lazarus-project hold | sudo dpkg --set-selections
$ echo fpc-laz hold | sudo dpkg --set-selections
$ echo fpc-src hold | sudo dpkg --set-selections

$ dpkg --get-selections | grep hold

ダウンロード

Lazarus 1.6.x https://drive.google.com/open?id=0B9Me_c5onmWobVZOdVlXSlZRRmc
Lazarus 1.8.x {$LazarusDir}/Component/onlinepackagemanagerにソースファイルがあります
Lazarus 2以降は、既にインストールされています

インストール、及び使い方

Lazarus and Free Pascak Wiki(英語) http://wiki.freepascal.org/Online_Package_Manager

LazColorPaletteコンポーネントのダウンロード

http://sourceforge.net/p/lazarus-ccr/svn/HEAD/tree/components/colorpalette/
※他のダウンロードサイトは古いため、エラーが出ます

LazImageEditorのダウンロード

https://svn.code.sf.net/p/lazarus-ccr/svn/applications/lazimageeditor/

LazImageEditorのinstall.shの編集

1. Install.sh内のImagesディレクトリィをimages(小文字)にimage変更します
2. 下記の内容を追加します

   cp default.pal $DESTDIR/usr/share/$EXENAME/

3. install.shを実行形式に変更します

   $ chmod 755 install.sh

コンパイルが終了したら、下記のコマンドを使ってインストールします

$ sudo ./install.sh

原因

ライブラリパスにcrtbegin.oがないため

対策

1. 端末で、以下のコマンドを実行してcrtbegin.oファイルを検索します

   $ find /usr/lib -name crtbegin.o
   /usr/lib/gcc/i686-linux-gnu/7/crtbegin.o
   $
   

2. crtbegin.oファイルがあるディレクトリをライブラリパスに設定します
   • 端末で、以下のコマンドを実行してfpc.cfgファイルを編集します(テキストエディタLeafpadを使用した場合)

     $ sudo leafpad /etc/fpc.cfg

   • 178行付近の-Flパラメータにcrtbegin.oファイルのあるディレクトリを追加し、保存します

     -Fl/usr/lib/fpc/$fpcversion/lib/$FPCTARGET;/usr/lib/gcc/i686-linux-gnu/7

参考: https://forum.lazarus.freepascal.org/index.php?topic=34288.0

1. Lengthを使用するとバイト数が返ってくるので、UTF8Lengthを使用する

   uses　..., LCLProc;
   ...
   var
     i: Integer;
     s: String;
   begin
     s := 'あいうえお';
     i := UTF8Length(s); // 5が返ってくる
   

2. 正しく文字列定数と文字列リテラルを扱うには、UTF-8でソースコードを作成し、{$CODEPAGE UTF8}ディレクティブを指定する

   {$MODE OBJFPC}{$H+}
   {$CODEPAGE UTF8}
   

   参考: http://lazpas.e-hiyori.org/wp/2014/04/28/667

GetUserDir

uses ..., WinDirs;
...
GetWindowsSpecialDir(CSIDL_PERSONAL)

uses
{$IFDEF LINUX}
  Unix
{$ENDIF}
{$IFDEF WINDOWS}
  Windows
{$ENDIF}
  ;			

function GetComputerNameCommon: String;
{$IFDEF WINDOWS}
var
  cnb: array[0..255] of char;
  sb: DWord;
{$ENDIF}
begin
  {$IFDEF LINUX}
  Result := GetHostName;
  {$ENDIF}
  {$IFDEF WINDOWS}
  sb := 256;
  getComputerName(cnb, sb);
  Result := String(cnb);
  {$ENDIF}
end;

AdditionalのTrayIconをフォームに貼り付け
StandardのTpopupMenuをフォームに貼り付け

TrayIcon1.Icon.LoadFromFile('aaa.ico');
TrayIcon1.Hint := 'TEST';
TrayIcon1.PopUpMenu := PopupMenu1;
TrayIcon1.Show

1. メインフォームのFormShow内容

   procedure TForm1.FormShow(Sender: TObject);
   begin
     // アプリケーションのタスクバーを非表示
     ShowInTaskBar := stNever;
   end;
   

2. SDIフォームのFormShow内容

   procedure TForm2.FormShow(Sender: TObject);
   begin
     {$IFDEF LINUX}
     // アプリケーションのタスクバーを非表示(Linux)
     ShowInTaskBar := stNever;
     {$ENDIF}
     {$IFDEF WINDOWS}
     // アプリケーションのタスクバーを非表示(Windows)
     ShowInTaskBar := stDefault;
     {$ENDIF}						 
   end;
   

FormCreateイベントで使用すると、稀にタスクバーを非表示できない場合があるので、FormShowイベントで利用します

uses gtk2;
...
gtk_window_stick(GTK_WINDOW(pointer(Handle)));
gtk_window_unstick(GTK_WINDOW(pointer(Handle)));

FormCreateイベントで使用すると、非表示/表示を繰り返したときに解除されるので、FormShowイベントで利用します

uses gtk2, gdk2;
...
gdk_window_fullscreen(PGtkWidget(Handle)^.window);
gdk_window_unfullscreen(PGtkWidget(Handle)^.window);

Application.ShowMainForm := False;

Constraints.MinWidth := 100;
Constraints.MinHeight := 34;

var
  p: TPoint;
  titlebarheight: Integer;
  framewidth: Integer;
begin
  // ウィンドウのタイトルバーの高さと枠幅を算出
  // (メインメニューを使用している場合は、メインメニューの高さを追加する)
  p := ClientToScreen(Point(-1, -1));
  titlebarheight := p.y - Top - MainMenu1.Height;
  framewidth := p.x - Left;

Mouse.CursorPos.X
Mouse.CursorPos.Y

Screen.Height
Screen.Width

uses LCLIntf;
...
GetWindowRect(Handle: HWND; var Rect: TRect):Integer;

Form1にStatusBar1とProgressBar1コンポーネントを配置する

procedure TForm1.FormCreate(Sender: TObject);
begin
  // プログレスバー(位置とサイズはFormResizeイベントに配置)
  ProgressBar1.Parent := StatusBar1;
  ProgressBar1.Align := alCustom; // alCustomにしないと移動できない
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  ProgressBar1.Top  := 2;
  ProgressBar1.Left := StatusBar1.Width - ProgressBar1.Width - 20;
end;

//=============================================================================
// ファイルのタイムスタンプ(更新日時)を返す
//=============================================================================
function GetFileModifyDate(FileName: String): TDateTime;
var
  F: TSearchRec;
begin
  FindFirst(FileName, faAnyFile, F);
  Result := FileDateToDateTime(F.Time);
  FindClose(F);
end;	

{$IFDEF LINUX}
Calendar1.Date := FormatDateTime('dd-mm-yyyy', Now);
{$ENDIF}
{$IFDEF WINDOWS}
Calendar1.Date := FormatDateTime('yyyy/mm/dd', Now);
{$ENDIF}

function TForm1.CalendarFormatChange(s: String): String;
begin
  Result := Calendar1.Date;
  {$IFDEF WINDOWS}
  // 曜日をブランクに変更(Windowsのみ)
  Result := StringReplace(Result, ' 日曜', '' , [rfReplaceAll]);
  Result := StringReplace(Result, ' 月曜', '' , [rfReplaceAll]);
  Result := StringReplace(Result, ' 火曜', '' , [rfReplaceAll]);
  Result := StringReplace(Result, ' 水曜', '' , [rfReplaceAll]);
  Result := StringReplace(Result, ' 木曜', '' , [rfReplaceAll]);
  Result := StringReplace(Result, ' 金曜', '' , [rfReplaceAll]);
  Result := StringReplace(Result, ' 土曜', '' , [rfReplaceAll]);
  // '年月日'を'/'に変更(Windowsのみ)
  Result := StringReplace(Result, '年', '/', [rfReplaceAll]);
  Result := StringReplace(Result, '月', '/', [rfReplaceAll]);
  Result := StringReplace(Result, '日', '' , [rfReplaceAll]);
  {$ENDIF}
end;			

ファンクション

//=============================================================================
// 外部プログラムの実行
// uses節にProcessを追加
// 参考: http://wiki.freepascal.org/Executing_External_Programs/ja
//=============================================================================
procedure launchprogram(cmd, param1, param2: String);
var
  p: TProcess;
begin
  p := TProcess.Create(nil);
  p.Executable:= cmd;
  if param1 <> '' then p.Parameters.Add(param1);
  if param2 <> '' then p.Parameters.Add(param2);
  // プログラムを走らせるときの、オプションを定義しましょう
  // このオプションは、実行した外部プログラムが停止するまで、
  // このプログラムが動かないようにします
  // p.Options := p.Options + [poWaitOnExit];
  p.Execute;
  // 外部プログラムが停止するまで、これは実行されません。
  p.Free;
end;

使い方

launchprogram('xdg-open', 'http://www.deepla.net/fusenc/fusenc.html', '');

type
  { TplStringGrid }
  TplStringGrid = class(TStringGrid)
  protected
    procedure DrawCell(aCol, aRow: Longint; aRect: TRect;
      aState: TGridDrawState); override;
  end;
  { Form1 }
  TForm1 = class(TForm)
    :
  private
    { private declarations }
    plStringGrid1: TplStringGrid;
    :
procedure TForm1.FormCreate(Sender: TObject);
begin
  //フォーム作成時にコンポーネントの入れ替え
  plStringGrid1 := TplStringGrid(ChangeComponent(StringGrid1, TplStringGrid));
end;
    :
//======================================================================
// TStgingGridの継承元のDrawCellメソッド
//	DrawText関数は、uses節にLCLIntf,LCLTypeを追加する
//======================================================================
procedure TplStringGrid.DrawCell(aCol, aRow: Integer; aRect: TRect;
                                 aState: TGridDrawState);
var
  tr: TRect;
begin
  if (gdFixed in aState) then begin
    // 固定グリッドの文字描画
    Canvas.Brush.Color := clBtnFace;
    Canvas.FillRect(Rect(aRect.Left,aRect.Top,aRect.Right-1,aRect.Bottom-1));
    Canvas.Pen.Color := clBlack;
    Canvas.Rectangle(Rect(aRect.Left-1,aRect.Top-1,aRect.Right,aRect.Bottom));
    Canvas.Font.Color := clBlack;
    DrawText(Canvas.Handle, PChar(Cells[aCol, aRow]), Length(Cells[aCol, aRow]),
             aRect, DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX or DT_CENTER);
  end else begin
    inherited;
  end;
end;

• ChangeComponentは、http://mrxray.on.coocan.jp/Delphi/CompoInstall/CompInstallDD.htm を参考
• ChangeComponentをLazarusで利用する時は、uses節にTypInfo,Controlsを追加する

// for systems using the PulseAudio sound server
// such as Linux Ubuntu Hardy Heron

uses
  [...] FileUtil, Process;

function PlaySoundLnx(fileName: String): Boolean;
const
  playerCmd = 'paplay';  // pulseaudio client  (Lubuntu -> aplay)
var
  AProcess: TProcess;
begin
  AProcess := TProcess.Create(nil);
  with Aprocess do begin
    CommandLine := FindDefaultExecutablePath(playerCmd) + 
      ' ' + filename;
    //Options := Options + [poWaitOnExit];
    try
      try
        Execute;
      except
        on E: Exception do
          ShowMessage(E.ClassName + 
            ' error raised, with message : ' + E.Message);
      end;
    finally
      Free;
    end;
  end;
end;

[...]

procedure PlayMyWAV;
begin
  // get application directory;
  // wav file is in the adudio subdirectory 
  AppDir := ExtractFilePath(Application.ExeName);
  // play WAV
  PlaySoundLnx(AppDir + 'audio/my.wav');
end;

Windowsのように、一時停止及び再再生が不可能

uses httpsend
...
function DownloadHTTP(URL, TargetFile: string): Boolean;
// Download file; retry if necessary.
// Could use Synapse HttpGetBinary, but that doesn't deal
// with result codes (i.e. it happily downloads a 404 error document)
const
  MaxRetries = 3;
var
  HTTPGetResult: Boolean;
  HTTPSender: THTTPSend;
  RetryAttempt: Integer;
begin
  Result := False;
  RetryAttempt := 1;
  HTTPSender := THTTPSend.Create;
  try
	 try
      // Try to get the file
      HTTPGetResult := HTTPSender.HTTPMethod('GET', URL);
      while (HTTPGetResult = False) and (RetryAttempt < MaxRetries) do
      begin
        Sleep(500 * RetryAttempt);
        HTTPGetResult := HTTPSender.HTTPMethod('GET', URL);
        RetryAttempt := RetryAttempt + 1;
      end;
      // If we have an answer from the server, check if the file
      // was sent to us.
      case HTTPSender.Resultcode of
        100..299:
          begin
            HTTPSender.Document.SaveToFile(TargetFile);
            Result := True;
          end; //informational, success
        300..399: Result := False; // redirection. Not implemented, but could be.
        400..499: Result := False; // client error; 404 not found etc
        500..599: Result := False; // internal server error
        else Result := False; // unknown code
      end;
    except
      // We don't care for the reason for this error; the download failed.
      Result := False;
    end;
  finally
    HTTPSender.Free;
  end;
end;

• httpsendは、https://code.google.com/p/synapse4lazarus/source/browse/trunk/source/?r=2 を参考

//=============================================================================
// idHTTPで読み込んだXMLからバージョンを検索
//	コンポーネントにIdHTTP
//	uses節にDOM, XMLReadを追加
//=============================================================================
function TMainForm.GetVersionFromXML: String;
var
  ss: TStringStream;
  doc: TXMLDocument;
  dn: TDOMNode;
  xmls: String;
  // ---------------------------------------------------
  // 子ノードの検索
  // ---------------------------------------------------
  function ProcessNode(nd: TDOMNode; s: String): String;
  var
    cn: TDOMNode;
  begin
    Result := s;
    if nd = nil then Exit; // Stops if reached a leaf
    if (LowerCase(nd.NodeName) = 'title') and
       (LowerCase(nd.TextContent) = 'fusenc') then Result := 'True';
    if (LowerCase(nd.NodeName) = 'description') and (s = 'True') then
      Result := nd.TextContent;
    // Goes to the child node
    cn := nd.FirstChild;
    // Processes all child nodes
    while cn <> nil do begin
      Result := ProcessNode(cn, Result);
      cn := cn.NextSibling;
    end;
  end;
  // ---------------------------------------------------
begin
  Result := '';
  try
    xmls := IdHTTP1.Get('http://www.deepla.net/softversion/version.xml');
    ss := TStringStream.Create(xmls);
    try
      ss.Position := 0;
      doc := nil;
      ReadXMLFile(doc, ss);
      dn := doc.DocumentElement.FirstChild;
      while dn  <> nil do
      begin
        Result := ProcessNode(dn, '');
        dn := dn.NextSibling;
      end;
    finally
      ss.Free;
    end;
  except
  end;
end;