Resources Unit

The code of the resources unit

unit Resources;
{
    Copyright (c) 2013 Jerzy Griffiths

    Licensed under the Apache License, Version 2.0 (the "License"); you may not
    use this file except in compliance with the License, as described at
    http://www.apache.org/licenses/ and http://www.pp4s.co.uk/licenses/ }
 
interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, MPlayer, ExtCtrls, strutils, ShellAPI, ShlObj, ComCtrls,
  ExtDlgs, jpeg, main_menu, Xmldoc, xmldom, msxml, XMLIntf;

type
  TResources_frm = class(TForm)
    Resource_Chooser_Panel: TPanel;
    MP3_shower_panel: TPanel;
    Resource_shower_panel: TPanel;
    mp3player: TMediaPlayer;
    Ld_Picture_btn: TButton;
    Browse_btn: TButton;
    Resources_lstbox: TListBox;
    Search_btn: TButton;
    Search_panel: TPanel;
    Search_podcasts_btn: TButton;
    txtfolder: TStaticText;
    Help_btn: TButton;
    Tags_edit: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Season_edit: TEdit;
    Episode_edit: TEdit;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Author_edit: TEdit;
    Name_edit: TEdit;
    Cancel_btn: TButton;
    OpenPictureDialog1: TOpenPictureDialog;
    Resource_shower_page: TPageControl;
    Delete_Picture_btn: TButton;
    Remove_Picture_btn: TButton;
    Label7: TLabel;
    Label8: TLabel;
    Delete_file_btn: TButton;
    Ld_File_btn: TButton;
    Remove_file_btn: TButton;
    Add_Podcast_btn: TButton;
    OpenDialog1: TOpenDialog;
    procedure Search_btnClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Browse_btnClick(Sender: TObject);
    procedure Resources_lstboxClick(Sender: TObject);
    procedure Help_btnClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Cancel_btnClick(Sender: TObject);
    procedure Search_podcasts_btnClick(Sender: TObject);
    procedure Ld_Picture_btnClick(Sender: TObject);
    procedure Add_Podcast_btnClick(Sender: TObject);
    procedure Ld_File_btnClick(Sender: TObject);
    procedure Delete_Picture_btnClick(Sender: TObject);
    procedure Remove_Picture_btnClick(Sender: TObject);
  private
    { Private declarations }
  public
    general_resources: boolean;
    Save_path: string;
    { Public declarations }
  end;

var
  Resources_frm: TResources_frm;
  MP3address: string;
  i: integer;
  Opening: boolean;
  XML: tXmldocument;

implementation

{$R *.dfm}

procedure Get_resources(Folder: string; sl: TStrings);
var
  File_name: TSearchRec;
begin
  sl.Clear;
  if FindFirst(Folder + '*.mp3', faAnyFile, File_name) = 0 then
    try
      repeat
        sl.Add(File_name.Name);
      until FindNext(File_name) <> 0;
    finally
      FindClose(File_name);
    end;
end;

function BrowseDialog(const Title: string; const Flag: integer): string;
var
  lpItemID: PItemIDList;
  BrowseInfo: TBrowseInfo;
  DisplayName: array[0..MAX_PATH] of char;
  TempPath: array[0..MAX_PATH] of char;
begin
  Result := '';
  FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
  with BrowseInfo do
  begin
    hwndOwner := Application.Handle;
    pszDisplayName := @DisplayName;
    lpszTitle := PChar(Title);
    ulFlags := Flag;
  end;
  lpItemID := SHBrowseForFolder(BrowseInfo);
  if lpItemId <> nil then
  begin
    SHGetPathFromIDList(lpItemID, TempPath);
    Result := IncludeTrailingBackslash(TempPath);
    GlobalFreePtr(lpItemID);
  end;
  //taken from internet tutorial for constructing an MP3 player
end;

procedure TResources_frm.Add_Podcast_btnClick(Sender: TObject);
var
  tempXML: ixmlDocument;
  ANode, podcast: IXMLNode;
  Catchint: integer;
  errorpos: integer;
begin
  opendialog1.Filter := 'All files|*.*';
  if season_edit.Text <> '' then
  begin
    val(season_edit.Text, catchint, errorpos);
    if not (errorpos = 0) then
    begin
      ShowMessage('Invalid input.');
      exit;
    end;
  end;
  if episode_edit.Text <> '' then
  begin
    val(episode_edit.Text, catchint, errorpos);
    if not (errorpos = 0) then
    begin
      ShowMessage('Invalid input.');
      exit;
    end;
  end;
  if opendialog1.Execute then
  begin
    tempxml := txmldocument.Create(nil);
    tempXML.LoadFromFile(Resources_frm.save_path + 'podcasts/Search_file.xml');
    tempXML.options := [donodeautoindent, donodeautoindent];
    ANode := tempXML.DocumentElement.AddChild('Podcast');//To add an item to catalog
    ANode.Attributes['id'] := 'PC' + IntToStr(tempxml.DocumentElement.ChildNodes.Count);
    //Give the item an ID
    podcast := ANode.AddChild('Name'); //Add a child node for name
    podcast.Text := Name_edit.Text;//Give name to podcast added
    podcast := ANode.AddChild('Author'); //Add a child node for name
    podcast.Text := Author_edit.Text;//Give name to podcast added
    podcast := ANode.AddChild('Episode'); //Add a child node for name
    podcast.Text := Episode_edit.Text;//Give name to podcast added
    podcast := ANode.AddChild('Season'); //Add a child node for name
    podcast.Text := Season_edit.Text;//Give name to podcast added
    podcast := ANode.AddChild('Tags'); //Add a child node for name
    podcast.Text := Tags_edit.Text;//Give tags to podcast added
    podcast := ANode.AddChild('Path'); //Add a child node for name
    podcast.Text := extractfilename(opendialog1.filename);//Give tags to podcast added
    tempXML.savetofile(Resources_frm.Save_path + 'podcasts\Search_file.xml');
    copyfile(PChar(opendialog1.Filename), PChar(Resources_frm.save_path +
             '\Podcasts\' + extractfilename(opendialog1.FileName)), True);
  end;
  openDialog1.Filter := 'Text Files|*.txt|XML Files|*.XML|HTML|*.html';
end;

procedure TResources_frm.Browse_btnClick(Sender: TObject);
var
  Folder_Path_For_MP3files: string;
begin
  Folder_Path_For_MP3files := BrowseDialog('Select a folder', BIF_RETURNONLYFSDIRS);
  if Folder_Path_For_MP3files = '' then
    Exit;

  txtFolder.Caption := Folder_Path_For_MP3files;

  //fill the list box with mp3 files
  Get_Resources(Folder_Path_For_MP3files, Resources_lstbox.Items);
  resources_lstbox.scrollwidth := 0;
  for i := 0 to resources_lstbox.items.Count - 1 do
  begin
    if resources_lstbox.Canvas.textwidth(resources_lstbox.items[i]) > resources_lstbox.scrollwidth then
    begin
      resources_lstbox.scrollwidth := resources_lstbox.Canvas.textwidth(resources_lstbox.items[i]) + 5;
    end;
  end;
end;

procedure TResources_frm.Ld_File_btnClick(Sender: TObject);
var
  TabSheet: TTabSheet;
  tabcount: integer;
  pagecount: string;
  completed: boolean;
begin
  if opening = False then
    if opendialog1.Execute then
      completed := True;
  if opening or completed then
  begin
    TabSheet := TTabSheet.Create(resource_shower_page);
    TabSheet.Caption := extractfilename(opendialog1.FileName);
    TabSheet.PageControl := resource_shower_page;
    tabcount := resource_shower_page.PageCount;
    Pagecount := IntToStr(tabcount);
    with Tmemo.Create(resources_frm) do
    begin
      parent := tabsheet;
      alignwithmargins := True;
      scrollbars := ssvertical;
      alignment := tarightjustify;
      Enabled := True;
      ReadOnly := True;
      Visible := True;
      Width := resource_shower_page.Width - 3;
      Height := resource_shower_page.Height - 3;
      Lines.loadfromfile(opendialog1.filename);
      left := 1;
      top := 1;
      anchors := [akLeft, akTop, akRight, akBottom];
    end;
    CopyFile(PChar(opendialog1.filename), PChar(save_path + extractfilename(opendialog1.filename)), True);
    Opening := False;
    completed := False;
  end;
end;

procedure TResources_frm.Ld_Picture_btnClick(Sender: TObject);
var
  TabSheet: TTabSheet;
  tabcount: integer;
  pagecount: string;
  completed: boolean;
begin
  if opening = False then
    if openpicturedialog1.Execute then
      completed := True;
  if completed or opening then
  begin
    TabSheet := TTabSheet.Create(resource_shower_page);
    TabSheet.Caption := extractfilename(openpicturedialog1.FileName);
    TabSheet.PageControl := resource_shower_page;
    tabcount := resource_shower_page.PageCount;
    Pagecount := IntToStr(tabcount);
    with Timage.Create(resources_frm) do
    begin
      parent := tabsheet;
      alignwithmargins := True;
      Enabled := True;
      Visible := True;
      proportional := True;
      Width := resource_shower_page.Width - 10;
      Height := resource_shower_page.Height - 10;
      picture.loadfromfile(openpicturedialog1.filename);
      if picture.Width > tabsheet.Width then
        left := 0
      else
        left := (tabsheet.Width - picture.Width) div 2;
      if picture.Height > tabsheet.Height then
        top := 0
      else
        top := (tabsheet.Height - picture.Height) div 2;
      anchors := [akLeft, akTop, akRight, akBottom];
    end;
    CopyFile(PChar(openpicturedialog1.filename), PChar(save_path +
             extractfilename(openpicturedialog1.filename)), True);
    opening := False;
    completed := False;
  end;
end;

procedure TResources_frm.Search_podcasts_btnClick(Sender: TObject);
var
  tempXML: IxmlDocument;
  ANode, parent, toreplace: IXMLNode;
  I: integer;
begin
  tempXML := TXMLDocument.Create(nil);
  tempXML.LoadFromFile(Resources_frm.save_path + 'podcasts\search_file.xml');
  for I := 0 to tempxml.documentelement.childnodes.Count - 1 do
  begin
    if Name_edit.Text <> '' then
    begin
      if not AnsiContainsStr(lowercase(tempxml.DocumentElement.ChildNodes[I].ChildNodes[0].NodeValue),
                             Lowercase(name_edit.Text)) then
      begin
        tempxml.documentelement.ChildNodes[i].attributes['id'] := 'toremove';
      end;
    end;
    if Episode_edit.Text <> '' then
    begin
      if lowercase(tempxml.DocumentElement.ChildNodes[I].ChildNodes[2].NodeValue) <> lowercase(episode_edit.Text) then
      begin
        tempXML.documentelement.ChildNodes[i].attributes['id'] := 'toremove';
      end;
    end;
    if Season_edit.Text <> '' then
    begin
      if lowercase(tempxml.DocumentElement.ChildNodes[I].ChildNodes[3].NodeValue) <> lowercase(Season_edit.Text) then
      begin
        tempXML.documentelement.ChildNodes[i].attributes['id'] := 'toremove';
      end;
    end;
    if Author_edit.Text <> '' then
    begin
      if not AnsiContainsStr(lowercase(tempxml.DocumentElement.ChildNodes[I].ChildNodes[1].NodeValue),
                             Lowercase(Author_edit.Text)) then
      begin
        tempXML.documentelement.ChildNodes[i].attributes['id'] := 'toremove';
      end;
    end;
    if Tags_edit.Text <> '' then
    begin
      if not AnsiContainsStr(lowercase(tempxml.DocumentElement.ChildNodes[I].ChildNodes[4].NodeValue),
                             Lowercase(Tags_edit.Text)) then
      begin
        tempXML.documentelement.ChildNodes[i].attributes['id'] := 'toremove';
      end;
    end;
  end;
  resources_lstbox.items.Clear;
  txtfolder.Caption := Resources_frm.save_path + '\podcasts\';
  i := 0;
  repeat
    begin
      if tempxml.documentelement.childnodes[i].attributes['id'] = 'toremove' then
      begin
        tempxml.documentelement.ChildNodes.Remove(tempxml.DocumentElement.ChildNodes[I]);
      end
      else
      begin
        resources_lstbox.items.add(tempxml.DocumentElement.ChildNodes[I].ChildNodes[5].NodeValue);
        Inc(i);
      end;
    end;
  until i = tempXML.DocumentElement.childnodes.Count;
  if tempXML.DocumentElement.ChildNodes.Count = 0 then
  begin
    ShowMessage('No records by that criteria have been found.');
  end;
end;

procedure TResources_frm.Cancel_btnClick(Sender: TObject);
begin
  resource_chooser_panel.Visible := True;
  search_panel.Visible := False;
end;

procedure TResources_frm.Delete_Picture_btnClick(Sender: TObject);
begin
  Resource_shower_page.ActivePage.Free;//Deletes page
end;

procedure TResources_frm.FormResize(Sender: TObject);
begin
  MP3_shower_panel.Top := 0;
  resource_shower_panel.Height := resources_frm.Height - 35;
  resource_shower_panel.Width := resources_frm.Width - 240;
  MP3_shower_panel.Left := resource_shower_panel.Left + resource_shower_panel.Width + 7;
  Resource_chooser_panel.Left := MP3_shower_panel.Left;
  Search_panel.Left := MP3_shower_panel.left;
  MP3_shower_panel.Height := resources_frm.Height - Search_panel.Height - 30;
  Search_panel.Top := 3 + MP3_shower_panel.Height;
  Resource_chooser_panel.top := Search_panel.Top;
end;

procedure TResources_frm.FormShow(Sender: TObject);
var
  File_name: tsearchrec;
  nameoffile, File_path, test: string;
  picture: boolean;
  i: integer;
begin
  for i := resource_shower_page.PageCount - 1 downto 0 do
    resource_shower_page.pages[i].Destroy;
  //if resource_shower_page.pagecount > 1 then resource_shower_page.pages[0].Destroy;
  //fill the list box with mp3 files
  mp3address := 'p:\My Music';
  txtfolder.Caption := mp3address;
  Get_Resources(mp3address, Resources_lstbox.Items);
  if general_resources then
  begin
    save_path := format('%sGeneral\resources\', [main_menu_frm.path]);
  end
  else
  begin
    save_path := format('%s%sGeneral\resources\', [main_menu_frm.path, main_menu_frm.filename]);
  end;
  forcedirectories(Save_path);
  openDialog1.Filter := 'Text Files|*.txt|XML Files|*.XML|HTML|*.html';
  if FindFirst(save_path + '*.*', FaAnyFile, file_name) = 0 then
  begin
    try
      repeat
        if (ExtractFileExt(file_name.Name) <> '.db') and
          (ExtractFileExt(file_name.Name) <> '.') and (ExtractFileExt(file_name.Name) <> '') then
        begin
          test := ExtractFileExt(file_name.Name);
          if (ExtractFileExt(file_name.Name) <> '.gif') and
            (ExtractFileExt(file_name.Name) <> '.jpg') and
            (ExtractFileExt(file_name.Name) <> '.jpeg') and
            (ExtractFileExt(file_name.Name) <> '.bmp') and
            (ExtractFileExt(file_name.Name) <> '.ico') and
            (ExtractFileExt(file_name.Name) <> '.emf') and
            (ExtractFileExt(file_name.Name) <> '.wmf') then
            picture := False
          else
            picture := True;
          opening := True;
          if picture then
          begin
            openpicturedialog1.FileName := save_path + file_name.Name;
            Ld_Picture_btnClick(nil);
          end
          else
          begin
            opendialog1.FileName := save_path + file_name.Name;
            Ld_File_btnClick(nil);
            //Dialog boxes were opening due to if dialogbox1.execute = true
          end;
        end;
      until FindNext(File_name) <> 0;
      opening := False;
    finally
      FindClose(File_name);
    end;
  end;
end;

procedure TResources_frm.Help_btnClick(Sender: TObject);
begin
  main_menu_frm.Openhelpfile;
end;

procedure TResources_frm.Remove_Picture_btnClick(Sender: TObject);
var
  todelete: string;
begin
  todelete := save_path + resource_shower_page.ActivePage.Caption;
  resource_shower_page.ActivePage.Free;
  Deletefile(todelete);
end;

procedure TResources_frm.Resources_lstboxClick(Sender: TObject);
var
  mp3File: string;
begin
  try
    //if resources_lstbox.Selected = nil then
    begin
      mp3File := Concat(txtFolder.Caption, resources_lstbox.Items.Strings[resources_lstbox.ItemIndex]);
      mp3player.Close;
      mp3player.FileName := mp3File;
      mp3player.Open;
    end;
  except

  end;
end;

procedure TResources_frm.Search_btnClick(Sender: TObject);
begin
  Search_panel.Visible := True;
  search_panel.left := MP3_shower_panel.left;
  search_panel.top := 5 + MP3_shower_panel.Height;
  search_panel.Width := MP3_shower_panel.Width;
  search_panel.left := MP3_shower_panel.left;
  Resource_chooser_panel.Visible := False;
end;

end.
Programming - a skill for life!

by Jerzy Griffiths: L6 Age ~17