596 lines
16 KiB
ObjectPascal
596 lines
16 KiB
ObjectPascal
{******************************************************************
|
|
|
|
JEDI-VCL Demo
|
|
|
|
Copyright (C) 2002 Project JEDI
|
|
|
|
Original author: Peter Thörnqvist
|
|
|
|
You may retrieve the latest version of this file at the JEDI-JVCL
|
|
home page, located at http://jvcl.sourceforge.net
|
|
|
|
The contents of this file are used with permission, subject to
|
|
the Mozilla Public License Version 1.1 (the "License"); you may
|
|
not use this file except in compliance with the License. You may
|
|
obtain a copy of the License at
|
|
http://www.mozilla.org/MPL/MPL-1_1Final.html
|
|
|
|
Software distributed under the License is distributed on an
|
|
"AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
|
implied. See the License for the specific language governing
|
|
rights and limitations under the License.
|
|
|
|
******************************************************************}
|
|
unit MainFrm;
|
|
|
|
{$I jvcl.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
|
|
Dialogs, StdCtrls, ComCtrls, ExtCtrls, ActnList, Menus, HTTPApp,
|
|
{$IFDEF COMPILER6_UP}HTTPProd,{$ENDIF}
|
|
JvExExtCtrls, JvNetscapeSplitter, JvExComCtrls, JvListView, JvExStdCtrls,
|
|
JvRichEdit, JvRadioGroup, JvDotNetControls;
|
|
|
|
type
|
|
TfrmMain = class(TForm)
|
|
alMain: TActionList;
|
|
acAdd: TAction;
|
|
acDelete: TAction;
|
|
acExportHTML: TAction;
|
|
acSave: TAction;
|
|
acLoad: TAction;
|
|
acReplace: TAction;
|
|
acSaveAs: TAction;
|
|
pnlLeft: TPanel;
|
|
vertSplitter: TJvNetscapeSplitter;
|
|
lvItems: TJvDotNetListView;
|
|
pnlRight: TPanel;
|
|
Label2: TLabel;
|
|
reAnswer: TJvDotNetRichEdit;
|
|
reQuestion: TJvDotNetRichEdit;
|
|
Label1: TLabel;
|
|
mmMain: TMainMenu;
|
|
File1: TMenuItem;
|
|
Edit1: TMenuItem;
|
|
Help1: TMenuItem;
|
|
Open1: TMenuItem;
|
|
Save1: TMenuItem;
|
|
SaveAsHTML1: TMenuItem;
|
|
N1: TMenuItem;
|
|
Exit1: TMenuItem;
|
|
Add1: TMenuItem;
|
|
Replace1: TMenuItem;
|
|
Delete1: TMenuItem;
|
|
acAbout: TAction;
|
|
acOptions: TAction;
|
|
About1: TMenuItem;
|
|
N2: TMenuItem;
|
|
Options1: TMenuItem;
|
|
horzSplitter: TJvNetscapeSplitter;
|
|
sbStatus: TStatusBar;
|
|
ppHTMLBuilder: TPageProducer;
|
|
acNew: TAction;
|
|
New1: TMenuItem;
|
|
SaveAs1: TMenuItem;
|
|
N3: TMenuItem;
|
|
acMoveUp: TAction;
|
|
acMoveDown: TAction;
|
|
popItems: TPopupMenu;
|
|
MoveUp1: TMenuItem;
|
|
MoveDown1: TMenuItem;
|
|
acHelp: TAction;
|
|
Label3: TLabel;
|
|
acNext: TAction;
|
|
acPrev: TAction;
|
|
acNextItem: TAction;
|
|
acPrevItem: TAction;
|
|
N4: TMenuItem;
|
|
Next1: TMenuItem;
|
|
Previous1: TMenuItem;
|
|
Bevel2: TBevel;
|
|
acFullScreen: TAction;
|
|
FullScreen1: TMenuItem;
|
|
N5: TMenuItem;
|
|
Help2: TMenuItem;
|
|
N6: TMenuItem;
|
|
procedure alMainUpdate(Action: TBasicAction; var Handled: Boolean);
|
|
procedure acAddExecute(Sender: TObject);
|
|
procedure acDeleteExecute(Sender: TObject);
|
|
procedure acSaveAsExecute(Sender: TObject);
|
|
procedure acLoadExecute(Sender: TObject);
|
|
procedure acExportHTMLExecute(Sender: TObject);
|
|
procedure acSaveExecute(Sender: TObject);
|
|
procedure acReplaceExecute(Sender: TObject);
|
|
procedure reAnswerEnter(Sender: TObject);
|
|
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
|
procedure lvItemsSelectItem(Sender: TObject; Item: TListItem;
|
|
Selected: Boolean);
|
|
procedure FormResize(Sender: TObject);
|
|
procedure Exit1Click(Sender: TObject);
|
|
procedure acOptionsExecute(Sender: TObject);
|
|
procedure ppHTMLBuilderHTMLTag(Sender: TObject; Tag: TTag;
|
|
const TagString: string; TagParams: TStrings;
|
|
var ReplaceText: string);
|
|
procedure acAboutExecute(Sender: TObject);
|
|
procedure lvItemsDeletion(Sender: TObject; Item: TListItem);
|
|
procedure acNewExecute(Sender: TObject);
|
|
procedure FormShow(Sender: TObject);
|
|
procedure acMoveUpExecute(Sender: TObject);
|
|
procedure acMoveDownExecute(Sender: TObject);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure acHelpExecute(Sender: TObject);
|
|
procedure reQuestionEnter(Sender: TObject);
|
|
procedure acNextExecute(Sender: TObject);
|
|
procedure acPrevExecute(Sender: TObject);
|
|
procedure acNextItemExecute(Sender: TObject);
|
|
procedure acPrevItemExecute(Sender: TObject);
|
|
procedure acFullScreenExecute(Sender: TObject);
|
|
procedure JvRadioGroup1ItemHint(Sender: TObject; Index: Integer;
|
|
var AHint: String);
|
|
private
|
|
{ Private declarations }
|
|
LastFilename, LastHTMLFile: string;
|
|
Modified: boolean;
|
|
CurrentQuestion, CurrentAnswer: string;
|
|
CurrentIndex: integer;
|
|
procedure ShowPreview(const Filename: string);
|
|
procedure UpdateStatus;
|
|
procedure LoadFromFile(const Filename: string);
|
|
procedure SaveToFile(const Filename: string);
|
|
procedure ExportToHTML(const Filename: string);
|
|
function CheckSave: boolean;
|
|
procedure SaveItem(lv:TListItem);
|
|
procedure LoadItem(lv:TListItem);
|
|
public
|
|
{ Public declarations }
|
|
end;
|
|
|
|
var
|
|
frmMain: TfrmMain;
|
|
|
|
implementation
|
|
uses
|
|
IniFiles, OptionsFrm, FAQGlobals, ShellAPI, JvJVCLUtils;
|
|
|
|
resourcestring
|
|
SFAQFileFilter = 'FAQ files (*.faq)|*.faq|All files (*.*)|*.*';
|
|
SHTMLFilter = 'HTML files (*.htm;*,html)|*.htm;*.html|All files (*.*)|*.*';
|
|
|
|
{$R *.dfm}
|
|
|
|
procedure TfrmMain.LoadFromFile(const Filename: string);
|
|
var
|
|
M: TIniFile;
|
|
i, j: integer;
|
|
S: TStringlist;
|
|
tmp: string;
|
|
begin
|
|
lvItems.Items.Clear;
|
|
M := TIniFile.Create(Filename);
|
|
try
|
|
j := M.ReadInteger('FAQ', 'Count', 0);
|
|
// FTitle := M.ReadString('FAQ','Title',FTitle);
|
|
// FStylesheet := M.ReadString('FAQ','Stylesheet',FStylesheet);
|
|
for i := 0 to j - 1 do
|
|
begin
|
|
tmp := DoLoadReplace(M.ReadString('FAQ', Format('Q%d', [i]), ''));
|
|
S := TStringlist.Create;
|
|
S.Text := DoLoadReplace(M.ReadString('FAQ', Format('A%d', [i]), ''));
|
|
with lvItems.Items.Add do
|
|
begin
|
|
Caption := tmp;
|
|
Data := S;
|
|
end;
|
|
end;
|
|
finally
|
|
M.Free;
|
|
end;
|
|
Modified := false;
|
|
UpdateStatus;
|
|
end;
|
|
|
|
procedure TfrmMain.SaveToFile(const Filename: string);
|
|
var
|
|
M: TIniFile;
|
|
i, j: integer;
|
|
begin
|
|
SaveItem(lvItems.Selected);
|
|
j := lvItems.Items.Count;
|
|
M := TIniFile.Create(Filename);
|
|
try
|
|
M.EraseSection('FAQ');
|
|
M.WriteInteger('FAQ', 'Count', j);
|
|
// M.WriteString('FAQ','Title',FTitle);
|
|
// M.writeString('FAQ','Stylesheet',FStylesheet);
|
|
for i := 0 to j - 1 do
|
|
begin
|
|
M.WriteString('FAQ', Format('Q%d', [i]), DoSaveReplace(lvItems.Items[i].Caption));
|
|
M.WriteString('FAQ', Format('A%d', [i]), DoSaveReplace(TStrings(lvItems.Items[i].Data).Text));
|
|
end;
|
|
finally
|
|
M.Free;
|
|
end;
|
|
Modified := false;
|
|
UpdateStatus;
|
|
end;
|
|
|
|
procedure TfrmMain.ExportToHTML(const Filename: string);
|
|
var
|
|
S: TStringlist;
|
|
i: integer;
|
|
begin
|
|
SaveItem(lvItems.Selected);
|
|
S := TStringlist.Create;
|
|
try
|
|
ppHTMLBuilder.HTMLDoc := FAQOptions.Header;
|
|
S.Add(ppHTMLBuilder.Content);
|
|
ppHTMLBuilder.HTMLDoc := FAQOptions.Item;
|
|
for i := 0 to lvItems.Items.Count - 1 do
|
|
begin
|
|
CurrentIndex := i;
|
|
CurrentQuestion := StringReplace(lvItems.Items[i].Caption, #13#10,'<br>',[rfReplaceAll]);
|
|
CurrentAnswer := StringReplace(TStrings(lvItems.Items[i].Data).Text,#13#10,'<br>',[rfReplaceAll]);
|
|
S.Add(ppHTMLBuilder.Content);
|
|
end;
|
|
ppHTMLBuilder.HTMLDoc := FAQOptions.Footer;
|
|
S.Add(ppHTMLBuilder.Content);
|
|
S.SaveToFile(Filename);
|
|
finally
|
|
S.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmMain.alMainUpdate(Action: TBasicAction; var Handled: Boolean);
|
|
begin
|
|
acDelete.Enabled := (lvItems.ItemIndex < lvItems.Items.Count) and (lvItems.ItemIndex > -1);
|
|
acAdd.Enabled := (reQuestion.Lines.Text <> '');
|
|
acReplace.Enabled := acDelete.Enabled and acAdd.Enabled;
|
|
acMoveUp.Enabled := (lvItems.ItemIndex > 0);
|
|
acMoveDown.Enabled := (lvItems.ItemIndex < lvItems.Items.Count - 1);
|
|
UpdateStatus;
|
|
end;
|
|
|
|
procedure TfrmMain.acAddExecute(Sender: TObject);
|
|
var
|
|
lv: TlistItem;
|
|
begin
|
|
lv := lvItems.FindCaption(0, FlattenText(reQuestion.Lines), false, true, true);
|
|
if lv = nil then
|
|
begin
|
|
lv := lvItems.Items.Add;
|
|
SaveItem(lv);
|
|
end;
|
|
lv.Selected := true;
|
|
lv.Focused := true;
|
|
Modified := true;
|
|
end;
|
|
|
|
procedure TfrmMain.acDeleteExecute(Sender: TObject);
|
|
var
|
|
lv: TListItem;
|
|
i: integer;
|
|
begin
|
|
lv := lvItems.Selected;
|
|
i := lv.Index;
|
|
lv.Delete;
|
|
if (i > 0) and (i < lvItems.Items.Count) then
|
|
lvItems.Items[i - 1].Selected := true
|
|
else if lvItems.Items.Count > 0 then
|
|
lvItems.Items[0].Selected := true;
|
|
lvItems.ItemFocused := lvItems.Selected;
|
|
lvItemsSelectItem(Sender, lvItems.Selected, true);
|
|
Modified := true;
|
|
end;
|
|
|
|
procedure TfrmMain.acLoadExecute(Sender: TObject);
|
|
begin
|
|
if CheckSave then
|
|
begin
|
|
ForceCurrentDirectory := true;
|
|
with TOpenDialog.Create(nil) do
|
|
try
|
|
Filename := LastFilename;
|
|
Filter := SFAQFileFilter;
|
|
if Execute then
|
|
begin
|
|
LastFilename := Filename;
|
|
LoadFromFile(LastFilename);
|
|
end;
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmMain.acExportHTMLExecute(Sender: TObject);
|
|
begin
|
|
ForceCurrentDirectory := true;
|
|
with TSaveDialog.Create(nil) do
|
|
try
|
|
Options := Options + [ofOverWritePrompt];
|
|
Filter := SHTMLFilter;
|
|
Filename := LastHTMLFile;
|
|
if Execute then
|
|
begin
|
|
ExportToHTML(Filename);
|
|
LastHTMLFile := Filename;
|
|
end;
|
|
ShowPreview(Filename);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmMain.acSaveExecute(Sender: TObject);
|
|
begin
|
|
if LastFileName = '' then
|
|
acSaveAs.Execute
|
|
else
|
|
SaveToFile(LastFileName);
|
|
end;
|
|
|
|
procedure TfrmMain.acReplaceExecute(Sender: TObject);
|
|
var
|
|
lv: TListItem;
|
|
begin
|
|
lv := lvItems.Selected;
|
|
if lv <> nil then
|
|
begin
|
|
lv.Caption := FlattenText(reQuestion.Lines);
|
|
TStrings(lv.Data).Assign(reAnswer.Lines);
|
|
end;
|
|
Modified := true;
|
|
end;
|
|
|
|
procedure TfrmMain.reAnswerEnter(Sender: TObject);
|
|
begin
|
|
reAnswer.SelectAll;
|
|
end;
|
|
|
|
procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
|
begin
|
|
CanClose := CheckSave;
|
|
end;
|
|
|
|
procedure TfrmMain.acSaveAsExecute(Sender: TObject);
|
|
begin
|
|
ForceCurrentDirectory := true;
|
|
with TSaveDialog.Create(nil) do
|
|
try
|
|
Options := Options + [ofOverWritePrompt];
|
|
Filename := LastFilename;
|
|
Filter := SFAQFileFilter;
|
|
DefaultExt := 'faq';
|
|
if Execute then
|
|
begin
|
|
LastFilename := Filename;
|
|
acSave.Execute;
|
|
end;
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmMain.lvItemsSelectItem(Sender: TObject; Item: TListItem;
|
|
Selected: Boolean);
|
|
begin
|
|
reQuestion.Clear;
|
|
reAnswer.Clear;
|
|
if (Item <> nil) and Selected then
|
|
LoadItem(Item);
|
|
end;
|
|
|
|
procedure TfrmMain.FormResize(Sender: TObject);
|
|
begin
|
|
lvItems.Columns[0].Width := -2;
|
|
end;
|
|
|
|
procedure TfrmMain.Exit1Click(Sender: TObject);
|
|
begin
|
|
Close;
|
|
end;
|
|
|
|
procedure TfrmMain.acOptionsExecute(Sender: TObject);
|
|
begin
|
|
TfrmOptions.Edit;
|
|
end;
|
|
|
|
procedure TfrmMain.UpdateStatus;
|
|
const
|
|
cModified: array[boolean] of PChar = (' Ready', ' Modified');
|
|
begin
|
|
if LastFilename = '' then
|
|
sbStatus.Panels[0].Text := ' New'
|
|
else
|
|
sbStatus.Panels[0].Text := ' ' + LastFilename;
|
|
sbStatus.Panels[1].Text := Format(' %d item(s)', [lvItems.Items.Count]);
|
|
sbStatus.Panels[2].Text := cModified[Modified];
|
|
end;
|
|
|
|
procedure TfrmMain.ppHTMLBuilderHTMLTag(Sender: TObject; Tag: TTag;
|
|
const TagString: string; TagParams: TStrings; var ReplaceText: string);
|
|
begin
|
|
if AnsiSameText(TagString, 'TITLE') then
|
|
ReplaceText := FAQOptions.Title
|
|
else if AnsiSameText(TagString, 'STYLESHEET') then
|
|
ReplaceText := FAQOptions.StylePath + FAQOptions.Stylesheet
|
|
else if AnsiSameText(TagString, 'Q_IMAGE') then
|
|
ReplaceText := FAQOptions.ImagePath + FAQOptions.QImage
|
|
else if AnsiSameText(TagString, 'A_IMAGE') then
|
|
ReplaceText := FAQOptions.ImagePath + FAQOptions.AImage
|
|
else if AnsiSameText(TagString, 'Q_ITEM') then
|
|
ReplaceText := CurrentQuestion
|
|
else if AnsiSameText(TagString, 'A_ITEM') then
|
|
ReplaceText := CurrentAnswer
|
|
else if AnsiSameText(TagString, 'FAQINDEX') then
|
|
ReplaceText := IntToStr(CurrentIndex);
|
|
end;
|
|
|
|
procedure TfrmMain.ShowPreview(const Filename: string);
|
|
begin
|
|
if MessageBox('Show HTML Preview?', 'Preview HTML', MB_YESNO) = IDYES then
|
|
ShellExecute(Handle, 'open', PChar(Filename), nil, nil, SW_NORMAL);
|
|
end;
|
|
|
|
procedure TfrmMain.acAboutExecute(Sender: TObject);
|
|
begin
|
|
ShowMessage('FAQ Builder 1.00'#13'Copyright (c) 2004 by Peter Thörnqvist; all rights reserved.'#13'Part of the JEDI-JVCL tools and released under MPL.');
|
|
end;
|
|
|
|
function TfrmMain.CheckSave: boolean;
|
|
var
|
|
S: string;
|
|
begin
|
|
Result := true;
|
|
if Modified then
|
|
begin
|
|
if LastFilename = '' then
|
|
S := 'Save changes to current FAQ file?'
|
|
else
|
|
S := Format('Save changes to "%s"?', [LastFilename]);
|
|
case MessageBox(S, 'Confirm save', MB_YESNOCANCEL) of
|
|
IDYES:
|
|
Result := acSave.Execute;
|
|
IDNO: ;
|
|
IDCANCEL:
|
|
Result := false;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmMain.lvItemsDeletion(Sender: TObject; Item: TListItem);
|
|
begin
|
|
if (Item <> nil) and (Item.Data <> nil) then
|
|
begin
|
|
TObject(Item.Data).Free;
|
|
Item.Data := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmMain.acNewExecute(Sender: TObject);
|
|
begin
|
|
if CheckSave then
|
|
begin
|
|
lvItems.Items.Clear;
|
|
reQuestion.Clear;
|
|
reAnswer.Clear;
|
|
LastFilename := '';
|
|
Modified := false;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmMain.FormShow(Sender: TObject);
|
|
begin
|
|
UpdateStatus;
|
|
end;
|
|
|
|
procedure TfrmMain.acMoveUpExecute(Sender: TObject);
|
|
begin
|
|
if lvItems.ItemIndex < 0 then Exit;
|
|
SaveItem(lvItems.Selected);
|
|
lvItems.MoveUp(lvItems.ItemIndex);
|
|
Modified := true;
|
|
end;
|
|
|
|
procedure TfrmMain.acMoveDownExecute(Sender: TObject);
|
|
begin
|
|
if lvItems.ItemIndex < 0 then Exit;
|
|
SaveItem(lvItems.Selected);
|
|
lvItems.MoveDown(lvItems.ItemIndex);
|
|
Modified := true;
|
|
end;
|
|
|
|
procedure TfrmMain.LoadItem(lv: TListItem);
|
|
begin
|
|
if lv <> nil then
|
|
begin
|
|
reQuestion.Lines.Text := lv.Caption;
|
|
if lv.Data <> nil then
|
|
reAnswer.Lines.Assign(TStrings(lv.Data));
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmMain.SaveItem(lv: TListItem);
|
|
begin
|
|
if lv <> nil then
|
|
begin
|
|
if lv.Data = nil then
|
|
begin
|
|
lv.Caption := FlattenText(reQuestion.Lines);
|
|
lv.Data := TStringlist.Create;
|
|
end;
|
|
TStringlist(lv.Data).Assign(reAnswer.Lines);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmMain.FormCreate(Sender: TObject);
|
|
begin
|
|
FAQOptions.LoadFromFile(ChangeFileExt(Application.Exename,'.ini'));
|
|
end;
|
|
|
|
procedure TfrmMain.acHelpExecute(Sender: TObject);
|
|
begin
|
|
ShellExecute(Handle, 'open', PChar(ExtractFilePath(Application.Exename) + 'help.htm'),nil,nil, SW_SHOWNORMAL);
|
|
end;
|
|
|
|
procedure TfrmMain.reQuestionEnter(Sender: TObject);
|
|
begin
|
|
reQuestion.SelStart := 0;
|
|
end;
|
|
|
|
procedure TfrmMain.acNextExecute(Sender: TObject);
|
|
begin
|
|
SelectNext(ActiveControl, true, true);
|
|
end;
|
|
|
|
procedure TfrmMain.acPrevExecute(Sender: TObject);
|
|
begin
|
|
SelectNext(ActiveControl, false, true);
|
|
end;
|
|
|
|
procedure TfrmMain.acNextItemExecute(Sender: TObject);
|
|
begin
|
|
lvItems.SelectNextItem;
|
|
end;
|
|
|
|
procedure TfrmMain.acPrevItemExecute(Sender: TObject);
|
|
begin
|
|
lvItems.SelectPrevItem;
|
|
end;
|
|
|
|
procedure TfrmMain.acFullScreenExecute(Sender: TObject);
|
|
var WP:TWindowPlacement;
|
|
begin
|
|
acFullScreen.Checked := not acFullScreen.Checked;
|
|
WP.length := sizeof(WP);
|
|
GetWindowPlacement(Handle,@WP);
|
|
if acFullScreen.Checked then
|
|
begin
|
|
if lvItems.Focused then
|
|
reQuestion.SetFocus;
|
|
vertSplitter.Minimized := true;
|
|
horzSplitter.Maximized := true;
|
|
WP.showCmd := SW_MAXIMIZE;
|
|
end
|
|
else
|
|
begin
|
|
vertSplitter.Minimized := false;
|
|
horzSplitter.Maximized := false;
|
|
WP.showCmd := SW_RESTORE;
|
|
end;
|
|
SetWindowPlacement(Handle,@WP);
|
|
|
|
end;
|
|
|
|
procedure TfrmMain.JvRadioGroup1ItemHint(Sender: TObject; Index: Integer;
|
|
var AHint: String);
|
|
begin
|
|
AHint := Format('This is the hint for item %d',[Index + 1]);
|
|
end;
|
|
|
|
end.
|
|
|