⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mainfrm.pas

📁 East make Tray Icon in delphi
💻 PAS
📖 第 1 页 / 共 2 页
字号:
        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鰎nqvist; 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.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -