OSDN -- Open-Source-Software-Entwicklung und Downloads
Übersetzungsstatus von Deutsch translation status for de
  • R/O
  • SSH
  • HTTPS

denkzettelcompanion: Commit


Commit MetaInfo

Revision51 (tree)
Zeit2018-10-06 20:18:39
Autordummzeuch

Log Message

(empty log message)

Ändern Zusammenfassung

Diff

--- tags/0.0.5/src/w_about.pas (nonexistent)
+++ tags/0.0.5/src/w_about.pas (revision 51)
@@ -0,0 +1,73 @@
1+unit w_About;
2+
3+{$mode objfpc}{$H+}
4+
5+interface
6+
7+uses
8+ Classes,
9+ SysUtils,
10+ FileUtil,
11+ Forms,
12+ Controls,
13+ Graphics,
14+ Dialogs,
15+ ExtCtrls,
16+ StdCtrls;
17+
18+type
19+
20+ { Tf_About }
21+
22+ Tf_About = class(TForm)
23+ b_Close: TButton;
24+ im_Logo: TImage;
25+ l_ProgInfo1: TLabel;
26+ l_ProgInfo2: TLabel;
27+ l_ProgInfo3: TLabel;
28+ l_ProgInfo5: TLabel;
29+ l_ProgName: TLabel;
30+ l_Copyright: TLabel;
31+ l_ProgInfo4: TLabel;
32+ procedure l_ProgInfo4Click(Sender: TObject);
33+ procedure l_ProgInfo5Click(Sender: TObject);
34+ private
35+ public
36+ class procedure Execute(_Owner: TWinControl);
37+ end;
38+
39+
40+implementation
41+
42+{$R *.lfm}
43+
44+uses
45+ LCLIntf,
46+ u_dzLazUtils;
47+
48+{ Tf_About }
49+
50+procedure Tf_About.l_ProgInfo5Click(Sender: TObject);
51+begin
52+ OpenURL(l_ProgInfo5.Caption);
53+end;
54+
55+procedure Tf_About.l_ProgInfo4Click(Sender: TObject);
56+begin
57+ OpenURL(l_ProgInfo4.Caption);
58+end;
59+
60+class procedure Tf_About.Execute(_Owner: TWinControl);
61+var
62+ frm: Tf_About;
63+begin
64+ frm := Tf_About.Create(_Owner);
65+ try
66+ TForm_CenterOn(frm, _Owner);
67+ frm.ShowModal;
68+ finally
69+ FreeAndNil(frm);
70+ end;
71+end;
72+
73+end.
--- tags/0.0.5/src/w_denkzettelcompanion.pas (nonexistent)
+++ tags/0.0.5/src/w_denkzettelcompanion.pas (revision 51)
@@ -0,0 +1,156 @@
1+unit w_DenkzettelCompanion;
2+
3+{$mode objfpc}{$H+}
4+
5+interface
6+
7+uses
8+ Windows,
9+ Classes,
10+ SysUtils,
11+ Forms,
12+ Controls,
13+ Menus,
14+ StdCtrls,
15+ wf_Categories;
16+
17+type
18+
19+ { Tf_DenkzettelCompanion }
20+
21+ Tf_DenkzettelCompanion = class(TForm)
22+ b_Configure: TButton;
23+ l_NotConfigured: TLabel;
24+ procedure b_ConfigureClick(Sender: TObject);
25+ procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
26+ procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
27+ private
28+ const
29+ WM_CONFIG = WM_USER + 4711;
30+
31+ procedure InitCategoryFrame;
32+ private
33+ FBasePath: String;
34+ FCategoriesFrame: Tfr_Categories;
35+ procedure WmConfig(var _msg: TMessage); message WM_CONFIG;
36+ procedure FirstConfig;
37+ public
38+ constructor Create(_Owner: TComponent); override;
39+ destructor Destroy; override;
40+ end;
41+
42+var
43+ f_DenkzettelCompanion: Tf_DenkzettelCompanion;
44+
45+implementation
46+
47+{$R *.lfm}
48+
49+uses
50+ IniFiles,
51+ u_dzLazUtils,
52+ u_dzformutils,
53+ w_Settings;
54+
55+{ Tf_DenkzettelCompanion }
56+
57+constructor Tf_DenkzettelCompanion.Create(_Owner: TComponent);
58+var
59+ Ini: TIniFile;
60+begin
61+ inherited Create(_Owner);
62+
63+ TForm_ReadPlacement(self, fpePosAndSize);
64+ Ini := TIniFile.Create(TApplication_GetDefaultIniFile);
65+ try
66+ FBasePath := Ini.ReadString('common', 'BasePath', TApplication_GetExeDirBS + 'Notes');
67+ finally
68+ FreeAndNil(Ini);
69+ end;
70+
71+ if not DirectoryExists(FBasePath) then begin
72+ b_Configure.Visible := True;
73+ l_NotConfigured.Visible := True;
74+ PostMessage(self.Handle, WM_CONFIG, 0, 0);
75+ Exit; //==>
76+ end;
77+
78+ InitCategoryFrame;
79+end;
80+
81+destructor Tf_DenkzettelCompanion.Destroy;
82+var
83+ Ini: TIniFile;
84+begin
85+ try
86+ Ini := TIniFile.Create(TApplication_GetDefaultIniFile);
87+ try
88+ Ini.WriteString('common', 'BasePath', FBasePath);
89+ finally
90+ FreeAndNil(Ini);
91+ end;
92+ except
93+ // ignore exceptions in destructor
94+ end;
95+ TForm_StorePlacement(self, fpePosAndSize);
96+ inherited Destroy;
97+end;
98+
99+procedure Tf_DenkzettelCompanion.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
100+begin
101+ if not Assigned(FCategoriesFrame) then
102+ Exit; //==>
103+ FCategoriesFrame.OnCloseQuery(Sender, CanClose);
104+end;
105+
106+procedure Tf_DenkzettelCompanion.FirstConfig;
107+begin
108+ FreeAndNil(FCategoriesFrame);
109+ if not Tf_Settings.Execute(Self, FBasePath) then
110+ Abort;
111+ if not DirectoryExists(FBasePath) then begin
112+ if not CreateDir(FBasePath) then
113+ raise Exception.Create('Could not create directory.');
114+ end;
115+ InitCategoryFrame;
116+ b_Configure.Visible := False;
117+ l_NotConfigured.Visible := False;
118+end;
119+
120+procedure Tf_DenkzettelCompanion.b_ConfigureClick(Sender: TObject);
121+begin
122+ FirstConfig;
123+end;
124+
125+procedure Tf_DenkzettelCompanion.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
126+begin
127+ if not Assigned(FCategoriesFrame) then
128+ Exit; //==>
129+ if Key = VK_F10 then begin
130+ if shift = [] then begin
131+ FCategoriesFrame.ShowMenu;
132+ Key := 0;
133+ end;
134+ end else if Key = VK_LEFT then begin
135+ if shift = [ssAlt] then
136+ FCategoriesFrame.GoBack;
137+ end else if Key = VK_RIGHT then begin
138+ if shift = [ssAlt] then
139+ FCategoriesFrame.OpenSelected;
140+ end;
141+end;
142+
143+procedure Tf_DenkzettelCompanion.InitCategoryFrame;
144+begin
145+ FCategoriesFrame := Tfr_Categories.Create(Self);
146+ FCategoriesFrame.Parent := Self;
147+ FCategoriesFrame.Align := alClient;
148+ FCategoriesFrame.Init(FBasePath);
149+end;
150+
151+procedure Tf_DenkzettelCompanion.WmConfig(var _msg: TMessage);
152+begin
153+ FirstConfig;
154+end;
155+
156+end.
--- tags/0.0.5/src/wf_categories.pas (nonexistent)
+++ tags/0.0.5/src/wf_categories.pas (revision 51)
@@ -0,0 +1,234 @@
1+unit wf_Categories;
2+
3+{$mode objfpc}{$H+}
4+
5+interface
6+
7+uses
8+ Classes,
9+ SysUtils,
10+ FileUtil,
11+ Forms,
12+ Controls,
13+ StdCtrls,
14+ ExtCtrls,
15+ Menus,
16+ wf_Notes,
17+ Types;
18+
19+type
20+
21+ { Tfr_Categories }
22+
23+ Tfr_Categories = class(TFrame)
24+ b_Menu: TButton;
25+ b_NewCategory: TButton;
26+ lb_Categories: TListBox;
27+ l_NoNotes: TLabel;
28+ mi_About: TMenuItem;
29+ mi_Configure: TMenuItem;
30+ mi_NewCategory: TMenuItem;
31+ pm_Main: TPopupMenu;
32+ P_Categories: TPanel;
33+ p_Main: TPanel;
34+ p_NoCategories: TPanel;
35+ procedure b_MenuClick(Sender: TObject);
36+ procedure FrameEnter(Sender: TObject);
37+ procedure FrameResize(Sender: TObject);
38+ procedure lb_CategoriesDrawItem(Control: TWinControl; Index: integer;
39+ ARect: TRect; State: TOwnerDrawState);
40+ procedure mi_AboutClick(Sender: TObject);
41+ procedure mi_NewCategoryClick(Sender: TObject);
42+ procedure mi_ConfigureClick(Sender: TObject);
43+ procedure lb_CategoriesDblClick(Sender: TObject);
44+ procedure lb_CategoriesKeyPress(Sender: TObject; var Key: char);
45+ private
46+ FBasePath: ^string;
47+ FNotesFrame: Tfr_Notes;
48+ function BasePathBS: string;
49+ function TryGetCategory(out _Category: string): boolean;
50+ procedure OnCloseCategory(_Sender: TObject);
51+ public
52+ constructor Create(_Owner: TComponent); override;
53+ procedure Init(var _BasePath: string);
54+ procedure GoBack;
55+ procedure OpenSelected;
56+ procedure ShowMenu;
57+ procedure OnCloseQuery(_Sender: TObject; var _CanClose: boolean);
58+ end;
59+
60+implementation
61+
62+{$R *.lfm}
63+
64+uses
65+ Graphics,
66+ LCLType,
67+ u_dzLazUtils,
68+ u_DenkzettelUtils,
69+ w_NewCategory,
70+ w_Settings,
71+ w_About;
72+
73+{ Tfr_Categories }
74+
75+constructor Tfr_Categories.Create(_Owner: TComponent);
76+begin
77+ inherited Create(_Owner);
78+
79+ b_Menu.Caption := TRICOLON;
80+
81+ FNotesFrame := Tfr_Notes.Create(Self);
82+ FNotesFrame.Visible := False;
83+ FNotesFrame.Parent := Self;
84+ FNotesFrame.Align := alClient;
85+ FNotesFrame.OnClose := @OnCloseCategory;
86+end;
87+
88+procedure Tfr_Categories.Init(var _BasePath: string);
89+begin
90+ FBasePath := @_BasePath;
91+
92+ EnumDirectories(BasePathBS, lb_Categories.Items, True, False);
93+ p_NoCategories.Visible := (lb_Categories.Count = 0);
94+ TWinControl_SetFocus(lb_Categories);
95+end;
96+
97+procedure Tfr_Categories.OnCloseQuery(_Sender: TObject; var _CanClose: boolean);
98+begin
99+ if not Assigned(FNotesFrame) or not FNotesFrame.Visible then
100+ Exit; //==>
101+ FNotesFrame.FormCloseQuery(_Sender, _CanClose);
102+end;
103+
104+procedure Tfr_Categories.OpenSelected;
105+var
106+ Category: string;
107+begin
108+ if not Assigned(FNotesFrame) then
109+ Exit; //==>
110+ if FNotesFrame.Visible then
111+ FNotesFrame.OpenSelected
112+ else begin
113+ if not TryGetCategory(Category) then
114+ Exit; //==>
115+ FNotesFrame.Init(Category, BasePathBS + Category, lb_Categories.Items);
116+ FNotesFrame.Visible := True;
117+ p_Main.Visible := False;
118+ end;
119+end;
120+
121+procedure Tfr_Categories.lb_CategoriesDblClick(Sender: TObject);
122+begin
123+ OpenSelected;
124+end;
125+
126+procedure Tfr_Categories.lb_CategoriesKeyPress(Sender: TObject; var Key: char);
127+begin
128+ if Key in [#13, #10] then
129+ OpenSelected;
130+end;
131+
132+procedure Tfr_Categories.mi_AboutClick(Sender: TObject);
133+begin
134+ Tf_About.Execute(Self);
135+end;
136+
137+procedure Tfr_Categories.GoBack;
138+begin
139+ if Assigned(FNotesFrame) and FNotesFrame.Visible then
140+ FNotesFrame.GoBack;
141+end;
142+
143+procedure Tfr_Categories.ShowMenu;
144+begin
145+ if Assigned(FNotesFrame) and FNotesFrame.Visible then
146+ FNotesFrame.ShowMenu
147+ else begin
148+ TButton_DrowpdownMenu(b_Menu, pm_Main);
149+ end;
150+end;
151+
152+procedure Tfr_Categories.b_MenuClick(Sender: TObject);
153+begin
154+ ShowMenu;
155+end;
156+
157+procedure Tfr_Categories.FrameEnter(Sender: TObject);
158+begin
159+ TWinControl_SetFocus(lb_Categories);
160+ if lb_Categories.ItemIndex = -1 then
161+ if lb_Categories.Items.Count > 0 then
162+ lb_Categories.ItemIndex := 0;
163+end;
164+
165+procedure Tfr_Categories.FrameResize(Sender: TObject);
166+var
167+ w, h: integer;
168+begin
169+ w := lb_Categories.Width;
170+ w := w - p_NoCategories.Width;
171+ p_NoCategories.Left := lb_Categories.Left + w div 2;
172+ h := lb_Categories.Height;
173+ h := h - p_NoCategories.Height;
174+ p_NoCategories.Top := lb_Categories.Top + h div 2;
175+end;
176+
177+procedure Tfr_Categories.lb_CategoriesDrawItem(Control: TWinControl;
178+ Index: integer; ARect: TRect; State: TOwnerDrawState);
179+var
180+ lb: TListBox absolute Control;
181+ cnv: TCanvas;
182+ s: string;
183+begin
184+ s := lb.Items[Index];
185+ cnv := lb.Canvas;
186+
187+ cnv.Brush.Color := NoteColorToColor(dcWhite, (odSelected in State));
188+ cnv.FillRect(ARect);
189+ if odSelected in State then
190+ cnv.TextRect(ARect, arect.Left, arect.Top, '>');
191+ cnv.TextRect(ARect, ARect.Left + 10, ARect.Top, s);
192+
193+ // Focus rect is drawn automatically
194+end;
195+
196+procedure Tfr_Categories.mi_NewCategoryClick(Sender: TObject);
197+var
198+ NewCategory: string;
199+begin
200+ if Tf_NewCategory.Execute(Self, BasePathBS, NewCategory) then
201+ Init(FBasePath^);
202+end;
203+
204+procedure Tfr_Categories.mi_ConfigureClick(Sender: TObject);
205+begin
206+ if Tf_Settings.Execute(self, FBasePath^) then
207+ Init(FBasePath^);
208+end;
209+
210+function Tfr_Categories.BasePathBS: string;
211+begin
212+ Result := IncludeTrailingPathDelimiter(FBasePath^);
213+end;
214+
215+function Tfr_Categories.TryGetCategory(out _Category: string): boolean;
216+var
217+ Idx: integer;
218+begin
219+ Result := False;
220+ Idx := lb_Categories.ItemIndex;
221+ if Idx = -1 then
222+ Exit; //==>
223+ _Category := lb_Categories.Items[Idx];
224+ Result := (_Category <> '');
225+end;
226+
227+procedure Tfr_Categories.OnCloseCategory(_Sender: TObject);
228+begin
229+ FNotesFrame.Visible := False;
230+ p_Main.Visible := True;
231+ TWinControl_SetFocus(lb_Categories);
232+end;
233+
234+end.
--- tags/0.0.5/src/wf_notes.pas (nonexistent)
+++ tags/0.0.5/src/wf_notes.pas (revision 51)
@@ -0,0 +1,358 @@
1+unit wf_Notes;
2+
3+{$mode objfpc}{$H+}
4+
5+interface
6+
7+uses
8+ Classes,
9+ SysUtils,
10+ Types,
11+ FileUtil,
12+ Forms,
13+ Controls,
14+ StdCtrls,
15+ ExtCtrls,
16+ Menus,
17+ wf_NoteEditor;
18+
19+type
20+
21+ { Tfr_Notes }
22+
23+ Tfr_Notes = class(TFrame)
24+ b_NewChecklist: TButton;
25+ b_NewNote: TButton;
26+ b_Menu: TButton;
27+ l_NoNotes: TLabel;
28+ mi_Move: TMenuItem;
29+ mi_Delete: TMenuItem;
30+ mi_NewChecklist: TMenuItem;
31+ p_NoNotes: TPanel;
32+ pm_Main: TPopupMenu;
33+ mi_About: TMenuItem;
34+ mi_NewNote: TMenuItem;
35+ b_Back: TButton;
36+ lb_Notes: TListBox;
37+ p_Main: TPanel;
38+ p_Top: TPanel;
39+ procedure FrameEnter(Sender: TObject);
40+ procedure FrameResize(Sender: TObject);
41+ procedure lb_NotesDrawItem(Control: TWinControl; Index: integer;
42+ ARect: TRect; State: TOwnerDrawState);
43+ procedure mi_AboutClick(Sender: TObject);
44+ procedure b_BackClick(Sender: TObject);
45+ procedure b_MenuClick(Sender: TObject);
46+ procedure mi_DeleteClick(Sender: TObject);
47+ procedure mi_NewChecklistClick(Sender: TObject);
48+ procedure mi_NewNoteClick(Sender: TObject);
49+ procedure lb_NotesDblClick(Sender: TObject);
50+ procedure lb_NotesKeyPress(Sender: TObject; var Key: char);
51+ private
52+ FCategory: string;
53+ FCategoryPathBS: string;
54+ FOnClose: TNotifyEvent;
55+ FEditFrame: Tfr_NoteEditor;
56+ FCategories: TStrings;
57+ procedure doOnClose;
58+ procedure mi_MoveToCategoryClick(_Sender: TObject);
59+ procedure OnCloseNote(_Sender: TObject);
60+ function TryGetNoteFn(out _fn: string): boolean;
61+ public
62+ constructor Create(_Owner: TComponent); override;
63+ destructor Destroy; override;
64+ procedure Init(const _Category: string; const _CategoryPath: string; _Categories: TStrings);
65+ procedure FormCloseQuery(_Sender: TObject; var _CanClose: boolean);
66+ procedure GoBack;
67+ procedure OpenSelected;
68+ procedure ShowMenu;
69+ property OnClose: TNotifyEvent read FOnClose write FOnClose;
70+ end;
71+
72+implementation
73+
74+{$R *.lfm}
75+
76+uses
77+ Graphics,
78+ Dialogs,
79+ LCLType,
80+ u_dzLazUtils,
81+ u_DenkzettelUtils,
82+ w_About;
83+
84+{ Tfr_Notes }
85+
86+constructor Tfr_Notes.Create(_Owner: TComponent);
87+begin
88+ inherited Create(_Owner);
89+
90+ b_Menu.Caption := TRICOLON;
91+
92+ FCategories := TStringList.Create;
93+
94+ FEditFrame := Tfr_NoteEditor.Create(Self);
95+ FEditFrame.Visible := False;
96+ FEditFrame.Parent := Self;
97+ FEditFrame.Align := alClient;
98+ FEditFrame.OnClose := @OnCloseNote;
99+end;
100+
101+destructor Tfr_Notes.Destroy;
102+begin
103+ FreeAndNil(FCategories);
104+ inherited Destroy;
105+end;
106+
107+procedure Tfr_Notes.Init(const _Category: string; const _CategoryPath: string; _Categories: TStrings);
108+var
109+ Files: TStringList;
110+ i: integer;
111+ fn, Title: string;
112+ IsChecklist: boolean;
113+ NoteColor: TDenkzettelColor;
114+ mi: TMenuItem;
115+begin
116+ FCategory := _Category;
117+ FCategoryPathBS := IncludeTrailingPathDelimiter(_CategoryPath);
118+ if Assigned(_Categories) then begin
119+ FCategories.Assign(_Categories);
120+ mi_Move.Clear;
121+ for i := 0 to FCategories.Count - 1 do begin
122+ mi := TMenuItem.Create(mi_Move);
123+ mi.Caption := FCategories[i];
124+ mi.OnClick := @mi_MoveToCategoryClick;
125+ mi_Move.Add(mi);
126+ end;
127+ end;
128+
129+
130+ p_Top.Caption := _Category;
131+
132+ lb_Notes.Items.Clear;
133+ Files := TStringList.Create;
134+ try
135+ EnumFiles(FCategoryPathBS, '*.txt', Files, True, False);
136+ for i := 0 to Files.Count - 1 do begin
137+ fn := files[i];
138+ if not DecodeFilename(fn, Title, IsChecklist, NoteColor) then
139+ Title := fn;
140+ lb_Notes.Items.AddObject(Title, TObject(PropertiesToPointer(NoteColor, IsChecklist)));
141+ end;
142+ p_NoNotes.Visible := (Files.Count = 0);
143+ finally
144+ FreeAndNil(Files);
145+ end;
146+ TWinControl_SetFocus(lb_Notes);
147+end;
148+
149+procedure Tfr_Notes.OnCloseNote(_Sender: TObject);
150+begin
151+ FEditFrame.Visible := False;
152+ p_Main.Visible := True;
153+ Init(FCategory, FCategoryPathBS, nil);
154+end;
155+
156+procedure Tfr_Notes.FormCloseQuery(_Sender: TObject; var _CanClose: boolean);
157+begin
158+ if not Assigned(FEditFrame) or not FEditFrame.Visible then
159+ Exit; //==>
160+ FEditFrame.FormCloseQuery(_Sender, _CanClose);
161+end;
162+
163+function Tfr_Notes.TryGetNoteFn(out _fn: string): boolean;
164+var
165+ Idx: integer;
166+ s: string;
167+begin
168+ Result := False;
169+ Idx := lb_Notes.ItemIndex;
170+ if Idx = -1 then
171+ Exit; //==>
172+ s := lb_Notes.Items[Idx];
173+ if s = '' then
174+ Exit; //==>
175+ Result := FindMatchingFile(FCategoryPathBS + s + '*.*', _fn, False) > 0;
176+end;
177+
178+procedure Tfr_Notes.doOnClose;
179+begin
180+ if Assigned(FOnClose) then
181+ FOnClose(Self);
182+end;
183+
184+procedure Tfr_Notes.OpenSelected;
185+var
186+ fn: string;
187+begin
188+ if not Assigned(FEditFrame) then
189+ Exit; //==>
190+ if not TryGetNoteFn(fn) then
191+ Exit; //==>
192+ FEditFrame.Init(FCategoryPathBS, fn);
193+ FEditFrame.Visible := True;
194+ p_Main.Visible := False;
195+end;
196+
197+procedure Tfr_Notes.lb_NotesDblClick(Sender: TObject);
198+begin
199+ OpenSelected;
200+end;
201+
202+procedure Tfr_Notes.lb_NotesKeyPress(Sender: TObject; var Key: char);
203+begin
204+ if Key in [#13, #10] then
205+ OpenSelected;
206+end;
207+
208+procedure Tfr_Notes.b_BackClick(Sender: TObject);
209+begin
210+ doOnClose;
211+end;
212+
213+procedure Tfr_Notes.GoBack;
214+begin
215+ if Assigned(FEditFrame) and FEditFrame.Visible then
216+ FEditFrame.GoBack
217+ else begin
218+ doOnClose;
219+ end;
220+end;
221+
222+procedure Tfr_Notes.ShowMenu;
223+begin
224+ if Assigned(FEditFrame) and FEditFrame.Visible then
225+ FEditFrame.ShowMenu
226+ else begin
227+ TButton_DrowpdownMenu(b_Menu, pm_Main);
228+ end;
229+end;
230+
231+procedure Tfr_Notes.b_MenuClick(Sender: TObject);
232+begin
233+ ShowMenu;
234+end;
235+
236+procedure Tfr_Notes.mi_DeleteClick(Sender: TObject);
237+var
238+ Note: string;
239+begin
240+ if not TryGetNoteFn(Note) then
241+ Exit; //==>
242+ if mrYes = MessageDlgCentered(Self, 'Delete this note?', mtConfirmation, [mbYes, mbCancel], 0) then begin
243+ if not DeleteFile(FCategoryPathBS + Note) then
244+ raise Exception.Create('Failed to delete file.');
245+ Init(FCategory, FCategoryPathBS, nil);
246+ end;
247+end;
248+
249+procedure Tfr_Notes.mi_NewChecklistClick(Sender: TObject);
250+begin
251+ FEditFrame.Init(FCategoryPathBS, '#L#');
252+ FEditFrame.Visible := True;
253+ p_Main.Visible := False;
254+end;
255+
256+procedure Tfr_Notes.mi_NewNoteClick(Sender: TObject);
257+begin
258+ FEditFrame.Init(FCategoryPathBS, '');
259+ FEditFrame.Visible := True;
260+ p_Main.Visible := False;
261+end;
262+
263+procedure Tfr_Notes.mi_AboutClick(Sender: TObject);
264+begin
265+ Tf_About.Execute(Self);
266+end;
267+
268+// for whatever reason menus.pp does not have StripHotKey
269+// (even though it was added in may 2016, but that's probably not the main repository
270+// https://github.com/alrieckert/lazarus/commit/8919d979e8cd628d1af2035fd9d230c69150c3cf
271+function StripHotkey(const Text: string): string;
272+var
273+ I, R: integer;
274+begin
275+ SetLength(Result, Length(Text));
276+ I := 1;
277+ R := 1;
278+ while I <= Length(Text) do begin
279+ if Text[I] = cHotkeyPrefix then begin
280+ if (I < Length(Text)) and (Text[I + 1] = cHotkeyPrefix) then begin
281+ Result[R] := Text[I];
282+ Inc(R);
283+ Inc(I, 2);
284+ end else
285+ Inc(I);
286+ end else begin
287+ Result[R] := Text[I];
288+ Inc(R);
289+ Inc(I);
290+ end;
291+ end;
292+ SetLength(Result, R - 1);
293+end;
294+
295+procedure Tfr_Notes.mi_MoveToCategoryClick(_Sender: TObject);
296+var
297+ Category: string;
298+ Path, fn: string;
299+begin
300+ if not TryGetNoteFn(fn) then
301+ Exit; //==>
302+
303+ Category := (_Sender as tMenuItem).Caption;
304+ Category := StripHotkey(Category);
305+
306+ Path := ExcludeTrailingPathDelimiter(FCategoryPathBS);
307+ Path := ExtractFileDir(path);
308+ Path := IncludeTrailingPathDelimiter(Path) + Category;
309+ Path := IncludeTrailingPathDelimiter(Path);
310+ if not RenameFile(FCategoryPathBS+fn, Path+fn) then
311+ raise Exception.Create('Moving the note failed.');
312+ Init(FCategory, FCategoryPathBS, nil);
313+end;
314+
315+procedure Tfr_Notes.FrameEnter(Sender: TObject);
316+begin
317+ TWinControl_SetFocus(lb_Notes);
318+ if lb_Notes.ItemIndex = -1 then
319+ if lb_Notes.Items.Count > 0 then
320+ lb_Notes.ItemIndex := 0;
321+end;
322+
323+procedure Tfr_Notes.FrameResize(Sender: TObject);
324+var
325+ w, h: integer;
326+begin
327+ w := lb_Notes.Width;
328+ w := w - p_NoNotes.Width;
329+ p_NoNotes.Left := lb_Notes.Left + w div 2;
330+ h := lb_Notes.Height;
331+ h := h - p_NoNotes.Height;
332+ p_NoNotes.Top := lb_Notes.Top + h div 2;
333+end;
334+
335+procedure Tfr_Notes.lb_NotesDrawItem(Control: TWinControl; Index: integer;
336+ ARect: TRect; State: TOwnerDrawState);
337+var
338+ lb: TListBox absolute Control;
339+ NoteColor: TDenkzettelColor;
340+ IsChecklist: boolean;
341+ cnv: TCanvas;
342+ s: string;
343+begin
344+ s := lb.Items[Index];
345+ PointerToProperties(lb.Items.Objects[Index], NoteColor, IsChecklist);
346+ cnv := lb.Canvas;
347+
348+ cnv.Brush.Color := NoteColorToColor(NoteColor, odSelected in State);
349+ cnv.FillRect(ARect);
350+
351+ if odSelected in State then
352+ cnv.TextRect(ARect, arect.Left, arect.Top, '>');
353+ cnv.TextRect(ARect, ARect.Left + 10, ARect.Top, s);
354+
355+ // Focus rect is drawn automatically
356+end;
357+
358+end.
--- tags/0.0.5/src/u_dzformutils.pas (nonexistent)
+++ tags/0.0.5/src/u_dzformutils.pas (revision 51)
@@ -0,0 +1,400 @@
1+{.GXFormatter.config=twm}
2+///<summary>
3+/// Implements functions which work on components but are not methods.
4+/// @author twm </summary>
5+unit u_dzformutils;
6+
7+interface
8+
9+uses
10+ Classes,
11+ Windows,
12+ SysUtils,
13+ Controls,
14+ Forms,
15+ Graphics,
16+ Types;
17+
18+///<summary>
19+/// The same as TForm.Monitor, but it works.
20+/// @returns the monitor on wich the center point of the form is located.
21+/// Warning: The result might be nil if the form is outside the visible area. </summary>
22+function TForm_GetMonitor(_frm: TForm): TMonitor;
23+
24+///<summary> centers a form on the given point, but makes sure the form is fully visible </summary>
25+procedure TForm_CenterOn(_frm: TForm; _Center: TPoint); overload;
26+///<summary> centers a form on the given component, but makes sure the form is fully visible </summary>
27+procedure TForm_CenterOn(_frm: TForm; _Center: TWinControl); overload;
28+
29+type
30+ TFormPlacementEnum = (fpePositionOnly, fpeSizeOnly, fpePosAndSize);
31+
32+///<summary> Stores the form's current position and size to the registry
33+/// @param frm is the form whose placement is to be stored
34+/// @param Which determines whether the Position and/or the size is to be stored
35+/// @param RegistryPath gives the full path, including the value name to write to,
36+/// not yet implemented: defaults to '<Company_name>\<executable>\<frm.Classname>\NormPos'
37+/// where <Company_name> is read from the version resources
38+/// and <frm.Classname is the form's ClassName without the T-Prefix
39+/// @param HKEY is the root key, defaults to HKEY_CURRENT_USER
40+/// @returns false, if anything goes wrong, including any exceptions that might
41+/// occur, true if it worked.
42+function TForm_StorePlacement(_frm: TForm; _Which: TFormPlacementEnum; const _RegistryPath: string;
43+ _HKEY: HKEY = HKEY_CURRENT_USER): boolean; overload;
44+
45+///<summary> Stores the form's current position and size to the registry
46+/// under Software\<executable>\<frm.name>\NormPos'
47+/// @param frm is the form whose placement is to be stored
48+/// @param Which determines whether the Position and/or the size is to be stored
49+/// @param HKEY is the root key, defaults to HKEY_CURRENT_USER
50+/// @returns false, if anything goes wrong, including any exceptions that might
51+/// occur, true if it worked.
52+function TForm_StorePlacement(_frm: TForm; _Which: TFormPlacementEnum;
53+ _HKEY: HKEY = HKEY_CURRENT_USER): boolean; overload;
54+
55+///<summary> Reads the form's position and size from the registry
56+/// @param frm is the form whose placement is to be read
57+/// @param Which determines whether the Position and/or the size is to be read
58+/// @param RegistryPath gives the full path, including the value name to write to,
59+/// not yet implemented: defaults to '<Company_name>\<executable>\<frm.Classname>\NormPos'
60+/// where <Company_name> is read from the version resources
61+/// and <frm.Classname is the form's ClassName without the T-Prefix
62+/// @param HKEY is the root key, defaults to HKEY_CURRENT_USER
63+/// @returns false, if anything goes wrong, including any exceptions that might
64+/// occur, true if it worked.
65+function TForm_ReadPlacement(_frm: TForm; _Which: TFormPlacementEnum; const _RegistryPath: string;
66+ _HKEY: HKEY = HKEY_CURRENT_USER): boolean; overload;
67+
68+///<summary> Reads the form's position and size from the registry
69+/// under Software\<executable>\<frm.name>\NormPos'
70+/// @param frm is the form whose placement is to be stored
71+/// @param Which determines whether the Position and/or the size is to be stored
72+/// @param HKEY is the root key, defaults to HKEY_CURRENT_USER
73+/// @returns false, if anything goes wrong, including any exceptions that might
74+/// occur, true if it worked.
75+function TForm_ReadPlacement(_frm: TForm; _Which: TFormPlacementEnum;
76+ _HKEY: HKEY = HKEY_CURRENT_USER): boolean; overload;
77+
78+///<summary> Generates the registry path for storing a form's placement as used in
79+/// TForm_Read/StorePlacement. </summary>
80+function TForm_GetPlacementRegistryPath(_frm: TForm): string; overload;
81+
82+///<summary> Generates the registry path for storing a form's placement as used in
83+/// TForm_Read/StorePlacement. </summary>
84+function TForm_GetPlacementRegistryPath(const _FrmName: string): string; overload;
85+
86+///<summary> Generates the registry path for storing a form's configuration. </summary>
87+function TForm_GetConfigRegistryPath(_frm: TForm): string; overload;
88+function TForm_GetConfigRegistryPath(const _FrmName: string): string; overload;
89+
90+implementation
91+
92+uses
93+ registry,
94+ strutils;
95+
96+procedure TMonitor_MakeFullyVisible(_MonitorRect: TRect; var _Left, _Top, _Width, _Height: integer);
97+begin
98+ if _Left + _Width > _MonitorRect.Right then
99+ _Left := _MonitorRect.Right - _Width;
100+ if _Left < _MonitorRect.Left then
101+ _Left := _MonitorRect.Left;
102+ if _Top + _Height > _MonitorRect.Bottom then
103+ _Top := _MonitorRect.Bottom - _Height;
104+ if _Top < _MonitorRect.Top then
105+ _Top := _MonitorRect.Top;
106+end;
107+
108+procedure TMonitor_MakeFullyVisible(_Monitor: TMonitor; var _Left, _Top, _Width, _Height: integer);
109+begin
110+ TMonitor_MakeFullyVisible(_Monitor.WorkareaRect, _Left, _Top, _Width, _Height);
111+end;
112+
113+procedure TMonitor_MakeFullyVisible(_MonitorRect: TRect; var _Rect: TRect; out _Width, _Height: integer);
114+var
115+ Left: integer;
116+ Top: integer;
117+begin
118+ Left := _Rect.Left;
119+ Top := _Rect.Top;
120+ _Width := _Rect.Right - Left;
121+ _Height := _Rect.Bottom - Top;
122+ TMonitor_MakeFullyVisible(_MonitorRect, Left, Top, _Width, _Height);
123+ _Rect.Left := Left;
124+ _Rect.Top := Top;
125+ _Rect.Right := Left + _Width;
126+ _Rect.Bottom := Top + _Height;
127+end;
128+
129+procedure TMonitor_MakeFullyVisible(_Monitor: TMonitor; var _Rect: TRect; out _Width, _Height: integer);
130+begin
131+ if Assigned(_Monitor) then
132+ TMonitor_MakeFullyVisible(_Monitor.WorkareaRect, _Rect, _Width, _Height);
133+end;
134+
135+procedure TMonitor_MakeFullyVisible(_Monitor: TMonitor; var _Rect: TRect);
136+var
137+ Width: integer;
138+ Height: integer;
139+begin
140+ TMonitor_MakeFullyVisible(_Monitor, _Rect, Width, Height);
141+end;
142+
143+procedure TMonitor_MakeFullyVisible(_Monitor: TMonitor; _frm: TForm);
144+var
145+ re: TRect;
146+begin
147+ re := _frm.BoundsRect;
148+ TMonitor_MakeFullyVisible(_Monitor, re);
149+ _frm.BoundsRect := re;
150+end;
151+
152+function TScreen_MonitorFromPoint(_pnt: TPoint): TMonitor;
153+var
154+ i: integer;
155+ WaRect: TRect;
156+begin
157+ for i := 0 to Screen.MonitorCount - 1 do begin
158+ Result := Screen.Monitors[i];
159+ WaRect := Result.WorkareaRect;
160+ if (WaRect.Top <= _pnt.Y) and (WaRect.Bottom >= _pnt.Y)
161+ and (WaRect.Left <= _pnt.X) and (WaRect.Right >= _pnt.X) then
162+ Exit;
163+ end;
164+ Result := nil;
165+end;
166+
167+function TForm_GetMonitor(_frm: TForm): TMonitor;
168+var
169+ Center: TPoint;
170+begin
171+ Center.X := _frm.Left + _frm.Width div 2;
172+ Center.Y := _frm.Top + _frm.Height div 2;
173+ Result := TScreen_MonitorFromPoint(Center);
174+end;
175+
176+procedure TForm_CenterOn(_frm: TForm; _Center: TPoint);
177+var
178+ Monitor: TMonitor;
179+begin
180+ _frm.Position := poDesigned;
181+ _frm.DefaultMonitor := dmDesktop;
182+ _frm.Left := _Center.X - _frm.Width div 2;
183+ _frm.Top := _Center.Y - _frm.Height div 2;
184+
185+ Monitor := TScreen_MonitorFromPoint(_Center);
186+ TMonitor_MakeFullyVisible(Monitor, _frm);
187+end;
188+
189+procedure TForm_CenterOn(_frm: TForm; _Center: TWinControl);
190+begin
191+ if not Assigned(_Center) then
192+ _Center := Application.MainForm;
193+ if not Assigned(_Center) then begin
194+ if Screen.FormCount > 0 then
195+ _Center := Screen.Forms[0];
196+ end;
197+ if Assigned(_Center) then begin
198+ if Assigned(_Center.Parent) then
199+ TForm_CenterOn(_frm, _Center.ClientToScreen(Point(_Center.Width div 2, _Center.Height div 2)))
200+ else
201+ TForm_CenterOn(_frm, Point(_Center.Left + _Center.Width div 2, _Center.Top + _Center.Height div 2));
202+ end else begin
203+ TForm_CenterOn(_frm, Point(Screen.Width div 2, Screen.Height div 2));
204+ end;
205+end;
206+
207+function TApplication_GetRegistryPath: string;
208+begin
209+ Result := 'Software\' + ChangeFileExt(ExtractFileName(Application.ExeName), '');
210+end;
211+
212+function TApplication_GetConfigRegistryPath: string;
213+begin
214+ Result := TApplication_GetRegistryPath + '\Config';
215+end;
216+
217+function TForm_GetPlacementRegistryPath(const _FrmName: string): string;
218+begin
219+ Result := TApplication_GetRegistryPath + '\' + _FrmName + '\NormPos';
220+end;
221+
222+function TForm_GetPlacementRegistryPath(_frm: TForm): string;
223+begin
224+ Result := TForm_GetPlacementRegistryPath(_frm.Name);
225+end;
226+
227+function TForm_GetConfigRegistryPath(const _FrmName: string): string;
228+begin
229+ Result := TApplication_GetRegistryPath + '\' + _FrmName + '\Config';
230+end;
231+
232+function TForm_GetConfigRegistryPath(_frm: TForm): string;
233+begin
234+ Result := TForm_GetConfigRegistryPath(_frm.Name);
235+end;
236+
237+procedure TRegistry_WriteString(const _Path: string; const _Value: string;
238+ _HKEY: HKEY = HKEY_CURRENT_USER);
239+var
240+ reg: TRegistry;
241+begin
242+ reg := TRegistry.Create;
243+ try
244+ reg.RootKey := _HKEY;
245+ if reg.OpenKey(ExtractFileDir(_Path), True) then begin
246+ try
247+ reg.WriteString(ExtractFileName(_Path), _Value);
248+ finally
249+ reg.CloseKey;
250+ end;
251+ end;
252+ finally
253+ FreeAndNil(reg);
254+ end;
255+end;
256+
257+function TForm_StorePlacement(_frm: TForm; _Which: TFormPlacementEnum; const _RegistryPath: string;
258+ _HKEY: HKEY = HKEY_CURRENT_USER): boolean;
259+var
260+ L, t, w, h: integer;
261+begin
262+ Result := False;
263+ try
264+ L := _frm.Left;
265+ t := _frm.Top;
266+ w := _frm.Width;
267+ h := _frm.Height;
268+ case _Which of
269+ fpePositionOnly: begin
270+ w := -1;
271+ h := -1;
272+ end;
273+ fpeSizeOnly: begin
274+ L := -1;
275+ t := -1;
276+ end;
277+ // fpePosAndSize: ;
278+ end;
279+ TRegistry_WriteString(_RegistryPath, Format('%d,%d,%d,%d', [L, t, w, h]));
280+ Result := True;
281+ except
282+ // Result stays false
283+ end;
284+end;
285+
286+function TForm_StorePlacement(_frm: TForm; _Which: TFormPlacementEnum;
287+ _HKEY: HKEY = HKEY_CURRENT_USER): boolean;
288+begin
289+ Result := TForm_StorePlacement(_frm, _Which, TForm_GetPlacementRegistryPath(_frm), _HKEY);
290+end;
291+
292+function TRegistry_TryReadString(const _Path: string; out _Value: string;
293+ _HKEY: HKEY = HKEY_CURRENT_USER): boolean;
294+var
295+ reg: TRegistry;
296+begin
297+ Result := False;
298+ reg := TRegistry.Create;
299+ try
300+ reg.RootKey := _HKEY;
301+ if reg.OpenKeyReadOnly(ExtractFileDir(_Path)) then begin
302+ try
303+ _Value := reg.ReadString(ExtractFileName(_Path));
304+ Result := True;
305+ finally
306+ reg.CloseKey;
307+ end;
308+ end;
309+ finally
310+ FreeAndNil(reg);
311+ end;
312+end;
313+
314+function TailStr(const _s: string; _Start: integer): string;
315+begin
316+ if _Start > Length(_s) then
317+ Result := ''
318+ else
319+ Result := Copy(_s, _Start, Length(_s) - _Start + 1);
320+end;
321+
322+function ExtractStr(var _Source: string; _Delimiter: char): string;
323+var
324+ p: integer;
325+begin
326+ p := Pos(_Delimiter, _Source);
327+ if p = 0 then begin
328+ Result := _Source;
329+ _Source := '';
330+ end else begin
331+ Result := LeftStr(_Source, p - 1);
332+ _Source := TailStr(_Source, p + 1);
333+ end;
334+end;
335+
336+function TForm_ReadPlacement(_frm: TForm; _Which: TFormPlacementEnum; const _RegistryPath: string;
337+ _HKEY: HKEY = HKEY_CURRENT_USER): boolean;
338+var
339+ s: string;
340+ PosStr: string;
341+ L, t, w, h: integer;
342+begin
343+ try
344+ Result := TRegistry_TryReadString(_RegistryPath, PosStr, _HKEY);
345+ if Result then begin
346+ s := ExtractStr(PosStr, ',');
347+ if not TryStrToInt(s, L) then
348+ Exit;
349+ s := ExtractStr(PosStr, ',');
350+ if not TryStrToInt(s, t) then
351+ Exit;
352+ s := ExtractStr(PosStr, ',');
353+ if not TryStrToInt(s, w) then
354+ Exit;
355+ s := PosStr;
356+ if not TryStrToInt(s, h) then
357+ Exit;
358+
359+ case _Which of
360+ fpePositionOnly: begin
361+ if L <> -1 then
362+ _frm.Left := L;
363+ if t <> -1 then
364+ _frm.Top := t;
365+ end;
366+ fpeSizeOnly: begin
367+ if w <> -1 then
368+ _frm.Width := w;
369+ if h <> -1 then
370+ _frm.Height := h;
371+ end;
372+ fpePosAndSize: begin
373+ if L <> -1 then
374+ _frm.Left := L;
375+ if t <> -1 then
376+ _frm.Top := t;
377+ if w <> -1 then
378+ _frm.Width := w;
379+ if h <> -1 then
380+ _frm.Height := h;
381+ end;
382+ else
383+ Exit;
384+ end;
385+ _frm.Position := poDesigned;
386+ _frm.MakeFullyVisible(nil);
387+ end;
388+ except
389+ Result := False;
390+ end;
391+end;
392+
393+function TForm_ReadPlacement(_frm: TForm; _Which: TFormPlacementEnum;
394+ _HKEY: HKEY = HKEY_CURRENT_USER): boolean; overload;
395+begin
396+ Result := TForm_ReadPlacement(_frm, _Which, TForm_GetPlacementRegistryPath(_frm), _HKEY);
397+end;
398+
399+
400+end.
--- tags/0.0.5/src/w_selectcolor.pas (nonexistent)
+++ tags/0.0.5/src/w_selectcolor.pas (revision 51)
@@ -0,0 +1,120 @@
1+unit w_SelectColor;
2+
3+{$mode objfpc}{$H+}
4+
5+interface
6+
7+uses
8+ Classes,
9+ SysUtils,
10+ FileUtil,
11+ Forms,
12+ Controls,
13+ Graphics,
14+ Dialogs,
15+ ExtCtrls,
16+ u_DenkzettelUtils;
17+
18+type
19+
20+ { Tf_SelectColor }
21+
22+ Tf_SelectColor = class(TForm)
23+ p_White: TPanel;
24+ procedure FormKeyPress(Sender: TObject; var Key: char);
25+ procedure p_WhiteClick(Sender: TObject);
26+ private
27+ FSelectedColor: TDenkzettelColor;
28+ procedure GetValue(out _Color: TDenkzettelColor);
29+ public
30+ class function Execute(_Owner: TWinControl; var _Color: TDenkzettelColor): boolean;
31+ constructor Create(_Owner: TComponent); override;
32+ end;
33+
34+implementation
35+
36+{$R *.lfm}
37+
38+uses
39+ u_dzLazUtils;
40+
41+{ Tf_SelectColor }
42+
43+class function Tf_SelectColor.Execute(_Owner: TWinControl; var _Color: TDenkzettelColor): boolean;
44+var
45+ frm: Tf_SelectColor;
46+begin
47+ frm := Tf_SelectColor.Create(_Owner);
48+ try
49+ TForm_CenterOn(frm, _Owner);
50+ Result := (frm.ShowModal = mrOk);
51+ if Result then
52+ frm.GetValue(_Color);
53+ finally
54+ FreeAndNil(frm);
55+ end;
56+end;
57+
58+constructor Tf_SelectColor.Create(_Owner: TComponent);
59+var
60+ dc: TDenkzettelColor;
61+ pnl: TPanel;
62+ h: integer;
63+ t: integer;
64+begin
65+ inherited Create(_Owner);
66+ p_White.Caption := NoteColorToChar(dcWhite);
67+ p_White.Color := NoteColorToColor(dcWhite, False);
68+
69+ t := p_White.Top;
70+ h := t + p_White.Height;
71+ for dc := Succ(Low(TDenkzettelColor)) to high(TDenkzettelColor) do begin
72+ t := t + h;
73+ pnl := TPanel.Create(Self);
74+ pnl.Parent := Self;
75+ pnl.Top := t;
76+ pnl.Height := p_White.Height;
77+ pnl.Left := p_White.Left;
78+ pnl.Width := p_White.Width;
79+ pnl.Caption := NoteColorToChar(dc);
80+ pnl.Name := '';
81+ pnl.Color := NoteColorToColor(dc, False);
82+ pnl.Tag := Ord(dc);
83+ pnl.OnClick := p_White.OnClick;
84+ end;
85+ Self.Height := t + h;
86+end;
87+
88+procedure Tf_SelectColor.p_WhiteClick(Sender: TObject);
89+begin
90+ FSelectedColor := TDenkzettelColor((Sender as TPanel).Tag);
91+ ModalResult := mrOk;
92+end;
93+
94+procedure Tf_SelectColor.FormKeyPress(Sender: TObject; var Key: char);
95+var
96+ ctrl: TControl;
97+ pnl: TPanel;
98+ i: integer;
99+ c: char;
100+begin
101+ c := UpCase(Key);
102+ for i := 0 to ControlCount - 1 do begin
103+ ctrl := Controls[i];
104+ if ctrl is TPanel then begin
105+ pnl := TPanel(ctrl);
106+ if pnl.Caption = c then begin
107+ pnl.OnClick(pnl);
108+ Exit; //==>
109+ end;
110+ end;
111+ end;
112+end;
113+
114+procedure Tf_SelectColor.GetValue(out _Color: TDenkzettelColor);
115+begin
116+ _Color := FSelectedColor;
117+end;
118+
119+
120+end.
--- tags/0.0.5/src/u_dzlazutils.pas (nonexistent)
+++ tags/0.0.5/src/u_dzlazutils.pas (revision 51)
@@ -0,0 +1,216 @@
1+unit u_dzLazUtils;
2+
3+{$mode objfpc}{$H+}
4+
5+interface
6+
7+uses
8+ SysUtils,
9+ Types,
10+ Classes,
11+ Controls,
12+ StdCtrls,
13+ Menus,
14+ Forms,
15+ Dialogs;
16+
17+const
18+ TRICOLON = #$E2#$81#$9D; // UTF-8 for #$205D tricolon unicode character
19+
20+procedure EnumDirectories(const _Base: string; _Dirs: TStrings;
21+ _Sorted: boolean = True; _FullName: boolean = True; const _Mask: string = '*');
22+procedure EnumFiles(const _Base: string; const _Mask: string; _Files: TStrings; _Sorted: boolean = True;
23+ _FullName: boolean = True; _AdditionalAttribs: integer = 0); overload;
24+procedure EnumFiles(const _FullMask: string; _Files: TStrings; _Sorted: boolean = True;
25+ _FullName: boolean = True; _AdditionalAttribs: integer = 0); overload;
26+///<summary>
27+/// Find a file matching the mask and return its name. If there are more than one matches, return
28+/// the first.
29+/// @param Mask is the mask the filen name must match
30+/// @param fn is the first file that was found, if any. Only valid if Result >0
31+/// @returns the number of matching files found. </summary>
32+function FindMatchingFile(const _Mask: string; out _fn: string; _FullName: boolean = True): integer;
33+
34+function IsValidFileName(const _Filename: string): boolean;
35+
36+procedure TForm_CenterOn(_frm: TForm; _Owner: TWinControl); overload;
37+function TForm_GetCenter(_frm: TForm): TPoint;
38+
39+function TControl_GetParentFormCenter(_ctrl: TControl): TPoint;
40+
41+procedure TWinControl_SetFocus(_ctrl: TWinControl);
42+
43+function TApplication_GetDefaultIniFile: string;
44+function TApplication_GetExeDir: string;
45+function TApplication_GetExeDirBS: string;
46+
47+procedure TButton_DrowpdownMenu(_btn: TButton; _pm: TPopupMenu);
48+
49+function MessageDlgCentered(_Owner: TWinControl; const aMsg: string; DlgType: TMsgDlgType;
50+ Buttons: TMsgDlgButtons; HelpCtx: longint = 0): TModalResult;
51+
52+implementation
53+
54+function TApplication_GetDefaultIniFile: string;
55+begin
56+ Result := ChangeFileExt(Application.ExeName, '.ini');
57+end;
58+
59+function TApplication_GetExeDir: string;
60+begin
61+ Result := ExtractFileDir(Application.ExeName);
62+end;
63+
64+function TApplication_GetExeDirBS: string;
65+begin
66+ Result := IncludeTrailingPathDelimiter(TApplication_GetExeDir);
67+end;
68+
69+procedure EnumDirectories(const _Base: string; _Dirs: TStrings;
70+ _Sorted: boolean = True; _FullName: boolean = True; const _Mask: string = '*');
71+var
72+ Base: string;
73+ SearchRec: TRawByteSearchRec;
74+ Dirs: TStringList;
75+begin
76+ _Dirs.Clear;
77+ Base := IncludeTrailingPathDelimiter(_Base);
78+ if FindFirst(Base + _Mask, faDirectory, SearchRec) = 0 then begin
79+ Dirs := TStringList.Create;
80+ try
81+ if not _FullName then
82+ base := '';
83+ repeat
84+ if (SearchRec.Attr and faDirectory) <> 0 then
85+ if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then begin
86+ Dirs.Add(Base + SearchRec.Name);
87+ end;
88+ until FindNext(SearchRec) <> 0;
89+ if _Sorted then
90+ Dirs.Sort;
91+ _Dirs.Assign(Dirs);
92+ finally
93+ FreeAndNil(Dirs);
94+ FindClose(SearchRec);
95+ end;
96+ end;
97+end;
98+
99+procedure EnumFiles(const _Base: string; const _Mask: string; _Files: TStrings; _Sorted: boolean = True;
100+ _FullName: boolean = True; _AdditionalAttribs: integer = 0);
101+begin
102+ EnumFiles(IncludeTrailingPathDelimiter(_Base) + _Mask, _Files, _Sorted, _FullName, _AdditionalAttribs);
103+end;
104+
105+procedure EnumFiles(const _FullMask: string; _Files: TStrings; _Sorted: boolean = True;
106+ _FullName: boolean = True; _AdditionalAttribs: integer = 0);
107+var
108+ SearchRec: TRawbyteSearchRec;
109+ Files: TStringList;
110+ Base: string;
111+begin
112+ _Files.Clear;
113+ if FindFirst(_FullMask, faArchive + _AdditionalAttribs, SearchRec) = 0 then begin
114+ Files := TStringList.Create;
115+ try
116+ if _FullName then begin
117+ Base := ExtractFileDir(_FullMask);
118+ Base := IncludeTrailingPathDelimiter(Base);
119+ end else
120+ base := '';
121+ repeat
122+ if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then begin
123+ Files.Add(Base + SearchRec.Name);
124+ end;
125+ until FindNext(SearchRec) <> 0;
126+ if _Sorted then
127+ Files.Sort;
128+ _Files.Assign(Files);
129+ finally
130+ FreeAndNil(Files);
131+ FindClose(SearchRec);
132+ end;
133+ end;
134+end;
135+
136+function FindMatchingFile(const _Mask: string; out _fn: string; _FullName: boolean = True): integer;
137+var
138+ Files: TStringList;
139+begin
140+ Files := TStringList.Create;
141+ try
142+ EnumFiles(_Mask, Files, True, _FullName);
143+ Result := Files.Count;
144+ if Result > 0 then
145+ _fn := Files[0];
146+ finally
147+ FreeAndNil(Files);
148+ end;
149+end;
150+
151+procedure TForm_CenterOn(_frm: TForm; _Owner: TWinControl);
152+var
153+ Center: TPoint;
154+begin
155+ Center := _Owner.ClientToScreen(Point(_Owner.Width div 2, _Owner.Height div 2));
156+ _frm.Left := Center.X - _frm.Width div 2;
157+ _frm.Top := Center.Y - _frm.Height div 2;
158+end;
159+
160+function TForm_GetCenter(_frm: TForm): TPoint;
161+begin
162+ Result := _frm.ClientToScreen(Point(_frm.Width div 2, _frm.Height div 2));
163+end;
164+
165+function TControl_GetParentFormCenter(_ctrl: TControl): TPoint;
166+begin
167+ Result := _ctrl.ClientToScreen(Point(_ctrl.Width div 2, _ctrl.Height div 2));
168+end;
169+
170+procedure TWinControl_SetFocus(_ctrl: TWinControl);
171+begin
172+ try
173+ if _ctrl.CanSetFocus then
174+ _ctrl.SetFocus
175+ except
176+ on e: EInvalidOperation do
177+ ; // ignore
178+ end;
179+end;
180+
181+procedure TButton_DrowpdownMenu(_btn: TButton; _pm: TPopupMenu);
182+var
183+ pnt: Types.TPoint;
184+begin
185+ pnt := _btn.ClientToScreen(Point(0, _btn.Height));
186+ _pm.PopUp(pnt.x, pnt.y);
187+end;
188+
189+function MessageDlgCentered(_Owner: TWinControl; const aMsg: string; DlgType: TMsgDlgType;
190+ Buttons: TMsgDlgButtons; HelpCtx: longint): TModalResult;
191+var
192+ Center: TPoint;
193+begin
194+ Center := TControl_GetParentFormCenter(_Owner);
195+ Result := MessageDlgPos(aMsg, DlgType, Buttons, HelpCtx, Center.x, Center.y);
196+end;
197+
198+function IsValidFileName(const _Filename: string): boolean;
199+const
200+ InvalidCharacters: set of char = ['\', '/', ':', '*', '?', '"', '<', '>', '|', #9, #13, #10];
201+var
202+ c: char;
203+begin
204+ Result := _Filename <> '';
205+
206+ if Result then begin
207+ for c in _Filename do begin
208+ Result := not (c in InvalidCharacters);
209+ if not Result then break;
210+ end;
211+ end;
212+end;
213+
214+end.
215+
216+
--- tags/0.0.5/src/wf_noteeditor.pas (nonexistent)
+++ tags/0.0.5/src/wf_noteeditor.pas (revision 51)
@@ -0,0 +1,420 @@
1+unit wf_NoteEditor;
2+
3+{$mode objfpc}{$H+}
4+
5+interface
6+
7+uses
8+ Classes,
9+ SysUtils,
10+ FileUtil,
11+ Forms,
12+ Controls,
13+ StdCtrls,
14+ ExtCtrls,
15+ Menus,
16+ CheckLst,
17+ u_DenkzettelUtils;
18+
19+type
20+ TNoteDisplay = (ndMemo, ndChecklist);
21+
22+ { Tfr_NoteEditor }
23+
24+ Tfr_NoteEditor = class(TFrame)
25+ b_AddChecklistItem: TButton;
26+ b_Back: TButton;
27+ b_Menu: TButton;
28+ clb_Content: TCheckListBox;
29+ ed_NewChecklistItem: TEdit;
30+ ed_Title: TEdit;
31+ l_Message: TLabel;
32+ mi_Delete: TMenuItem;
33+ mi_Line: TMenuItem;
34+ mi_Revert: TMenuItem;
35+ mi_Save: TMenuItem;
36+ mi_ChangeColor: TMenuItem;
37+ mi_ToggleChecklist: TMenuItem;
38+ m_Content: TMemo;
39+ Panel1: TPanel;
40+ p_Checklist: TPanel;
41+ pm_Main: TPopupMenu;
42+ p_Top: TPanel;
43+ procedure b_AddChecklistItemClick(Sender: TObject);
44+ procedure b_BackClick(Sender: TObject);
45+ procedure b_MenuClick(Sender: TObject);
46+ procedure ed_NewChecklistItemEnter(Sender: TObject);
47+ procedure ed_NewChecklistItemExit(Sender: TObject);
48+ procedure ed_TitleChange(Sender: TObject);
49+ procedure FrameEnter(Sender: TObject);
50+ procedure mi_ChangeColorClick(Sender: TObject);
51+ procedure mi_DeleteClick(Sender: TObject);
52+ procedure mi_RevertClick(Sender: TObject);
53+ procedure mi_SaveClick(Sender: TObject);
54+ procedure mi_ToggleChecklistClick(Sender: TObject);
55+ private
56+ FControls: array[TNoteDisplay] of TControl;
57+ FPathBS: string;
58+ FFilenameOnly: string;
59+ FOnClose: TNotifyEvent;
60+ FOrigContent: string;
61+ FNoteColor: TDenkzettelColor;
62+ function BuildFilename: string;
63+ function IsChecklist: boolean;
64+ function ContentHasChanged: boolean;
65+ procedure doOnClose;
66+ procedure GetContent(out _s: string);
67+ procedure SetContent(const _s: string);
68+ procedure SaveNote;
69+ procedure SwitchDisplay(_Display: TNoteDisplay);
70+ public
71+ constructor Create(_Owner: TComponent); override;
72+ procedure Init(const _Path: string; const _FilenameOnly: string);
73+ procedure FormCloseQuery(_Sender: TObject; var _CanClose: boolean);
74+ procedure GoBack;
75+ procedure ShowMenu;
76+ property OnClose: TNotifyEvent read FOnClose write FOnClose;
77+ end;
78+
79+implementation
80+
81+{$R *.lfm}
82+
83+uses
84+ Dialogs,
85+ Graphics,
86+ strutils,
87+ u_dzLazUtils,
88+ w_SelectColor;
89+
90+{ Tfr_NoteEditor }
91+
92+constructor Tfr_NoteEditor.Create(_Owner: TComponent);
93+begin
94+ inherited Create(_Owner);
95+
96+ b_Menu.Caption := TRICOLON;
97+ FControls[ndMemo] := m_Content;
98+ FControls[ndChecklist] := p_Checklist;
99+end;
100+
101+procedure Tfr_NoteEditor.Init(const _Path: string; const _FilenameOnly: string);
102+var
103+ Title: string;
104+ lIsCheckList: boolean;
105+ sl: TStringList;
106+ cl: TColor;
107+ s: string;
108+begin
109+ s := ExcludeTrailingPathDelimiter(_Path);
110+ Assert(s <> '');
111+ l_Message.Visible := False;
112+ FPathBS := IncludeTrailingPathDelimiter(s);
113+ FFilenameOnly := _FilenameOnly;
114+ DecodeFilename(FFilenameOnly, Title, lIsCheckList, FNoteColor);
115+ if Title <> '' then begin
116+ ed_Title.Text := Title;
117+ cl := NoteColorToColor(FNoteColor, False);
118+ ed_Title.Color := cl;
119+ m_Content.Color := cl;
120+ if lIsCheckList then
121+ SwitchDisplay(ndChecklist)
122+ else
123+ SwitchDisplay(ndMemo);
124+ sl := TStringList.Create;
125+ try
126+ sl.LoadFromFile(FPathBS + FFilenameOnly);
127+ FOrigContent := sl.Text;
128+ SetContent(FOrigContent);
129+ finally
130+ FreeAndNil(sl);
131+ end;
132+ end else begin
133+ if lIsCheckList then begin
134+ ed_Title.Text := 'New Checklist';
135+ SwitchDisplay(ndChecklist);
136+ end else begin
137+ ed_Title.Text := 'New Note';
138+ SwitchDisplay(ndMemo);
139+ end;
140+ SetContent('');
141+ end;
142+end;
143+
144+procedure Tfr_NoteEditor.doOnClose;
145+var
146+ CanClose: boolean;
147+begin
148+ CanClose := True;
149+ FormCloseQuery(Self, CanClose);
150+ if CanClose then begin
151+ if Assigned(FOnClose) then
152+ FOnClose(Self);
153+ end;
154+end;
155+
156+procedure Tfr_NoteEditor.b_BackClick(Sender: TObject);
157+begin
158+ GoBack;
159+end;
160+
161+procedure Tfr_NoteEditor.b_AddChecklistItemClick(Sender: TObject);
162+var
163+ s: TCaption;
164+begin
165+ s := ed_NewChecklistItem.Text;
166+ clb_Content.Items.Add(s);
167+ ed_NewChecklistItem.Text := '';
168+ TWinControl_SetFocus(ed_NewChecklistItem);
169+end;
170+
171+procedure Tfr_NoteEditor.b_MenuClick(Sender: TObject);
172+begin
173+ ShowMenu;
174+end;
175+
176+procedure Tfr_NoteEditor.ed_NewChecklistItemEnter(Sender: TObject);
177+begin
178+ b_AddChecklistItem.Default := True;
179+end;
180+
181+procedure Tfr_NoteEditor.ed_NewChecklistItemExit(Sender: TObject);
182+begin
183+ b_AddChecklistItem.Default := False;
184+end;
185+
186+procedure Tfr_NoteEditor.ed_TitleChange(Sender: TObject);
187+var
188+ fn: string;
189+begin
190+ l_Message.Visible := False;
191+ if ed_Title.Text = '' then
192+ Exit;//==>
193+ fn := BuildFilename;
194+ if not IsValidFileName(fn) then begin
195+ l_Message.Caption := 'Warning: This note title is not a valid file name.';
196+ l_Message.Visible := True;
197+ Exit; //==>
198+ end;
199+ if FFilenameOnly = '' then begin
200+ if FileExists(FPathBS + fn) then begin
201+ l_Message.Caption := 'Warning: A note with this title already exists.';
202+ l_Message.Visible := True;
203+ Exit; //==>
204+ end;
205+ end;
206+ // todo: Maybe create the file in order to be sure it is a valid file name?
207+end;
208+
209+procedure Tfr_NoteEditor.FrameEnter(Sender: TObject);
210+begin
211+ if FFilenameOnly <> '' then
212+ TWinControl_SetFocus(m_Content)
213+ else
214+ TWinControl_SetFocus(ed_Title);
215+end;
216+
217+procedure Tfr_NoteEditor.mi_ChangeColorClick(Sender: TObject);
218+var
219+ dc: TDenkzettelColor;
220+ cl: TColor;
221+begin
222+ dc := dcWhite;
223+ if Tf_SelectColor.Execute(Self, dc) then begin
224+ FNoteColor := dc;
225+ cl := NoteColorToColor(dc, False);
226+ ed_Title.Color := cl;
227+ m_Content.Color := cl;
228+ end;
229+end;
230+
231+procedure Tfr_NoteEditor.mi_DeleteClick(Sender: TObject);
232+begin
233+ if FFilenameOnly = '' then
234+ Exit; //==>
235+ if mrYes = MessageDlgCentered(Self, 'Delete this note?', mtConfirmation, [mbYes, mbCancel], 0) then begin
236+ if not DeleteFile(FPathBS + FFilenameOnly) then
237+ raise Exception.Create('Failed to delete file.');
238+ if Assigned(FOnClose) then
239+ FOnClose(Self);
240+ end;
241+end;
242+
243+procedure Tfr_NoteEditor.mi_RevertClick(Sender: TObject);
244+begin
245+ if ContentHasChanged then
246+ if mrYes = MessageDlgCentered(Self, 'Revert your changes?', mtConfirmation, [mbYes, mbCancel], 0) then begin
247+ Init(FPathBS, FFilenameOnly);
248+ end;
249+end;
250+
251+procedure Tfr_NoteEditor.mi_SaveClick(Sender: TObject);
252+begin
253+ SaveNote;
254+end;
255+
256+procedure Tfr_NoteEditor.SwitchDisplay(_Display: TNoteDisplay);
257+var
258+ s: string;
259+begin
260+ GetContent(s);
261+ m_Content.Visible := False;
262+ p_Checklist.Visible := False;
263+ FControls[_Display].Visible := True;;
264+ SetContent(s);
265+
266+ TWinControl_SetFocus(m_Content);
267+end;
268+
269+procedure Tfr_NoteEditor.GetContent(out _s: string);
270+var
271+ i: integer;
272+ s: string;
273+ sl: TStringList;
274+begin
275+ sl := TStringList.Create;
276+ try
277+ if m_Content.Visible then begin
278+ sl.Assign(m_Content.Lines);
279+ end else if p_Checklist.Visible then begin
280+ for i := 0 to clb_Content.Items.Count - 1 do begin
281+ s := clb_Content.Items[i];
282+ if clb_Content.Checked[i] then
283+ s := '- ' + s
284+ else
285+ s := '+ ' + s;
286+ sl.Add(s);
287+ end;
288+ end else
289+ raise Exception.Create('Either the memo or the checklist must be visible');
290+ _s := sl.Text;
291+ finally
292+ FreeAndNil(sl)
293+ end;
294+end;
295+
296+procedure Tfr_NoteEditor.SetContent(const _s: string);
297+var
298+ i, Idx: integer;
299+ s: string;
300+ sl: TStringList;
301+begin
302+ sl := TStringList.Create;
303+ try
304+ sl.Text := _s;
305+ if m_Content.Visible then begin
306+ m_Content.Lines.Assign(sl);
307+ end else if p_Checklist.Visible then begin
308+ clb_Content.Items.Clear;
309+ for i := 0 to sl.Count - 1 do begin
310+ s := sl[i];
311+ if s <> '' then begin
312+ if AnsiStartsText('+ ', s) then begin
313+ Idx := clb_Content.Items.Add(Copy(s, 3));
314+ end else if AnsiStartsText('- ', s) then begin
315+ Idx := clb_Content.Items.Add(Copy(s, 3));
316+ clb_Content.Checked[Idx] := True;
317+ end else begin
318+ clb_Content.Items.Add(s);
319+ end;
320+ end;
321+ end;
322+ end else
323+ raise Exception.Create('Either the memo or the checklist must be visible');
324+ finally
325+ FreeAndNil(sl);
326+ end;
327+end;
328+
329+procedure Tfr_NoteEditor.mi_ToggleChecklistClick(Sender: TObject);
330+begin
331+ if IsChecklist then
332+ SwitchDisplay(ndMemo)
333+ else
334+ SwitchDisplay(ndChecklist);
335+end;
336+
337+procedure Tfr_NoteEditor.GoBack;
338+begin
339+ doOnClose;
340+end;
341+
342+procedure Tfr_NoteEditor.ShowMenu;
343+begin
344+ TButton_DrowpdownMenu(b_Menu, pm_Main);
345+end;
346+
347+function Tfr_NoteEditor.IsChecklist: boolean;
348+begin
349+ Result := p_Checklist.Visible;
350+end;
351+
352+function Tfr_NoteEditor.BuildFilename: string;
353+var
354+ ext: string;
355+begin
356+ Result := EncodeFilename(ed_Title.Text, IsChecklist, FNoteColor);
357+ ext := ExtractFileExt(FFilenameOnly);
358+ if ext = '' then
359+ ext := DEFAULT_EXTENSION;
360+ Result := Result + ext;
361+end;
362+
363+function Tfr_NoteEditor.ContentHasChanged: boolean;
364+var
365+ fn, s: string;
366+begin
367+ fn := BuildFilename;
368+ Result := True;
369+ if fn <> FFilenameOnly then
370+ Exit; //==>
371+ GetContent(s);
372+ Result := (s <> FOrigContent);
373+end;
374+
375+procedure Tfr_NoteEditor.SaveNote;
376+var
377+ fn: string;
378+ sl: TStringList;
379+begin
380+ fn := BuildFilename;
381+ if FFilenameOnly <> '' then begin
382+ if FFilenameOnly <> fn then begin
383+ if not RenameFile(FPathBS + FFilenameOnly, FPathBS + fn) then begin
384+ MessageDlgCentered(Self, 'Renaming the file failed. Please make sure that your title is a valid file name!',
385+ mtError, [mbOK]);
386+ SysUtils.Abort;
387+ end;
388+ end;
389+ end;
390+ FFilenameOnly := fn;
391+ sl := TStringList.Create;
392+ try
393+ GetContent(FOrigContent);
394+ sl.Text := FOrigContent;
395+ sl.SaveToFile(FPathBS + FFilenameOnly);
396+ finally
397+ FreeAndNil(sl);
398+ end;
399+end;
400+
401+procedure Tfr_NoteEditor.FormCloseQuery(_Sender: TObject; var _CanClose: boolean);
402+var
403+ Res: TModalResult;
404+begin
405+ if not ContentHasChanged then
406+ Exit; //==>
407+
408+ Res := MessageDlgCentered(Self, 'You have unsaved changes. Do you want to save them?',
409+ mtConfirmation, [mbYes, mbNo, mbCancel]);
410+ case Res of
411+ mrYes: begin
412+ SaveNote;
413+ end;
414+ mrNo: ;
415+ else
416+ _CanClose := False;
417+ end;
418+end;
419+
420+end.
--- tags/0.0.5/src/u_denkzettelutils.pas (nonexistent)
+++ tags/0.0.5/src/u_denkzettelutils.pas (revision 51)
@@ -0,0 +1,230 @@
1+unit u_DenkzettelUtils;
2+
3+{$mode objfpc}{$H+}
4+
5+interface
6+
7+uses
8+ Windows,
9+ SysUtils,
10+ Classes,
11+ Graphics;
12+
13+const
14+ DEFAULT_EXTENSION = '.txt';
15+
16+type
17+ TDenkzettelColor = (dcWhite, dcRed, dcOrange, dcYellow, dcMagenta, dcViolet, dcBlue, dcGreen);
18+
19+
20+function DecodeFilename(const _fn: string;
21+ out _Title: string; out _IsChecklist: boolean; out _Color: TDenkzettelColor): boolean;
22+
23+function EncodeFilename(const _Title: string; _IsChecklist: boolean; _Color: TDenkzettelColor): string;
24+
25+function PropertiesToPointer(_Color: TDenkzettelColor; _IsChecklist: boolean): Pointer;
26+procedure PointerToProperties(_Ptr: Pointer; out _Color: TDenkzettelColor; out _IsChecklist: boolean);
27+
28+function NoteColorToColor(_NoteColor: TDenkzettelColor; _IsSelected: boolean): TColor;
29+function DarkenColor(_Color: TColor; _Percent: byte): TColor;
30+function BrightenColor(_Color: TColor; _Percent: byte): TColor;
31+function NoteColorToChar(_dc: TDenkzettelColor): char;
32+function CharToNoteColor(_c: char): TDenkzettelColor;
33+
34+implementation
35+
36+uses
37+ strutils;
38+
39+type
40+ TPropEncoderRec = packed record
41+ case boolean of
42+ True: (AsPointer: Pointer);
43+ False: (
44+ Color: TDenkzettelColor;
45+ IsChecklist: boolean);
46+ end;
47+
48+function PropertiesToPointer(_Color: TDenkzettelColor; _IsChecklist: boolean): Pointer;
49+var
50+ rec: TPropEncoderRec;
51+begin
52+ ZeroMemory(@rec, SizeOf(rec));
53+ rec.Color := _Color;
54+ rec.IsChecklist := _IsChecklist;
55+ Result := rec.AsPointer;
56+end;
57+
58+procedure PointerToProperties(_Ptr: Pointer; out _Color: TDenkzettelColor; out _IsChecklist: boolean);
59+var
60+ rec: TPropEncoderRec;
61+begin
62+ ZeroMemory(@rec, SizeOf(rec));
63+ rec.AsPointer := _Ptr;
64+ _Color := rec.Color;
65+ _IsChecklist := rec.IsChecklist;
66+end;
67+
68+function DarkenColor(_Color: TColor; _Percent: byte): TColor;
69+var R, G, B: byte;
70+begin
71+ R := GetRValue(_Color);
72+ G := GetGValue(_Color);
73+ B := GetBValue(_Color);
74+ R := Round(R * _Percent / 100);
75+ G := Round(G * _Percent / 100);
76+ B := Round(B * _Percent / 100);
77+ Result := RGB(R, G, B);
78+end;
79+
80+function BrightenColor(_Color: TColor; _Percent: byte): TColor;
81+var R, G, B: byte;
82+begin
83+ R := GetRValue(_Color);
84+ G := GetGValue(_Color);
85+ B := GetBValue(_Color);
86+ R := Round(R * _Percent / 100) + Round(255 - _Percent / 100 * 255);
87+ G := Round(G * _Percent / 100) + Round(255 - _Percent / 100 * 255);
88+ B := Round(B * _Percent / 100) + Round(255 - _Percent / 100 * 255);
89+ Result := RGB(R, G, B);
90+end;
91+
92+
93+
94+function NoteColorToColor(_NoteColor: TDenkzettelColor; _IsSelected: boolean): TColor;
95+var
96+ clDenkzettelRed: TColor;
97+ clDenkzettelOrange: TColor;
98+ clDenkzettelYellow: TColor;
99+ clDenkzettelMagenta: TColor;
100+ clDenkzettelViolet: TColor;
101+ clDenkzettelBlue: TColor;
102+ clDenkzettelGreen: TColor;
103+begin
104+ clDenkzettelRed := RGBToColor(255, 180, 180); //RGBToColor(255, 128, 128);
105+ clDenkzettelOrange := RGBToColor(250, 192, 86); //RGBToColor(255, 170, 130);
106+ clDenkzettelYellow := RGBToColor(255, 255, 128);
107+ clDenkzettelMagenta := RGBToColor(255, 170, 255);
108+ clDenkzettelViolet := RGBToColor(217, 179, 255);
109+ clDenkzettelBlue := RGBToColor(152, 218, 254);
110+ clDenkzettelGreen := RGBToColor(193, 255, 193);
111+
112+ case _NoteColor of
113+ dcRed: Result := clDenkzettelRed;
114+ dcOrange: Result := clDenkzettelOrange;
115+ dcYellow: Result := clDenkzettelYellow;
116+ dcMagenta: Result := clDenkzettelMagenta;
117+ dcViolet: Result := clDenkzettelViolet;
118+ dcBlue: Result := clDenkzettelBlue;
119+ dcGreen: Result := clDenkzettelGreen;
120+ else // dcWhite:
121+ if _IsSelected then
122+ Result := clHighlight
123+ else
124+ Result := clWindow;
125+ Exit; //==>
126+ end;
127+ if _IsSelected then
128+ Result := DarkenColor(Result, 80);
129+end;
130+
131+function ExtractHashSuffix(var _s: string; out _Suffix: string): boolean;
132+var
133+ len: integer;
134+ i: integer;
135+begin
136+ Result := False;
137+ if _s = '' then
138+ Exit; //==>
139+ Len := Length(_s);
140+ if _s[Len] <> '#' then
141+ Exit; //==>
142+ i := Len - 1;
143+ while i > 0 do begin
144+ if _s[i] = '#' then begin
145+ _Suffix := Copy(_s, i);
146+ _s := LeftStr(_s, i - 1);
147+ Result := True;
148+ Exit; //==>
149+ end;
150+ Dec(i);
151+ end;
152+end;
153+
154+function NoteColorToChar(_dc: TDenkzettelColor): char;
155+begin
156+ case _dc of
157+ dcRed: Result := 'R';
158+ dcOrange: Result := 'O';
159+ dcYellow: Result := 'Y';
160+ dcMagenta: Result := 'M';
161+ dcViolet: Result := 'V';
162+ dcBlue: Result := 'B';
163+ dcGreen: Result := 'G';
164+ else
165+ Result := 'W';
166+ end;
167+end;
168+
169+function CharToNoteColor(_c: char): TDenkzettelColor;
170+begin
171+ case _c of
172+ 'R': Result := dcRed;
173+ 'O': Result := dcOrange;
174+ 'Y': Result := dcYellow;
175+ 'M': Result := dcMagenta;
176+ 'V': Result := dcViolet;
177+ 'B': Result := dcBlue;
178+ 'G': Result := dcGreen;
179+ else
180+ Result := dcWhite;
181+ end;
182+end;
183+
184+function DecodeFilename(const _fn: string;
185+ out _Title: string; out _IsChecklist: boolean; out _Color: TDenkZettelColor): boolean;
186+var
187+ s: string;
188+ Suffix: string;
189+ Option: string;
190+ Value: string;
191+begin
192+ s := ChangeFileExt(ExtractFileName(_fn), '');
193+ Result := False;
194+ _IsChecklist := False;
195+ _Color := dcWhite;
196+ _Title := s;
197+ while ExtractHashSuffix(s, Suffix) do begin
198+ if LeftStr(Suffix, 1) <> '#' then
199+ Exit; //==>
200+ if RightStr(Suffix, 1) <> '#' then
201+ Exit; //==>
202+ Option := Copy(Suffix, 2, Length(Suffix) - 2);
203+ Value := UpCase(Copy(Option, 2));
204+ Option := UpCase(LeftStr(Option, 1));
205+ case Option[1] of
206+ 'C': begin
207+ // Color
208+ if Length(Value) <> 1 then
209+ Exit; //==>
210+ _Color := CharToNoteColor(Value[1]);
211+ end;
212+ 'L': begin
213+ _IsChecklist := True;
214+ end;
215+ end;
216+ end;
217+ _Title := s;
218+ Result := True;
219+end;
220+
221+function EncodeFilename(const _Title: string; _IsChecklist: boolean; _Color: TDenkzettelColor): string;
222+begin
223+ Result := _Title;
224+ if _IsChecklist then
225+ Result := Result + '#L#';
226+ if _Color <> dcWhite then
227+ Result := Result + '#C' + NoteColorToChar(_Color) + '#';
228+end;
229+
230+end.
--- tags/0.0.5/src/w_newcategory.pas (nonexistent)
+++ tags/0.0.5/src/w_newcategory.pas (revision 51)
@@ -0,0 +1,84 @@
1+unit w_NewCategory;
2+
3+{$mode objfpc}{$H+}
4+
5+interface
6+
7+uses
8+ Classes,
9+ SysUtils,
10+ FileUtil,
11+ Forms,
12+ Controls,
13+ Graphics,
14+ Dialogs,
15+ StdCtrls;
16+
17+type
18+
19+ { Tf_NewCategory }
20+
21+ Tf_NewCategory = class(TForm)
22+ b_Cancel: TButton;
23+ b_Create: TButton;
24+ ed_Category: TEdit;
25+ l_Blurb: TLabel;
26+ l_Category: TLabel;
27+ procedure b_CreateClick(Sender: TObject);
28+ private
29+ FBaseDir: string;
30+ procedure SetData(const _BaseDir: string; const _CategoryName: string);
31+ procedure GetData(out _CategoryName: string);
32+ public
33+ class function Execute(_Owner: TWinControl; const _BaseDir: string; var _CategoryName: string): boolean;
34+ end;
35+
36+implementation
37+
38+uses
39+ u_dzLazUtils;
40+
41+{$R *.lfm}
42+
43+{ Tf_NewCategory }
44+
45+class function Tf_NewCategory.Execute(_Owner: TWinControl; const _BaseDir: string;
46+ var _CategoryName: string): boolean;
47+var
48+ frm: Tf_NewCategory;
49+begin
50+ frm := Tf_NewCategory.Create(_Owner);
51+ try
52+ TForm_CenterOn(frm, _Owner);
53+ frm.SetData(_BaseDir, _CategoryName);
54+ Result := (mrOk = frm.ShowModal);
55+ if Result then
56+ frm.GetData(_CategoryName);
57+
58+ finally
59+ FreeAndNil(frm);
60+ end;
61+end;
62+
63+procedure Tf_NewCategory.b_CreateClick(Sender: TObject);
64+var
65+ NewDir: string;
66+begin
67+ NewDir := FBaseDir + ed_Category.Text;
68+ if not CreateDir(newdir) then
69+ raise Exception.Create('Could not create directory.');
70+ ModalResult := mrOk;
71+end;
72+
73+procedure Tf_NewCategory.SetData(const _BaseDir: string; const _CategoryName: string);
74+begin
75+ FBaseDir := IncludeTrailingPathDelimiter(_BaseDir);
76+ ed_Category.Text := _CategoryName;
77+end;
78+
79+procedure Tf_NewCategory.GetData(out _CategoryName: string);
80+begin
81+ _CategoryName := ed_Category.Text;
82+end;
83+
84+end.
--- tags/0.0.5/src/w_settings.pas (nonexistent)
+++ tags/0.0.5/src/w_settings.pas (revision 51)
@@ -0,0 +1,70 @@
1+unit w_Settings;
2+
3+{$mode objfpc}{$H+}
4+
5+interface
6+
7+uses
8+ Classes,
9+ SysUtils,
10+ FileUtil,
11+ Forms,
12+ Controls,
13+ Graphics,
14+ Dialogs,
15+ StdCtrls,
16+ EditBtn;
17+
18+type
19+
20+ { Tf_Settings }
21+
22+ Tf_Settings = class(TForm)
23+ b_OK: TButton;
24+ b_Cancel: TButton;
25+ de_BaseDirectory: TDirectoryEdit;
26+ l_BaseDirectory: TLabel;
27+ private
28+ procedure SetData(const _BaseDir: string);
29+ procedure GetData(out _BaseDir: string);
30+ public
31+ class function Execute(_Owner: TWinControl; var _BaseDir: string): boolean;
32+ end;
33+
34+
35+implementation
36+
37+{$R *.lfm}
38+
39+uses
40+ u_dzLazUtils;
41+
42+{ Tf_Settings }
43+
44+class function Tf_Settings.Execute(_Owner: TWinControl; var _BaseDir: string): boolean;
45+var
46+ frm: Tf_Settings;
47+begin
48+ frm := Tf_Settings.Create(_Owner);
49+ try
50+ TForm_CenterOn(frm, _Owner);
51+ frm.SetData(_BaseDir);
52+ Result := frm.ShowModal = mrOk;
53+ if Result then
54+ frm.GetData(_BaseDir);
55+ finally
56+ FreeAndNil(frm);
57+ end;
58+end;
59+
60+procedure Tf_Settings.SetData(const _BaseDir: string);
61+begin
62+ de_BaseDirectory.Directory := _BaseDir;
63+end;
64+
65+procedure Tf_Settings.GetData(out _BaseDir: string);
66+begin
67+ _BaseDir := de_BaseDirectory.Directory;
68+end;
69+
70+end.
--- tags/0.0.5/!readme.txt (nonexistent)
+++ tags/0.0.5/!readme.txt (revision 51)
@@ -0,0 +1,15 @@
1+Suffixes for the file name are apparently used to encode the way how Denkzettel displays the
2+notes:
3+* #C?# is the background color, where ? is one of:
4+ + R -> Red
5+ + O -> Orange
6+ + Y -> Yellow
7+ + M -> Magenta
8+ + V -> Violet
9+ + B -> Blue
10+ + G -> Green
11+ If there is no #C?# suffix the background color is white
12+
13+* #L# means that the note is a checklist
14+
15+* Sometimes there is a #N?# suffix (I have only seen #N1# yet, so maybe that's the only value)
\ No newline at end of file
Show on old repository browser