< linkdetail01.htm < indextable01.htm < index.html
<<< freepascal_lazarus_03_001.html >>>
Counter： 回
(... 2025R07-1101-SAT-1114)Lazarus FreePascal Talking Board 01 0001
freepascal_lazarus_01_001.html
freepascal_lazarus_02_001.html
2026R08-0117-SAT-1657
skalogryz/richmemo
https://github.com/skalogryz/richmemo/
未確認。僕はそもそも付属LCLを活用する事を目的とするので。付属LCLの継承の可能性はある。
(... 2026R08-0117-SAT-1657)
2026R08-0113-TUE-1754
残念ながら、選択範囲に書式を適用する事はできません。プレーンテキストベースで、選択範囲に対して部分的なフォントや色を設定できない。
□■□■□■□■□■□■□■□■□■□■□■□■□
■□■□■□■□■□■□■□■□■□■□■□■□■
■□■□■□■□■□■□■□■□■□■□■□■□■
□■□■□■□■□■□■□■□■□■□■□■□■□
[[[ Unit1.pas ]]]
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, StdCtrls, ExtCtrls, ColorBox,
RTTICtrls, Dialogs, Graphics;
type
{ TForm1 }
TForm1 = class(TForm)
CheckBold: TCheckBox;
CheckItalic: TCheckBox;
ColorBox1: TColorBox;
ComboFont: TComboBox;
ComboSize: TComboBox;
TIMemo1: TTIMemo;
procedure CheckBoldChange(Sender: TObject);
procedure CheckItalicChange(Sender: TObject);
procedure ColorBox1Change(Sender: TObject);
procedure ComboFontChange(Sender: TObject);
procedure ComboSizeChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
FLoading: Boolean; // 初期化中かどうかを判定するフラグ
procedure UpdateFont;
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
var
i: Integer;
begin
// 読み込み開始。この間、各コンポーネントのChangeイベントは無視されます
FLoading := True;
try
// フォント一覧を取得
ComboFont.Items.Assign(Screen.Fonts);
ComboFont.ItemIndex := ComboFont.Items.IndexOf(TIMemo1.Font.Name);
// サイズ一覧を設定
ComboSize.Items.Clear;
for i := 8 to 32 do
ComboSize.Items.Add(IntToStr(i));
ComboSize.ItemIndex := ComboSize.Items.IndexOf(IntToStr(TIMemo1.Font.Size));
// 初期スタイルと色の同期
CheckBold.Checked := fsBold in TIMemo1.Font.Style;
CheckItalic.Checked := fsItalic in TIMemo1.Font.Style;
// ColorBox1が存在することを確認してから代入
if Assigned(ColorBox1) then
ColorBox1.Selected := TIMemo1.Font.Color;
finally
// すべての配置と初期設定が終わったのでフラグを下ろす
FLoading := False;
end;
end;
procedure TForm1.ComboFontChange(Sender: TObject);
begin
if FLoading then Exit;
TIMemo1.Font.Name := ComboFont.Text;
end;
procedure TForm1.ComboSizeChange(Sender: TObject);
begin
if FLoading then Exit;
if ComboSize.Text <> '' then
TIMemo1.Font.Size := StrToIntDef(ComboSize.Text, 12);
end;
procedure TForm1.CheckBoldChange(Sender: TObject);
begin
if FLoading then Exit;
UpdateFont;
end;
procedure TForm1.CheckItalicChange(Sender: TObject);
begin
if FLoading then Exit;
UpdateFont;
end;
procedure TForm1.ColorBox1Change(Sender: TObject);
begin
// 読み込み中、またはColorBox1が未生成なら処理しない
if FLoading or not Assigned(ColorBox1) then Exit;
TIMemo1.Font.Color := ColorBox1.Selected;
end;
procedure TForm1.UpdateFont;
var
Style: TFontStyles;
begin
if FLoading then Exit;
Style := [];
if CheckBold.Checked then Include(Style, fsBold);
if CheckItalic.Checked then Include(Style, fsItalic);
TIMemo1.Font.Style := Style;
end;
end.
□■□■□■□■□■□■□■□■□■□■□■□■□
■□■□■□■□■□■□■□■□■□■□■□■□■
■□■□■□■□■□■□■□■□■□■□■□■□■
□■□■□■□■□■□■□■□■□■□■□■□■□
[[[ unit1.lfm ]]]
object Form1: TForm1
Left = 1091
Height = 400
Top = 134
Width = 600
Caption = 'TTIMemo Rich Editor Sample'
ClientHeight = 400
ClientWidth = 600
LCLVersion = '4.4.0.0'
OnCreate = FormCreate
object ComboFont: TComboBox
Left = 8
Height = 23
Top = 8
Width = 180
ItemHeight = 15
TabOrder = 0
OnChange = ComboFontChange
end
object ComboSize: TComboBox
Left = 200
Height = 23
Top = 8
Width = 60
ItemHeight = 15
TabOrder = 1
OnChange = ComboSizeChange
end
object CheckBold: TCheckBox
Left = 280
Height = 19
Top = 10
Width = 42
Caption = 'Bold'
TabOrder = 2
OnChange = CheckBoldChange
end
object CheckItalic: TCheckBox
Left = 340
Height = 19
Top = 10
Width = 43
Caption = 'Italic'
TabOrder = 3
OnChange = CheckItalicChange
end
object TIMemo1: TTIMemo
Left = 8
Height = 340
Top = 40
Width = 584
Anchors = [akTop, akLeft, akRight, akBottom]
Lines.Strings = (
'これはリッチエディットのサンプルです。'
)
end
object ColorBox1: TColorBox
Left = 408
Height = 26
Top = 8
Width = 100
ItemHeight = 18
TabOrder = 5
OnChange = ColorBox1Change
end
end
□■□■□■□■□■□■□■□■□■□■□■□■□
■□■□■□■□■□■□■□■□■□■□■□■□■
■□■□■□■□■□■□■□■□■□■□■□■□■
□■□■□■□■□■□■□■□■□■□■□■□■□
18:05
Counter: 000044
20:28
Counter: 000046
2025R07-1229-MON-1141
Lazarus Free Pascal サンプル
study_class.lpr.html
コンソールプログラム。
以下に同じ。
2025R07-1228-SUN-1958
Lazarus Free Pascal サンプル
raiiexample.lpr.html
コンソールプログラム。
コンソールプログラムでのビルド実行方法:
[プロジェクト]-[プロジェクトを閉じる]で「プロジェクトウィザード」-「新規プロジェクト」もしくは[プロジェクト]-[新規プロジェクト]から「新規にプロジェクトを作成窓」から「単純なプログラム」でIDEを開き、上記リンクraiiexample.lpr.htmlのソースコードをCtrl+aで全文選択、Ctrl+cでコピー。Lazarusエディターを同じくCtrl+aで全文選択、Ctrl+vでペースト。お好きなフォルダにlprファイルを保存。コンパイル＆構築。コンソールプログラムなので、コマンドプロンプトを起動する。
cmd(コマンドプロンプト。ターミナル)を開く方法:
① Windowsエクスプローラー(ファイラー)でプロジェクトを保存した(exe生成場所)フォルダを開く
② アドレスバーにマウスカーソルを持っていって、右端の文字のない部分をクリックし、そこに「cmd」と入力し⏎キーを押す。
そこで、「raiiexample.exe」と入力し(途中まで入力しタブキーで補完入力可能)、エンター(⏎キー)で実行。
2025R07-1210-WED-1748
・Circle(円)はπr2乗(パイアール2乗)。r=radius。 [ \text{Area} = \pi \cdot r^2 ]
Area = π*(5*5)
・Square(四角形・正方形)はs2乗。s=side。 [ \text{Area} = s^2 ]
Area = s*s
ShapeFactory.pas::
(Unit1.pasを保存時に、ShapeFactory.pasに改名している)
1) Lazarusの[プロジェクト]から[プロジェクトを閉じる]で一度開いているファイルを全て閉じる。保存していないソースコードで必要なものは保存する。
2) 新しく、 (閉じた場合は、同じく[プロジェクト]から[プロジェクトを開く]をクリック）「プロジェクトウィザード」が開く。そこから「新規プロジェクト」をクリックして、「アプリケーション」をクリック。
3) IDEが起動するので、まず、Formをタイトルバーがかくれない位置に移動。
4) まず、初期起動に指定されているUnit1.pasのファイル名を替えるにあたって、以下の茶色枠のように、一行目にunit ShapeFactory;と書いてあれば自動でファイル名候補として表示される。なので、今回は、以下の.pasソースコードを先にLazarusエディターのunit1というタブに貼り付ける。
5) では、以下の茶色枠の.pasの内容をブラウザで選択したらCtrl＋cでコピする。Lazarusのエディターの定型文をCtrl＋aで選択、Ctrl＋vすると内容消去＋内容貼り付けができる。
6) (貼り付け完了したら)Ctrl＋s([ファイル]-[保存]に同じ)すると、ファイル保存ダイアログウィンドウが出ます。そこでお好きな場所へ例えば、C:\Documents\Lazarus\pgm\study-0001などを作成します。
7) 表示されたダイアログにファイル名「project1.lpi」と出ている。これはのちに実行ファイル.exeになるファイル名を指定するものだ。プロジェクトファイルと呼ばれます。例えば、ここでは「tshape.lpi」として保存する。
8) lpiを保存するとすぐに自動的に.pas保存ダイアログウィンドウが表示され(今回は貼り付けたソースコードに「ShapeFactory.pas」というファイル名が記述されているので自動的に記述されています。これは(unit)ユニットファイルと呼ばれています。では、「ShapeFactory.pas」となっているのを確認して保存。これで、.lpiと.pasが保存されました。次に、
9) [ファイル]-[開く]から、unit1.pasの代わりのShapeFactory.pasに対応する「shapefactory.lfm」を見つけて、開きます。
10) .lfmファイルが開いたら以下のグレー枠に、
ShapeFactory.pas (Unit1.pasの改名):
unit ShapeFactory;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls;
type
// 抽象基底クラス
TShape = class
public
function Area: Double; virtual; abstract;
function Description: String; virtual;
end;
// 派生クラス：円
TCircle = class(TShape)
private
FRadius: Double;
public
constructor Create(ARadius: Double);
function Area: Double; override;
function Description: String; override;
end;
// 派生クラス：四角形
TSquare = class(TShape)
private
FSide: Double;
public
constructor Create(ASide: Double);
function Area: Double; override;
function Description: String; override;
end;
{ TForm1 }
TForm1 = class(TForm)
BtnCArea: TButton;
BtnCDsp: TButton;
BtnSArea: TButton;
BtnSDsp: TButton;
BtnClear: TButton;
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
Memo1: TMemo;
procedure BtnCAreaClick(Sender: TObject);
procedure BtnCDspClick(Sender: TObject);
procedure BtnSAreaClick(Sender: TObject);
procedure BtnSDspClick(Sender: TObject);
procedure BtnClearClick(Sender: TObject);
private
public
end;
var
Form1: TForm1;
// ファクトリ関数
function CreateShape(const ShapeType: String): TShape;
implementation
{$R *.lfm}
//uses
//SysUtils;
{ TShape }
function TShape.Description: String;
begin
Result := 'Generic Shape';
end;
{ TCircle }
constructor TCircle.Create(ARadius: Double);
begin
inherited Create;
FRadius := ARadius;
end;
function TCircle.Area: Double;
begin
Result := Pi * FRadius * FRadius;
end;
function TCircle.Description: String;
begin
Result := Format('Circle (radius=%.2f)', [FRadius]);
end;
{ TSquare }
constructor TSquare.Create(ASide: Double);
begin
inherited Create;
FSide := ASide;
end;
function TSquare.Area: Double;
begin
Result := FSide * FSide;
end;
function TSquare.Description: String;
begin
Result := Format('Square (side=%.2f)', [FSide]);
end;
{ TForm1 }
procedure TForm1.BtnCAreaClick(Sender: TObject);
var
Shape: TShape;
begin
Shape := CreateShape('circle');
try
Memo1.Lines.Add(FloatToStr(Shape.Area));
finally
Shape.Free;
end;
end;
procedure TForm1.BtnCDspClick(Sender: TObject);
var
Shape: TShape;
begin
Shape := CreateShape('circle');
try
Memo1.Lines.Add(Shape.Description);
finally
Shape.Free;
end;
end;
procedure TForm1.BtnSAreaClick(Sender: TObject);
var
Shape: TShape;
begin
Shape := CreateShape('square');
try
Memo1.Lines.Add(FloatToStr(Shape.Area));
finally
Shape.Free;
end;
end;
procedure TForm1.BtnSDspClick(Sender: TObject);
var
Shape: TShape;
begin
Shape := CreateShape('square');
try
Memo1.Lines.Add(Shape.Description);
finally
Shape.Free;
end;
end;
procedure TForm1.BtnClearClick(Sender: TObject);
begin
Memo1.Lines.Clear;
end;
{ Factory }
function CreateShape(const ShapeType: String): TShape;
begin
if ShapeType = 'circle' then
Result := TCircle.Create(5.0)
else if ShapeType = 'square' then
Result := TSquare.Create(3.0)
else
raise Exception.Create('Unknown shape type: ' + ShapeType);
end;
end.
10) 以下のグレー枠に書いてあるobject Form1: TForm1から始まる
〇「以下のグレー枠のshapefactory.lfmファイルの内容を選択しコピー」した後、コピーした内容を先ほど開いた、Lazarusのエディターのshapefactory.lfmタブに貼り付ける工程だ。
〇 まず、Lazarusの.lfmタブをCtrl＋a(全選択)で全選択し青く反転されたら、次に反転をDelを押して消去しCtrl＋v(貼り付け)。反転を上からそのままCtrl＋v(貼り付け)で貼り付けでもいい、とても賢い。そしてCtrl+sで今操作したタブの内容を保存できる。
〇 .lfmの貼り付けを完了したら、[ファイル]-[全て保存]でとりあえず「全ての変更を保存」する。
11) 最終工程。変更した.lfmこの場合、shapefactory.lfmの変更を反映させるためにLazarusを再起動します。[ファイル]-[再起動]で再起動します(ただし変更履歴はクリアされます。そもそも「やり直し」がうまく動きませんが・・・)。上手くいけばForm1のコンポーネント群が貼り付けられているはず。もし、貼り付けられていない場合で、かつエラーが出ない場合は、.lfmの内容が書き換わっていない、元に戻っている、初期状態に戻っている場合がある。その時は、もう一度、「shapefactory.lfm」タブを開き、内容が戻っていれば、もう一度貼り付けて保存。[ファイル]メニューから再起動する。
※ もし、再起動時にエラーが出る場合、.pasと.lfmの整合性がとれていないので、必ず.pasの内容の改造前に、先にshapefactory.lfmの反映を行ってください。
ShapeFactory.lfm::
object Form1: TForm1
Left = 1164
Height = 240
Top = 125
Width = 320
Caption = 'Form1'
ClientHeight = 240
ClientWidth = 320
LCLVersion = '4.4.0.0'
object Memo1: TMemo
Left = 128
Height = 208
Top = 16
Width = 142
TabOrder = 0
end
object BtnClear: TButton
Left = 24
Height = 25
Top = 199
Width = 75
Caption = 'Clear'
TabOrder = 1
OnClick = BtnClearClick
end
object GroupBox1: TGroupBox
Left = 16
Height = 87
Top = 9
Width = 96
Caption = 'TCircle:'
ClientHeight = 67
ClientWidth = 92
TabOrder = 2
object BtnCArea: TButton
Left = 8
Height = 25
Top = 0
Width = 75
Caption = 'Area'
TabOrder = 0
OnClick = BtnCAreaClick
end
object BtnCDsp: TButton
Left = 8
Height = 25
Top = 32
Width = 75
Caption = 'Description'
TabOrder = 1
OnClick = BtnCDspClick
end
end
object GroupBox2: TGroupBox
Left = 16
Height = 84
Top = 104
Width = 96
Caption = 'TSquare:'
ClientHeight = 64
ClientWidth = 92
TabOrder = 3
object BtnSArea: TButton
Left = 8
Height = 25
Top = 0
Width = 75
Caption = 'Area'
TabOrder = 0
OnClick = BtnSAreaClick
end
object BtnSDsp: TButton
Left = 8
Height = 25
Top = 32
Width = 75
Caption = 'Description'
TabOrder = 1
OnClick = BtnSDspClick
end
end
end
2025R07-1101-SAT-1120
①プロジェクトメニューで管理。プロジェクトメニューを制するものがLazarusを征する。
まず、プロジェクトを一度閉じる。
.ifmに内容を貼り付けた場合は、[ファイル]-[再起動]が必要。ただし、.pasの貼り付けも必要で.pasと.lfmの整合性がとれていないとエラーで大変。だが、非常に便利。.lfmが開けばFormのデザインが自動で再現されている。正確にはFormの内容とプロパティーは.lfmにテキストで書いてあるという事。.pasに書く事も可能で、そうして.lfmの容量を減らす事ができる。
waku_gray
waku_blue
waku_orange
waku_green
waku_red
waku_brown
waku_yellow
CC BY tDG.