mainfrm.pas

East make Tray Icon in delphi

{******************************************************************

                       JEDI-VCL Demo

 Copyright (C) 2002 Project JEDI

 Original author: Peter Th鰎nqvist

 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.

******************************************************************}
{$I jvcl.inc}
unit MainFrm;
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;