WO1998052189A2 - Multimedia interface with user interaction tracking - Google Patents

Multimedia interface with user interaction tracking Download PDF

Info

Publication number
WO1998052189A2
WO1998052189A2 PCT/US1998/010035 US9810035W WO9852189A2 WO 1998052189 A2 WO1998052189 A2 WO 1998052189A2 US 9810035 W US9810035 W US 9810035W WO 9852189 A2 WO9852189 A2 WO 9852189A2
Authority
WO
WIPO (PCT)
Prior art keywords
xbrowserdata
begin
procedure
false
integer
Prior art date
Application number
PCT/US1998/010035
Other languages
French (fr)
Other versions
WO1998052189A3 (en
Inventor
J. Gary Snyder
Steven Bliss
David W. Steele
Original Assignee
Palantir Software, Inc.
Priority date (The priority date is an assumption and is not a legal conclusion. Google has not performed a legal analysis and makes no representation as to the accuracy of the date listed.)
Filing date
Publication date
Application filed by Palantir Software, Inc. filed Critical Palantir Software, Inc.
Priority to CA002289533A priority Critical patent/CA2289533A1/en
Priority to EP98923457A priority patent/EP1032934A2/en
Priority to AU75749/98A priority patent/AU7574998A/en
Publication of WO1998052189A2 publication Critical patent/WO1998052189A2/en
Publication of WO1998052189A3 publication Critical patent/WO1998052189A3/en

Links

Classifications

    • G—PHYSICS
    • G11—INFORMATION STORAGE
    • G11B—INFORMATION STORAGE BASED ON RELATIVE MOVEMENT BETWEEN RECORD CARRIER AND TRANSDUCER
    • G11B27/00—Editing; Indexing; Addressing; Timing or synchronising; Monitoring; Measuring tape travel
    • G11B27/10—Indexing; Addressing; Timing or synchronising; Measuring tape travel
    • G11B27/34—Indicating arrangements 
    • G—PHYSICS
    • G06—COMPUTING; CALCULATING OR COUNTING
    • G06F—ELECTRIC DIGITAL DATA PROCESSING
    • G06F16/00—Information retrieval; Database structures therefor; File system structures therefor
    • G06F16/40—Information retrieval; Database structures therefor; File system structures therefor of multimedia data, e.g. slideshows comprising image and additional audio data
    • G—PHYSICS
    • G11—INFORMATION STORAGE
    • G11B—INFORMATION STORAGE BASED ON RELATIVE MOVEMENT BETWEEN RECORD CARRIER AND TRANSDUCER
    • G11B27/00—Editing; Indexing; Addressing; Timing or synchronising; Monitoring; Measuring tape travel
    • G11B27/02—Editing, e.g. varying the order of information signals recorded on, or reproduced from, record carriers
    • G11B27/031—Electronic editing of digitised analogue information signals, e.g. audio or video signals
    • G11B27/034—Electronic editing of digitised analogue information signals, e.g. audio or video signals on discs
    • G—PHYSICS
    • G11—INFORMATION STORAGE
    • G11B—INFORMATION STORAGE BASED ON RELATIVE MOVEMENT BETWEEN RECORD CARRIER AND TRANSDUCER
    • G11B27/00—Editing; Indexing; Addressing; Timing or synchronising; Monitoring; Measuring tape travel
    • G11B27/10—Indexing; Addressing; Timing or synchronising; Measuring tape travel
    • G11B27/102—Programmed access in sequence to addressed parts of tracks of operating record carriers
    • G11B27/105—Programmed access in sequence to addressed parts of tracks of operating record carriers of operating discs
    • G—PHYSICS
    • G11—INFORMATION STORAGE
    • G11B—INFORMATION STORAGE BASED ON RELATIVE MOVEMENT BETWEEN RECORD CARRIER AND TRANSDUCER
    • G11B27/00—Editing; Indexing; Addressing; Timing or synchronising; Monitoring; Measuring tape travel
    • G11B27/10—Indexing; Addressing; Timing or synchronising; Measuring tape travel
    • G11B27/11—Indexing; Addressing; Timing or synchronising; Measuring tape travel by using information not detectable on the record carrier
    • G—PHYSICS
    • G11—INFORMATION STORAGE
    • G11B—INFORMATION STORAGE BASED ON RELATIVE MOVEMENT BETWEEN RECORD CARRIER AND TRANSDUCER
    • G11B2220/00—Record carriers by type
    • G11B2220/20—Disc-shaped record carriers
    • G11B2220/21—Disc-shaped record carriers characterised in that the disc is of read-only, rewritable, or recordable type
    • G11B2220/213—Read-only discs
    • G—PHYSICS
    • G11—INFORMATION STORAGE
    • G11B—INFORMATION STORAGE BASED ON RELATIVE MOVEMENT BETWEEN RECORD CARRIER AND TRANSDUCER
    • G11B2220/00—Record carriers by type
    • G11B2220/20—Disc-shaped record carriers
    • G11B2220/25—Disc-shaped record carriers characterised in that the disc is based on a specific recording technology
    • G11B2220/2537—Optical discs
    • G11B2220/2545—CDs
    • G—PHYSICS
    • G11—INFORMATION STORAGE
    • G11B—INFORMATION STORAGE BASED ON RELATIVE MOVEMENT BETWEEN RECORD CARRIER AND TRANSDUCER
    • G11B2220/00—Record carriers by type
    • G11B2220/20—Disc-shaped record carriers
    • G11B2220/25—Disc-shaped record carriers characterised in that the disc is based on a specific recording technology
    • G11B2220/2537—Optical discs
    • G11B2220/2562—DVDs [digital versatile discs]; Digital video discs; MMCDs; HDCDs
    • G—PHYSICS
    • G11—INFORMATION STORAGE
    • G11B—INFORMATION STORAGE BASED ON RELATIVE MOVEMENT BETWEEN RECORD CARRIER AND TRANSDUCER
    • G11B2220/00—Record carriers by type
    • G11B2220/60—Solid state media
    • G11B2220/61—Solid state media wherein solid state memory is used for storing A/V content

Definitions

  • the present invention relates to bringing intelligence to CD audio recording as well as digital videos that are going to be used on CD's.
  • the invention provides an intelligent interface that will be added to a CD.
  • the CD is re-mastered with this interface which adds intelligence to the CD.
  • a multimedia supplement for computer accessible artist-recorded media comprising: program means added to recorded media and accessible by a computer (a) for viewing an introduction video recorded by the artist;
  • the present invention provides an intelligent multimedia add on for CD's or any other prerecorded media.
  • the consumer can access this addition program material via their PC of other computer.
  • the system and process is designed to be very consumer friendly so anyone can access the additional content of the recording.
  • This additional content may typically be comprised of an introductory video, recorded by the artist. This video welcomes the listener and tells the listener what is included on the system. It may inform the user of the installation available of a special link to the artist Web site and the desk top top icon that quickly launches the artist Web site.
  • the listener has the option of playing only what song they would like to hear and when they play the song the words to that song are displayed on their computer screen as they are sung. There are four other options that the listener can pick in selection two, one; play a video related to the song if one is provided, two; play an audio commentary of the song by the artist, three; display information about the song and four; print the words to the selected song.
  • Additional functions are available throught a menu which displays whenever the IQcd symbol is clicked. Added functions include the installation of Wallpaper graphics and a Screen Saver of the artist on their computer. Other selections on the menu list information about the album as well as copyright information on the program.
  • CD e.g. a normal audio-music CD
  • an introduction video which will have been recorded by the recording artist to whatever the artist deems appropriate, but typically the recording artist will (a) give an introduction (b) thanking the individual for buying the artist's CD's, (c) telling something about the CD, (d) mentioning that if the user wants to know the CD give a behind the scenes tour of the different songs on the CD, (e) can go to web site by installing and subsequently using the artist's unique Web viewer.
  • the artist may also say that there is some very interesting things to be seen on the artist's web site that no one else has seen or can see. It will be a tour to see some secret background of things the artist did while making the recording. By installing the artist's Web link the user may be asked to optionally answer a few questions, particularly age, zip code, and whatever questions artist may want to ask. The icon for the artist will appear on the computer screen.
  • Another unique feature of this system is that if the individual has already bought another CD of the artist that has been enhanced in accordance with the instant system technology, this next CD when place in the PC will recognize the prior purchase and the system can jump to a second introduction screen and not to the main introduction screen.
  • the recording artist may come on screen noting this second, third, etc purchase, and thanking the user target for the 2nd CD purchase, hoping that the user enjoyed specified recordings on the prior purchase(s), and hoping that the user enjoyed this recording because the artist has some more exciting songs to sing.
  • the artist may also note that the user has visited the artist's web site as well and have some more unique insights if the user will again visit the artist's web site. If fact the user would be surprised because the artist has mad some other changes that pertain to this recording. Also, user may be told that if they want to hear the music, just click on the music button.
  • the users will each have an option of playing all of them or "play”, "pause", "volume control” and "random play”.
  • “play” or a "particular song” the words to the song being sung also appear on the screen. As the song is being sung, the words are highlighted in synchronization with the words being sung.
  • the user wants to stop or pause they hit the "pause” button.
  • the user wants to move to a particular spot in the song they can move to the scroll bar and scroll to a desired place in the song. Movement of the scroll bar will highlight the words to the music.
  • Another way of moving to a particular place in a song is to click on a word in the song, and it begins to play on that move.
  • CD's played but only the songs that are played with the present system thereon because the intelligence is synchronized to a particular CD going to a specific web site to tally the totals for the particular artist so that the artist has a ten song CD and individuals tend to play 5 of the songs on a regular basis, the system can report to the artist the relative frequency of playing each song, and thereby give an idea of the more popular songs. Also the artist is given an indication of how many individuals are plugged into this technology, because the system will be getting feedback from anyone who goes on line, to identify the individuals who watch the CD's and is indeed playing the artist's songs.
  • WEB SITE ACCESS CONTROL AND TRACKING which permits the users or individuals to use hot buttons which relate to the album and whatever else the artist wants done. For example, users might want to be directly linked to a home page that relates to the album, but there also can be hot keys that show other things such as concert tours, souvenirs, to chat with the artist, or to go to the artist's home page.
  • the user may be asked zip code, gender, and any other questions the artist/customer wants.
  • the user's PC will appear an icon for that artist.
  • the icon is clicked on to launch its driver and thereafter to be connected to the artist's web site.
  • the user will enter a new home page of the artist for this CD album and will see an album holder page, and be given a welcome greeting by the artist. They will see hot buttons which will link them to sites that will pertain to the interests of the user. This may be a recording, where the tour currently is, where the artist is appearing, background, hints of future information, the site of production of the CD, who is responsible for it, what other artists participated, and some other background.
  • Some links may have controlled access in accordance with aspects of the present invention.
  • Some of the pages can be encrypted as described hereinbelow and require use of encryption from the instant system to see the sites so a casual viewer (one who does not enter the site through the instant system) would not be able to see this proprietary information.
  • the user may be communicating with the web site and exchanging information about why they are visiting on the web site, what intrigues them about the site, and thus provide a profile of the individuals as they visit the site.
  • Another area of the profile may be what music has this viewer listened to, poll the data to determine what songs were played on the CD. This data may become a vital link to some awards by determining how often songs are played. Also it can help identify what songs are liked or are popular.
  • the system can tell how many times the songs are played, are they played in entirety, and are they played in sequential order. Of course the system can capture other data of where, what and how long the user visited on the web site.
  • the interface takes users to the site which in turn allows link to more than one web site so that if the artist was working on a charity and using a web site, or working with another artist who has a site, the user can click on a moving marquee in the upper left hand comer of the screen to be taken directly to these sites, and get information on the charity or other artist.
  • Retailers are beginning to sell on a seasonal basis, a music CD with selected tracks having certain songs they believe are appropriate for a clientele.
  • the user can view these CD's by song, view the words, and be linked to the retailer's web site.
  • a retailer uses a CD to have a user linked to the retailer's web site, and there do catalog shopping or keep abreast of the latest technology. What is important for the retailer is that now on the user's desk top is the icon for that particular store, and the user can be instantly launched to that site.
  • the retailer may use other aspects of the invention to link to some other things they want, e.g. to some recording artist's sites where there may be cross- promotions.
  • Promotional CD's are sent to radio stations throughout the country with multiple artists.
  • the CD can give a brief introduction of each artist, and/or have artist make its own introduction, and if the user wants to know more, click on the appropriate buttons that are provided. This gives the radio stations more human interest information on the artists, by seeing them in action and listening to them speak. Also they can determine where the artist is while on tour or if in town.
  • Fig. 1 shows a block diagram of a specific embodiment of the present invention.
  • Figs. 2 to 4 show typical screen views.
  • Fig. 5 shows thevarious graphical elements used to render figs 2 to 4.
  • Fig. 6 shows a typical initialization file used to initially configure the invention.
  • Fig. 7a is a CD PROFILE DATA FILE "PROFILE.TXT" wherein a site page sends this data via the internet to a server for collating and processing.
  • the server uses this information for various purposes, one of which is to produce a report of the types of CDs out there (i.e. original vs. copy).
  • the server can make an assumption as to whether the CD is a copy or not. For example, if the track layout is even slightly different than that of a known original, then it is probably a copy.
  • Fig. 7b is a TRACK PLAYING TIMES DATA FILE "STATS.TXT" wherein the site page sends this data via the internet to a server for collating and processing.
  • the server uses this information to produce a report of which CD tracks are played more than others, and whether the "WORDS DISPLAY" feature was used.
  • Figs. 8 to 18(a & b) are flow diagrams of the major parts of the programs
  • Fig. 19 is a schematic representation of the system of the present invention in a network such as the World Wide Web.
  • the present invention relates to directing selected users to World Wide Web (WWW) sites. More particularly, the present invention relates to directing the selected users to WWW sites by Hypertext Markup Language (HTML) coding and Web browser control.
  • HTML Hypertext Markup Language
  • the worldwide network of computers commonly known as the Internet has seen explosive growth in the last several years. This growth has been fueled by the introduction and widespread use of web browsers which provide graphical user interface (GUI) based access to network servers.
  • GUI graphical user interface
  • the network servers support documents formatted as so-called web pages.
  • the World Wide Web (WWW) is that collection of servers on the Internet that use Hypertext Transfer Protocol (HTTP).
  • HTTP is a known application protocol that provides users access to files.
  • the files can be in different formats such as text, graphics, images, sound, video, etc., which use a standard page description language known as Hypertext Markup Language (HTML). HTML provides basic document formatting and provides the programmer with a means to specify links to other servers and files.
  • HTML Hypertext Markup Language
  • TCP/IP Transmission Control Protocol/Internet Protocol
  • the current techniques for limiting access to Web pages are (a) programming the Web server to honor requests from a limited range of IP addresses or domain names; and (b) explicitly assigning passwords to individuals or groups, which they need to submit when attempting a retrieval.
  • the current techniques for tracking the browsing behavior of a user are: "cookies” sent by a Web server to the user's browser and resubmitted by that Web browser during the next access to the same site; and a "shadow” or proxy Web server that watches all Web site accesses to a site, passes along retrieval requests and gathers and stores browsing behavior information.
  • the flow diagrams are of a computer program embodiment of the present invention which the typical user of the invention will receive in distributable form on a computer-readable medium with the program encoded thereon, such as on floppy disk or CDROM.
  • This program called the Browser Controller (BC)
  • BC Browser Controller
  • the BC controls the user's own already existent World Wide Web browser software and instructs it to retrieve particular Web pages (the "invitation" to browse). This targeted site address is distributed with the BC (floppy disk or CDROM).
  • the BC before retrieving the targeted Web page(s), may check with a known site on the Internet or a local network to validate itself as being a legitimate or authorized copy of the BC.
  • This validation method may stem from the use of a unique "Serial Number" encoded on the diskette (or CDROM) containing the BC.
  • copy-protection schemes may be used.
  • usage-limiting techniques are currently being used to limit the number of simultaneous users of commercial software on local-area-networks (LANs).
  • LANs local-area-networks
  • an organization will purchase the license to run a limited number of copies of a software product.
  • the master copy of the software is placed on the LAN file server.
  • another copy-restriction program is run which checks how many current users of that software there are, and either allows or rejects the particular user's request to run the software.
  • This technique cannot limit the uses of the software by people not connected to the LAN, such as employees of the organization who wish to use the software at home.
  • Publishers can also place the software onto a medium that is difficult or expensive to copy, such as CDROM until writable CDROM drives become inexpensive. Or, they may make it difficult to copy the documentation manual for the software, for instance, by choosing perfect-binding for their manuals. However, these methods primarily discourage, rather than prevent, copying, or copyprotection may be bypassed altogether. If a Serial Number is used, part of that number can be used to identify the subgroup of users receiving the software. This information will be referred to as the "Batch Code" below. For instance, a
  • This information can be used demographically along with the browsing records detailed below.
  • the address (URL) of the initial Web page is not explicitly shown to the user, and those features of the user's browser that normally allow the display of the target Web page address are disabled. This leaves the user in ignorance of where the Web site is, that he is currently looking at. This means that it is difficult to send someone else, who is not "invited", the URL of the Web page, because that URL is unknown to the user.
  • This Web page encryption invisible to retrievers of the Web page without BC, can be used by BC to deliver auxiliary information to the BC user, such as "hot-buttons" to be displayed on the browser window to take the user to other Web sites.
  • auxiliary information such as "hot-buttons" to be displayed on the browser window to take the user to other Web sites.
  • Other uses of the encrypted Web page information include: using the Serial Number (Batch Code) to decide what Web Page information to show any particular user; to provide last-minute instructions to the BC to control Web page access.
  • a program can be encrypted on the Web Page to be executed by the BC.
  • the BC monitors the movements of the user, and can report such details of the user's browsing behavior as: length of time viewing any page; sequence of pages viewed; time of day for any action such as start of the browsing session, etc. These records may be stored by the BC on the user's hard drive for later statistical analysis.
  • the BC may explicitly ask the user for personal or demographic information, such as gender, age, locality, etc. and also store this information.
  • the BC can upload the browsing behavior reports from previous browsing sessions as well as the demographics information.
  • the browser controller is a program distributed to the user in the form of computer readable code on floppy disk, CDROM or other distributable medium (including electronic transfer).
  • the primary purpose of the BC in accordance with the present invention is to control the user's own World Wide Web browser software that is installed on the user's computer. Once Installed on the user's computer, the BC will access the particular sites that It was designed to retrieve, and perform a number of other browsing and access control functions including:
  • the BC includes Browser.pas, Main. pas and HTTP. pas program modules. Browser.pas. See Code Listings in the following Appendix I
  • the Browser.pas module contains functions to find and capture a browser.
  • the Code Listings in the following Appendix I currently support Netscape Navigator and Internet Explorer. Main. pas. See Code Listings in the following Appendix II
  • the Main.pas module contains the main BC window.
  • the form handles all the toolbar functionality and tracks the movements of the user to be reported to the server.
  • HTTP.pas. See Code Listings in the following Appendix III
  • the HTTP.pas module contains functions to talk to the HTTP server where the CGI scripts that record feedback reside. Feedback can be added to the object and will be cached until it is sent off to the server.
  • Installation Information is computer-readable encoded data on the same distribution medium as the BC and will be used by the BC. It contains at least the following types of information:
  • a Serial Number or Batch Code identifying the distribution medium copy as an "authorized” copy.
  • This information can be used to prevent unauthorized copying of the program, by making unauthorized copies unusable.
  • This information can also be used to further identify the user of the software (Batch Code indicating what group of people was targeted for the distribution of the disks that the user received).
  • BIS Browsing Information Store
  • Encryption programs are used to encrypt Web pages and othr information such as authorization codes so that they can only be meaningful to the BC which must decrypt the first. Typical Usage
  • the user receives a floppy disk or a music CD as discussed hereinabove containing the Browser Controller (BC) and the Installation Information (II), and uses a standard or customized program to install the software on his computer.
  • BC Browser Controller
  • II Installation Information
  • demographic information is assembled by asking the user personal and/or business questions (such as gender, age, location, business field, manufacturing, service, sales, marketing number of employees), and the answers are stored in the user's computer for later transmittal to the Browsing Information Store (BIS).
  • BIOS Browsing Information Store
  • the user's computer system is searched to locate a WWW browser that the BC is capable of controlling.
  • the BC is designed to control most popular WWW browsers. If no such browser is found, and the installation package does not contain one for the user, then the installation process terminates, indicating to the user that the BC will not run for lack of necessary programs.
  • Fig. 17 shows a flow diagram of a program for the installation of the Browser Controller program. Installation of the BC occurs as needed through out the program. For example, see Main.pas in Appendix I, lines 178; 269-271 ; 276-356; 413-471 ; 515-523; and 592-601.
  • a search of the hard drive of the user's computer is made for a suitable controllable browser 10. If a suitable browser is not found on the hard drive, and if the distributed medium is provided with a browser, the browser program from the distributed medium is installed on the user's hard drive 10. Atematively the BC could incorporate all the functionality of a browser by combining it with commercially available software building blocks. Also a browser such as Netscape Navagator can be included on the distributed disk.
  • the program asks the user for user's target drive, and the BC files and Installation Information are decompressed and unpacked 11 from the installation disk and placed onto the target drive 13,14.
  • the user is asked demographic questions 15, and the answers are stored in a Demographic file on the target drive.
  • the installation program is ended and the Browser Controller program on the target drive (typically the C-drive) is executed.
  • Figs. 18a and 18b provide flow diagrams of the Browser Controller (BC) program.
  • the code listings for the Browser Controller program are in the following Appendixes I, II and III. These code listings are for Windows application which is typically driven by external events such as actuation of buttons.
  • Installation is typically driven by external events such as actuation of buttons.
  • the program determines whether a suitable WWW browser program is available 31. Availability of a suitable browser is implemented by Brower.pas in Appendix II. If a browser program is not available on the target drive, the program is ended.
  • the Current URL and time of retrieval are stored 46.
  • the control of the Browser used for the retrieving and displaying WWW page is implemented by Browser.pas of Appendix II.
  • Main.pas initiates Browser at least inpart at lines 853-882 and line 1021. This procedure and Browser.pas force the user's browser to request the specified URL.
  • Demographic information from the user may direct the BC to command the Browser to retrieve alternate web pages and/or show different "hot buttons", or alter the user interface in other ways.
  • This "hot button” information can also be included on the disk in the II area. After all of this is done, a Web page is displayed to the user.
  • the user after viewing the primary (first) Web page, can in the usual fashion, click on the hypertext links in the page to retrieve other pages.
  • the BC While the user is viewing these Web pages, the BC is watching the user's behavior and taking note of which Web page is being displayed and for how long, and the sequence of Web pages that the user chooses to look at.
  • the BC will report the user's browsing records electronically to a central computer (BIS). Browsing reports and user demographics are sent to the central computer 49 when a predetermined amount of time has passed or a predetermined number of places have been visited 24, or when the Browser is shut down 48.
  • BIOS central computer
  • the above described embodiment directs the user to a single Web site.
  • the user is directed to a selection of a plurality of sites.
  • the BC takes the user to a screen with a plurality of buttons, each button representing a different on of the Web sites.
  • the buttons may be on a drop down menu or a scrolling marquee.
  • Fig. 19 there is shown an embodiment of the system of the present invention for bringing selected WWW users to view particular Web pages, showing these Web pages only to selected users, and tracking and reporting voluntarily provided demographic information and the users' browsing behavior amongst the chosen Web pages.
  • the system comprises a Browser-Controller program encoded on computer readable media 80 that is distributed to the selected users.
  • typical forms of the media are floppy disks, CDROMs, CD- Audio, DVD and Solid-state media (e.g., Smart Cards).
  • Each one of the users installs a respective one of the computer readable media 80 on a user computer 82.
  • the user computer 82 executes the Browser-Controller program to control the user's own already existent Worid Wide Web browser software 84 and instructs it to retrieve particular Web pages. If there is no existing browser software, a suitable browser program optionally can be distributed to the user along with the Browser-Controller and the Tracker Client programs on one of the media 80.
  • a central computer 88 Is located In the network and optionally has Installed thereon a Tracker Server program 91 including a database for storing Current Tokens received from the Browser- Controller programs.
  • Each Browser-Controller program is validated by the Tracker Server program 91 on the central computer 88 before being permitted to retrieve the targeted Web page(s) on a Primary Web site 90.
  • the retrieved Web pages or files optionally will need to be decrypted either by the
  • the Statistical Database 93 may alternatively be on a separate web site that is accessible by the owner of the Primary Web site 90.
  • the data collection program 92 with the statistical database 93 collectively are the BIS.
  • a browser on a user's computer is used to direct the user to a web site by the following steps.
  • a first function is that a registry is searched to determine whether a browser is on the user's computer system, and to identify the browser.
  • the registry is a database maintained by the system for tracking various information including file extensions and the applications the file extensions are associated with.
  • This function searches the registry to find the executable file associated with the .htm extension.
  • This executable is assumed to be a browser which can be controlled by the Browser Controller (BC) program.
  • BC Browser Controller
  • the browser executable is retrieved from the registry and executed. (See browser.pas: lines 612-641)
  • Each browser typically has the name of the browser in its title bar, e.g. Netscape normally says “Netscape -" and then the URL that you are currently addressing.
  • Internet E ⁇ xplorer also usually operates the same way so that these programs can be searched for and located. However, if a window of either browser is not located within a reasonable period of time (e.g., 30 seconds), then the search is terminated and the user is given an error message. (See browser.pas, lines 646-663 and lines 124-163).
  • the system handle for that window is used to make the window a child of one of the windows contained in the BC application.
  • a "handle" is a unique 16-bit numeric identifier. Each window that is currently opened in the system has a unique handle. Thereafter, the browser window will only be visible inside the BC application. (See browser.pas: line 674).
  • a search through the browser is made to determine which child window inside the browser is the largest.
  • the largest child window should be the browser output window. (See browser.pas: lines 610-737).
  • the position of the largest window and are used to determine what the extra space on all sides of the browser window should be.
  • the menus, the tool bars and the status bar are pushed outwardly so that they are not displayed.
  • the space thereabout is calculated, and the entire BC application is resized so that only the browser window is displayed within the BC window. This resizing is achievable because the top and left coordinates of a window can be set to negative coordinates and thereby move the peripheral portions off the screen, or in this case the peripheral portions will go out of the window that is set as the window's parent. (See main.pas, lines 1035-1109).
  • the browser is captured, its handle is known, and the browser is contained within the BC window.
  • the actual window which contains the browser is not yet visible.
  • the BC program itself is visible, so the output window is blank. If you are already connected to the Internet then the browser will begin to operate.
  • the user can connect to the Internet again and press one of the buttons on the browser, e.g., the home button to take the user to the home page, to again begin the program.
  • one of the buttons on the browser e.g., the home button to take the user to the home page, to again begin the program.
  • a timer is activated which goes on periodically to look into all the child windows to determine if the URL that was initially passed to Netscape or Explorer has appeared within that box.
  • the target box is identified by the fact that the URL that was specified on the command line when the program was run now appears in that target box.
  • Internet Explorer if it fails to find the host or if it is a bad host or if the server is down, Internet Explorer will put in BLANK.HTM which is stored on the hard drive. Once the URL field has been found, the browser is made visible within the BC application. (See main.pas: lines 1152-1164)
  • BC program Whenever the user follows a link to a different page, the BC program will know it because BC checks that box every 1/4 of a second to see if it is changed. If that box does change, then BC sends information to the server concerning that change. (See main.pas: lines 1209-1295)
  • BC has an algorithm which will walk through all the menus, and can thereby determine each item menu caption (the title of each menu item).
  • the BC does not search the menu as soon as Internet Explorer is found because Internet E ⁇ xplorer does not build its menus until one is connected to a web page - i.e. must be connected to an Internet host before it builds its menus - and thus permit a walk through and read.
  • the BC program can control the captured browser through the browser's, (2) the BC program can determine what the user is doing through the edit box, (3) and the browser window is always dynamically resized to fit inside the BC application.
  • the BC tool bar is effectively substituted for that of the browser. Since none of the browser's buttons are visible, direct control of the browser is not possible. Thus, at this point, the BC program controls all functionality.
  • BarRect Bounds(Bar.spriteBack.Left+1 , Bar.spriteBack.Top,
  • Bar.iSlidePosition ConvertSweepToSlide(Bar, Bar.iSweepPosition)
  • Bar.iSlidePosition ConvertSweepToSlide(Bar,Bar.iSweepPosition)
  • Bar.iSweepTravel Bar.iSweepWidth-iSlideButtonSize
  • Width imglmage.Width
  • Height : Height
  • BitmapOverlay (Bitmap: TBitmap; var Sprite, SpriteOffset: TSprite);
  • iAudioTrackStart iAudioTrackLength: array [1..MAX TRACKS] of longint;
  • iStatsTrackStart iStatsTrackLength: array [1..MAX TRACKS] of longint;
  • iPausedTime (Position div 100) - iAudioTrackStart[iLastTrackNo];

Abstract

A multimedia supplement for computer accessible artist-recorded media comprising program means added to recorded media and accessible by a computer; (a) for viewing an introduction video recorded by the artist; (b) for installing a special link to the artist's web site, and an icon that quickly launches to the artist web site; and (c) for playing the artist(s) recorded rendition, including (i) displaying the title of each recorded event (e.g. song titles, acts and scenes of a play, musical, dance, etc.), (ii) a viewer optionally and selectively viewing and/or listening to any one or all of the recorded renditions, and (iii) displaying words spoken or sung in sync with the performance; (iv) a viewer optionally playing a video of the rendition song if one is provided, (v) a viewer optionally playing an audio commentary of the rendition, and (vi) a viewer optionally displaying information about the rendition.

Description

MULTIMEDIA INTERFACE WITH USER INTERACTION TRACKING The present invention relates to bringing intelligence to CD audio recording as well as digital videos that are going to be used on CD's. The invention provides an intelligent interface that will be added to a CD. The CD is re-mastered with this interface which adds intelligence to the CD.
In accordance with an aspect of the present invention, there is provided a multimedia supplement for computer accessible artist-recorded media comprising: program means added to recorded media and accessible by a computer (a) for viewing an introduction video recorded by the artist;
(b)for installing a special link to the artist's web site, and an icon that quickly launches to the artist web site including;
(i) tracking the user's browsing of the Web site, (c) for playing the artist(s) recorded rendition, including:
(i) displaying the title of each recorded event (e.g. song titles, acts and scenes of a play, musical, dance, etc),
(ii) a viewer optionally and selectively viewing and/or listening to any one or all of the recorded renditions, and
(iii) displaying words spoken or sung in sync with the performance; (iv) a viewer optionally playing a video of the rendition song if one is provided, (v) a viewer optionally playing an audio commentary of the rendition, and (vi) a viewer optionally displaying information about the rendition. The present invention provides an intelligent multimedia add on for CD's or any other prerecorded media. The consumer can access this addition program material via their PC of other computer. The system and process is designed to be very consumer friendly so anyone can access the additional content of the recording. This additional content may typically be comprised of an introductory video, recorded by the artist. This video welcomes the listener and tells the listener what is included on the system. It may inform the user of the installation available of a special link to the artist Web site and the desk top top icon that quickly launches the artist Web site.
Next the use is presented with the Album cover or a list of track titles available for playing. The listener has the option of playing only what song they would like to hear and when they play the song the words to that song are displayed on their computer screen as they are sung. There are four other options that the listener can pick in selection two, one; play a video related to the song if one is provided, two; play an audio commentary of the song by the artist, three; display information about the song and four; print the words to the selected song.
Additional functions are available throught a menu which displays whenever the IQcd symbol is clicked. Added functions include the installation of Wallpaper graphics and a Screen Saver of the artist on their computer. Other selections on the menu list information about the album as well as copyright information on the program.
1. When a user (at times called target herein) inserts the CD (e.g. a normal audio-music CD) into the user's computer, the user will be greeted with a cover shot showing the CD album cover on the personal computer.
2. Immediately following the album cover will be an introduction video, which will have been recorded by the recording artist to whatever the artist deems appropriate, but typically the recording artist will (a) give an introduction (b) thanking the individual for buying the artist's CD's, (c) telling something about the CD, (d) mentioning that if the user wants to know the CD give a behind the scenes tour of the different songs on the CD, (e) can go to web site by installing and subsequently using the artist's unique Web viewer.
The artist may also say that there is some very interesting things to be seen on the artist's web site that no one else has seen or can see. It will be a tour to see some secret background of things the artist did while making the recording. By installing the artist's Web link the user may be asked to optionally answer a few questions, particularly age, zip code, and whatever questions artist may want to ask. The icon for the artist will appear on the computer screen.
Thus it is a brief video talking about an introduction to get a personalized contact with the user (warm & cozy feeling). A one-on-one experience.
Another unique feature of this system is that if the individual has already bought another CD of the artist that has been enhanced in accordance with the instant system technology, this next CD when place in the PC will recognize the prior purchase and the system can jump to a second introduction screen and not to the main introduction screen. The recording artist may come on screen noting this second, third, etc purchase, and thanking the user target for the 2nd CD purchase, hoping that the user enjoyed specified recordings on the prior purchase(s), and hoping that the user enjoyed this recording because the artist has some more exciting songs to sing. The artist may also note that the user has visited the artist's web site as well and have some more unique insights if the user will again visit the artist's web site. If fact the user would be surprised because the artist has mad some other changes that pertain to this recording. Also, user may be told that if they want to hear the music, just click on the music button.
Once this process is complete, the users will each have an option of playing all of them or "play", "pause", "volume control" and "random play". When the user clicks on "play" or a "particular song", the words to the song being sung also appear on the screen. As the song is being sung, the words are highlighted in synchronization with the words being sung. When the user wants to stop or pause, they hit the "pause" button. When the user wants to move to a particular spot in the song, they can move to the scroll bar and scroll to a desired place in the song. Movement of the scroll bar will highlight the words to the music. Another way of moving to a particular place in a song is to click on a word in the song, and it begins to play on that move. Once the user is finished playing, they merely close down the cd player as they would normally. For the recording artist, there is a hidden benefit. Any time the individual goes on line to visit the recording artist site, aspects of the present invention receives information of what songs the individual played for a particular CD. The system does not poll the playing of other
CD's played, but only the songs that are played with the present system thereon because the intelligence is synchronized to a particular CD going to a specific web site to tally the totals for the particular artist so that the artist has a ten song CD and individuals tend to play 5 of the songs on a regular basis, the system can report to the artist the relative frequency of playing each song, and thereby give an idea of the more popular songs. Also the artist is given an indication of how many individuals are plugged into this technology, because the system will be getting feedback from anyone who goes on line, to identify the individuals who watch the CD's and is indeed playing the artist's songs.
The interface aspect of the present invention is described below under the heading WEB SITE ACCESS CONTROL AND TRACKING which permits the users or individuals to use hot buttons which relate to the album and whatever else the artist wants done. For example, users might want to be directly linked to a home page that relates to the album, but there also can be hot keys that show other things such as concert tours, souvenirs, to chat with the artist, or to go to the artist's home page.
When a user hits the "Link to the web" button they are linked the web site access control to a specific web site where:
1. The user may be asked zip code, gender, and any other questions the artist/customer wants.
2. During "Install" the artist may prompt, ask questions, e.g. age, tell us about yourself, would you like to install the software at this time? Thank you for installing. It is now completed.
At this time on the user's PC will appear an icon for that artist. The icon is clicked on to launch its driver and thereafter to be connected to the artist's web site. In this case, and at the users instructions, the user will enter a new home page of the artist for this CD album and will see an album holder page, and be given a welcome greeting by the artist. They will see hot buttons which will link them to sites that will pertain to the interests of the user. This may be a recording, where the tour currently is, where the artist is appearing, background, hints of future information, the site of production of the CD, who is responsible for it, what other artists participated, and some other background.
Some links may have controlled access in accordance with aspects of the present invention. Some of the pages can be encrypted as described hereinbelow and require use of encryption from the instant system to see the sites so a casual viewer (one who does not enter the site through the instant system) would not be able to see this proprietary information. At the same time the user is playing the music, the user may be communicating with the web site and exchanging information about why they are visiting on the web site, what intrigues them about the site, and thus provide a profile of the individuals as they visit the site. Another area of the profile may be what music has this viewer listened to, poll the data to determine what songs were played on the CD. This data may become a vital link to some awards by determining how often songs are played. Also it can help identify what songs are liked or are popular. It can also verify whether song was played in its entirety, or only for 10 seconds, 15 seconds, etc. This music tally data is strong enough that it may be used as a basis for award presentation(s). This would avoid the possibility of a seeded song where it is in a loop being played over and over again, e.g. if it is being played at 3 AM it may be assumed that it is in a continuous loop, and can be identified as a single play if the customer
(record producer or recording artist) wishes. The system can tell how many times the songs are played, are they played in entirety, and are they played in sequential order. Of course the system can capture other data of where, what and how long the user visited on the web site.
The interface takes users to the site which in turn allows link to more than one web site so that if the artist was working on a charity and using a web site, or working with another artist who has a site, the user can click on a moving marquee in the upper left hand comer of the screen to be taken directly to these sites, and get information on the charity or other artist.
Following are some applications for the instant system:
(1) Retailers are beginning to sell on a seasonal basis, a music CD with selected tracks having certain songs they believe are appropriate for a clientele. By using the invention, the user can view these CD's by song, view the words, and be linked to the retailer's web site.
For example, a retailer uses a CD to have a user linked to the retailer's web site, and there do catalog shopping or keep abreast of the latest technology. What is important for the retailer is that now on the user's desk top is the icon for that particular store, and the user can be instantly launched to that site.The retailer may use other aspects of the invention to link to some other things they want, e.g. to some recording artist's sites where there may be cross- promotions.
(2) Public service where a portion of the recording goes to a charity. For example, when an artist is giving a portion of the proceeds to a particular charity, e.g. MS, a user buying such a CD can insert it in a PC and have an introduction video by the charity thanking the user for the contribution through the purchase, and thanking the recording artist, identifying how much of the purchase money is going to the charity, provide a description of the charity's work, and can include a link to the charity's own site.
(3) Promotional CD's are sent to radio stations throughout the country with multiple artists. By using the present system, the CD can give a brief introduction of each artist, and/or have artist make its own introduction, and if the user wants to know more, click on the appropriate buttons that are provided. This gives the radio stations more human interest information on the artists, by seeing them in action and listening to them speak. Also they can determine where the artist is while on tour or if in town.
Fig. 1 shows a block diagram of a specific embodiment of the present invention. Figs. 2 to 4 show typical screen views.
Fig. 5 shows thevarious graphical elements used to render figs 2 to 4.
Fig. 6 shows a typical initialization file used to initially configure the invention.
Fig. 7a is a CD PROFILE DATA FILE "PROFILE.TXT" wherein a site page sends this data via the internet to a server for collating and processing. The server uses this information for various purposes, one of which is to produce a report of the types of CDs out there (i.e. original vs. copy). By comparing the track (and other) profile information collected, with a profile of a known original CD, the server can make an assumption as to whether the CD is a copy or not. For example, if the track layout is even slightly different than that of a known original, then it is probably a copy.
Fig. 7b is a TRACK PLAYING TIMES DATA FILE "STATS.TXT" wherein the site page sends this data via the internet to a server for collating and processing. The server uses this information to produce a report of which CD tracks are played more than others, and whether the "WORDS DISPLAY" feature was used.
Figs. 8 to 18(a & b) are flow diagrams of the major parts of the programs
Fig. 19 is a schematic representation of the system of the present invention in a network such as the World Wide Web.
The following pages 24 to 214 are code listing for an embodiment of the present invention.
The blocks in the flow diagrams refer to the programs by line numbers for performance of the recited functions, and also to the applicable Figure where appropriate. The following pages 215 to 276 are code listing for an interface embodiment of the present invention for web site access control and tracking.
WEB SITE ACCESS CONTROL AND TRACKING
The present invention relates to directing selected users to World Wide Web (WWW) sites. More particularly, the present invention relates to directing the selected users to WWW sites by Hypertext Markup Language (HTML) coding and Web browser control.
The worldwide network of computers commonly known as the Internet has seen explosive growth in the last several years. This growth has been fueled by the introduction and widespread use of web browsers which provide graphical user interface (GUI) based access to network servers. The network servers support documents formatted as so-called web pages. The World Wide Web (WWW) is that collection of servers on the Internet that use Hypertext Transfer Protocol (HTTP). HTTP is a known application protocol that provides users access to files. The files can be in different formats such as text, graphics, images, sound, video, etc., which use a standard page description language known as Hypertext Markup Language (HTML). HTML provides basic document formatting and provides the programmer with a means to specify links to other servers and files. Use of an HTML-compliant user browser involves specification of a link via a Uniform Resource Locator or URL. Upon such specification, the user makes a Transmission Control Protocol/Internet Protocol (TCP/IP) request to the server identified in the link and receives a web page (i.e., a document formatted according to HTML) in return. The current techniques for limiting access to Web pages are (a) programming the Web server to honor requests from a limited range of IP addresses or domain names; and (b) explicitly assigning passwords to individuals or groups, which they need to submit when attempting a retrieval.
The current techniques for tracking the browsing behavior of a user are: "cookies" sent by a Web server to the user's browser and resubmitted by that Web browser during the next access to the same site; and a "shadow" or proxy Web server that watches all Web site accesses to a site, passes along retrieval requests and gathers and stores browsing behavior information.
However, these techniques do not allow, for instance, a Chicago manufacturer to "invite" only Chicago residents to view his Web pages, except through a process tedious to the user, for example by asking each retriever whether he lives in Chicago. Nor do simple techniques currently exist to track the behavior of people actually viewing a manufacturer's Web pages to determine, for instance, (i) how long in time the user views a particular page, (ii) what sequence of pages was viewed, and (iii) whether pages not belonging to the manufacturer were also viewed. Current techniques for gathering such information require reprogramming the Web servers which send the manufacturer's Web pages to the user.
With reference to Figs. 17 to 19, the flow diagrams are of a computer program embodiment of the present invention which the typical user of the invention will receive in distributable form on a computer-readable medium with the program encoded thereon, such as on floppy disk or CDROM. This program, called the Browser Controller (BC), is distributed only to those people "invited" to view a particular Web site such as by purchasing a music CD as described hereinabove.
The BC controls the user's own already existent World Wide Web browser software and instructs it to retrieve particular Web pages (the "invitation" to browse). This targeted site address is distributed with the BC (floppy disk or CDROM).
The BC, before retrieving the targeted Web page(s), may check with a known site on the Internet or a local network to validate itself as being a legitimate or authorized copy of the BC. This validation method may stem from the use of a unique "Serial Number" encoded on the diskette (or CDROM) containing the BC.
Alternatively, other copy-protection schemes may be used. For example, usage-limiting techniques are currently being used to limit the number of simultaneous users of commercial software on local-area-networks (LANs). Typically, an organization will purchase the license to run a limited number of copies of a software product. The master copy of the software is placed on the LAN file server. Whenever a user on the LAN executes the software, another copy-restriction program is run which checks how many current users of that software there are, and either allows or rejects the particular user's request to run the software. This technique cannot limit the uses of the software by people not connected to the LAN, such as employees of the organization who wish to use the software at home. Publishers can also place the software onto a medium that is difficult or expensive to copy, such as CDROM until writable CDROM drives become inexpensive. Or, they may make it difficult to copy the documentation manual for the software, for instance, by choosing perfect-binding for their manuals. However, these methods primarily discourage, rather than prevent, copying, or copyprotection may be bypassed altogether. If a Serial Number is used, part of that number can be used to identify the subgroup of users receiving the software. This information will be referred to as the "Batch Code" below. For instance, a
"1" as the first digit of the Serial Number may mean that this disk was distributed at a particular trade show, whereas a "2" might indicate that the disk was given to all employees of a particular corporation.
This information can be used demographically along with the browsing records detailed below.
While the BC is in control of the user's Web browser, the address (URL) of the initial Web page is not explicitly shown to the user, and those features of the user's browser that normally allow the display of the target Web page address are disabled. This leaves the user in ignorance of where the Web site is, that he is currently looking at. This means that it is difficult to send someone else, who is not "invited", the URL of the Web page, because that URL is unknown to the user.
Further restrictions can be placed on who can see the Web page by encrypting the Web page itself in a special way (part of this invention) so that only those "invited" will see the restricted information, while those not "invited" will see other, unrestricted, information, even though the URL of both views of the Web page is identical. The BC will decrypt the retrieved Web page prior to showing it to the user. Those without the BC will see the unencrypted Web page, which may still be intelligible but will show not show any unrestricted information.
This Web page encryption, invisible to retrievers of the Web page without BC, can be used by BC to deliver auxiliary information to the BC user, such as "hot-buttons" to be displayed on the browser window to take the user to other Web sites. Other uses of the encrypted Web page information include: using the Serial Number (Batch Code) to decide what Web Page information to show any particular user; to provide last-minute instructions to the BC to control Web page access. In fact, a program can be encrypted on the Web Page to be executed by the BC.
Once the user is browsing on the "invited" Web site and those Web pages that the "invited" page links to, the BC monitors the movements of the user, and can report such details of the user's browsing behavior as: length of time viewing any page; sequence of pages viewed; time of day for any action such as start of the browsing session, etc. These records may be stored by the BC on the user's hard drive for later statistical analysis.
In addition to browsing behavior, the BC may explicitly ask the user for personal or demographic information, such as gender, age, locality, etc. and also store this information.
At the same time as the user is viewing the "invited" pages, the BC can upload the browsing behavior reports from previous browsing sessions as well as the demographics information.
Software Components of the System
Browser Controller (BC): The browser controller is a program distributed to the user in the form of computer readable code on floppy disk, CDROM or other distributable medium (including electronic transfer). The primary purpose of the BC in accordance with the present invention is to control the user's own World Wide Web browser software that is installed on the user's computer. Once Installed on the user's computer, the BC will access the particular sites that It was designed to retrieve, and perform a number of other browsing and access control functions including:
(a) Optionally detecting unauthorized copies of itself, and preventing any further execution if detected. (b) Retrieving "invited" Web Pages from the Internet or intranet.
(c) Decrypting any specially encrypted Web pages, and following the contained display or execution instructions that were planted on the Web pages.
(d) Controlling the user's Web browser to retrieve and display selected Web pages.
(e) Gathering statistics on the user's Web browsing movements and sending that information to a central computer for statistical data gathering.
The BC includes Browser.pas, Main. pas and HTTP. pas program modules. Browser.pas. See Code Listings in the following Appendix I
The Browser.pas module contains functions to find and capture a browser. The Code Listings in the following Appendix I currently support Netscape Navigator and Internet Explorer. Main. pas. See Code Listings in the following Appendix II
The Main.pas module contains the main BC window. The form handles all the toolbar functionality and tracks the movements of the user to be reported to the server. HTTP.pas. See Code Listings in the following Appendix III
The HTTP.pas module contains functions to talk to the HTTP server where the CGI scripts that record feedback reside. Feedback can be added to the object and will be cached until it is sent off to the server.
Installation Information: Installation Information is computer-readable encoded data on the same distribution medium as the BC and will be used by the BC. It contains at least the following types of information:
(a) Optionally, a Serial Number or Batch Code identifying the distribution medium copy as an "authorized" copy. This information can be used to prevent unauthorized copying of the program, by making unauthorized copies unusable. This information can also be used to further identify the user of the software (Batch Code indicating what group of people was targeted for the distribution of the disks that the user received).
(b) The Web Page address (URL) that the BC should show the user.
(c) The Internet address of the copy-protection host computer that controls access to the BC, if such a copy-protection scheme is used. Other information may be included here if a different access control scheme is used.
(d) The Internet address of the user-browsing-information storing computer.
(e) Displayed "hot buttons" that when pressed will take the user to particular Web pages. Browsing Information Store (BIS). The BIS is software running on a computer which is accessible via the Internet to which the BC uploads browsing information for storage into a database.
Encryption. Encryption programs are used to encrypt Web pages and othr information such as authorization codes so that they can only be meaningful to the BC which must decrypt the first. Typical Usage
The following steps illustrate how the parts of the invention are used, and the functions of each part:
The user receives a floppy disk or a music CD as discussed hereinabove containing the Browser Controller (BC) and the Installation Information (II), and uses a standard or customized program to install the software on his computer. During installation on the user's computer, demographic information is assembled by asking the user personal and/or business questions (such as gender, age, location, business field, manufacturing, service, sales, marketing number of employees), and the answers are stored in the user's computer for later transmittal to the Browsing Information Store (BIS).
Also during installation, the user's computer system is searched to locate a WWW browser that the BC is capable of controlling. The BC is designed to control most popular WWW browsers. If no such browser is found, and the installation package does not contain one for the user, then the installation process terminates, indicating to the user that the BC will not run for lack of necessary programs.
Fig. 17 shows a flow diagram of a program for the installation of the Browser Controller program. Installation of the BC occurs as needed through out the program. For example, see Main.pas in Appendix I, lines 178; 269-271 ; 276-356; 413-471 ; 515-523; and 592-601.
With reference to Fig. 17, a search of the hard drive of the user's computer is made for a suitable controllable browser 10. If a suitable browser is not found on the hard drive, and if the distributed medium is provided with a browser, the browser program from the distributed medium is installed on the user's hard drive 10. Atematively the BC could incorporate all the functionality of a browser by combining it with commercially available software building blocks. Also a browser such as Netscape Navagator can be included on the distributed disk.
If a browser is not available, the installation program is exited and the user is advised by a message on the user's computer that "Suitable WWW browser is not available. Installation failed."
Then the program asks the user for user's target drive, and the BC files and Installation Information are decompressed and unpacked 11 from the installation disk and placed onto the target drive 13,14. The user is asked demographic questions 15, and the answers are stored in a Demographic file on the target drive. The installation program is ended and the Browser Controller program on the target drive (typically the C-drive) is executed.
Figs. 18a and 18b provide flow diagrams of the Browser Controller (BC) program. The code listings for the Browser Controller program are in the following Appendixes I, II and III. These code listings are for Windows application which is typically driven by external events such as actuation of buttons. With reference to Figs. 18a and 18b, Installation
Information 32,33 for the Browser Controller, including demographics, copy-protection information, and primary web page and browser to use are read and deciphered. The program then determines whether a suitable WWW browser program is available 31. Availability of a suitable browser is implemented by Brower.pas in Appendix II. If a browser program is not available on the target drive, the program is ended.
Then, if the Primary Web page is encrypted 40, decrypt and decipher instructions are obtained 41. Also, instructions are followed 42 to obtain the decrypted Primary Web page 36. If the Primary Web page is not encrypted, the Primary Web page is directly retrieved 36 . Also, displayable HTML is then deposited Into the Primary Web Page Display. If there are no BC Instructions, the raw HTML are copied, with possible BASE HREF addition, into the Primary Web Page Display. Control is released to the browser to display the Primary Web Page 43. The visit to Primary Web Page is reported 49; and as the user clicks on WWW hypertext links
44, an infinite loops watch the browser respond to user's clicks 45, 46 and also watching the clock 47.
Specifically, if the browser check is showing a different page, the Current URL and time of retrieval are stored 46.
The control of the Browser used for the retrieving and displaying WWW page is implemented by Browser.pas of Appendix II. Main.pas initiates Browser at least inpart at lines 853-882 and line 1021. This procedure and Browser.pas force the user's browser to request the specified URL.
Demographic information from the user may direct the BC to command the Browser to retrieve alternate web pages and/or show different "hot buttons", or alter the user interface in other ways. This "hot button" information can also be included on the disk in the II area. After all of this is done, a Web page is displayed to the user.
The user, after viewing the primary (first) Web page, can in the usual fashion, click on the hypertext links in the page to retrieve other pages.
While the user is viewing these Web pages, the BC is watching the user's behavior and taking note of which Web page is being displayed and for how long, and the sequence of Web pages that the user chooses to look at.
Periodically, the BC will report the user's browsing records electronically to a central computer (BIS). Browsing reports and user demographics are sent to the central computer 49 when a predetermined amount of time has passed or a predetermined number of places have been visited 24, or when the Browser is shut down 48.
The above described embodiment directs the user to a single Web site. In another embodiment of the present invention, the user is directed to a selection of a plurality of sites. In this embodiment, the BC takes the user to a screen with a plurality of buttons, each button representing a different on of the Web sites. Alternatively, the buttons may be on a drop down menu or a scrolling marquee.
With reference to Fig. 19, there is shown an embodiment of the system of the present invention for bringing selected WWW users to view particular Web pages, showing these Web pages only to selected users, and tracking and reporting voluntarily provided demographic information and the users' browsing behavior amongst the chosen Web pages. As described above, the system comprises a Browser-Controller program encoded on computer readable media 80 that is distributed to the selected users. As shown in Fig. 19, typical forms of the media are floppy disks, CDROMs, CD- Audio, DVD and Solid-state media (e.g., Smart Cards). Each one of the users installs a respective one of the computer readable media 80 on a user computer 82. The user computer 82 executes the Browser-Controller program to control the user's own already existent Worid Wide Web browser software 84 and instructs it to retrieve particular Web pages. If there is no existing browser software, a suitable browser program optionally can be distributed to the user along with the Browser-Controller and the Tracker Client programs on one of the media 80.
A central computer 88 Is located In the network and optionally has Installed thereon a Tracker Server program 91 including a database for storing Current Tokens received from the Browser- Controller programs. Each Browser-Controller program is validated by the Tracker Server program 91 on the central computer 88 before being permitted to retrieve the targeted Web page(s) on a Primary Web site 90. The retrieved Web pages or files optionally will need to be decrypted either by the
Tracker Server program or the Browser-Controller program before the user can display the retrieved
Web pages. Browsing information from the user's browser, such as which pages are being retrieved and when, as well as the browsing behavior records are sent to a Statistical Data Collecting Program
92 on the central computer 88 for statistical analysis, then forwarded to a Statistical Data database 93 for retrieval on behalf of the Primary Web site owner. The Statistical Database 93 may alternatively be on a separate web site that is accessible by the owner of the Primary Web site 90. The data collection program 92 with the statistical database 93 collectively are the BIS.
As noted above the code listings for the Browser Controller programs are in the following Appendixes I, II and III and are browser.pas, main.pas and HTTP.pas, respectively. In an embodiment of the invention, a browser on a user's computer is used to direct the user to a web site by the following steps.
In accordance with an aspect of the present invention, a first function is that a registry is searched to determine whether a browser is on the user's computer system, and to identify the browser. The registry is a database maintained by the system for tracking various information including file extensions and the applications the file extensions are associated with. This function searches the registry to find the executable file associated with the .htm extension. This executable is assumed to be a browser which can be controlled by the Browser Controller (BC) program. Thus, the registry is used to find the browser which the user considers to be the default browser. (See browser.pas: lines 246-295).
The browser executable is retrieved from the registry and executed. (See browser.pas: lines 612-641)
Each browser typically has the name of the browser in its title bar, e.g. Netscape normally says "Netscape -" and then the URL that you are currently addressing. Internet EΞxplorer also usually operates the same way so that these programs can be searched for and located. However, if a window of either browser is not located within a reasonable period of time (e.g., 30 seconds), then the search is terminated and the user is given an error message. (See browser.pas, lines 646-663 and lines 124-163).
If the browser window is found, the system handle for that window is used to make the window a child of one of the windows contained in the BC application. A "handle" is a unique 16-bit numeric identifier. Each window that is currently opened in the system has a unique handle. Thereafter, the browser window will only be visible inside the BC application. (See browser.pas: line 674).
A search through the browser is made to determine which child window inside the browser is the largest. The largest child window should be the browser output window. (See browser.pas: lines 610-737).
The position of the largest window and are used to determine what the extra space on all sides of the browser window should be. On the top there will be the menus and the tool bars; on the bottom there will be a status bar; and to the left and to the right will be the actual edges of the window. The menus, the tool bars and the status bar are pushed outwardly so that they are not displayed. Once the browser interior window is obtained, the space thereabout is calculated, and the entire BC application is resized so that only the browser window is displayed within the BC window. This resizing is achievable because the top and left coordinates of a window can be set to negative coordinates and thereby move the peripheral portions off the screen, or in this case the peripheral portions will go out of the window that is set as the window's parent. (See main.pas, lines 1035-1109).
At this point, the browser is captured, its handle is known, and the browser is contained within the BC window.
The actual window which contains the browser is not yet visible. The BC program itself is visible, so the output window is blank. If you are already connected to the Internet then the browser will begin to operate.
If you are not connected to the Internet and are in Windows 95, then the dialer will come up and ask if the user wants to connect or not. (See main.pas: lines 1167-1204) If the user responds "yes", then the browser program is connected to the Internet. If say no or cancel, an error message is given, e.g., "sorry cannot retrieve or contact" whatever host the browser was to contact and the user is done.
At this point the user can connect to the Internet again and press one of the buttons on the browser, e.g., the home button to take the user to the home page, to again begin the program.
In any case, if there is a connection, there also a box on which contains the current URL. Now under Netscape, this box is filled as soon as the program is run. Under Internet Explorer, the box is not filled until Explorer has actually made contact with the host.
Since the contents of this box are very important to BC in accordance with the present invention, the handle to this text box must be identified. These text controls also have handles because they are actually windows.
A timer is activated which goes on periodically to look into all the child windows to determine if the URL that was initially passed to Netscape or Explorer has appeared within that box. The target box is identified by the fact that the URL that was specified on the command line when the program was run now appears in that target box.
At some point this will happen. However, in the case of Internet Explorer, if it fails to find the host or if it is a bad host or if the server is down, Internet Explorer will put in BLANK.HTM which is stored on the hard drive. Once the URL field has been found, the browser is made visible within the BC application. (See main.pas: lines 1152-1164)
Whenever the user follows a link to a different page, the BC program will know it because BC checks that box every 1/4 of a second to see if it is changed. If that box does change, then BC sends information to the server concerning that change. (See main.pas: lines 1209-1295)
The next step in controlling Netscape is that BC has an algorithm which will walk through all the menus, and can thereby determine each item menu caption (the title of each menu item). (See main.pas: lines 1146-1147)
From each caption it can be determined whether it is an menu item that we want to control. For example, "EXIT" is an item caption that we want to control. "Find", "stop", "back", "forward", "print" and "reload" (which are normally on the tool bar itself) are Items normally sought. Back & forward are critical operations. Reload is needed. "Stop" and "find" are not sought in the following code listings. However, "stop" and "find" can be in a manner similar to the manner "find", "stop", "back", "forward", "print" and "reload" are made available by the following code listings.
With Internet EΞxplorer, the BC does not search the menu as soon as Internet Explorer is found because Internet EΞxplorer does not build its menus until one is connected to a web page - i.e. must be connected to an Internet host before it builds its menus - and thus permit a walk through and read.
Once the menus have been walked, these values are stored in an array in the BC program for later use. Thereafter, the browser is controlled from the array through the operating system.
Therefore, (1) the BC program can control the captured browser through the browser's, (2) the BC program can determine what the user is doing through the edit box, (3) and the browser window is always dynamically resized to fit inside the BC application.
Once the browser is captured, the BC tool bar is effectively substituted for that of the browser. Since none of the browser's buttons are visible, direct control of the browser is not possible. Thus, at this point, the BC program controls all functionality.
The only thing that can be done within the browser window is that the hypertext links are clicked upon to take the user to various places.
The attached appendix pages APP1 to APP131 are incorporated herein and form part of this application.
While the invention has been described in conjunction with specific embodiments thereof, it is evident that many alternatives, modifications, and variations will be apparent to those skilled in the art in light of the foregoing description. Accordingly, it is intended to embrace all such alternatives, modification, and variations as fall within the spirit and broad scope of the appended claims.
0001 unit BitBars;
0002
{=====_===============================================
0003 interface
0004
{=====================__:_===========_=============
0005 {$IFDEF WINDOWS}
0006 uses
0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
0008 Forms, Dialogs, ExtCtrls,
0009 Run, Main, Bitmaps;
0010 {$ELSE}
0011 uses
0012 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
0013 ExtCtrls, StdCtrls,
0014 Run, Main, Bitmaps;
0015 {$ENDIF}
0016 { }
0017 type
0018 TBar = record
0019 bVertical: boolean;
0020 bEnabled: boolean;
0021 bForceDraw: boolean;
0022 iSlideRange, iSlidePosition: longint;
0023 iSweepWidth, iSweepHeight: longint;
0024 iSweepStart, iSweepTravel: longint;
0025 iSweepMoveStartPosition, iSweepPosition: longint;
0026 bmpBuffer: TBitmap;
0027 spriteBack, spriteRod, spriteButton, spriteEndl , spriteEnd2: TSprite
0028 end;
0029 { }
0030 procedure Barlnitialize(var Bar: Tbar; imgBarBack, imgBarRod, imgBarButton,
0031 imgBarEndl , imgBarEnd2: Tlmage);
0032 procedure BarExit(var Bar: TBar);
0033 procedure BarEnable(var Bar: TBar);
0034 procedure BarOlssable(var Bar: TBar);
0035 procedure BarSetRange(var Bar: TBar; range: longint);
0036 procedure BarSetPosition(var Bar: TBar; Position: longint);
0037 function BarGetPosition(var Bar: TBar): longint; 0038 procedure BarMouseMoveStart(var Bar: Tbar);
0039 procedure BarMouseMoveDraw(var Bar: TBar; x,y: longint);
0040 function BarButtonHit(var Bar: TBar): boolean; 0041
0042 implementation
0043
0044 function ConvertSweepToSlide(var Bar: TBar; SweepPosition: longint): longint; forward;
0045 function ConvertSlideToSweep(var Bar: TBar; SlidePosition: longint): longint; forward;
0046 procedure DrawAndUpdate(var Bar: TBar; NewSweepPosition: longint); forward;
0047 {-r=====================================================
0048 { Local Routines }
0049
{===============_======^^
0050 function ConvertSweepToSlide(var Bar: TBar; SweepPosition: longint): longint;
0051 begin
0052 result := ((Bar.iSlideRange - (Bar.iSlideRange div Bar.iSweepTravel)) *
0053 SweepPosition) div (Bar.iSweeρTravel-1)
0054 end;
0055 { }
0056 function ConvertSlideToSweep(var Bar: TBar; SlidePosition: longint): longint;
0057 begin
0058 result := ((Bar.iSweepTravel-1) * SlidePosition) div
0059 (Bar.iSlideRange - (Bar.iSlideRange div Bar.iSweepTravel))
0060 end;
0061 { }
0062 procedure DrawAndUpdate(var Bar: TBar; NewSweepPosition: longint);
0063 var
0064 iRodLeft, iRodTop: longint;
0065 iOffset: longint;
0066 BarRect: TRect;
0067 begin
0068 if NewSweepPosition<0 then
0069 NewSweepPosition := 0;
0070 if NewSweepPosition>Bar.iSweepTravel-1 then
0071 NewSweepPosition := Bar.lSweepTravel-1 ;
0072 if (not Bar.bForceDraw) and (NewSweepPosition=Bar.iSweepPosition) then
0073 exit;
0074 Bar.iSweepPosition := NewSweepPosition; 0075 if not Bar.bEnabled then
0076 exit;
0077 Bar.bForceDraw := false;
0078 iOffset := Bar.iSweepStart-NewSweepPosition;
0079 if Bar.bVertical then begin
0080 iRodLeft := 0;
0081 iRodTop := iOffset;
0082 Bar.spriteButton. Top := Bar.spriteRod.Top+NewSweepPosition
0083 end
0084 else begin
0085 iRodLeft := iOffset;
0086 iRodTop := 0;
0087 Bar.spriteButton. Left := Bar.spriteRod.Left+NewSweepPosition
0088 end;
0089 BitmapOveriay(Bar.bmpBuffer, Bar.spriteBack, Bar.spriteBack);
0090 BitBlt(Bar.bmpBuffer.Canvas.Handle,
0091 Bar.spriteRod.Left-Bar.spriteBack.Left,
0092 Bar.spriteRod.Top-Bar.spriteBack.Top,
0093 Bar.iSweepWidth, Bar.iSweepHeight,
0094 Bar.spriteRod.lmage.Canvas.Handle, iRodLeft, iRodTop, srcCOPY);
0095 BitmapOveriay(Bar.bmpBuffer, Bar.spriteButton, Bar.spriteBack);
0096 BitmapOveriay(Bar.bmpBuffer, Bar.spriteEndl , Bar.spriteBack);
0097 BitmapOverlay(Bar.bmpBuffer, Bar.spriteEnd2, Bar.spriteBack);
0098 BitBlt(bmpPlayer.Canvas.Handle,
0099 Bar.spriteBack.Left, Bar.spriteBack.Top,
0100 Bar.spriteBack. Width-1 , Bar.spriteBack.Height,
0101 Bar.bmpBuffer.Canvas.Handle , 1 , 0, srcCOPY);
0102 BarRect := Bounds(Bar.spriteBack.Left+1 , Bar.spriteBack.Top,
0103 Bar.spriteBack. Width-1 , Bar.spriteBack.Height);
0104 BitmapUpdateScreen(BarRect)
0105 end; 0106 {=====_=_=_=============================_=============
0107 { Main code }
0108 =====_====_====================================_===
0109 procedure BarEnable(var Bar: TBar);
0110 begin
0111 if Bar.iSlideRange=0 then begin
0112 BarDissable(Bar);
0113 exit 0114 end;
0115 if not Bar.bEnabled then begin
0116 Bar.bEnabled := true;
0117 Bar.bForceDraw := true;
0118 DrawAndUpdate(Bar, ConvertSlideToSweep(Bar, Bar.iSlidePosition));
0119 end
0120 end;
0121 { }
0122 procedure BarDissable(var Bar: Tbar);
0123 begin
0124 if Bar.bEnabled then begin
0125 Bar.bEnabled := false;
0126 Bar.bForceDraw := false;
0127 BitmapDraw(Bar.spriteBack)
0128 end
0129 end;
0130 { }
0131 procedure BarSetRange(var Bar: TBar; Range: longint);
0132 begin
0133 Bar.iSlideRange := Range;
0134 if Range>0 then
0135 Bar.iSlidePosition := ConvertSweepToSlide(Bar, Bar.iSweepPosition)
0136 else
0137 BarDissable(Bar)
0138 end;
0139 {- }
0140 procedure BarSetPosition(var Bar: TBar; Position: longint);
0141 begin
0142 Bar.iSlidePosition := Position;
0143 if Bar.bEnabled then
0144 DrawAndUpdate(Bar, ConvertSlideToSweep(Bar,Position))
0145 end;
0146 {- }
0147 function BarGetPosition(var Bar: TBar): longint;
0148 begin
0149 result := Bar.iSlidePosition;
0150 end;
0151 {============================^
0152 { Mouse Handling }
0153
{================= ============================ ======================} 0154 function BarButtonHit(var Bar: TBar): boolean;
0155 begin
0156 result := Bar.bEnabled and BitmapHit(Bar.spriteButton) and
0157 not (BitmapHit(Bar.spriteEndl) or BitmapHit(Bar.spriteEnd2))
0158 end;
0159 { }
0160 procedure BarMouseMoveStart(var Bar: TBar);
0161 begin
0162 Bar.iSweepMoveStartPosition := Bar.iSweepPosition
0163 end;
0164 { }
0165 procedure BarMouseMoveDraw(var Bar: TBar; x,y: longint);
0166 var
0167 iMove: longint;
0168 begin
0169 if Bar.bVertical then
0170 iMove := y-iMouseDownY
0171 else
0172 iMove := x-iMouseDownX;
0173 DrawAndUpdate(Bar, Bar.iSweepMoveStartPosition+iMove);
0174 Bar.iSlidePosition := ConvertSweepToSlide(Bar,Bar.iSweepPosition)
0175 end; 0176 {==================================================================== =}
0177 { Initalize / Exit }
0178
<=========================================================================}
0179 procedure Barlnitialize(var Bar: Tbar; imgBarBack, imgBarRod, imgBarButton,
0180 imgBarEndl , imgBarEnd2: Tlmage);
0181 var
0182 I: stringtδO];
0183 p: integer;
0184 iSlideButtonSize: longint;
0185 begin
0186 BitmapCreate(Bar.spriteBack, imgBarBack, false);
0187 BitmapCreate(Bar.spriteRod, imgBarRod, true);
0188 BitmapCreate(Bar.spriteButton, imgBarButton, true);
0189 BitmapCreate(Bar.spriteEnd1 , imgBarEndl , true);
0190 BitmapCreate(Bar.spriteEnd2, imgBarEnd2, true);
0191 Bar.bmpBuffer := TBitmap.Create;
0192 Bar.bmpBuffer.Assign(imgBarBack.Picture. Bitmap); 0193 I := imgBarRod.Hint;
0194 p := Pos(',',l);
0195 Bar.iSweepWidth := StrTolnt(Copy(l,1 ,p-1));
0196 l := Copy(l,p+1 ,99);
0197 p := Pos(V,l);
0198 Bar.iSweepHeight := StrTolnt(Copy(l,1 ,p-1));
0199 if Copy(l,p+1 ,1)='V then
0200 Bar.bVertical := true
0201 else
0202 Bar.bVertical := false;
0203 Bar.iSweepStart := StrTolnt(Copy(l,p+2,99));
0204 if Bar.bVertical then begin
0205 iSlideButtonSize := Bar.spriteButton. Height;
0206 Bar.iSweepTravel := Bar.iSweepHeight-iSlideButtonSize;
0207 Bar.spriteButton. Left := Bar.spriteBack.Left
0208 end
0209 else begin
0210 iSlideButtonSize := Bar.spriteButton. Width;
0211 Bar.iSweepTravel := Bar.iSweepWidth-iSlideButtonSize;
0212 Bar.spriteButton. Top := Bar.spriteBack.Top
0213 end;
0214 Bar.iSweepPosition := -1 ;
0215 Bar.bEnabled := false;
0216 Bar.bForceDraw := false
0217 end;
0218 { }
0219 procedure BarExit(var Bar: TBar);
0220 begin
0221 Bar.bmpBuffer.Free;
0222 BitmapDestroy(Bar.spriteEnd2);
0223 BitmapDestroy(Bar.spriteEndl);
0224 BitmapDestroy(Bar.spriteButton);
0225 BitmapDestroy(Bar.spriteRod);
0226 BitmapDestroy(Bar.spriteBack)
0227 end;
0228 end. 0001 unit BitBtns;
0002 {=============================_
0003 interface
0004
0005 {$IFDEF WINDOWS}
0006 uses
0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
0008 Forms, Dialogs,
0009 Run, Main, Bitmaps;
0010 {$ELSE}
0011 uses
0012 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
0013 EΞxtCtrls, StdCtris,
0014 Run, Main, Bitmaps;
0015 {$ENDIF}
0016 { }
0017 procedure Buttonslnitialize;
0018 procedure ButtonsExit;
0019 procedure ButtonsMouseDown_ExitCheck;
0020 procedure ButtonsMouseDown;
0021 procedure ButtonsMouseUp;
0022 procedure ButtonsForceNone;
0023 procedure ButtonsForcePlay;
0024 procedure ButtonsForcePause;
0025 procedure ButtonsForceStop; 0026
{ ======================================================
0027 implementation
0028 {=================================^
0029 var
0030 spritePlay Jp,
0031 spritePlay_Down,
0032 spritePause Jp,
0033 spritePause_Down,
0034 spriteResumeJJp,
0035 spriteResume_Down,
0036 spriteStopJJp, 0037 spriteStop_Down,
0038 spriteEjectJJp,
0039 spriteEject_Down,
0040 spriteRandom_UpOn,
0041 spriteRandom_DownOn,
0042 spriteRandomJJpOff,
0043 spriteRandom_DownOff,
0044 spriteExit_Up,
0045 spriteExit_Down,
0046 spritelnfo_Up,
0047 spritelnfo_Down,
0048 spriteWords_Up,
0049 sprite Words_Down ,
0050 spriteTracks_Up,
0051 spriteTracks_Down ,
0052 spritePrint_Up,
0053 spritePrint_Down,
0054 spriteVideo_Up,
0055 sprite Video_Down,
0056 spriteCommentary Jp,
0057 spriteCommentary_Down: TSprite;
0058 bButtonsMouseDown: boolean;
0059
{======================================================
0060 { Main code }
0061
0062 procedure ButtonsMouseDown_ExitCheck;
0063 begin
0064 if BitmapHit(spriteExit_Up) then begin
0065 bButtonsMouseDown := true;
0066 BitmapDraw(spriteExit_Down);
0067 frmRun.ExitPressed
0068 end
0069 end;
0070 { }
0071 procedure ButtonsMouseDown;
0072 begin
0073 case ePlayButtonState of
0074 bsPLAY: if BitmapHit(spritePlay_Up) then begin
0075 bButtonsMouseDown := true; 0076 BitmapDraw(spritePlay_Down);
0077 BitmapDraw(spriteSTOP_Up);
0078 eStopButtonState := bsSTOP;
0079 frmRun.PlayPressed;
0080 exit
0081 end;
0082 bsPAUSE: if BitmapHit(spritePause_Up) then begin
0083 bButtonsMouseDown := true;
0084 BitmapDraw(spritePause_Down);
0085 frmRun.PausePressed;
0086 exit
0087 end;
0088 bsRESUME: if BitmapHit(spriteResume_Up) then begin
0089 bButtonsMouseDown := true;
0090 BitmapDraw(spriteResume_Down);
0091 f rmRun . ResumePressed ;
0092 exit
0093 end
0094 end;
0095 case eStopButtonState of
0096 bsEJECT: if BitmapHit(spriteEject_Up) then begin
0097 bButtonsMouseDown := true;
0098 BitmapDraw(spriteEject_Down);
0099 frmRun.EjectPressed;
0100 exit
0101 end;
0102 bsSTOP: if BitmapHit(spriteStop_Up) then begin
0103 bButtonsMouseDown := true;
0104 BitmapDraw(spriteStop_Down);
0105 BitmapDraw(spritePlayJJp);
0106 ePlayButtonState := bsPLAY;
0107 frmRun.StopPressed;
0108 exit
0109 end;
0110 end;
0111 case eRandomButtonState of
0112 bsRANDOM_ON: if BitmapHit(spriteRandomJJpOn) then begin
0113 bButtonsMouseDown := true;
0114 BitmapDraw(spriteRandom_DownOff);
0115 eRandomButtonState := bsRANDOM_OFF;
0116 exit 0117 end;
0118 bsRANDOMJDFF: if BitmapHit(spriteRandomJJpOn) then begin
0119 bButtonsMouseDown := true;
0120 BitmapDraw(spriteRandom_DownOn);
0121 eRandomButtonState := bsRANDOMJDN;
0122 exit
0123 end
0124 end;
0125 if BitmapHit(spritelnfo_Up) then
0126 if eTubeModeStateotmlNFO then begin
0127 bButtonsMouseDown := true;
0128 BitmapDraw(spritelnfo_Down);
0129 BitmapDraw(spriteWords_Up);
0130 BitmapDraw(spriteTracks_Up);
0131 eTubeModeState := tmlNFO;
0132 frmRun.ModeSetlnfo;
0133 exit
0134 end;
0135 if BitmapHit(spriteWords_Up) then
0136 if eTubeModeStateotmWORDS then begin
0137 bButtonsMouseDown := true;
0138 BitmapDraw(spritelnfoJJp);
0139 BitmapDraw(spriteWords_Down);
0140 BitmapDraw(spriteTracks_Up);
0141 eTubeModeState := tmWORDS;
0142 frmRun.ModeSetWords;
0143 exit
0144 end;
0145 if BitmapHit(spriteTracks_Up) then
0146 if eTubeModeStateotmTRACKS then begin
0147 bButtonsMouseDown := true;
0148 BitmapDraw(spritelnfo_Up);
0149 BitmapDraw(spriteWords_Up);
0150 BitmapDraw(spriteTracks_Down);
0151 eTubeModeState := tmTRACKS;
0152 frmRun.ModeSetTracks;
0153 exit
0154 end;
0155 if BitmapHit(spritePrint_Up) then begin
0156 bButtonsMouseDown := true;
0157 BitmapDraw(spritePrint_Down); 0158 exit
0159 end;
0160 if BitmapHit(spriteVideoJJp) then begin
0161 bButtonsMouseDown := true;
0162 BitmapDraw(sprite Video_Down) ;
0163 exit
0164 end;
0165 if BitmapHit(spriteCommentary_Up) then begin
0166 bButtonsMouseDown := true;
0167 BitmapDraw(spriteCommentary_Down);
0168 exit
0169 end;
0170 end;
0171 { }
0172 procedure ButtonsMouseUp;
0173 begin
0174 if not bButtonsMouseDown then
0175 exit;
0176 bButtonsMouseDown := false;
0177 case ePlayButtonState of
0178 bsPLAY: if BitmapHit(spritePlayJJp) then begin
0179 BitmapDraw(spritePauseJJp);
0180 ePlayButtonState := bsPAUSE;
0181 exit
0182 end;
0183 bsPAUSE: if BitmapHit(spritePause_Up) then begin
0184 BitmapDraw(spriteResume_Up);
0185 ePlayButtonState := bsRESUME;
0186 exit
0187 end;
0188 bsRESUME: if BitmapHit(spriteResume_Up) then begin
0189 BitmapDraw(spritePauseJJp);
0190 ePlayButtonState := bsPAUSE;
0191 exit
0192 end;
0193 end;
0194 case eStopButtonState of
0195 bsEJECT: if BitmapHit(spriteEject_Up) then begin
0196 BitmapDraw(spriteEject_Up);
0197 exit
0198 end; 0199 bsSTOP: if BitmapHit(spriteStopJJp) then begin
0200 BitmapDraw(spriteEject_Up);
0201 eStopButtonState := bsEJECT;
0202 exit
0203 end;
0204 end;
0205 case eRandomButtonState of
0206 bsRANDOMJDN: if BitmapHit(spriteRandomJJpOn) then begin
0207 BitmapDraw(spriteRandom_UpOn);
0208 exit
0209 end;
0210 bsRANDOM_OFF: if BitmapHit(spriteRandom_UpOn) then begin
0211 BitmapDraw(spriteRandomJJpOff);
0212 exit
0213 end;
0214 end;
0215 if BitmapHit(spritePrint_Up) then begin
0216 BitmapDraw(spritePrint_Up);
0217 frmRun.PrintPressed;
0218 exit
0219 end;
0220 if BitmapHit(spriteVideo_Up) then begin
0221 BitmapDraw(spriteVideo_Up);
0222 frmRun.VideoPressed;
0223 exit
0224 end;
0225 if BitmapHit(spriteCommentary_Up) then begin
0226 BitmapDraw(spriteCommentary_Up);
0227 frmRun.CommentaryPressed;
0228 exit
0229 end
0230 end; 0231 {======================================================================
0232 { Change button state }
0233 {==============================^^
0234 procedure ButtonsForceNone;
0235 begin
0236 if bButtonsMouseDown then
0237 exit; 0238 BitmapDraw(spriteTracks Jp);
0239 BitmapDraw(spriteWordsJJp);
0240 BitmapDraw(spritelnfo_Up)
0241 end;
0242 { }
0243 procedure ButtonsForcePlay;
0244 begin
0245 if bButtonsMouseDown then
0246 exit;
0247 BitmapDraw(spritePause_Up);
0248 ePlayButtonState := bsPAUSE;
0249 BitmapDraw(spriteStopJJp);
0250 eStopButtonState := bsSTOP;
0251 end;
0252 {
0253 procedure ButtonsForcePause;
0254 begin
0255 if bButtonsMouseDown then
0256 exit;
0257 BitmapDraw(spriteResume_Up);
0258 ePlayButtonState := bsRESUME;
0259 BitmapDraw(spriteStop_Up);
0260 eStopButtonState := bsSTOP;
0261 end;
0262 {
0263 procedure ButtonsForceStop;
0264 begin
0265 if bButtonsMouseDown then
0266 exit;
0267 BitmapDraw(spritePlayJJp);
0268 ePlayButtonState := bsPLAY;
0269 BitmapDraw(spriteEject Jp);
0270 eStopButtonState := bsEJECT;
0271 end;
0272 {===============================
0273 { Initalize / Exit
0274
{===============================
0275 procedure Buttonslnitialize;
0276 begin BitmapCreate(spritePlay_Up, frmMain.imgPlayJJp, true);
BitmapCreate(spritePlay_Down, frmMain.imgPlay_Down, true);
BitmapCreate(spritePause_Up, frmMain.imgPause_Up, true);
BitmapCreate(spritePause_Down, frmMain.imgPause_Down, true);
BitmapCreate(spriteResume_Up, frmMain.imgResume_Up, true);
BitmapCreate(spriteResume_Down, frmMain.imgResume_Down, true);
BitmapCreate(spriteStop_Up, frmMain.imgStop_Up, true);
BitmapCreate(spriteStop_Down, frmMain.imgStop_Down, true);
BitmapCreate(spriteEject_Up, frmMain.imgEject_Up, true);
BitmapCreate(spriteEject_Down, frmMain.imgEject_Down, true);
BitmapCreate(spriteRandom_UpOn, frmMain.imgRandom JpOn, true);
BitmapCreate(spriteRandom_DownOn, frmMain.imgRandom_DownOn, true);
BitmapCreate(spriteRandom_UpOff, frmMain.imgRandomJJpOff, true);
BitmapCreate(spriteRandom_DownOff, frmMain.imgRandom_DownOff, true);
BitmapCreate(spriteExit_Up, frmMain.imgExit Jp, true);
BitmapCreate(spriteExit_Down, frmMain.imgExit_Down, true);
BitmapCreate(spritelnfo_Up, frmMain.imglnfo_Up, true);
BitmapCreate(spritelnfo_Down, frmMain.imglnfo_Down, true);
BitmapCreate(spriteWords_Up, frmMain.imgWords_Up, true);
BitmapCreate(spriteWords_Down, frmMain.imgWords_Down, true);
BitmapCreate(spriteTracks_Up, frmMain.imgTracks_Up, true);
BitmapCreate(spriteTracks_Down, frmMain.imgTracks_Down, true);
BitmapCreate(spritePrint_Up, frmMain.imgPrint_Up, true);
BitmapCreate(spritePrint_Down, frmMain.imgPrint_Down, true);
BitmapCreate(spriteVideo_Up, frmMain.imgVideo Jp, true);
BitmapCreate(spriteVideo_Down, frmMain.imgVideo_Down, true);
BitmapCreate(spriteCommentary_Up, frmMain.imgCommentary_Up, true);
BitmapCreate(spriteCommentary_Down, frmMain.imgCommentary_Down, true);
BitmapDraw(spritePiayJJp);
BitmapDraw(spriteEject_Up);
BitmapDraw(spriteRandom_UpOff);
BitmapDraw(spriteExit_Up);
BitmapDraw(spritelnfo_Up);
BitmapDraw(spriteWords_Up);
BitmapDraw(spriteTracks_Up);
BitmapDraw(spritePrint_Up);
BitmapDraw(spriteVideo_Up);
BitmapDraw(spriteCommentary_Up); ePlayButtonState := bsPLAY; eStopButtonState := bsEJECT; eRandomButtonState := bsRANDOM OFF; 0318 eTubeModeState := tmlNTRO;
0319 bButtonsMouseDown := false
0320 end;
0321 { }
0322 procedure ButtonsEΞxit;
0323 begin
0324 BitmapDestroy(spritePlay_Up);
0325 BitmapDestroy(spritePlay_Down);
0326 BitmapDestroy(spritePauseJJp);
0327 BitmapDestroy(spritePause_Down);
0328 BitmapDestroy(spriteResume_Up);
0329 BitmapDestroy(spriteResume_Down);
0330 BitmapDestroy(spriteStop_Up);
0331 BitmapDestroy(spriteStop_Down);
0332 BitmapDestroy(spriteEject_Up);
0333 BitmapDestroy(spriteEject_Down);
0334 BitmapDestroy(spriteRandom_UpOn);
0335 BitmapDestroy(spriteRandom_DownOn);
0336 BitmapDestroy(spriteRandom_UpOff);
0337 BitmapDestroy(spriteRandom_DownOff);
0338 BitmapDestroy(spriteExit_Up);
0339 BitmapDestroy(spriteExit_Down);
0340 BitmapDestroy(spritelnfo_Up);
0341 BitmapDestroy(spritelnfo_Down);
0342 BitmapDestroy(spriteWords_Up);
0343 BitmapDestroy(spriteWords_Down);
0344 BitmapDestroy(spriteTracks_Up);
0345 BitmapDestroy(spriteTracks_Down) ;
0346 BitmapDestroy(spritePrint_Up);
0347 BitmapDestroy(spritePrint_Down);
0348 BitmapDestroy(spriteVideo_Up);
0349 BitmapDestroy(spriteVideo_Down) ;
0350 BitmapDestroy(spriteCommentary_Up);
0351 BitmapDestroy(spriteCommentary_Down)
0352 end;
0353 end. 0001 unit Bitmaps;
0002 {=========================================================================}
0003 interface
0004 {================================_
0005 {$IFDEF WINDOWS}
0006 uses
0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
0008 Forms, Dialogs, ExtCtrls,
0009 Run, Main, SysFig;
0010 {$ELSE}
0011 uses
0012 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
0013 ExtCtrls, StdCtrls,
0014 Run, Main, SysFig;
0015 {$ENDIF}
0016 { }
0017 type
0018 TSprite = record
0019 Left, Top: longint;
0020 Width, Height: longint;
0021 bUseMask: boolean;
0022 Image: TBitmap;
0023 Mask: TBitmap
0024 end;
0025 pTSprite = TSprite;
0026 {- }
0027 procedure BitmapCreate(var Sprite: TSprite; imglmage: Tlmage; UseMask: boolean);
0028 procedure BitmapDestroy(var Sprite: TSprite);
0029 procedure BitmapOveriay(Bitmap: TBitmap; var Sprite, SpriteOffset: TSprite);
0030 procedure BitmapDraw(var Sprite: TSprite);
0031 procedure BitmapUpdateScreen(Rect: TRect);
0032 function BitmapHit(var Sprite: TSprite): boolean;
0033 {==============================_
0034 implementation
0035
{=========================================================================}
0036 0037 { Code }
0038
{ =====================================================================}
0039 procedure BitmapCreate(var Sprite: TSprite; imglmage: Tlmage; UseMask: boolean);
0040 var
0041 I: string[50];
0042 p: integer;
0043 begin
0044 I := imglmage. Hint;
0045 p := PosC'.l);
0046 Sprite.Left := StrTolnt(Copy(l,1 ,p-1));
0047 l := Copy(l,p+1 ,99);
0048 p := Pos(7,l);
0049 if p=0 then begin
0050 Sprite.Top := StrTolnt(l);
0051 imglmage.Hint := ";
0052 end
0053 else begin
0054 Sprite.Top := StrTolnt(Copy(l,1 ,p-1));
0055 imglmage.Hint := Copy(l,p+1 ,99)
0056 end;
0057 with Sprite do begin
0058 Width := imglmage.Width;
0059 Height := imglmage. Height;
0060 Image := TBitmap.Create;
0061 lmage.Assign(imglmage. Picture. Bitmap);
0062 bUseMask := UseMask
0063 end;
0064 if UseMask then begin
0065 with Sprite do begin
0066 Mask := TBitmap.Create;
0067 Mask. Width := Width+1 ;
0068 Mask. Height := Height
0069 end;
0070 with Sprite. Mask.Canvas do begin
0071 Brush.Color := clBlack;
0072 Brush.Style := bsSolid;
0073 BrushCopy(ClipRect, imglmage.Picture.Bitmap, ClipRect, TRANSPARENT_COLOR)
0074 end;
0075 with Sprite. I mage.Canvas do begin
0076 Brush.Color := clWhite; 0077 Brush.Style := bsSolid;
0078 BrushCopy(ClipRect, imglmage.Picture.Bitmap, ClipRect, TRANSPARENT_COLOR);
0079 end;
0080 with Sprite do
0081 BitBlt(Mask.Canvas.Handle, 0, 0, Width, Height,
0082 Image.Canvas.Handle, 0, 0, MERGEPAINT)
0083 end
0084 end;
0085 { }
0086 procedure BitmapDestroy(var Sprite: TSprite);
0087 begin
0088 with Sprite do begin
0089 Image.Free;
0090 if bUseMask then
0091 Mask. Free;
0092 end
0093 end;
0094 { }
0095 procedure BitmapOverlay(Bitmap: TBitmap; var Sprite, SpriteOffset: TSprite);
0096 var
0097 iLeft, iTop: longint;
0098 begin
0099 with Sprite do begin
0100 if @SpriteOffset=nil then begin
0101 iLeft := Left;
0102 iTop := Top
0103 end
0104 else begin
0105 iLeft := Left-SpriteOffset.Left;
0106 iTop := Top-SpriteOffset.Top
0107 end;
0108 if bUseMask then begin
0109 BitBlt(Bitmap.Canvas.Handle, iLeft+1 , iTop, Width-1 , Height,
0110 Mask.Canvas.Handle, 1 , 0, srcPAINT);
0111 BitBlt(Bitmap.Canvas.Handle, iLeft+1 , iTop, Width-1 , Height,
0112 Image.Canvas.Handle, 1 , 0, srcAND)
0113 end
0114 else begin
0115 BitBlt(Bitmap.Canvas.Handle, iLeft+1 , iTop, Width-1 , Height,
0116 Image.Canvas.Handle, 1 , 0, srcCOPY)
0117 end 0118 end;
0119 end;
0120 { }
0121 procedure BitmapDraw(var Sprite: TSprite);
0122 var
0123 SpriteRect: TRect;
0124 begin
0125 with Sprite do begin
0126 BitmapOverlay(bmpPlayer, Sprite, TSprite(nilΛ));
0127 SpriteRect := Bounds(Left, Top, Width, Height);
0128 BitmapUpdateScreen(SpriteRect)
0129 end
0130 end;
0131 { }
0132 procedure BitmapUpdateScreen(Rect: TRect);
0133 begin
0134 with frmRun. Canvas do begin
0135 if bVideo256 then begin
0136 SelectPalette(Handle, bmpPalette.Palette, false);
0137 RealizePalette(Handle)
0138 end;
0139 BitBlt(frmRun.Canvas.Handle, Rect.Left, Rect.Top,
0140 Rect.Right-Rect.Left+1 , Rect.Bottom-Rect.Top+1 ,
0141 bmpPlayer.Canvas.Handle, Rect.Left, Rect.Top, srcCOPY);
0142 end;
0143 end;
0144 { }
0145 function BitmapHit(var Sprite: TSprite): boolean;
0146 var
0147 x, y: longint;
0148 begin
0149 result := false;
0150 with Sprite do begin
0151 x := iMouseDownX-Left;
0152 y := iMouseDownY-Top;
0153 if (x<0) or (x-Width-1 >0) then
0154 exit;
0155 if (y<0) or (y-Height-1 >0) then
0156 exit;
0157 if bUseMask then
0158 result := (Mask.Canvas.Pixels[x,yj=clWhite) 0159 else
0160 result := true
0161 end;
0162 end;
0163 end.
0001 unit CDPiayer;
0002 {=========================================================================}
0003 interface
0004
0005 {$IFDEF WINDOWS}
0006 uses
0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
0008 Forms, Dialogs, E≡xtCtris, MPIayer,
0009 Run, Main, Logging;
0010 {$ELSE}
0011 uses
0012 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
0013 ExtCtrls, StdCtrls, MPIayer,
0014 Run, Main, Logging;
0015 {$ENDIF}
0016 {- }
0017 var
0018 iAudioTracks: longint;
0019 iAudioTrackStart, iAudioTrackLength: array [1..MAX TRACKS] of longint;
0020 iStatsCDStart, iStatsCDLength: longint;
0021 iStatsTrackStart, iStatsTrackLength: array [1..MAX TRACKS] of longint;
0022 iStatsPlayed: array [1..MAX TRACKS] of longint;
0023 bTrackEnabled: array [1..MAX TRACKS] of boolean;
0024 eCDPIayerState: (psERROR, psNOCD, psPLAYING, psSTOPPED, psPAUSED, psOPEN);
0025 iPausedTime: longint;
0026 iHoldOffUpdate: longint;
0027 iPlayTimeout: longint;
0028 { }
0029 procedure Playerlnitialize;
0030 procedure PlayerTimerTick;
0031 procedure PlayerEject;
0032 procedure PlayerStop;
0033 procedure PlayerPlay(start: TLogStart; TrackTime: longint);
0034 procedure PlayerPause;
0035 procedure Player esume;
0036 procedure PlayerGetTrackAndTime( var TrackNo, TrackTime: longint);
0037 {==============================_
0038 implementation 0039
0040 procedure PlayerEject;
0041 begin
0042 frmRun.MouseDissable;
0043 eCDPIayerState := psNOCD;
0044 with frmRun.mmCDPIayer do begin
0045 TimeFormat := tfMilliseconds;
0046 LoggingLoglt(lePLAY, (Position div 100) - iAudioTrackStart[iLastTrackNo]);
0047 try
0048 Wait := true;
0049 Notify := false;
0050 Stop
0051 except
0052 end;
0053 try
0054 Wait := true;
0055 Notify := false;
0056 Close
0057 except
0058 end;
0059 try
0060 Wait := false;
0061 Notify := false;
0062 Eject
0063 except
0064 end
0065 end;
0066 frmRun.MouseEnable
0067 end;
0068 { xxx }
0069 procedure PlayerStop;
0070 begin
0071 frmRun.MouseDissable;
0072 eCDPIayerState := psSTOPPED;
0073 with frmRun.mmCDPIayer do begin
0074 TimeFormat := tfMilliseconds;
0075 LoggingLoglt(lePLAY, (Position div 100) - iAudioTrackStartfiLastTrackNo]);
0076 try
0077 Wait := true;
0078 Notify := false; 0079 Stop
0080 except
0081 end
0082 end;
0083 frmRun.MouseEnable
0084 end;
0085 {- }
0086 procedure PlayerPlay(start: TLogStart; TrackTime: longint);
0087 begin
0088 frmRun.MouseDissable;
0089 eCDPIayerState := psSTOPPED;
0090 with frmRun.mmCDPIayer do begin
0091 TimeFormat := tfMilliseconds;
0092 LoggingLoglt(lePLAY, (Position div 100) - iAudioTrackStartfiLastTrackNo]);
0093 if Mode=mpOpen then begin
0094 frmRun.ErrorMessage(There is no CD in the drive to play!');
0095 eCDPIayerState := psOPEN;
0096 frmRun.MouseEnable;
0097 exit
0098 end;
0099 try
0100 Wait := true;
0101 Notify := false;
0102 Stop
0103 except
0104 end;
0105 try
0106 TimeFormat := tfMilliseconds;
0107 Position := 100*(iAudioTrackStart[iLastTrackNo] + TrackTime);
0108 Wait := false;
0109 Notify := false;
0110 Play;
0111 except
0112 frmRun.ErrorMessage(There is a problem trying to play the CD!');
0113 frmRun.MouseEnable;
0114 exit
0115 end;
0116 iPlayTimeout := 20;
0117 while (ModeompPLAYING) do
0118 if (iPlayTimeout=0) then begin
01 9 frmRun.ErrorMessage('There Is a problem trying to play the CD!'); 0120 try
0121 Wait := false;
0122 Notify := false;
0123 Open
0124 except
0125 end;
0126 frmRun.MouseEnable;
0127 exit
0128 end
0129 end;
0130 LoggingEvent(lePLAY, start, iLastTrackNo, TrackTime);
0131 iHoldOffUpdate := MCITODISPLAY_HOLDOFF;
0132 eCDPIayerState := psPLAYING;
0133 frmRun.MouseEnable
0134 end;
0135 { }
0136 procedure PlayerPause;
0137 begin
0138 frmRun.MouseDissable;
0139 eCDPIayerState := psPAUSED;
0140 with frmRun.mmCDPIayer do begin
0141 TimeFormat := tfMilliseconds;
0142 LoggingLoglt(leVIDEO, (Position div 100) - iAudioTrackStartpLastTrackNo]);
0143 try
0144 TimeFormat := tfMilliseconds;
0145 iPausedTime := (Position div 100) - iAudioTrackStart[iLastTrackNo];
0146 Wait := true;
0147 Notify := false;
0148 Stop
0149 except
0150 end
0151 end;
0152 frmRun.MouseEnable
0153 end;
0154 { }
0155 procedure PlayerResume;
0156 begin
0157 with frmRun.mmCDPIayer do begin
0158 TimeFormat := tfMilliseconds;
0159 LoggingLoglt(lePLAY, (Position div 100) - iAudioTrackStartfiLastTrackNo])
0160 end; 0161 PlayerPlay(lsRESUME, iPausedTime)
0162 end;
0163 { }
0164 procedure PlayerGetTrackAndTime( var TrackNo, TrackTime: longint);
0165 var
0166 iTrack: longint;
0167 begin
0168 with frmRun.mmCDPIayer do begin
0169 TimeFormat := tfMilliseconds;
0170 TrackNo := iAudioTracks;
0171 TrackTime := Position div 100;
0172 for iTrack := 2 to iAudioTracks do
0173 if iAudioTrackStart[iTrack]>TrackTime then begin
0174 TrackNo := iTrack-1 ;
0175 break
0176 end;
0177 TrackTime := TrackTime-iAudioTrackStart[TrackNo]
0178 end
0179 end;
0180
{===== ======= =============== ===============================}
0181 { Initalize / Exit }
0182
{=========================================================================}
0183 procedure PlayerTimerTick;
0184 begin
0185 if iHoldOffUpdate>0 then
0186 Dec(iHoldOffUpdate);
0187 if iPlayTimeout>0 then
0188 Dec(iPlayTimeout)
0189 end; 0190
{====================================== ========================== }
0191 { Initalize / EΞxit }
0192
{============ϊ======= ==================================================}
0193 procedure Playerlnitialize;
0194 var
0195 iTrack: longint;
0196 begin
0197 frmRun.MouseDissable; 0198 eCDPIayerState := psNOCD;
0199 with frmRun.mmCDPIayer do begin
0200 if Mode=mpPlaying then
0201 try
0202 Wait := true;
0203 Notify := false;
0204 Stop
0205 except
0206 end;
0207 try
0208 DeviceType := dtCDAudio;
0209 Wait := true;
0210 Notify := false;
0211 Open;
0212 except
0213 frmRun.SevereError('The CD drive is already in use or not working!');
0214 exit
0215 end;
0216 if Mode=mpPlaying then
0217 try
0218 Wait := true;
0219 Notify := false;
0220 Stop
0221 except
0222 end;
0223 if ModeompSTOPPED then begin
0224 frmRun.SevereError('There is no CD in the drive to play!');
0225 exit
0226 end;
0227 TimeFormat := tfMilliseconds;
0228 iStatsCDStart := Start;
0229 iStatsCDLength := Length;
0230 for iTrack := 1 to iAudioTracks do begin
0231 iStatsTrackStartpTrack] := TrackPosition[iTrack];
0232 iStatsTrackLength[iTrack] := TrackLength[iTrack];
0233 iAudioTrackStart[iTrack] := TrackPosition[iTrack] div 100
0234 end
0235 end;
0236 eCDPIayerState := psSTOPPED;
0237 iHoldOffUpdate := 0;
0238 iPlayTimeout := 0; 0239 frmRun.MouseEnable
0240 end;
0241 end.
0001 unit Comment;
0002 {=========================================================================}
0003 interface
0004
{========= =====================.====-==================================}
0005 {$IFDEF WINDOWS}
0006 uses
0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
0008 Forms, Dialogs, EΞxtCtrls, MPIayer,
0009 Run, Main, CDPIayer, SysFig, Logging;
0010 {$ELSE}
0011 uses
0012 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
0013 ExtCtrls, StdCtrls, MPIayer,
0014 Run, Main, CDPIayer, SysFig, Logging;
0015 {$ENDIF}
0016 { }
0017 var
0018 bCommentaryAvailable: array [1..MAX TRACKS] of boolean;
0019 { }
0020 procedure Commentarylnitialize;
0021 procedure CommentaryStop;
0022 procedure CommentaryPlay(TrackNo: longint);
0023 procedure CommentaryNotify; 0024
0025 implementation
0026
{=========================================================================}
0027 {=========================================================================}
0028 { Main Code }
0029 {=================================-:========-::=:======:=======================}
0030 procedure CommentaryStop;
0031 begin
0032 with frmRun.mmCommentary do begin
0033 TimeFormat := tfMilliseconds;
0034 LoggingLoglt(leCOMMENT, Position div 100);
0035 try 0036 Wait := true;
0037 Notify := false;
0038 Stop
0039 except
0040 end
0041 end
0042 end;
0043 { - •}
0044 procedure CommentaryPlay(TrackNo: longint);
0045 begin
0046 with frmRun.mmCommentary do begin
0047 TimeFormat := tfMilliseconds;
0048 LoggingLoglt(leCOMMENT, Position div 100);
0049 try
0050 FileName := sRunDirectory+'Stuff\Coment'+lntToStr(TrackNo)+'.wav';
0051 Wait := true;
0052 Notify := false;
0053 Open;
0054 Wait := false;
0055 Notify := true;
0056 Play
0057 except
0058 frmRun.ErrorMessage(There is a problem with Commentary playback!');
0059 exit
0060 end;
0061 LoggingEvent(leCOMMENT, IsOTHER, TrackNo, 0)
0062 end;
0063 end;
0064 { }
0065 procedure CommentaryNotify;
0066 begin
0067 with frmRun.mmCommentary do begin
0068 TimeFormat := tfMilliseconds;
0069 LoggingLoglt(leCOMMENT, Position div 100)
0070 end
0071 end; 0072
0073 { Initalize / Exit }
0074 {=========================================================================} 0075 procedure Commentarylnitialize;
0076 var
0077 fCommentary: TextFile;
0078 iTrack: integer;
0079 begin
0080 for iTrack := 1 to iAudioTracks do begin
0081 bCommentaryAvailable[iTrack] := true;
0082 try
0083 AssignFile(fCommentary, sRunDirectory+'Stuff\Coment'+lntToStr(iTrack)+'.wav')
0084 Reset(fCommentary) ;
0085 CloseFile(fCommentary)
0086 except
0087 bCommentaryAvailable[iTrack] := false
0088 end
0089 end
0090 end;
0091 end.
0001 unit Counter;
0002 {=======================================================================
=}
0003 interface
0004 ======================================================================;
=}
0005 {$IFDEF WINDOWS}
0006 uses
0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
0008 Forms, Dialogs,
0009 Run, Main, Bitmaps, Tube;
0010 {$ELSE}
0011 uses
0012 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
0013 EΞxtCtrls, StdCtris,
0014 Run, Main, Bitmaps, Tube;
0015 {$ENDIF}
0016 { }
0017 procedure Counterlnitialize;
0018 procedure CounterExit;
0019 procedure CounterNewTrack;
0020 procedure CounterSetTime(TrackTime: longint);
0021 { }
0022 type
0023 TTrackMS = record
0024 Minutes: longint;
0025 Seconds: longint
0026 end;
0027 { }
0028 var
0029 OldTrackMS: TTrackMS;
0030 spriteCounter: TSprite;
0031 {======================================================================
=}
0032 implementation
0033
=} 0034 const
0035 COUNTER_COLOR = $00A00000;
0036
0037 {=======================================================================
=}
0038 { Code }
0039 {:s:======================================================================
=}
0040 procedure CounterNewTrack;
0041 begin
0042 OldTrackMS.Minutes := -1
0043 end;
0044 {- }
0045 procedure CounterSetTime(TrackTime: longint);
0046 var
0047 TrackMS: TTrackMS;
0048 sTime: string[6];
0049 CounterRect: TRect;
0050 begin
0051 TrackMS.Minutes := TrackTime div 600;
0052 TrackMS.Seconds := (TrackTime - 600*TrackMS. Minutes) div 10;
0053 if (TrackMS.Minutes=OldTrackMS.Minutes) and
0054 (TrackMS.Seconds=OldTrackMS.Seconds) then
0055 exit;
0056 with bmpPlayer.Canvas do begin
0057 BitmapOverlay(bmpPlayer, spriteCounter, TSprite(nilΛ));
0058 sTime := lntToStr(TrackMS.Minutes);
0059 if TrackMS.Minutes<10 then
0060 sTime := O'+sTime;
0061 sTime := sTime+ϊ;
0062 if TrackMS.Seconds<10 then
0063 sTime := sTime+'0'+lntToStr(TrackMS.Seconds)
0064 else
0065 sTime := sTime+lntToStr(TrackMS.Seconds);
0066 Brush.Style := bsClear;
0067 Font.Size := iTextFontSize-2;
0068 Font.Color := COUNTER_COLOR;
0069 Font.Style := [];
0070 CounterRect := Bounds(spriteCounter.Left, spriteCounter.Top, 0071 spriteCounter. Width, spriteCounter.Height);
0072 ExtTextOut(Handle,
0073 spriteCounter.Left+2, spriteCounter. Top+4,
0074 0, ©CounterRect, Pointer(@sTime[1]), 5, nil);
0075 BitmapUpdateScreen(CounterRect)
0076 end
0077 end;
0078 {======================================================================
=}
0079 { Initalize / Exit }
0080
{======================================================================
=}
0081 procedure Counterlnitialize;
0082 begin
0083 BitmapCreate(spriteCounter, frmMain.imgCounter, false);
0084 OldTrackMS.Minutes := -1
0085 end;
0086 { }
0087 procedure CounterExit;
0088 begin
0089 BitmapDestroy(spriteCounter)
0090 end;
0091 end.
0001 unit Info;
0002 {=========================================================================}
0003 interface
0004
<=========================================================================}
0005 {$IFDEF WINDOWS}
0006 uses
0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
0008 Forms, Dialogs,
0009 Run, Main, CDPIayer, BitBtns, BitBars, Tube, SysFig;
0010 {$ELSE}
0011 uses
0012 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
0013 ExtCtrls, StdCtrls,
0014 Run, Main, CDPIayer, BitBtns, BitBars, Tube, SysFig;
0015 {$ENDIF}
0016 { }
0017 procedure Infolnitialize;
0018 procedure InfoExit;
0019 procedure InfoNewTrackfJrackNo: longint);
0020 { }
0021 var
0022 Thelnfo: array [1..MAX TRACKS] of TTubeList; 0023 {=========================================================================}
0024 implementation
0025
{=========================================================================}
0026 {================-=========================================================}
0027 { Code }
0028 {=========================================================================}
0029 procedure lnfoNewTrack(TrackNo: longint);
0030 begin
0031 if eTubeModeState=tmlNFO then
0032 TubeDisplay(Thelnfo[TrackNo]);
0033 TubeSetTopLine(Thelnfo[TrackNo], 1)
0034 end;
0035 {=========================================================================} 0036 { Initalize / Exit }
0037 {=======================================================================
0038 procedure Infolnitialize;
0039 var
0040 flnfo: TextFile;
0041 iTrack: Integer;
0042 I: String[250];
0043 begin
0044 for iTrack := 1 to iAudioTracks do begin
0045 AssignFile(flnfo, sRunDirectory+'Stuff\lnfo'+lntToStr(iTrack)+'.txt');
0046 Reset(flnfo);
0047 Thelnfo[iTrack].TextList := TStringList.Create;
0048 while not Eof(flnfo) do begin
0049 ReadLn(flnfo, I);
0050 Thelnfo[iTrack].TextList.AddObject(l, nil)
0051 end;
0052 CloseFile(flnfo);
0053 TubelnitList(spriteTubeText, Thelnfo[iTrack], -3, 0);
0054 end
0055 end;
0056 { }
0057 procedure InfoEΞxit;
0058 var
0059 iTrack: Integer;
0060 begin
0061 for iTrack := 1 to iAudioTracks do
0062 if Thelnfo[iTrack].TextList<>nil then
0063 TubeEΞxitList(Thelnfo[iTrack])
0064 end;
0065 end.
0001 unit IniFig;
0002 {=======================================================================
0003 interface
0004 =======================================================================
0005 {$IFDEF WINDOWS}
0006 uses
0007 WinTypes, WinProcs, SysUtils, Messages, Classes, Controls, Inifiles, Registry,
0008 Run, SysFig;
0009 {$ELSE}
0010 uses
0011 Windows, SysUtils, Messages, Classes, Controls, IniFiles, Registry,
0012 Run, SysFig;
0013 {$ENDIF}
0014 { }
0015 function InifigLoad: boolean;
0016 { }
0017 var
0018 iniCryptPublic: Integer;
0019 iniCryptPrime: Extended;
0020 inilnfoURL,
0021 iniVoteURL: string[200];
0022 inilnfoFile,
0023 iniVoteFile: string[50];
0024 iniAppName,
0025 iniAppTitle: string[100];
0026 iniAlbumHandle,
0027 iniAlbumLabel,
0028 iniAlbumArtist,
0029 iniAlbumName: string[100];
0030 iniApplicationName,
0031 iniApplicationTitle: string[100];
0032 iniWallpaper,
0033 iniScreenSaver: string[50];
0034 iniPlaylntro,
0035 iniAskVote,
0036 iniAskVideo,
0037 iniSendVote,
0038 iniSendlnfo: (qfONCE, qfALWAYS, qfNEVER, qfASK);
0039 iniPlayByeBye: boolean; 0040 iniVoteϋmit: integer;
0041 {======================================================================__
0042 implementation
0043
{=======================================================================
0044 function InifigLoad: boolean;
0045 var
0046 flniFile: TextFile;
0047 Ini: TlniFile;
0048 Reg: TRegistry;
0049 sKey: string[200];
0050 sPlaylntro,
0051 sAskVote,
0052 sAskVideo,
0053 sSendVote,
0054 sSendlnfo: string[20];
0055 begin
0056 result := false;
0057 try
0058 AssignFile( flniFile, sRunDirectory+'IQPIayer.ini');
0059 Reset( flniFile);
0060 CloseFile( flniFile);
0061 except
0062 exit
0063 end;
0064 try
0065 Ini := TlniFile.Create( sRunDirectory+'IQPIayer.ini');
0066 except
0067 exit
0068 end;
0069 try
0070 iniCryptPublic := lni.Readlnteger('lnternet', 'CryptPublic', -1);
0071 iniCryptPrime := lni.Readlnteger(*lntemef, 'CryptPrime', -1);
0072 inilnfoFile := lni.ReadString('lntemet', 'Filelnfo', ");
0073 inilnfoURL := lni.ReadString('lntemet', 'URLInfo', ");
0074 iniVoteFile := lni.ReadString('lntemef, 'FileVote', ");
0075 iniVoteURL := lni.ReadString('lntemet', 'URLVote', ");
0076 iniAlbumHandle := lni.ReadString('Album', 'Handle', ");
0077 iniAlbumLabel := lni.ReadString('Album', 'Label', ");
0078 iniAlbumArtist := lni.ReadString('Album', 'Artist', "); 0079 iniAlbumName := lni.ReadString('Album', 'Name', ");
0080 iniAppName := lni.ReadString('Application', 'Name', ");
0081 iniAppTitle := lni.ReadString('Application', Title', ");
0082 iniWallpaper := lni.ReadString('Application', 'Wallpaper", ");
0083 iniScreenSaver := iniWallpaper;
0084 sPlaylπtro := UpperCase(lni.ReadString('Application\ 'Playlntro', "));
0085 sAskVote := UpperCase(lni.ReadString('Application', 'AskVote', "));
0086 sAskVideo := UpperCase(lni.ReadString('Application', 'AskVideo', "));
0087 sSendVote := UpperCase(lni.ReadString Application', 'SendVote', "));
0088 sSendlnfo := UpperCase(lni.ReadString('Application', 'Sendlnfo', "));
0089 iniPlayByeBye := lni.ReadBool('Application', 'PlayBye', false);
0090 iniVoteLimit := lni.Readlnteger('Application', 'VoteLimif, -1);
0091 except
0092 end;
0093 Ini. Free;
0094 if iniCryptPublic=-1 then exit;
0095 if iniCryptPrime=-1 then exit;
0096 if iniCryptPublic=-1 then exit;
0097 if iniinfoFile=" then exit;
0098 if inilnfoURL=" then exit;
0099 if iniVoteURL=" then exit;
0100 if iniVoteFile=" then exit;
0101 if iniAlbumHandle=" then exit;
0102 if iniAlbumLabel=" then exit;
0103 if iniAlbumArtist=" then exit;
0104 if iniAlbumName=" then exit;
0105 if iniAppName=" then exit;
0106 if iniAppTitle=" then exit;
0107 if iniWallpaper=" then exit;
0108 if iniScreenSaver=" then exit;
0109 if sPiaylntro='ONCE' then iniPlaylntro := qfONCE
0110 else if sPlaylntro='ALWAYS' then iniPlaylntro := qfALWAYS
0111 else if sPlaylntro='NEVER' then iniPlaylntro := qfNEVER
0112 else
0113 exit;
0114 if sAskVote='ONCE' then iniAskVote := qfONCE
0115 else if sAskVote='ALWAYS' then iniAskVote := qfALWAYS
0116 else if sAskVote='NEVER' then iniAskVote := qfNEVER
0117 else
0118 exit;
0119 if sAskVideo='ONCE' then iniAskVideo := qfONCE 0120 else if sAskVideo='ALWAYS' then iniAskVideo := qfALWAYS
0121 else if sAskVideo='NEVER' then iniAskVideo := qfNEVER
0122 else
0123 exit;
0124 if sSendVote='ALWAYS" then iniSendVote := qfALWAYS
0125 else if sSendVote='NEVER' then iniSendVote := qfNEVER
0126 else if sSendVote='ASK' then iniSendVote := qfASK
0127 else
0128 exit;
0129 if sSendlnfo='ONCE' then iniSendlnfo := qfONCE
0130 else if sSendlnfo='ALWAYS' then iniSendlnfo := qfALWAYS
0131 else if sSendlnfo='NEVER' then iniSendlnfo := qfNEVER
0132 else
0133 exit;
0134 if iniVoteϋmit=-1 then
0135 exit;
0136 try
0137 Reg := TRegistry.Create
0138 except
0139 exit
0140 end;
0141 Reg.RootKey := HKEY_LOCAL_MACHINE;
0142 sKey := '\SOFTWARE\Palantir\IQcd\'+iniAlbumHandle+'\lnfo';
0143 try
0144 if Reg.OpenKey(sKey,true) then
0145 Reg.WriteString('URL',inilnfoURL+'/append.cgi?file='+inilnfoFile+'&data=')
0146 except
0147 exit
0148 end;
0149 Reg.RootKey := HKEY_LOCAL_MACHINE;
0150 sKey := '\SOFTWARE\Palantir\IQcd\'+iniAlbumHandle+'\Vote';
0151 try
0152 if Reg.OpenKey(sKey,true) then
0153 Reg.WriteString('URL,,iniVoteURL+'/append.cgi?file='+iniVoteFile+'&data=')
0154 except
0155 exit
0156 end;
0157 result := true
0158 end;
0159 end. 0001 unit IQAbout;
0002 {=========================================================================}
0003 interface
0004
{--=------- ============================================================}
0005 {$IFDEF WINDOWS}
0006 uses
0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
0008 Forms, Dialogs,
0009 Run, Main, Tube, Bitmaps, SysFig;
0010 {$ELSE}
0011 uses
0012 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
0013 ExtCtrls, StdCtrls,
0014 Run, Main, Tube, Bitmaps, SysFig;
0015 {$ENDIF}
0016 { }
0017 procedure Aboutlnitialize;
0018 procedure AboutExit;
0019 { }
0020 var
0021 spriteTubeCDABout,
0022 spriteTubelQAbout: TSprite;
0023 TheCDAbout: TTubeList;
0024 ThelQAbout: TTubeList;
0025 {=========================================================================}
0026 implementation
0027
{=========================================================================}
0028
{===================================================== ================}
0029 { Code }
0030
{=========================================================================}
0031 procedure Aboutlnitialize;
0032 var
0033 fAbout: TextFile;
0034 I: string[100];
0035 begin; 0036 BitmapCreate(spriteTubeCDAbout, frmMain.imgTube_CDAbout, true);
0037 BitmapCreate(spriteTubelQAbout, frmMain.imgTube_IQAbout, true);
0038 TheCDAbout.TextList := TStringList.Create;
0039 AssignFile(fAbout, sRunDirectory+'StufftCDInfo.txt');
0040 Reset(fAbout);
0041 while not Eof(fAbout) do begin
0042 ReadLn(f About, I);
0043 TheCDAbout.TextList.AddObject(l, nil)
0044 end;
0045 CloseFile(fAbout);
0046 TubelnitList(spriteTubeCDAbout, TheCDAbout, -3, 0);
0047 ThelQAbout.TextList := TStringList.Create;
0048 AssignFile(fAbout, sRunDirectory+'StuffMQInfo.txt');
0049 Reset(fAbout);
0050 while not Eof(fAbout) do begin
0051 ReadLn(fAbout, I);
0052 ThelQAbout.TextList.AddObjectO, nil)
0053 end;
0054 CloseFile(fAbout);
0055 TubelnitList(spriteTubelQAbout, ThelQAbout, -3, 0)
0056 end;
0057 { }
0058 procedure AboutEΞxit;
0059 begin
0060 TubeExitList(ThelQAbout);
0061 TubeExitListfTheCDAbout);
0062 BitmapDestroy(spriteTubeCDAbout);
0063 BitmapDestroy(spriteTubelQAbout)
0064 end;
0065 end.
0001 unit IQMenu;
0002 {=========================================================================}
0003 interface
0004 {=========================================================================}
0005 {$IFDEF WINDOWS}
0006 uses
0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
0008 Forms, Dialogs, LMDnonvS, IniFiles, Registry,
0009 Run, Main, Tube, Bitmaps, Wall, Saver, SysFig;
0010 {$ELSE}
0011 uses
0012 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
0013 ExtCtrls, StdCtris, LMDnonvS, IniFiles, Registry,
0014 Run, Main, Tube, Bitmaps, Wall, Saver, SysFig;
0015 {$ENDIF}
0016 { }
0017 var
0018 TheMenu: TTubeList;
0019 { }
0020 procedure Menulnitialize;
0021 procedure MenuExit;
0022 function MenuGetLine(Menultem: longint): longint;
0023 procedure MenuEnableltem(Menultem: longint);
0024 procedure MenuDissableltem(Menultem: longint);
0025 procedure MenuUpdate;
0026 procedure MenuHighlightltem(Menultem: longint);
0027 procedure MenuMouseDown;
0028 procedure MenuMouseMove(X,Y: longint);
0029 procedure MenuTimerTick;
0030 {=========================================================================}
0031 implementation
0032
{=========================================================================}
0033 var
0034 iHintltem: longint;
0035 iHintX, iHintY: longint;
0036 iHintDelayTimer: longint;
0037 sHintMsg: string[250]; 0038 bHintVisible: boolean;
0039 blnHintArea: boolean; 0040 {=========================================================================}
0041 { Main Code }
0042 {=========================================================================}
0043 function MenuGetLine(Menultem: longint): longint;
0044 var
0045 iLine: longint;
0046 iLastLine: longint;
0047 {pTubeLine: pTTubeLine;}
0048 begin
0049 iLastLine := TheMenu.TextList.Count-1 ;
0050 {for iLine := 0 to iLastLine do
0051 pTubeLine := pTTubeLine(TheMenu.TextList.Objects[iLiπe]);
0052 if pTubeLineΛ.iTimeStamp=Menultem then begin}
0053 for iLine := 0 to iLastLine do
0054 with pTTubeLine(TheMenu.TextList.Objects[iLine])Λ do
0055 if iTimeStamp=Menultem then begin
0056 result := iLine+1 ;
0057 exit
0058 end;
0059 frmRun.SevereError('MenuGetLine - line not found!');
0060 result := 1
0061 end;
0062 { }
0063 procedure MenuEnableltem(Menultem: longint);
0064 begin
0065 TubeSetEnable(TheMenu, MenuGetLine(Menultem))
0066 end;
0067 { }
0068 procedure MenuDissableltem(Menultem: longint);
0069 begin
0070 TubeSetDissable(TheMenu, MenuGetLine(Menultem))
0071 end;
0072 { }
0073 procedure MenuHighlightltem(Menultem: longint);
0074 begin
0075 TubeSetAIINormal(TheMenu);
0076 TubeSetHighlightfTheMenu, MenuGetLine(Menuitem)) 0077 end;
0078 { }
0079 procedure MenuUpdate;
0080 var
0081 menu: TStringList;
0082 iLine, iLastLine: integer;
0083 begin
0084 menu := TheMenu.TextList;
0085 iLastLine := menu. Count-1 ;
0086 for iLine := 0 to iLastLine do
0087 case pTTubeLine(menu.Objects[iLine]).iTimeStamp of
0088 4: if UsingOurWallpaper and not UsingThisWallpaper(startWallpaperName) then
0089 menu.Strings[iLine] := '{!s12 h15 c020}Previous Wallpaper"
0090 else
0091 menu.Strings[iLine] := '{!s12 h15 c020}lnstall Wallpaper';
0092 5: if UsingOurSaver and not UsingThisSaver(startScreenSaver) then
0093 menu.Strings[iLine] := '{!s12 h15 c020}Previous Screen Saver'
0094 else
0095 menu.Strings[iLine] := '{!s12 h15 c020}lnstall Screen Saver";
0096 7: if UsingWallpaper then
0097 menu.Strings[iLine] := '{!s12 h20 c020}Tum Wallpaper Off
0098 else
0099 menu.Strings[iLine] := '{!s12 h20 c020}Tum Wallpaper On';
0100 9: if bHintsEnabled then
0101 menu.Strings[iLine] := '{!s12 h20 c020}Turn Hints Off
0102 else
0103 menu.Strings[iLine] := '{!s12 h20 c020}Turn Hints On'
0104 end;
0105 TubeRefreshfTheMenu)
0106 end;
0107 {=======================================================================
0108 { Mouse Handling }
0109
{=======================================================================
0110 procedure MenuMouseDown;
0111 var
0112 iMenultem: longint;
0113 begin
0114 if eTubeModeStateotmMENU then
0115 exit; 0116 iMenultem := TubeltemHit(iMOuseDownX MOuseDownY);
0117 if iMenultem>0 then begin
0118 iHintDelay Timer := 0;
0119 if bHintVisible then begin
0120 frmRun.blobHint.HideMessage;
0121 bHintVisible := false
0122 end;
0123 frmRun.MenuClicked(iMenultem)
0124 end
0125 end;
0126 { }
0127 procedure MenuMouseMove(X,Y: longint);
0128 var
0129 iltem: longint;
0130 label
0131 exitl ;
0132 begin
0133 if eTubeModeStateotmMENU then
0134 goto exitl ;
0135 iHintX := frmRun.Left+X+5;
0136 iHintY := frmRun.Top+Y-0;
0137 iltem := TubeltemHit(X,Y);
0138 if iltem>0 then begin
0139 if iltemoiHintltem then begin
0140 if bHintVisible then begin
0141 frmRun.blobHint.HideMessage;
0142 bHintVisible := false
0143 end;
0144 iHintDelayTimer := HINT_DELAY;
0145 iHintltem := iltem
0146 end;
0147 exit
0148 end;
0149 exitl :
0150 iHintDelayTimer := 0;
0151 iHintltem := 0;
0152 blnHintArea := false;
0153 if bHintVisible then begin
0154 frmRun.blobHint.HideMessage;
0155 bHintVisible := false
0156 end 0157 end;
0158 { }
0159 procedure MenuTimerTick;
0160 begin
0161 if iHintDelayTimer=0 then
0162 exit;
0163 Dec(iHintDelayTimer);
0164 if iHintDelayTimer=0 then begin
0165 if bHintVisible then
0166 frmRun.blobHint.HideMessage;
0167 iHintLastX := iHintX;
0168 iHintLastY := iHintY;
0169 sHintLastMsg := sHintMsg;
0170 frmRun.blobHint.Position := hpAboveRight;
0171 frmRun.blobHint.ShowMessage(sHintMsg, iHintX, iHintY);
0172 bHintVisible := true
0173 end
0174 end; 0175 ================= ==================================================}
0176 { Initalize / Exit }
0177
{======================== =============================================}
0178 procedure Menulnitialize;
0179 begin;
0180 TheMenu.TextList := TStringList.Create;
0181 TheMenu.TextList.AddObject( '{h20}', Pointer(O));
0182 TheMenu.TextList.AddObject( '{!s12 h15 c020}Show CD Infomation', Pointer(1));
0183 TheMenu.TextList.AddObject( '{!s12 h20 c020}Show IQcd Infomation', Pointer(2));
0184 TheMenu.TextList.AddObject( '{!s12 h20 c020}Play Intro Video', Pointer(3));
0185 TheMenu.TextList.AddObject( '{!s12 h20 c020}lnstall Wallpaper', Pointer(4));
0186 if not UsingOurSaver then
0187 TheMenu.TextList.AddObject( '{!s12 hi 5 c020}lnstall Screen saver\ Pointer(5));
0188 if UsingWallpaper then
0189 TheMenu.TextList.AddObject( '{!s12 h20 c020}Turn Wallpaper On', Pointer(7))
0190 else
0191 TheMenu.Textϋst.AddObject( '{!s12 h20 c020}Turn Wallpaper Off, Pointer(7));
0192 if not bVideoEnable then begin
0193 TheMenu.TextList.AddObject( '{!s12 h15 c020}lnstall Web Link', Pointer(6));
0194 TheMenu.TextList.AddObject( '{!s12 h15 c020}lnstall Active Movie', Pointer(8))
0195 end 0196 else
0197 TheMenu.TextList.AddObject( '{!s12 h15 c020}lnstall Web Link', Pointer(6));
0198 TheMenu.TextList.AddObject( '{!s12 h20 c020}Turn Hints Off, Pointer(9));
0199 TubelnitList(spriteTubeMenu, TheMenu, -3, 8);
0200 sHintMsg := 'Click selection to do it.';
0201 iHintltem := 0;
0202 iHintDelayTimer := 0;
0203 bHintVisible := false;
0204 blnHintArea := false;
0205 sCurrentWall := ";
0206 sCurrentTile := O';
0207 sCurrentSaver := "
0208 end;
0209 { }
0210 procedure MenuExit;
0211 begin
0212 TubeExitList(TheMenu)
0213 end;
0214 end.
program IQPIayer;
uses Forms,
Run in 'RUN.PAS' {frmRun}, Main in 'MAIN.PAS' {frmMain}, Video in 'VIDEO.PAS' {frmVideo}, Regions in 'REGIONS.PAS', Bitmaps in 'BITMAPS.PAS', BitBars in 'BITBARS.PAS', BitBtns in 'BITBTNS.PAS', ScrolBar in 'SCROLBAR.PAS', TimeBar in TIMEBAR.PAS', VolumBar in 'VOLUMBAR.PAS', PlayList in 'PLAYLIST.PAS*, Logo in 'LOGO.PAS', Tube in TUBE.PAS', Words in 'WORDS.PAS', Tracks in TRACKS.PAS', Info in 'INFO.PAS', Counter in 'COUNTER.PAS', Comment in 'COMMENT.PAS', CDPIayer in 'CDPLAYER.PAS', IQMenu in 'IQMenu.pas', I Q About in 'IQAbout.pas', TrkMedia in TrkMedia.pas', QYesNo in 'QYesNo.pas', Wall in 'Wall. pas', Logging in 'Logging.pas', Inifig in 'IniFig.pas', SysFig in 'SysFig. pas', RegFig in 'RegFig.pas', Saver in 'Saver.pas';
{$R *.RES}
begin
Application. Initialize;
Application.CreateForm(TfrmRun, frmRun);
Application. Run; end. 0001 unit Logging;
0002
{================================================== ===================}
0003 interface
0004 {=========================================================================}
0005 {$IFDEF WINDOWS}
0006 uses
0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
0008 Forms, Dialogs, Inifiles,
0009 Run, IniFig, RegFig, SysFig, Wall, Saver;
0010 {$ELSE}
0011 uses
0012 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
0013 ExtCtrls, StdCtris, Registry,
0014 Run, IniFig, RegFig, SysFig, Wall, Saver;
0015 {$ENDIF}
0016 { }
0017 type
0018 TLogEvent = (lePLAY, leVIDEO, leCOMMENT, leWALL, leLINK, leSAVER,
0019 leNONE );
0020 TLogStart = (IsPLAY, IsRESUME, IsTIMEBAR, IsWORDS, IsTRACK, IsNEXT, IsOTHER);
0021 { }
0022 procedure Logginglnitialize;
0023 procedure LoggingEvent(event: TLogEvent; start: TLogStart; track, timeO: integer);
0024 procedure LoggingLoglt(event: TLogEvent; timel : integer); 0025 {=========================================================================}
0026 implementation
0027 {=========================================================================}
0028 uses
0029 CDPIayer;
0030 { }
0031 const
0032 sEvents: array [lePLAY.. leNONE] of string =
0033 ('PLAY', 'VIDEO', 'COMMENT', 'iWALU, 'iLINK', 'iSAVER', '?');
0034 sE2vents: array [lePLAY.. leNONE] of string =
0035 CPC, 'PV, 'Pm', 'lw', 'II', 'Is', '?');
0036 sStarts: array [IsPLAY.. IsOTHER] of string =
0037 ('play', 'resume', 'timebar\ 'words', 'track', 'next', Other"); 0038 { }
0039 var
0040 regFirstRun: string[30];
0041 Login, LogOut, LogSeq: integer;
0042 logXevent: TLogEvent;
0043 logXstart: TLogStart;
0044 logXtrack: integer;
0045 logXtimeO: integer;
0046
{================== ========== =================================}
0047 { Code }
0048
{=============================== ======================================
0049 procedure LoggingEvent(event: TLogEvent; start: TLogStart; track, timeO: integer);
0050 begin
0051 logXevent := event;
0052 logXstart := start;
0053 logXtrack := track;
0054 logXtimeO := timeO;
0055 end;
0056 { }
0057 procedure LoggingLoglt(event: TLogEvent; timel : integer);
0058 var
0059 Reg: TRegistry;
0060 sKey: string[200];
0061 iTrack: integer;
0062 log: string[250];
0063 s: string[30];
0064 begin
0065 if not regVoteEnabled then
0066 exit;
0067 if (Logln-LogOut)>iniVoteLimit then
0068 exit;
0069 if (logXevent=leNONE) or (logXeventoevent) then
0070 exit;
0071 if logXtimeO<0 then
0072 logXtimeO := 0;
0073 if timel <logXtimeO then
0074 timel := logXtimeO;
0075 if timel =logXtimeO then
0076 exit; 0077 Log := 'v1.00,'+iniAlbumHandle+','+regHandle+
0078 7+regFirstRun+','+SysPad(LogSeq,6)+
0079 ','+regZip+','+regAge+','+regSex+',';
0080 case eTubeModeState of
0081 tmTF ACKS: s := Tt";
0082 tmWORDS: s := Tw';
0083 tmlNFO: s := Ti";
0084 else
0085 s := To'
0086 end;
0087 Log := Log+s+7;
0088 For iTrack := 1 to iAudioTracks do
0089 if bTrackEnabled[iTrack] then
0090 Log := Log+'E'
0091 else
0092 Log := Log+'d';
0093 if WallpaperOurslnstalled then
0094 Log := Log+',Y'
0095 else
0096 Log := Log+',n';
0097 if UsingWallpaper then
0098 Log := Log+
0099 else
0100 Log := Log+'n';
0101 if UsingOurWallpaper then
0102 Log := Log+'Y'
0103 else
0104 Log := Log+'n';
0105 if SaverOurslnstalled then
0106 Log := Log+',Y'
0107 else
0108 Log := Log+',n';
0109 if UsingSaver then
0110 Log := Log+T
0111 else
0112 Log := Log+'n';
0113 if UsingOurSaver then
0114 Log := Log+'Y'
0115 else
0116 Log := Log+'n';
0117 if regHasTargetPage then 0118 Log := Log+',Y,'
0119 else
0120 Log := Log+',n,';
0121 Log := Log+sE2vents[logXevent]+SysPad(logXtrack,2)+
0122 ','+FormatDateTime('yyyy/mm/dd-hh:nn:ss', Now)+
0123 ','+sEvents[logXevent]+','+sStarts[logXstart]+','+SysPad(logXtrack,2)+
0124 ','+lntToStr(logXtime0)+','+lntToStr(time1)+','+lntToStr(time1-logXtime0);
0125 logXevent := leNONE;
0126 try
0127 Reg := TRegistry.Create
0128 except
0129 exit
0130 end;
0131 Reg.RootKey := HKEY_LOCAL_MACHINE;
0132 sKey := '\SOFTWARE\Palantir\IQcd\'+iniAlbumHandle+'\Vote';
0133 try
0134 if Reg.OpenKey(sKey.true) then
0135 Reg.WriteString('x'+SysPad(logln,9), log);
0136 lnc(logln)
0137 except
0138 end;
0139 try
0140 Reg.Writelnteger('ln', Login)
0141 {Reg.WritelntegerCOuf, LogOut)}
0142 except
0143 end;
0144 Reg.CloseKey;
0145 Reg. Free;
0146 end; 0147 {======================================================================
0148 { Initalize / Exit }
0149 {===================================_=================================
0150 procedure Logginglnitialize;
0151 var
0152 Reg: TRegistry;
0153 sKey, sValue: string[200];
0154 iTrack: integer;
0155 st: string[3];
0156 begin 0157 try
0158 Reg := TRegistry.Create
0159 except
0160 exit
0161 end;
0162 Reg.RootKey := HKEY_LOCAL_MACHINE;
0163 sKey := '\SOFTWARE\Palantir\IQcd\'+iniAlbumHandle;
0164 try
0165 if Reg.OpenKey(sKey,true) then begin
0166 sValue := 'FirstRun';
0167 if not Reg.ValueEΞxists(sValue) then begin
0168 regFirstRun := FormatDateTime('yyyy/mm/dd-hh:nn:ss', Now);
0169 Reg.WriteString(sValue, regFirstRun)
0170 end
0171 else
0172 regFirstRun := Reg.ReadString(sValue);
0173 Reg.WriteString('Label',iniAlbumLabel);
0174 Reg.WriteString('Artist',iniAlbumArtist);
0175 Reg.WriteString('Name',iniAlbumName);
0176 Reg.WriteString('Wallpaper',iniWallpaper)
0177 end
0178 except
0179 end;
0180 Reg.RootKey := HKEY_LOCAL_MACHINE;
0181 sKey := '\SOFTWARE\Palantir\IQcd\'+iniAlbumHandle+'\lnfo';
0182 try
0183 if Reg.OpenKey(sKey.true) then begin
0184 for iTrack := 1 to iAudioTracks do begin
0185 if iTrack<10 then st := O'+lntToStr(iTrack)
0186 else st := IntToStr(iTrack);
0187 Reg.Writelnteger(st+'-Begin", iStatsTrackStart[iTrack]);
0188 Reg.Writelnteger(st+'-Length', iStatsTrackLengthfiTrack])
0189 end;
0190 Reg.Writelnteger(TotalBegin', iStatsCDStart);
0191 Reg.Writelnteger(TotalLength', iStatsCDLength)
0192 end
0193 except
0194 end;
0195 Reg.RootKey := HKEY_LOCAL_MACHINE;
0196 sKey := '\SOFTWARE\Palantir\IQcd\'+iniAlbumHandle+'\Vote';
0197 Login := 1 ; 0198 LogOut := 1 ;
0199 try
0200 if Reg.OpenKey(sKey,true) then begin
0201 if Reg.ValueExists('ln') then
0202 Login := Reg.Readlnteger('ln');
0203 if Reg.ValueExists('Out') then
0204 LogOut := Reg.Readlnteger('Out');
0205 Reg.Writelnteger('ln", login);
0206 Reg.Writelnteger('Out", logOut);
0207 if Reg.ValueExists('Sequence') then
0208 LogSeq := Reg.Readlnteger('Sequence')
0209 else
0210 Logseq := 0;
0211 Inc(LogSeq);
0212 Reg.Writelnteger('Sequence', logSeq)
0213 end
0214 except
0215 Login := 1 ;
0216 LogOut := 1 ;
0217 LogSeq := 1
0218 end;
0219 Reg.CloseKey;
0220 Reg. Free;
0221 logXevent := leNONE
0222 end;
0223 end.
0001 unit Logo;
0002 {=========================================================================}
0003 interface
0004 {========================================^
0005 {$IFDEF WINDOWS}
0006 uses
0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
0008 Forms, Dialogs,
0009 Run, Main, Tube, Bitmaps, BitBtns;
0010 {$ELSE}
0011 uses
0012 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
0013 ExtCtrls, StdCtris,
0014 Run, Main, Tube, Bitmaps, BitBtns;
0015 {$ENDIF}
0016 { }
0017 procedure Logolnitialize;
0018 procedure LogoExit;
0019 procedure LogoMouseMove(X,Y: longint);
0020 procedure LogoMouseDown;
0021 { }
0022 var
0023 bLogoDown: boolean;
0024 spriteLogo Jp, spriteLogo_Down: TSprite; 0025 {=========================================================================}
0026 implementation
0027 {=========================================================================}
0028
{======== ======================== ===================== =========}
0029 { Local Routines }
0030
{=================================== =============================== }
0031 function LogoHit(X,Y: longint): boolean;
0032 begin
0033 with spriteLogo_Up do
0034 Result := ((X>=Left) and (X<=Left+Width-1) and (Y>=Top) and (Y<=Top+Height-1))
0035 end; 0036 {=========================================================================}
0037 { Main Code }
0038
{========================================================= ============}
0039 procedure LogoMouseMove(X,Y: longint);
0040 var
0041 LogoRect: Trect;
0042 begin
0043 with spriteLogo_Up do
0044 LogoRect := Bounds(Left,Top,Width,Height);
0045 if LogoHit(X,Y) then begin
0046 if not bLogoDown then
0047 BitmapOverlay(bmpPlayer, spriteLogo_Down, TSprite(nilΛ));
0048 BitmapUpdateScreen(LogoRect);
0049 bLogoDown := true
0050 end
0051 else begin
0052 if bLogoDown then
0053 BitmapOverlay(bmpPlayer, spriteLogo_Up, TSprite(nilΛ));
0054 BitmapUpdateScreen(LogoRect);
0055 bLogoDown := false
0056 end
0057 end;
0058 { }
0059 procedure LogoMouseDown;
0060 begin
0061 if LogoHit(iMouseDownX,iMouseDownY) then
0062 frmRun.LogoClicked
0063 end;
0064
<================== ================ ======================= ====}
0065 { Initalize / Exit }
0066
0067 procedure Logolnitialize;
0068 begin
0069 BitmapCreate(spriteLogo_Up, frmMain.imgLogo_Up, true);
0070 BitmapCreate(spriteLogo_Down, frmMain.imgLogo_Down, true);
0071 bLogoDown := false
0072 end; 0073 { }
0074 procedure LogoEΞxit;
0075 begin
0076 BitmapDestroy(spriteLogo_Down);
0077 BitmapDestroy(spriteLogo_Up)
0078 end;
0079 end.
0001 unit Main;
0002 {=====================================================================
0003 interface
0004 <=====================================================================
0005 {$IFDEF WINDOWS}
0006 uses
0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
0008 Forms, Dialogs, ExtCtrls;
0009 {$ELSE}
0010 uses
0011 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
0012 ExtCtrls, StdCtris;
0013 {$ENDIF}
0014 { }
0015 type
0016 TfrmMain = class(TForm)
0017 imgExit_Up: Tlmage;
0018 imgExit_Down: Tlmage;
0019 imglnfo Jp: Tlmage;
0020 imglnfo_Down: Tlmage;
0021 imgWordsJJp: Tlmage;
0022 imgWords_Down: Tlmage;
0023 imgTracks Jp: Tlmage;
0024 imgTracks_Down: Tlmage;
0025 imgPrintJJp: Tlmage;
0026 imgPrint_Down: Tlmage;
0027 imgVideoJJp: Tlmage;
0028 imgVideo_Down: Tlmage;
0029 imgCommentary_Up: Tlmage;
0030 imgCommentary_Down: Tlmage;
0031 imgPlayJJp: Tlmage;
0032 imgPlay_Down: Tlmage;
0033 imgStop Jp: Tlmage;
0034 imgEject_Down: Tlmage;
0035 imgStop_Down: Tlmage;
0036 imgEjectJJp: Tlmage;
0037 imgRandom_UpOff: Tlmage;
0038 imgRandomJJpOn: Tlmage;
0039 imgRandom_DownOn: Tlmage; 0040 imgRandom_DownOff: Tlmage
0041 imgTime_End1 : Tlmage;
0042 imgVolume_End1 : Tlmage;
0043 imgScroll_Rod: Tlmage;
0044 imgVolume_Rod: Tlmage;
0045 imgTime_Rod: Tlmage;
0046 imgCounter: Tlmage;
0047 imgPauseJJp: Tlmage;
0048 imgResume Jp: Tlmage;
0049 imgPause_Down: Tlmage;
0050 imgResume_Down: Tlmage;
0051 imgTracks_Back: Tlmage;
0052 imgVolume_Back: Tlmage;
0053 imgScroll_Back: Tlmage;
0054 imgTime_Back: Tlmage;
0055 imgScroll_End1 : Tlmage;
0056 imgScroll_End2: Tlmage;
0057 imgScroll_Button: Tlmage;
0058 imgTime_End2: Tlmage;
0059 imgTime_Button: Tlmage;
0060 imgVolume__End2: Tlmage;
0061 imgVolume_Button: Tlmage;
0062 imgTracks_LedOn: Tlmage;
0063 imgTracks_LedOff: Tlmage;
0064 imgPlayer: Tlmage;
0065 imgLogo_Up: Tlmage;
0066 imgLogo_Down: Tlmage;
0067 imgTubeJntro: Tlmage;
0068 imgTube Text: Tlmage;
0069 imgTube_CDAbout: Tlmage;
0070 imgTube_IQAbout: Tlmage;
0071 imgMenu_Bullet: Tlmage;
0072 imgPalette: Tlmage;
0073 imgTracks_Video: Tlmage;
0074 imgTracks_Comment: Tlmage;
0075 imgTracks_Cyes: Tlmage;
0076 imgTracks_Cno: Tlmage;
0077 imgTracks_Vyes: Tlmage;
0078 imgTracks_Vno: Tlmage;
0079 imgTracks_Block: Tlmage;
0080 imgTube_Menu: Tlmage; 0081 imgTbQyes_Up: Tlmage;
0082 imgTbQyes_Down: Tlmage;
0083 imgTbQnoJJp: Tlmage;
0084 imgTbQno_Down: Tlmage;
0085 end;
0086 { }
0087 var
0088 frmMain: TfrmMain; 0089
{===== =========================================================}
0090 implementation
0091 {$R *.DFM}
0092
{------------------ ===================================================}
0093 0094 end.
SUBSTΓΓUTE SHEET (RULE 26) 0001 unit PlayList;
0002
<================= ==================================================}
0003 interface
0004
{=========================================================================}
0005 {$IFDEF WINDOWS}
0006 uses
0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
0008 Forms, Dialogs, LMDnonvS,
0009 Run, Main, CDPIayer, Tube, BitBtns, SysFig;
0010 {$ELSE}
0011 uses
0012 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
0013 ExtCtrls, StdCtris, LMDnonvS,
0014 Run, Main, CDPIayer, Tube, BitBtns, SysFig;
0015 {$ENDIF}
0016 { }
0017 procedure PlayListlnitialize;
0018 procedure PlayϋstExit;
0019 procedure PlayListNewTrack(TrackNo: longint);
0020 procedure PlayListTrackEnable(TrackNo: longint);
0021 procedure PlayListTrackDissable(TrackNo: longint);
0022 procedure PlayListMouseDown;
0023 procedure PlayListMouseMove(X,Y: longint);
0024 procedure PlayListTimerTick;
0025 { }
0026 var
0027 ThePiayList: TTubeList; 0028
<========== = ====================================================}
0029 implementation
0030
{========================= ============================================}
0031 var
0032 iHintltem: longint;
0033 iHintX, iHintY: longint;
0034 iHintDelayTimer: longint;
0035 sHintMsg: string[250];
0036 bHintVisible: boolean;
0037 blnHintArea: boolean; 0038
{=========================================================================}
0039 { Main Code }
0040 {=========================================================================}
0041 procedure PlayListNewTrackfTrackNo: longint);
0042 begin
0043 TubeSetAIINormal(ThePlayList);
0044 TubeSetHighlight(ThePlayList, TrackNo);
0045 if eTubeModeState=tmTRACKS then
0046 TubeDisplay(ThePlayList)
0047 end;
0048 { }
0049 procedure PlayListTrackEnable(TrackNo: longint);
0050 begin
0051 TubeSetEnable(ThePlayList, TrackNo);
0052 end;
0053 {- }
0054 procedure PlayListTrackDissableCTrackNo: longint);
0055 begin
0056 TubeSetDissablefThePlayList, TrackNo);
0057 frmRun. TrackDissable(TrackNo)
0058 end; 0059
0060 { Mouse Handling }
0061
{==== ===================== ========================================}
0062 procedure PlayListMouseDown;
0063 var
0064 iTrack: longint;
0065 begin
0066 if eTubeModeStateotmTRACKS then
0067 exit;
0068 iTrack := TubeltemHit(iMOuseDownX,iMOuseDownY);
0069 if iTrack>0 then begin
0070 iHintDelayTimer := 0;
0071 if bHintVisible then begin
0072 frmRun.blobHint.HideMessage;
0073 bHintVisible := false
0074 end; 0075 if bTrackEnabled[iTrack] then
0076 frmRun.TrackClicked(iTrack)
0077 end
0078 end;
0079 {- }
0080 procedure PlayListMouseMove(X,Y: longint);
0081 var
0082 iltem: longint;
0083 label
0084 exitl ;
0085 begin
0086 if eTubeModeStateotmTRACKS then
0087 goto exitl ;
0088 iHintX := frmRun.Left+X+5;
0089 iHintY := fπτιRun.Top+Y-0;
0090 iltem := TubeltemHit(X,Y);
0091 if iltem>0 then begin
0092 if iltemoiHintitem then begin
0093 if bHintVisible then begin
0094 frmRun.blobHint.HideMessage;
0095 bHintVisible := false
0096 end;
0097 iHintDelayTimer := HINT_DELAY;
0098 iHintltem := iltem
0099 end;
0100 exit
0101 end;
0102 exitl :
0103 iHintDelayTimer := 0;
0104 iHintltem := 0;
0105 if bHintVisible then begin
0106 frmRun.blobHint.HideMessage;
0107 bHintVisible := false
0108 end
0109 end;
0110 { }
0111 procedure PlayListTimerTick;
0112 begin
0113 if iHintDelayTimer=0 then
0114 exit;
0115 Dec(iHintDelayTimer); 0116 if iHintDelayTimer=0 then begin
0117 if bHintVisible then
0118 frmRun.blobHint.HideMessage;
0119 iHintLastX := iHintX;
0120 iHintLastY := iHintY;
0121 sHintLastMsg := sHintMsg;
0122 frmRun. blobHint.Position := hpAboveRight;
0123 frmRun.blobHint.ShowMessage(sHintMsg, iHintX, iHintY);
0124 bHintVisible := true
0125 end
0126 end; 0127 ======================================================================
0128 { Initalize / Exit }
0129 {======================================================================
0130 procedure PlayListlnitialize;
0131 var
0132 fTracks: TextFile;
0133 I: string[250];
0134 begin;
0135 ThePlayList.TextList := TStringList.Create;
0136 AssignFile(fTracks, sRunDirectory+'StufATracks.txt');
0137 Reset(fTracks);
0138 iAudioTracks := 0;
0139 while not Eof(fTracks) and (iAudioTracks<MAX_TRACKS) do begin
0140 Inc(iAudioTracks);
0141 ReadLn(fTracks, I);
0142 ThePlayList.TextList.AddObject(l, Pointer(iAudioTracks));
0143 end;
0144 CloseFile(fTracks);
0145 TubelnitList(spriteTubeText, ThePlayList,
0146 iTextBlockHeight div iAudioTracks, 0);
0147 sHintMsg := 'Click title to select track.';
0148 iHintltem := 0;
0149 iHintDelayTimer := 0;
0150 bHintVisible := false;
0151 blnHintArea := false
0152 end;
0153 {- }
0154 procedure PlayListEΞxit; 0155 begin
0156 TubeExitList(ThePlayList)
0157 end;
0158 end.
0001 unit QYesNo;
0002 {=========================================================================}
0003 interface
0004
0005 {$IFDEF WINDOWS}
0006 uses
0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
0008 Forms, Dialogs,
0009 Run, Main, Bitmaps, Tube, SysFig;
0010 {$ELSE}
0011 uses
0012 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
0013 ExtCtrls, StdCtris,
0014 Run, Main, Bitmaps, Tube, SysFig;
0015 {$ENDIF}
0016 { }
0017 type
0018 TProc = Procedure;
0019 { }
0020 var
0021 TheQvideo: TTubeList;
0022 TheQvote: TTubelist;
0023 { }
0024 procedure Qynlnitialize;
0025 procedure QynEΞxit;
0026 procedure QynAsk(var TubeQ: TTubeList; xYes, xNo: TProc);
0027 procedure QynMouseMove(X,Y: longint);
0028 procedure QynMouseDown;
0029 {=====================================================:
0030 implementation
0031
{=====================================================:
0032 var
0033 bYesDowπ,
0034 bNoDown: boolean;
0035 spriteQyes Jp,
0036 spriteQyes_Down,
0037 spriteQno Jp, 0038 spriteQno_Down: TSprite;
0039 qaYes, qaNO: TProc; 0040 {=======================================================================
0041 { Local Routines }
0042 <=======================================================================
0043 function QHit(var Sprite: TSprite; x,y: longint): boolean;
0044 begin
0045 with Sprite do
0046 Result := ((x>=Left) and (x<=Left+Width-1) and (y>=Top) and (y<=Top+Height-1))
0047 end;
0048 {=======================================================================
0049 { Main code }
0050
{=======================================================================
0051 procedure QynAsk(var TubeQ: TTubeList; xYes, xNo: TProc);
0052 begin
0053 TubeDisplayfTubeQ);
0054 eTubeModeState := tmQYN;
0055 BitmapDraw(spriteQyes_Up);
0056 BitmapDraw(spriteQno_Up);
0057 qaYes := xYes;
0058 qaNo := xNo;
0059 bYesDown := false;
0060 bNoDown := false
0061 end; 0062 {=======================================================================
0063 { Mouse support }
0064
{================================================ ===================
0065 procedure QynMouseMove(X,Y: longint);
0066 begin
0067 if eTubeModeStateotmQYN then
0068 exit;
0069 if QHit(spriteQyes_Up, x, y) then begin
0070 if not bYesDown then begin
0071 BitmapDraw(spriteQyes_Down);
0072 bYesDown := true 0073 end
0074 end
0075 else begin
0076 if bYesDown then begin
0077 BitmapDraw(spriteQyes_Up);
0078 bYesDown := false
0079 end
0080 end;
0081 if QHit(spriteQno_Up, x, y) then begin
0082 if not bNoDown then begin
0083 BitmapDraw(spriteQno_Down);
0084 bNoDown := true
0085 end
0086 end
0087 else begin
0088 if bNoDown then begin
0089 BitmapDraw(spriteQno_Up);
0090 bNoDown := false
0091 end
0092 end
0093 end;
0094 { }
0095 procedure QynMouseDown;
0096 begin
0097 if eTubeModeStateotmQYN then
0098 exit;
0099 if BitmapHit(spriteQyesJJp) then
0100 qaYes;
0101 if BitmapHit(spriteQno_Up) then
0102 qaNo;
0103 end; 0104
{======================================================================:
0105 { Initalize / Exit }
0106 {======================================================================
0107 procedure Qynlnitialize;
0108 var
0109 fQ: TextFile;
0110 I: string[250];
0111 begin 0112 BitmapCreate(spriteQyes_Up, frmMain.imgTbQyes_Up, false);
0113 BitmapCreate(spriteQyes_Down, frmMain.imgTbQyes_Down, false);
0114 BitmapCreate(spriteQno_Up, frmMain.imgTbQno_Up, false);
0115 BitmapCreate(spriteQno_Down, frmMain.imgTbQno_Down, false);
0116 TheQvideo.TextList := TStringList.Create;
0117 AssignFile(fQ, sRunDirectory+'StuffXQmovie.txt');
0118 Reset(fQ);
0119 while not Eof(fQ) do begin
0120 ReadLn(fQ, I);
0121 TheQvideo.TextList. AddObject(l, Pointer(O));
0122 end;
0123 CloseFile(fQ);
0124 TubelnitList(spriteTubeText, TheQvideo, -3, 0);
0125 TheQvote.TextList := TStringList.Create;
0126 AssignFile(fQ, sRunDirectory+'StufAQvote.txt');
0127 Reset(fQ);
0128 while not Eof(fQ) do begin
0129 ReadLn(fQ, I);
0130 TheQvote.TextList.AddObject(l, Pointer(O));
0131 end;
0132 CloseFile(fQ);
0133 TubelnitList(spriteTubeText, TheQvote, -3, 0);
0134 bYesDown := false;
0135 bNoDown := false
0136 end;
0137 { }
0138 procedure QynEΞxit;
0139 begin
0140 BitmapDestroy(spriteQyesJJp);
0141 BitmapDestroy(spriteQyes_Down);
0142 BitmapDestroy(spriteQno_Up);
0143 BitmapDestroy(spriteQno_Down);
0144 TubeEΞxitList(TheQvote);
0145 TubeExitList(TheQvideo)
0146 end;
0147 end. 0001 unit RegFig;
0002 {=========================================================================}
0003 interface
0004 {=========================================================================}
0005 {$IFDEF WINDOWS}
0006 uses
0007 Forms, WinTypes, WinProcs, SysUtils, Messages, Classes, Controls, Inifiles,
0008 Run, IniFig;
0009 {$ELSE}
0010 uses
0011 Forms, Windows, SysUtils, Messages, Classes, Controls, IniFiles, Registry,
0012 Run, IniFig;
0013 {$ENDIF}
0014 { }
0015 function RegFigLoad: boolean;
0016 procedure RegFigUpdate;
0017 { }
0018 var
0019 regHasTargetPage,
0020 regVoteEnabled,
0021 reglnfoEnabled,
0022 regVideoAsked,
0023 regVoteAsked,
0024 reglntroPlayed,
0025 reglnfoSent: boolean;
0026 regHandle: string[20];
0027 regZip,
0028 regAge,
0029 regSex: string[20]; 0030 {=========================================================================}
0031 implementation
0032
{=================================== = ===========================>
0033 function RegFigLoad: boolean;
0034 var
0035 Reg: TRegistry;
0036 sKey, sValue: string[200];
0037 n: integer; 0038 begin
0039 result := false;
0040 try
0041 Reg := TRegistry.Create
0042 except
0043 exit
0044 end;
0045 regHandle := ";
0046 Reg.RootKey := HKEY_LOCAL_MACHINE;
0047 sKey := •\SOFTWARE\Palantir';
0048 try
0049 if Reg.OpenKey(sKey.true) then begin
0050 sValue := "Handle';
0051 if Reg.ValueExists(sValue) then
0052 regHandle := Reg.ReadString(sValue)
0053 else begin
0054 for n := 1 to 10 do
0055 regHandle := regHandle + Chr(Random(26)+Ord('A'));
0056 Reg.WriteString(sValue, regHandle)
0057 end
0058 end
0059 except
0060 end;
0061 regZip := O0000";
0062 regAge := '00';
0063 regSex := '?';
0064 Reg.RootKey := HKEY_LOCAL_MACHINE;
0065 sKey := '\SOFTWARE\Palantir\User";
0066 try
0067 if Reg.OpenKey(sKey,true) then begin
0068 sValue := "Zip";
0069 if Reg.ValueE≡xists(sValue) then
0070 regZip := Reg.ReadString(sValue);
0071 sValue := 'Age';
0072 if Reg.ValueExists(sValue) then
0073 regAge := Reg.ReadString(sValue);
0074 sValue := 'Sex';
0075 if Reg.ValueExists(sValue) then
0076 regSex := Reg.ReadString(sValue)
0077 end
0078 except 0079 end;
0080
0081 Reg.RootKey := HKEY_LOCAL_MACHINE;
0082 sKey := '\SOFTWARE\Palantir\IQcd\'+iniAlbumHandie+'\Flags';
0083 try
0084 if Reg.OpenKey(sKey,true) then begin
0085 sValue := 'IntroPlayed';
0086 if Reg.ValueExists(sValue) then
0087 reglntroPlayed := Reg.ReadBool(sValue)
0088 else
0089 reglntroPlayed := false;
0090 sValue := 'VideoAsked';
0091 if Reg.ValueExists(sValue) then
0092 regVideoAsked := Reg.ReadBool(sValue)
0093 else
0094 regVideoAsked := false;
0095 sValue := 'VoteAsked';
0096 if Reg.ValueExists(sValue) then
0097 regVoteAsked := Reg.ReadBool(sValue)
0098 else
0099 regVoteAsked := false;
0100 sValue := 'InfoSent';
0101 if Reg. ValueExists(sValue) then
0102 reglnfoSent := Reg.ReadBool(sValue)
0103 else
0104 reglnfoSent := false;
0105 sValue := 'VoteEnabled';
0106 if Reg.ValueExists(sValue) then
0107 regVoteEnabled := Reg.ReadBool(sValue)
0108 else
0109 regVoteEnabled := false;
0110 sValue := 'InfoEnabled';
0111 if Reg.ValueExists(sValue) then
0112 reglnfoEnabled := Reg.ReadBool(sValue)
0113 else
0114 reglnfoEnabled := false;
0115 sValue := TargetPage';
0116 if Reg.ValueExists(sValue) then
0117 regHasTargetPage := Reg.ReadBool(sValue)
0118 else
0119 regHasTargetPage := false; 0120 end
0121 except
0122 end;
0123 Reg. Free;
0124 result := true
0125 end;
0126 { -}
0127 procedure RegFigUpdate;
0128 var
0129 Reg: TRegistry;
0130 sKey: string[200];
0131 begin
0132 try
0133 Reg := TRegistry.Create
0134 except
0135 exit
0136 end;
0137 Reg.RootKey := HKEY_LOCAL_MACHINE;
0138 sKey := '\SOFTWARE\Palantir\IQcdV+iniAlbumHandle+'\Flags';
0139 try
0140 if Reg.OpenKey(sKey.true) then begin
0141 Reg.WriteBoolCVoteEnabled', regVoteEnabled);
0142 Reg.WriteBool('lnfoEnabled', reglnfoEnabled);
0143 Reg.WriteBool('lntroPlayed', reglntroPlayed);
0144 Reg.WriteBool('VideoAsked', regVideoAsked);
0145 Reg.WriteBool('VoteAsked', regVoteAsked);
0146 if iniSendlnfo=qfALWAYS then
0147 Reg.WriteBool('lnfoSent', reglnfoSent)
0148 end
0149 except
0150 end;
0151 Reg.Free
0152 end;
0153 end. 0001 unit Regions;
0002
{====== =============================================================}
0003 interface
0004
{========================================================= ============}
0005 {$IFDEF WINDOWS}
0006 uses
0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
0008 Forms, Dialogs,
0009 Run, Main;
0010 {$ELSE}
0011 uses
0012 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
0013 ExtCtrls, StdCtris,
0014 Run, Main;
0015 {$ENDIF}
0016 { }
0017 procedure Outlinelmage(lmageCanvas: TCanvas;
0018 iCanvasHeight, iCanvasWidth: longint;
0019 var PolygonRegion: hRGN); 0020 {=========================================================================}
0021 implementation
0022
{============== ======================================================}
0023 type
0024 POINT = record
0025 x: longint;
0026 y: longint;
0027 end;
0028 {- }
0029 const
0030 iScanX: array [0..9] of longint = (-1 , -1 , 0, +1 , +1 , +1 , 0, -1 , -1 , -1 );
0031 iScanY: array [0..9] of longint = ( 0, -1 , -1 , -1 , 0, +1 , +1 , +1 , 0, -1 );
0032 { }
0033 var
0034 tOutline: array [0..1000] of POINT;
0035 WorkingCanvas: TCanvas;
0036 iCanvasMaxX, iCanvasMaxY: longint;
0037 iFirstPixelX, iFirstPixelY: longint; 0038 iLastPixelX, iLastPixelY: longint;
0039 iLastDirection: longint;
0040 iPixelX, iPixelY: longint;
0041 iDirection: longint;
0042 { }
0043 procedure FindFirstPixel; forward;
0044 procedure FindNextPixel; forward;
0045 procedure FindPixel(iAtX, iAtY: longint); forward;
0046
{=== ============ ==================================================}
0047 { Code }
0048
{=========================================================================}
0049 procedure Outlinelmage(lmageCanvas: TCanvas;
0050 iCanvasHeight, iCanvasWidth: longint;
0051 var PolygonRegion: hRGN);
0052 var
0053 iPoints: longint;
0054 begin
0055 WorkingCanvas := ImageCanvas;
0056 iCanvasMaxX := iCanvasWidth-1 ;
0057 iCanvasMaxY := iCanvasHeight-1 ;
0058 FindFirstPixel;
0059 tOutline[0].X := iFirstPixelX;
0060 tOutline[0].Y := iFirstPixelY;
0061 iPoints := 1 ;
0062 FindPixel( iFirstPixelX, iFirstPixelY);
0063 repeat
0064 FindNextPixel;
0065 if iDirectionoiLastDirection then begin
0066 tOutline[iPoints].X := iLastPixelX;
0067 tOutline[iPoints].Y := iLastPixelY;
0068 iPoints := iPoints+1 ;
0069 end
0070 until (iPixelX=iFirstPixelX) and (iPixelY=iFirstPixelY);
0071 PolygonRegion := CreatePolygonRgn( tOutline, iPoints, WINDING);
0072 end;
0073 { }
0074 procedure FindFirstPixel;
0075 var
0076 x: longint; 0077 CanvasDC: HDC;
0078 begin
0079 CanvasDC := WorkingCanvas.Handle;
0080 For x := 1 to iCanvasMaxX do
0081 if GetPixel(CanvasDC,x,x)<>TRANSPARENT_COLOR then break;
0082 if x>=iCanvasMaxX then
0083 frmRun.SevereError('FindFirstPixel - Image not found!');
0084 FindPixel( x, x);
0085 iFirstPixelX := iPixelX;
0086 iFirstPixelY := iPixelY;
0087 end;
0088 { }
0089 procedure FindNextPixel;
0090 begin
0091 FindPixel( iPixelX, iPixelY)
0092 {var
0093 x1 , x, y1 , y: longint;
0094 label
0095 Find_Pixel,
0096 Got_Pixel;
0097 begin
0098 CanvasDC := WorkingCanvas.handle;
0099 x1 := iPixelX+iScanX[iDirection];
0100 y1 := iPixelY+iScanY[iDirection];
0101 if (x1<0) or (x1>iCanvasMaxX) or (y1<0) or (y1>iCanvasMaxY) then goto Find_Pixel;
0102 if GetPixel(CanvasDC,x1 ,y1)=TRANSPARENT_COLOR then goto Find_Pixel;
0103 x := iPixelX+iScanX[iDirection-1];
0104 y := iPixelY+iScanY[iDirection-1];
0105 if (x<0) or (x>iCanvasMaxX) or (y<0) or (y>iCanvasMaxY) then goto Got_Pixel;
0106 if GetPixel(CanvasDC,x,y)=TRANSPARENT_COLOR then goto Got_Pixel;
0107 Find_Pixel:
0108 FindPixel( iPixelX, iPixelY);
0109 exit;
0110 Got_Pixel:
0111 iPixelX := x1 ;
0112 iPixelY := y1 ;}
0113 end;
0114 { }
0115 procedure FindPixel(iAtX, iAtY: longint);
0116 var
0117 d: Integer; 0118 bPixell , bPixel2: boolean;
0119 CanvasDC: HDC;
0120 begin
0121 iLastPixelX := iPixelX;
0122 iLastPixelY := iPixelY;
0123 iLastDirection := iDirection;
0124 bPixell := false; {kill compiler warning}
0125 CanvasDC := WorkingCanvas.handle;
0126 for d := 1 to 9 do begin
0127 iPixelX := iAtX+iScanX[d];
0128 iPixelY := iAtY+iScanY[d];
0129 if (iPixelX>=0) and (iPixelX<=iCanvasMaxX) and
0130 (iPixelY>=0) and (iPixelY<=iCanvasMaxY) then
0131 bPixel2 := (GetPixel(CanvasDC,iPixelX,iPixelY)<>TRANSPARENT_COLOR)
0132 else
0133 bPixel2 := False;
0134 if d>1 then
0135 if bPixel2 and (Not bPixell) then
0136 break;
0137 bPixeh := bPixel2
0138 end;
0139 iDirection := d;
0140 if iDirection>9 then
0141 frmRun. SevereError('FindPixel - not found!')
0142 end;
0143 end.
0001 unit Run;
0002 {$DEFINE KILLERASE} 0003 {=========================================================================}
0004 interface
0005
{=========== ==================================================== }
0006 {$IFDEF WINDOWS}
0007 uses
0008 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
0009 Forms, Dialogs, StdCtris, ExtCtrls, MPIayer, ComCtrls, ShellAPI,
0010 xPrgExec, xFCopy, LMDnonvS, LMDclass, LMDctri, LMDmmS, LMDwave;
0011 {$ELSE}
0012 uses
0013 SysUtils, Windows, Messages, Classes, Graphics, Controls,
0014 Forms, Dialogs, StdCtris, ExtCtrls, MPIayer, ComCtrls, ShellAPI,
0015 xPrgExec, xFCopy, LMDnonvS, LMDclass, LMDctri, LMDmmS, LMDwave;
0016 {$ENDIF}
0017 { }
0018 const
0019 UM_REΞALSTART = WMJJSER+1 ;
0020 TEXT_NORMAL = clBlack;
0021 TEXT HIGHLIGHT = clWhite;
0022 TEXT_DISSABLED = $006F6470;
0023 { }
0024 type
0025 TfrmRun = class(TForm)
0026 tmTimer: TTimer;
0027 mmCDPIayer: TMediaPlayer;
0028 PrintDialog: TPrintDialog;
0029 mmCommentary: TMediaPlayer;
0030 Run: TxProgEΞxec;
0031 FileCopier: TxFileCopy;
0032 ProgressBar: TProgressBar;
0033 blobMessage: TLMDMessageHint;
0034 waveSorry: TLMDWaveComp;
0035 Onelnstance: TLMDOnelnstance;
0036 blobHlnt: TLMDMessageHint;
0037 waveByeBye: TLMDWaveComp;
0038 wavelnstallingWallpaper: TLMDWaveComp;
0039 wavelnstallingSaver: TLMDWaveComp; 0040 { }
0041 procedure FormCreate(Sender: TObject);
0042 procedure FormClose(Sender: TObject; var Action: TCIoseAction);
0043 procedure FormPaint(Sender: TObject);
0044 procedure RunMouseDown(Sender: TObject; Button: TMouseButton;
0045 Shift: TShiftState; X, Y: Integer);
0046 procedure RunMouseUp(Sender: TObject; Button: TMouseButton;
0047 Shift: TShiftState; X, Y: Integer);
0048 procedure RunMouseMove(Sender: TObject;
0049 Shift: TShiftState; X, Y: Integer);
0050 procedure tmTimerTick(Sender: TObject);
0051 procedure RunAfterExec(Sender: TObject);
0052 procedure FileCopierNotify(Sender: TObject);
0053 procedure mmCommentaryNotify(Sender: TObject);
0054 { }
0055 function NextTrack(TrackFrom: Integer): longint;
0056 procedure PlayNextTrack(TrackFrom: Integer);
0057 procedure GoCopyFile(FileFrom, FileTo: string);
0058 { }
0059 procedure PlayPressed;
0060 procedure PausePressed;
0061 procedure ResumePressed;
0062 procedure StopPressed;
0063 procedure EjectPressed;
0064 procedure VideoPressed;
0065 procedure CommentaryPressed;
0066 procedure PrintPressed;
0067 procedure ExitPressed;
0068 procedure ModeSetlnfo;
0069 procedure ModeSetWords;
0070 procedure ModeSetTracks;
0071 procedure LogoClicked;
0072 procedure MenuClicked(Menultem: longint);
0073 procedure TrackClicked(Track: longint);
0074 procedure WordsClicked(WordTime: longint);
0075 procedure SetTrackfJrackNo: longint);
0076 procedure TrackDissablefJrackNo: longint);
0077 procedure TimeMoveStart;
0078 procedure TimeMoveEnd;
0079 procedure MouseEnable;
0080 procedure MouseDissable; 0081 function NoVideo: boolean;
0082 procedure ErrorMessage(const msg: string);
0083 procedure SevereError(const msg: string);
0084 private
0085 procedure ldleProcess(Sender: TObject; var Done: Boolean);
0086 procedure DefaultException(Sender: TObject; E: Exception);
0087 procedure RealStart(var Msg: TMessage);
0088 message UM_REALSTART;
0089 {$IFDEF KILLERASE}
0090 procedure FormErase(var Msg: TWMEraseBkgnd);
0091 message WM_EraseBkgnd;
0092 {$ENDIF}
0093 end;
0094 { }
0095 const
0096 MAX_TRACKS = 20;
0097 UNKNOWN = 0;
0098 FORCE_FIRST = 9999;
0099 MENU_NORMALIZETIME = 5;
0100 DELAYJNTROVIDEO = 5;
0101 SCROLL_DELAY = 40;
0102 HINT_DELAY = 15;
0103 MCITODISPLAY_HOLDOFF = 3;
0104 TRANSPARENT_COLOR = clRed;
0105 WINDOWCOLOR_16BIT = clBackground;
0106 { }
0107 var
0108 frmRun: TfrmRun;
0109 bmpPlayer: TBitmap;
0110 bmpPalette: TBitmap;
0111 bMouseEnabled: boolean;
0112 iMouseDownX, iMouseDownY: longint;
0113 bqAskVideo,
0114 bqAskVote: boolean;
0115 bqPlaylntro: boolean;
0116 iDeiaylntroVideo: longint;
0117 iMenuNormalizeTimer,
0118 iErrorMessageTimer: longint;
0119 iLastTrackNo: longint;
0120 ePlayButtonState: (bsPLAY, bsPAUSE, bsRESUME);
0121 eStopButtonState: (bsEJECT, bsSTOP); 0122 eRandomButtonState: (bsRANDOMJDN, bsRANDOMJDFF);
0123 eTubeModeState: (tmlNTRO, tmMENU, tmABOUT, tmlQABOUT, tmTRACKS, tm WORDS, tmlNFO, tmQYN);
0124 bStopPaint: boolean;
0125 iHintLastX, iHintLastY: longint;
0126 sHintLastMsg: string[250];
0127 bHintsEnabled: boolean;
0128 sCurrentWall: string[100];
0129 sCurτentTile: string[100];
0130 sCurrentSaver: string[100];
0131 { }
0132 procedure qaVideoYes; forward;
0133 procedure qaVideoNo; forward;
0134 procedure qaVoteYes; forward;
0135 procedure qaVoteNo; forward;
0136 procedure qaNextl ; forward;
0137 procedure qaNext2; forward;
0138 procedure qaNext3; forward; 0139 {=========================================================================}
0140 implementation
0141 {$R *.DFM} 0142
{========== === ============================================== ===}
0143 uses
0144 Main, Playϋst, Tracks, Words, Info,
0145 QYesNo, TrkMedia, ScrolBar, TimeBar, VolumBar,
0146 Regions, Bitmaps, BitBtns, BitBars, Sysfig,
0147 Tube, Video, Comment, Counter, Logo, Inifig,
0148 IQMenu, IQAbout, CDPIayer, Wall, Saver,
0149 RegFig, Logging;
0150 { }
0151 var
0152 bMouseDown: boolean;
0153 iLastMouseX: longint = -1 ;
0154 iLastMouseY: longint = -1 ;
0155 Thelntro: TTubeList;
0156 bQvideo, bQvote: boolean;
0157 {=========================================================================}
0158 { Utility Routines } 0159 {=============================================================
0160 { }
0161 function TfrmRun.NextTrack(TrackFrom: longint): longint;
0162 var
0163 iTrack, iTracksEnabled: longint;
0164 iTrackl , iTrack2: longint;
0165 begin
0166 iTracksEnabled := 0;
0167 for iTrack := 1 to iAudioTracks do
0168 if bTrackEnabled[iTrack] then
0169 Inc(iTracksEnabled);
0170 iTrack2 := 0;
0171 for iTrackl := TrackFrom to iAudioTracks do
0172 if bTrackEnabled[iTrack1 ] then begin
0173 iTrack2 := iTrackl ;
0174 break
0175 end;
0176 if iTrack2=0 then
0177 for iTrackl := 1 to TrackFrom-1 do
0178 if bTrackEnabled[iTrack1 ] then begin
0179 iTrack2 := iTrackl ;
0180 break
0181 end;
0182 if iTrack2=0 then begin
0183 SevereError('PlayNextTrack: all tracks dissabled!');
0184 Result := 1 ;
0185 exit
0186 end;
0187 if (eRandomButtonState=bsRANDOM_ON) and (iTracksEnabled> 1 ) then
0188 repeat
0189 iTrack2 := Random(iAudioTracks)+1
0190 until bTrackEnabled[iTrack2] and (iTrack2<>TrackFrom);
0191 Result := iTrack2;
0192 end;
0193 { }
0194 procedure TfrmRun.PlayNextTrack(TrackFrom: Integer);
0195 begin
0196 SetTrack(NextTrack(TrackFrom));
0197 PlayerPlay(lsNEXT, iLastTrackNo)
0198 end; 0199 { }
0200 procedure TfrmRun.GoCopyFile(FileFrom, FileTo: string);
0201 begin
0202 MouseDissabie;
0203 with FileCopier do begin
0204 ProgressBar.Show;
0205 SourceFile := FileFrom;
0206 TargetFile := FileTo;
0207 EΞxecute
0208 end;
0209 MouseEnable;
0210 end;
0211 {- }
0212 procedure TfrmRun.FileCopierNotify(Sender: TObject);
0213 begin
0214 if FileCopier.Percent>=100 then
0215 ProgressBar.Hide
0216 else
0217 ProgressBar.Position := FileCopier. Percent
0218 end;
0219 { }
0220 procedure TfrmRun.mmCommentaryNotify(Sender: TObject);
0221 begin
0222 CommentaryNotify;
0223 end;
0224 <======================================================================
0225 { Process button press }
0226
{======================================================================
0227 procedure TfrmRun.PlayPressed;
0228 begin
0229 VideoStop;
0230 CommentaryStop;
0231 PlayerPlay(lsPLAY, TimeBarGetPosition)
0232 end;
0233 { }
0234 procedure TfrmRun.PausePressed;
0235 begin
0236 VideoStop;
0237 CommentaryStop; 0238 TimeBarPosition(iPausedTime) ;
0239 PlayerPause
0240 end;
0241 {- }
0242 procedure TfrmRun.ResumePressed;
0243 begin
0244 VideoStop;
0245 CommentaryStop;
0246 TimeBarPosition(iPausedTime);
0247 PlayerResume
0248 end;
0249 { }
0250 procedure TfrmRun.StopPressed;
0251 begin
0252 VideoStop;
0253 CommentaryStop;
0254 PlayerStop
0255 end;
U_. U γ. .
0257 procedure TfrmRun.EjectPressed;
0258 begin
0259 PlayerStop;
0260 VideoStop;
0261 CommentaryStop;
0262 PlayerEject;
0263 EΞxitPressed
0264 end;
0265 / - ;}
0266 procedure TfrmRun.PrintPressed;
0267 begin
0268 TubePrint
0269 end;
0270 { }
0271 procedure TfrmRun.VideoPressed;
0272 begin
0273 if NoVideo then
0274 exit;
0275 if not bVideoAvailable[iLastTrackNo] then begin
0276 ErτorMessage(This track does not have a video clip, sorry.');
0277 exit
0278 end; 0279 if eCDPIayerState=psPLAYING then begin
0280 ButtonsForcePause;
0281 PlayerPause
0282 end;
0283 VideoStop;
0284 CommentaryStop;
0285 VideoPlay(iLastTrackNo, nil)
0286 end;
0287 . }
0288 procedure TfrmRun.CommentaryPressed;
0289 begin
0290 if not bCommentaryAvailable[iLastTrackNo] then begin
0291 ErrorMessage(This track does not have a commentary, sorry.');
0292 exit
0293 end;
0294 if eCDPIayerState=psPLAYING then begin
0295 ButtonsForcePause;
0296 PlayerPause
0297 end;
0298 VideoStop;
0299 CommentaryStop;
0300 CommentaryPlay(iLastTrackNo)
0301 end;
0302 { }
0303 procedure TfrmRun.ExitPressed;
0304 begin
0305 VideoStop;
0306 CommentaryStop;
0307 TubeDisplay(Thelntro);
0308 eTubeModeState := tmlntro;
0309 PlayerStop;
0310 if iniPlayByeBye then
0311 frmRun.waveByeBye.PlaySound(sdSync);
0312 Close
0313 end; 0314 {========================================================
0315 { Process mode changes }
0316 {=====================================:-.==================
0317 procedure TfrmRun.ModeSetlnfo; 0318 begin
0319 VideoStop;
0320 CommentaryStop;
0321 TubeSetTopLine(Thelnfo[iLastTrackNo], 1);
0322 TubeDisplay(Thelnfo[iLastTrackNo]);
0323 MediaDraw(iLastTrackNo)
0324 end;
0325 { }
0326 procedure TfrmRun.ModeSetWords;
0327 begin
0328 VideoStop;
0329 CommentaryStop;
0330 TubeDisplay(TheWords[iLastTrackNo]);
0331 MediaDraw(iLastTrackNo)
0332 end;
0333 { }
0334 procedure TfrmRun.ModeSetTracks;
0335 begin
0336 VideoStop;
0337 CommentaryStop;
0338 TubeDisplay(ThePlayList);
0339 MediaDraw(iLastTrackNo)
0340 end;
0341 {======================================================================
0342 { Process Logo / Menu mouse click }
0343
{======================================================================
0344 procedure TfrmRun.LogoClicked;
0345 begin
0346 VideoStop;
0347 CommentaryStop;
0348 ButtonsForceNone;
0349 if eTubeModeState=tmMenu then begin
0350 TubeDisplay(Thelntro);
0351 eTubeModeState := tmintro
0352 end
0353 else begin
0354 iMenuNormalizeTimer := 0;
0355 TubeSetAIINormal(TheMenu);
0356 TubeDisplay(TheMenu); 0357 eTubeModeState := tmMenu
0358 end
0359 end;
0360 { }
0361 procedure TfrmRun.MenuClicked(Menultem: longint);
0362 begin
0363 MenuHighlightltem(Menultem);
0364 iMenuNormalizeTimer := MENU_NORMALIZETIME;
0365 case Menultem of
0366 1 : begin
0367 ButtonsForceNone;
0368 eTubeModeState := tmABOUT;
0369 TubeDisplay(TheCDAbout)
0370 end;
0371 2: begin
0372 ButtonsForceNone;
0373 eTubeModeState := tmlQABOUT;
0374 TubeDisplay(ThelQAbout)
0375 end;
0376 3: begin
0377 if eCDPIayerState=psPLAYING then begin
0378 PlayerPause;
0379 ButtonsForcePause
0380 end;
0381 VideoStop;
0382 CommentaryStop;
0383 VideoPlay(INTROVIDEO, nil);
0384 reglntroPlayed := true
0385 end;
0386 4: begin
0387 if UsingOurWallpaper and
0388 not UsingThisWallpaper(startWallpaperName) then begin
0389 sCurrentWall := startWailpaperName;
0390 sCurrentTile := startWallpaperTile
0391 end
0392 else begin
0393 wavelnstallingWallpaper.Play;
0394 GoCopyFile(sRunDirectory+'StufT\Wall.bmp',
0395 sWindowsDirectory+iniWallpaper+'.bmp');
0396 sCurrentWall := sWindowsDirectory+iniWallpaper+'.bmp';
0397 sCurrentTile := '0' 0398 end;
0399 SetWallpaper(sCurrentWall, sCurrentTile);
0400 MenuUpdate
0401 end;
0402 5: begin
0403 if UsingOurSaver and not UsingThisSaver(startScreenSaver) then
0404 sCurrentSaver := startScreenSaver
0405 else begin
0406 wavelnstallingSaver.Play;
0407 GoCopyFile(sRunDirectory+ 'Stuff\Saver.exe',
0408 sSystemDirectory+iniScreenSaver+'.scr');
0409 sCurrentSaver := sSystemDirectory+iniScreenSaver+'.scr'
0410 end;
0411 SetSaver(sCurrentSaver);
0412 MenuUpdate
0413 end;
0414 6: begin
0415 VideoStop;
0416 CommentaryStop;
0417 ButtonsForceStop;
0418 StopPressed;
0419 Run.CmdLine := sRunDirectory+'Stuf WebLink.exe';
0420 if Run.Execute then
0421 {$IFDEF WINDOWS}
0422 WindowState := TWindowState(wsMinimized)
0423 {$ELSE}
0424 Application. inimize
0425 {$ENDIF}
0426 else
0427 ErrorMessage('Unable to run Web Link installer!')
0428 end;
0429 7: begin
0430 if UsingWallpaper then begin
0431 GetWallpaper(sCurrentWall, sCurrentTile);
0432 SetWallpaper(", '0')
0433 end
0434 else
0435 SetWallpaper(sCurrentWall, sCurrentTile);
0436 MenuUpdate
0437 end;
0438 8: begin 0439 VideoStop;
0440 CommentaryStop;
0441 ButtonsForceStop; -
0442 StopPressed;
0443 Run.CmdLine := sRunDirectory+'StufAActMovie.exe';
0444 if Run. Execute then
0445 {$IFDEF WINDOWS}
0446 WindowState := TWindowState(wsMinimized)
0447 {$ELSE}
0448 Application. Minimize
0449 {$ENDIF}
0450 else
0451 ErrorMessage('Unable to Install Active Movie!')
0452 end;
0453 9: begin
0454 bHintsEnabled := not bHintsEnabled;
0455 MenuUpdate
0456 end;
0457 10: ShellExecute(frmRun.Handle,
0458 'Open', 'http://www.baconbros.com/',
0459 nil, nil, SW_SHOWNORMAL)
0460 else
0461 SevereError('MenuClicked - invalid item!')
0462 end
0463 end; 0464
{=====================================================:
0465 { Process Tracks/Words mouse click }
0466
{======================================================
0467 procedure TfrmRun.TrackClicked(Track: longint);
0468 begin
0469 if eCDPIayerState=psPAUSED then begin
0470 ButtonsForceStop;
0471 StopPressed
0472 end;
0473 {if eCDPIayerState=psPLAYING then}
0474 SetTrackiTrack);
0475 if eCDPIayerState=psPLAYING then begin
0476 ButtonsForcePlay;
0477 PlayerPlay(lsTRACK, 0) 0478 end
0479 end;
0480 { }
0481 procedure TfrmRun.WordsClicked(WordTime: longint);
0482 begin
0483 if eCDPIayerState=psPLAYING then
0484 ScrollBarStartDelay;
0485 TimeBarPosition(WordTime);
0486 if eCDPIayerState=psPLAYING then begin
0487 ButtonsForcePlay;
0488 PlayerPlay(lsWORDS, WordTime)
0489 end
0490 end;
0491 { }
0492 procedure TfrmRun.SetTrack(TrackNo: longint);
0493 begin
0494 if TrackNooiLastTrackNo then begin
0495 TimeBarNewTrack(TrackNo);
0496 PlayListNewTracktTrackNo);
0497 TracksNewTrack(TrackNo);
0498 WordsNewTracktTrackNo);
0499 lnfoNewTrack(TrackNo);
0500 MediaNewTrack(TrackNo);
0501 iLastTrackNo := TrackNo
0502 end
0503 end;
0504 { }
0505 procedure TfrmRun.TrackDissable(TrackNo: longint);
0506 begin
0507 if iLastTrackNo=TrackNo then
0508 if eCDPIayerState=psPLAYING then
0509 PlayNextTrack(TrackNo+1)
0510 else
0511 SetTrack(NextTrack(TrackNo+1))
0512 end; 0513 {=========================================================================}
0514 { Process mouse moved bars }
0515
{=========================================================================}
0516 procedure TfrmRun.TimeMoveStart; 0517 begin
0518 if eCDPIayerState=psPLAYING then begin
0519 ButtonsForcePause;
0520 PlayerPause
0521 end
0522 else if eCDPIayerState=psPAUSED then begin
0523 ButtonsForceStop;
0524 PlayerStop
0525 end
0526 end;
0527 { }
0528 procedure TfrmRun.TimeMoveEnd;
0529 begin
0530 if eCDPIayerState=psPAUSED then begin
0531 ButtonsForcePlay;
0532 PlayerPlay(lsTIMEBAR, TimeBarGetPosition)
0533 end
0534 end; 0535 {======================================================================
0536 { Backround processing }
0537 ======================================================================
0538 procedure TfrmRun.ldleProcess(Sender: TObject; var Done: Boolean);
0539 var
0540 iTrack, iTime: longint;
0541 label
0542 exitl ;
0543 begin
0544 VolumeBackgroundProcess;
0545 if (eCDPIayerState=psPLAYING) and (mmCDPIayer.Mode=mpOPEN) then begin
0546 PlayerStop;
0547 ButtonsForceStop;
0548 eCDPIayerState := psNOCD;
0549 Close;
0550 goto exitl
0551 end;
0552 if eCDPIayerState=psPLAYING then begin
0553 PlayerGetTrackAndTime(iTrack,iTime);
0554 if (mmCDPIayer.Mode=mpStopped) and (iTrack=iAudioTracks) then begin
0555 PlayNextTrack(l); 0556 goto exitl
0557 end;
0558 if (iTrackoiLastTrackNo) and (iHoldOffUpdate=0) then
0559 if (iTrack>=1) and (iTrack<=iAudioTracks) then begin
0560 if bTrackEnabled[iTrack] then
0561 if (eRandomButtonState=bsRANDOM_OFF) then
0562 SetTrack(iTrack)
0563 else begin
0564 PlayNextTrack(iTrack);
0565 iTrack := 0
0566 end
0567 else begin
0568 PlayNextTrack(iTrack+1);
0569 iTrack := 0
0570 end
0571 end;
0572 If iTrack=iLastTrackNo then
0573 TimeBarPosition(iTime)
0574 end;
0575 exitl :
0576 Done := true
0577 end;
0578 { }
0579 procedure IntroDone;
0580 begin
0581 reglntroPlayed := true;
0582 qaNext2
0583 end;
0584 { }
0585 procedure TfrmRun.tmTimerTick(Sender: TObject);
0586 begin
0587 if iErrorMessageTimer>0 then begin
0588 Dec(iErrorMessageTimer);
0589 if iErrorMessageTimer=0 then
0590 frmRun. blobMessage.HideMessage
0591 end;
0592 PlayerTimerTick;
0593 MenuTimerTick;
0594 TracksTimerTick;
0595 PlayListTimerTick;
0596 WordsTimerTick; 0597 ScrollBarTimerTick;
0598 TimeBarTimerTick;
0599 VolumeBarTimerTick;
0600 if not bStopPaint then begin
0601 ScrollBarTimerTick;
0602 if iMenuNormalizeTimer>0 then begin
0603 Dec(iMenuNormalizeTimer);
0604 if iMenuNormalizeTimer=0 then
0605 TubeSetAIINormal(TheMenu)
0606 end
0607 end;
0608 if iDelaylntroVideo>0 then begin
0609 Dec(iDelaylntro Video);
0610 if iDelaylntroVideo=0 then
0611 VideoPlay(INTROVIDEO, IntroDone)
0612 end;
0613 end;
0614
{=====================================================:
0615 { Process mouse click/move }
0616 {=====================================================:
0617 procedure TfrmRun.MouseEnable;
0618 begin
0619 Cursor := crArrow;
0620 bMouseEnabled := true;
0621 end;
0622 { }
0623 procedure TfrmRun.MouseDissable;
0624 begin
0625 bMouseEnabled := false;
0626 Cursor := crHourGlass;
0627 end;
0628 { }
0629 procedure TfrmRun.RunMouseDown(Sender: TObject;
0630 Button: TMouseButton; Shift: TShiftState;
0631 X, Y: Integer);
0632 begin
0633 if iE orMessageTimeroO then
0634 frmRun. blobMessage.HideMessage;
0635 if not bMouseEnabled then 0636 exit;
0637 if Button=mbLeft then begin
0638 iMouseDownX := X;
0639 iMouseDownY := Y;
0640 bMouseDown := true;
0641 ButtonsMouseDown_ExitCheck;
0642 QynMouseDown;
0643 if eTubeModeStateotmQYN then begin
0644 ButtonsMouseDown ;
0645 ScrollBarMouseDown;
0646 TimeBarMouseDown;
0647 VolumeBarMouseDown;
0648 MenuMouseDown;
0649 PlayListMouseDown;
0650 WordsMouseDown;
0651 TracksMouseDown;
0652 LogoMouseDown
0653 end
0654 end
0655 end;
0656 / }
0657 procedure TfrmRun.RunMouseUp(Sender: TObject;
0658 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
0659 begin
0660 if not bMouseEnabled then
0661 exit;
0662 ButtonsMouseUp;
0663 ScrollBarMouseUp;
0664 TimeBarMouseUp;
0665 VolumeBarMouseUp;
0666 bMouseDown := false
0667 end;
0668 {- }
0669 procedure TfrmRun.RunMouseMove(Sender: TObject;
0670 Shift: TShiftState; X, Y: Integer);
0671 begin
0672 if not bMouseEnabled then
0673 exit;
0674 if (X<0) or (X>Width-1) or (Y<0) or (Y>Height-1) then begin
0675 X := -1 ;
0676 Y := -1 0677 end;
0678 if (X=iLastMouseX) and (Y=iLastMouseY) then
0679 exit;
0680 iLastMouseX := X;
0681 iLastMouseY := Y;
0682 if bHintsEnabled and not bMouseDown then begin
0683 ScrollBarMouseMove(X,Y);
0684 TimeBarMouseMove(X,Y);
0685 VolumeBarMouseMove(X,Y);
0686 TracksMouseMove(X,Y);
0687 PlaylistMouseMove(X,Y);
0688 WordsMouseMove(X,Y);
0689 MenuMouseMove(X,Y)
0690 end;
0691 LogoMouseMove(X,Y);
0692 QynMouseMove(X.Y);
0693 if bMouseDown then begin
0694 ScrollBarMouseDrag(X,Y);
0695 TimeBarMouseDrag(X,Y);
0696 VolumeBarMouseDrag(X,Y)
0697 end;
0698 end;
0699 {======================================================================
0700 { Initalize / Exit }
0701
{======================================================================
0702 procedure TfrmRun.FormCreate(Sender: TObject);
0703 var
0704 WindowRegion: hRGN;
0705 blniOk: boolean;
0706 begin
0707 MouseDissable;
0708 bStopPaint := true;
0709 iMenuNormalizeTimer := 0;
0710 iErrorMessageTimer := 0;
0711 Randomize;
0712 SysFigLoad;
0713 blniOk := IniFigLoad;
0714 if blniOk then begin
0715 Application.lcon.LoadFromFiie(sRunDirectory+'Stuff\lcon.ico'); 0716 Application.Title := iniAppName;
0717 frmRun. Caption := iniAppTitle
0718 end;
0719 SysFigCheckVideo;
0720 VideolnitializeO;
0721 frmMain := TfrmMain.Create(nil);
0722 bmpPalette := TBitmap.Create;
0723 bmpPalette.Assign(frmMain.imgPalette.Picture. Bitmap);
0724 bmpPlayer := TBitmap.Create;
0725 bmpPlayer.Assign(frmMain.imgPlayer.Picture. Bitmap);
0726 frmRun.ClientWidth := frmMain.imgPlayer. Width;
0727 frmRun. ClientHeight := frmMain.imgPlayer.Height;
0728 with bmpPlayer.Canvas do begin
0729 Brush.Color := WINDOWCOLOR 6BIT;
0730 Brush.Style := bsSOLID;
0731 BrushCopy(ClipRect, frmMain. imgPlayer.Picture. Bitmap,
0732 ClipRect, TRANSPARENT_COLOR)
0733 end;
0734 {$IFNDEF WINDOWS}
0735 with frmMain.imgPlayer do
0736 Outlinelmage( Canvas, Height, Width, WindowRegion);
0737 SetWindowRgn( Handle, WindowRegion, false);
0738 {$ENDIF}
0739 Buttonslnitialize;
0740 ScrollBarlnitiaiize;
0741 TimeBarlnitialize;
0742 Tubelnitiaiize;
0743 PlayListlnitialize;
0744 Trackslnitialize;
0745 Wordslnitialize;
0746 Menulnitiaiize;
0747 Aboutlnitialize;
0748 Infolnitialize;
0749 Counterlnitialize;
0750 Logolnitialize;
0751 Commentarylnitialize;
0752 Videolnitialize;
0753 Medialnitialize;
0754 Qynlnitialize;
0755 VolumeBarlnitialize;
0756 frmMain. Free; 0757 Thelntro.TextList := TStringList.Create;
0758 TubelnitList(spriteTubelntro, Thelntro, 0, 0);
0759 iLastTrackNo := 0;
0760 SetTrack(1);
0761 ModeSetTracks;
0762 TubeDisplay(Thelntro);
0763 eTubeModeState := tmlNTRO;
0764 ProgressBar.Hide;
0765 ProgressBar.Position := 0;
0766 ProgressBar.Top := iTextBlockTop+iTextBlockHeight+2;
0767 ProgressBar.Left := iTextBlockLeft+((iTextBlockWidth-ProgressBar. Width) div 2);
0768 bStopPaint := false;
0769 Playerlnitialize;
0770 if blniOK then
0771 blniOk := RegFigLoad;
0772 if blniOk then begin
0773 Logginglnitialize;
0774 if iniPlaylntro=qfONCE then
0775 bqPlaylntro := not reglntroPlayed
0776 else
0777 bqPlaylntro := (iniPlaylntro=qfALWAYS);
0778 if iniAskVideo=qfONCE then
0779 bqAskVideo := not regVideoAsked
0780 else
0781 bqAskVideo := (iniAskVideo=qf ALWAYS);
0782 case iniSendVote of
0783 qfALWAYS: begin regVoteEnabled := true;
0784 bqAskVote := false end;
0785 qfNEVER: begin regVoteEnabled := false;
0786 bqAskVote := false end
0787 else
0788 if iniAskVote=qfONCE then
0789 bqAskVote := not regVoteAsked
0790 else
0791 bqAskVote := (iniAskVote=qfALWAYS)
0792 end;
0793 case iniSendlnfo of
0794 qfALWAYS: reglnfoEnabled := true;
0795 qfNEVER: reglnfoEnabled := false
0796 end
0797 end; 0798 if bStopPaint then
0799 exit;
0800 iHintLastX := 100;
0801 iHintLastY := 100;
0802 sHintLastMsg := 'No Hint!';
0803 bHintsEnabled := true;
0804 bQvideo := false;
0805 bQvote := false;
0806 tmTimer.Enabled := true;
0807 Application.OnException := DefaultException;
0808 Application.Onldle := IdleProcess;
0809 if not blniOk then
0810 SevereError('Unable to Start!');
0811 PostMessage(Handle, UM_REALSTART, 0, 0)
0812 end;
0813 { }
0814 procedure TfrmRun.FormClose(Sender: TObject; var Action: TCIoseAction);
0815 begin
0816 tmTimer.Enabled := false;
0817 bStopPaint := true;
0818 RegFigUpdate;
0819 TubeExitListfThelntro);
0820 VolumeBarEΞxit;
0821 QynEΞxit;
0822 MediaExit;
0823 VideoExit;
0824 LogoExit;
0825 CounterExit;
0826 InfoExit;
0827 AboutExit;
0828 MenuExit;
0829 WordsEΞxit;
0830 TracksExit;
0831 PlayListExit;
0832 TubeExit;
0833 TimeBarExit;
0834 ScrollBarExit;
0835 ButtonsExit;
0836 bmpPiayer.Free
0837 end;
0838 { } 0839 procedure TfrmRun.RealStart(var Msg: TMessage);
0840 begin
0841 if bqAskVideo and (not bVideoEnable) then
0842 QynAsk(TheQvideo, qaVideoYes, qaVideoNO)
0843 else
0844 qaNextl ;
0845 end;
0846 {- }
0847 procedure TfrmRun.RunAfterExec(Sender: TObject);
0848 begin
0849 {$IFDEF WINDOWS}
0850 WindowState := TWindowState(wsNormal);
0851 {$ELSE}
0852 Application. Restore;
0853 {$ENDIF}
0854 if bQvideo then begin
0855 SysFigCheckVideo;
0856 bQvideo := false;
0857 qaNextl
0858 end
0859 end;
0860 { }
0861 procedure qaVideoNO;
0862 begin
0863 regVideoAsked := true;
0864 qaNextl
0865 end;
0866 {- }
0867 procedure qaVideoYes;
0868 begin
0869 regVideoAsked := true;
0870 bQvideo := true;
0871 frmRun.Run.CmdUne := sRunDirectory+'StufAActMovie.exe';
0872 if frmRun. Run. Execute then
0873 {$IFDEF WINDOWS}
0874 WindowState := TWindowState(wsMinimized)
0875 {$ELSE}
0876 Application. Minimize
0877 {$ENDIF}
0878 else begin
0879 frmRun. ErrorMessage('Unable to Install Active Movie!'); 0880 bQvideo := false;
0881 qaNextl
0882 end
0883 end;
0884 { }
0885 procedure qaNextl ;
0886 begin
0887 TubeDisplay(Thelntro);
0888 eTubeModeState := tmlNTRO;
0889 if bVideoEnabie and bqPlaylntro then begin
0890 bqPlaylntro := false;
0891 if bqAskVote then
0892 eTubeModeState := tmQYN;
0893 iDelaylntroVideo := DELAYJNTROVIDEO
0894 end
0895 else
0896 qaNext2
0897 end;
0898 { }
0899 procedure qaNext2;
0900 begin
0901 if bqAskVote then
0902 QynAsk(TheQvote, qaVoteYes, qaVoteNo)
0903 else
0904 qaNext3
0905 end;
0906 { }
0907 procedure qaVoteNO;
0908 begin
0909 regVoteAsked := true;
0910 regVoteEnabled := false;
0911 qaNext3
0912 end;
0913 { }
0914 procedure qaVoteYes;
0915 begin
0916 regVoteAsked := true;
0917 regVoteEnabled := true;
0918 qaNext3
0919 end;
0920 { } 0921 procedure qaNext3;
0922 begin
0923 TubeDisplay(Thelntro);
0924 eTubeModeState := tmlNTRO
0925 end; 0926
<===================================== ============================}
0927 { Errors }
0928
{==================================== =================================}
0929 function TfrmRun.NoVideo: boolean;
0930 begin
0931 if bVideoEnabie then begin
0932 Result := false;
0933 exit
0934 end;
0935 waveSorry.Play;
0936 with frmRun. blobMessage do begin
0937 MaxWidth := 152;
0938 ShowMessagefYour system is not configured to play MPEG video. '+
0939 'Click the IQ symbol at the bottom left, and select '+
0940 '"Install Active Movie".'+char(10)+char(10)+char(13)+
0941 'You do not need to perform this install if '+
0942 'you will not be playing videos, the CD audio '+
0943 'will still work.',
0944 frmRun.Left+310, frmRun.Top+64)
0945 end;
0946 iErrorMessageTimer := 200;
0947 Result := true
0948 end;
0949 { }
0950 procedure TfrmRun.ErrorMessage(const msg: string);
0951 begin
0952 waveSorry.Play;
0953 with frmRun. blobMessage do begin
0954 MaxWidth := 152;
0955 ShowMessage(Msg, frmRun.Left+310, frmRun.Top+64)
0956 end;
0957 iErrorMessageTimer := 50
0958 end;
0959 { } 0960 procedure TfrmRun.SevereError(const msg: string);
0961 begin
0962 tmTimer.Enabled := false;
0963 bStopPaint := true;
0964 MessageDlg('( '+msg+' )'+char(10)+char(10)+char(13)+
0965 'An unexpected problem occured, and IQcd must exit now:'+
0966 char(10)+char(13)+
0967 'All will be fine, but you should reboot your computer.',
0968 mtError, [], 0);
0969 Close;
0970 Application. Terminate
0971 end;
0972 { }
0973 procedure TfrmRun.DefaultException(Sender: TObject; E: Exception);
0974 begin
0975 if true {Application.Terminated} then begin
0976 MessageDlg(E.Message, mtError, [mbOK], 0);
0977 exit
0978 end;
0979 waveSorry.Play;
0980 with frmRun. blobMessage do begin
0981 MaxWidth := 230;
0982 ShowMessage(E.Message+char(10)+char(10)+char(13)+
0983 'An unexpected problem occured, but it should be '+
0984 'o.k. to keep going. If things do not work right '+
0985 'then exit IQcd or reboot your system.',
0986 frmRun.Left+310, frmRun.Top+64)
0987 end;
0988 iErrorMessageTimer := -1
0989 end; 0990 {======================================================================
0991 { form repaint }
0992 {======================================================================
0993 {$IFDEF KILLERASE}
0994 procedure TfrmRun.FormErase(var Msg: TWMEraseBkgnd);
0995 begin
0996 {if bVideo256 then begin
0997 SelectPalette(Handle, imgPalette. Picture. Bitmap.Palette, false);
0998 RealizePalette(Handle) 0999 end;}
1000 Msg.Result := LRESULT(False)
1001 end;
1002 {$ENDIF}
1003 {- }
1004 procedure TfrmRun.FormPaint(Sender: TObject);
1005 var
1006 FullRect: TRect;
1007 begin
1008 if bStopPaint then
1009 exit;
1010 if bVideo256 then begin
1011 FullRect := Bounds(0, 0, ClientWidth, ClientHeight);
1012 BitmapUpdateScreen(FullRect)
1013 end
1014 else
1015 BitmapUpdateScreen(Canvas.ClipRect)
1016 end;
1017 end.
0001 unit Saver;
0002
{======= ======== ============================ =================}
0003 interface
0004
0005 {$IFDEF WINDOWS}
0006 uses
0007 WinTypes, WinProcs, SysUtils, Messages, Classes, Controls, Inifiles,
0008 Run, IniFig;
0009 {$ELSE}
0010 uses
0011 Windows, SysUtils, Messages, Classes, Controls, Inifiles,
0012 Run, IniFig;
0013 {$ENDIF}
0014 { }
0015 function SaverOurslnstalled: boolean;
0016 function UsingThisSaver(const ThisSaver: string): boolean;
0017 function UsingSaver: boolean;
0018 function UsingOurSaver: boolean;
0019 function SetSaver(const SaverName: string): boolean;
0020 procedure GetSaver( var SaverName: string); 0021 {=========================================================================}
0022 implementation
0023 ======================= = =======================================}
0024 uses
0025 Sysfig; 0026
0027 { Code }
0028 {=========================================================================}
0029 function SaverOurslnstalled: boolean;
0030 var
0031 fSaver: TextFile;
0032 begin
0033 try
0034 AssignFile(fSaver, sSystemDirectory+iniScreenSaver+'.scr');
0035 Reset(fSaver); 0036 CloseFile(f Saver);
0037 result := true
0038 except
0039 result := false
0040 end
0041 end;
0042 { }
0043 function UsingThisSaver(const ThisSaver: string): boolean;
0044 var
0045 Ini: TlniFile;
0046 begin
0047 result := false;
0048 try
0049 Ini := TlniFile.Create(sWindowsDirectory+'System.ini')
0050 except
0051 exit
0052 end;
0053 try
0054 result := (lni.ReadString('boot', 'SCRNSAVE.EXE', ")=ThisSaver)
0055 except
0056 end;
0057 Ini.Free;
0058 end;
0059 { }
0060 function UsingSaver: boolean;
0061 begin
0062 result := not UsingThisSaver(");
0063 end;
0064 { }
0065 function UsingOurSaver: boolean;
0066 begin
0067 result := UsingThisSaver(sSystemDirectory+iniScreenSaver+'.scr');
0068 end;
0069 { }
0070 function SetSaver( const SaverName: string): boolean;
0071 var
0072 Ini: TlniFile;
0073 begin
0074 result := true;
0075 try
0076 Ini := TlniFile.Create(sWindowsDirectory+'System.ini') 0077 except
0078 exit
0079 end;
0080 try
0081 Ini.WriteStringCboot', 'SCRNSAVE.EXE', SaverName)
0082 except
0083 end;
0084 Ini. Free;
0085 result := false
0086 end;
0087 / }
0088 procedure GetSaver( var SaverName: string);
0089 var
0090 ini: TlniFile;
0091 begin
0092 SaverName := ";
0093 try
0094 Ini := TlniFile.Create(sWindowsDirectory+'System.ini')
0095 except
0096 exit
0097 end;
0098 try
0099 SaverName := lni.ReadString('boof, 'SCRNSAVE.EXE', ")
0100 except
0101 end;
0102 Ini. Free
0103 end;
0104 end.
0001 unit ScrolBar;
0002 ====== ======================================================= ====}
0003 interface
0004 ================ ====================================================}
0005 {$IFDEF WINDOWS}
0006 uses
0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
0008 Forms, Dialogs, LMDnonvS,
0009 Run, Main, CDPIayer, BitBtns, BitBars;
0010 {$ELSE}
0011 uses
0012 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
0013 ExtCtrls, StdCtris, LMDnonvS,
0014 Run, Main, CDPIayer, BitBtns, BitBars;
0015 {$ENDIF}
0016 {- }
0017 procedure ScrollBarlnitialize;
0018 procedure ScroilBarEΞxit;
0019 procedure ScroilBarStartDelay;
0020 procedure ScrollBarMouseDown;
0021 procedure ScrollBarMouseUp;
0022 procedure ScrollBarMouseDrag( x, y: longint);
0023 procedure ScrollBarMouseMove(X,Y: longint);
0024 procedure ScrollBarTimerTick;
0025 procedure ScrollBarAbort;
0026 procedure ScrollBarPosition(Position: longint);
0027 {- }
0028 var
0029 Scroll: TBar;
0030 {=========================================================================}
0031 implementation
0032
0033 uses
0034 Tube, Words;
0035 {- }
0036 var
0037 bScrollBarMouseDown: boolean; 0038 iTimerPosition: longint;
0039 iTimerDelay: longint;
0040 iHintltem: longint;
0041 iHintX, iHintY: longint;
0042 iHintDelayTimer: longint;
0043 sHintMsg: string[250];
0044 bHintVisible: boolean;
0045 blnHintArea: boolean;
0046 {==================================================================
0047 { Main Code }
0048
{========================================================================
0049 procedure ScrollBarPosition(Position: longint);
0050 begin
0051 if bScrollBarMouseDown or (iTimerDelay>=0) then
0052 iTimerPosition := Position
0053 else
0054 BarSetPosition(Scroll, Position);
0055 TubeScroll(Scroll.iSlidePosition)
0056 end;
0057 { }
0058 procedure ScrollBarStartDelay;
0059 begin
0060 iTimerDelay := SCROLL_DELAY
0061 end;
0062 {========================================================================
0063 { Mouse Handling }
0064
{========================================================================
0065 procedure ScrollBarMouseDown;
0066 begin
0067 if Scroll.bEnabled and BarButtonHit(Scroll) then begin
0068 iHintltem := 0;
0069 iHintDelayTimer := 0;
0070 if bHintVisible then begin
0071 frmRun.blobHint.HideMessage;
0072 bHintVisible := false
0073 end;
0074 BarMouseMoveStart(Scroll); 0075 bScrollBarMouseDown := true;
0076 if (eTubeModeState=tmWORDS) and (eCDPIayerState=psPLAYING) then begin
0077 iTimerPosition := Scroll. iSlidePosition;
0078 iTimerDelay := SCROLL_DELAY
0079 end
0080 end
0081 end;
0082 { }
0083 procedure ScroilBarMouseUp;
0084 begin
0085 bScrollBarMouseDown := false;
0086 end;
0087 { }
0088 procedure ScrollBarMouseDrag( x, y: longint);
0089 begin
0090 if bScrollBarMouseDown then begin
0091 BarMouseMoveDraw(Scroll,x,y);
0092 TubeScroll(Scroll.iSlidePosition)
0093 end
0094 end;
0095 { }
0096 procedure ScrollBarMouseMove(X,Y: longint);
0097 var
0098 iltem: longint;
0099 x1 ,y1 : longint;
0100 label
0101 exitl ;
0102 begin
0103 if not Scroll.bEnabled then
0104 goto exitl ;
0105 if bScrollBarMouseDown then
0106 goto exitl;
0107 iHintX := frmRun.Lefl+X-5;
0108 iHintY := frmRun.Top+Y-O;
0109 iltem := 0;
0110 with Scroll.spriteBack do begin
0111 x1 := X-Left;
0112 y1 := Y-Top;
0113 if (x1>=0) and (x1-Width-1<=0) and (y1>=0) and (y1-Height-1<=0) then
0114 iltem := 1
0115 end; 0116 if iltem>0 then begin
0117 if iltemoiHintltem then begin
0118 iHintDelayTimer := HINT_DELAY;
0119 iHintltem := iltem
0120 end;
0121 exit
0122 end;
0123 exitl :
0124 iHintDelayTimer := 0;
0125 iHintltem := 0; 0126
0127 if bHintVisible then begin
0128 frmRun.blobHint.HideMessage;
0129 bHintVisible := false
0130 end
0131 end;
0132 { }
0133 procedure ScrollBarTimerTick;
0134 begin
0135 if iHintDelayTimer>0 then begin
0136 Dec(iHintDelayTimer);
0137 if iHintDelayTimer=0 then begin
0138 if bHintVisible then
0139 frmRun.blobHint.HideMessage;
0140 iHintLastX := iHintX;
0141 iHintLastY := iHintY;
0142 sHintLastMsg := sHintMsg;
0143 frmRun.blobHint.Position := hpAboveLeft;
0144 frmRun.blobHint.ShowMessage(sHintMsg, iHintX, iHintY);
0145 bHintVisible := true
0146 end
0147 end;
0148 if bScrollBarMouseDown or (iTimerDelay<0) then
0149 exit;
0150 Dec(iTimerDelay);
0151 if iTimerDelay<0 then begin
0152 BarSetPosition(Scroll, iTimerPosition);
0153 TubeScroll(iTimerPosition)
0154 end
0155 end; 0156 {======================================================================= 0157 { Mouse Handling }
0158
0159 procedure ScrollBarAbort;
0160 begin
0161 bScrollBarMouseDown := false;
0162 if iTimerDelay>-1 then begin
0163 iTimerDelay := -1 ;
0164 TubeScroll(iTimerPosition)
0165 end
0166 end;
0167 {=======================================================================
0168 { Initalize / Exit }
0169 {=======================================================================
0170 procedure ScrollBarlnitialize;
0171 begin
0172 Barlnitialize(Scroll, frmMain. imgScroll_Back,
0173 frmMain. imgScroll_Rod, frmMain. imgScroll_Button,
0174 frmMain. imgScroll_End1 , frmMain. imgScroll_End2);
0175 iTimerDelay := -1 ;
0176 sHintMsg := 'Drag button to scroll display.';
0177 iHintltem := 0;
0178 iHintDelayTimer := 0;
0179 bHintVisible := false;
0180 blnHintArea := false;
0181 bScrollBarMouseDown := false
0182 end;
0183 { }
0184 procedure ScrollBarExit;
0185 begin
0186 BarExit(Scroll)
0187 end;
0188 end. 0001 unit SysFig;
0002 {=========================================================================}
0003 interface
0004
{=========================================================================}
0005 {$IFDEF WINDOWS}
0006 uses
0007 Forms, WinTypes, WinProcs, SysUtils, Messages, Classes, Controls, Inifiles,
0008 Run;
0009 {$ELSE}
0010 uses
0011 Forms, Windows, SysUtils, Messages, Classes, Controls, IniFiles,
0012 Run;
0013 {$ENDIF}
0014 { }
0015 function SysPad( N, span: integer): string;
0016 procedure SysFigCheckVideo;
0017 procedure SysFigLoad;
0018 {- }
0019 var
0020 bVideo256: boolean;
0021 bVideoEnabie: boolean;
0022 sRunDirectory: string[200];
0023 sWindowsDirectory: string[200];
0024 sSystemDirectory: string[200];
0025 startWallpaperName,
0026 startWallpaperTile: string[200];
0027 startScreenSaver: string[100]; 0028
{=========== ========= == ================================= }
0029 implementation
0030
{=================================================================== }
0031 uses
0032 Wall, Saver;
0033 {=========================================================================}
0034 { Code }
0035 0036 procedure SysFigCheckVideo;
0037 var
0038 Ini: TlniFile;
0039 s: string[100];
0040 begin
0041 bVideoEnabie := false;
0042 Ini := TlniFile. Create(sWindowsDirectory+'System. ini');
0043 try
0044 s := Ini.ReadStringCMCI', 'MPEGVIDEO', ");
0045 except
0046 end;
0047 if so" then
0048 bVideoEnabie := true;
0049 Ini. Free
0050 end;
0051 { }
0052 function SysPad( N, span: integer): string;
0053 var
0054 st: string[12];
0055 begin
0056 st := IntToStr(N);
0057 if Length(st)<span then
0058 result := Copy('000000000', 1 , span-Length(st)) + st
0059 else
0060 result := st
0061 end;
0062 { }
0063 procedure SysFig Load;
0064 var
0065 n: word;
0066 DC: HDC;
0067 begin
0068 DC := frmRun.Canvas.Handle;
0069 if (GetDeviceCaps(DC, RASTERCAPS) and RC_PALETTE)<>0 then
0070 bVideo256 := true
0071 else
0072 bVideo256 := false;
0073 sRunDirectory := ExtractFilePath(Application.ExeName);
0074 n := GetWindowsDirectory(Pointer(@sWindowsDirectory[1]), 200-1);
0075 if sWindowsDirectory[n]<>'\' then begin
0076 sWindowsDirectory[n+1] := 'Y; 0077 lnc(n)
0078 end;
0079 sWindowsDirectory[0] := Char(n);
0080 n := GetSystemDirectory(Pointer(@sSystemDirectory[1]), 200-1);
0081 if sSystemDirectory[n]<>'V then begin
0082 sSystemDirectory[n+1] := 'V;
0083 lnc(n)
0084 end;
0085 sSystemDirectory[0] := Char(n);
0086 GetWallpaper(startWallpaperName, startWallpaperTile);
0087 GetSaver(startScreenSaver)
0088 end;
0089 end.
0001 unit TimeBar;
0002 {=========================================================================}
0003 interface
0004
0005 {$IFDEF WINDOWS}
0006 uses
0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
0008 Forms, Dialogs, LMDnonvS,
0009 Run, Main, BitBars, Tube, Words, ScrolBar, Counter;
0010 {$ELSE}
0011 uses
0012 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
0013 ExtCtrls, StdCtris, LMDnonvS,
0014 Run, Main, BitBars, Tube, Words, ScrolBar, Counter;
0015 {$ENDIF}
0016 { }
0017 procedure TimeBarlnitialize;
0018 procedure TimeBarExit;
0019 procedure TimeBarNewTrack(TrackNo: longint);
0020 procedure TimeBarPosition(TrackTime: longint);
0021 function TimeBarGetPosition: longint;
0022 procedure TimeBarMouseDown;
0023 procedure TimeBarMouseUp;
0024 procedure TimeBarMouseDrag( x, y: longint);
0025 procedure TimeBarMouseMove(X,Y: longint);
0026 procedure TimeBarTimerTick;
0027 { }
0028 var
0029 Time: TBar;
0030
{==================================================================== =}
0031 implementation
0032
{=========================================================================}
0033 uses
0034 CDPIayer;
0035 { }
0036 var
0037 oTimeBarMouseDown: boolean; 0038 iHintltem: longint;
0039 iHintX, iHintY: longint;
0040 iHintDelayTimer: longint;
0041 sHintMsg: string[250];
0042 bHintVisible: boolean;
0043 blnHintArea: boolean;
0044 {=========================================================================}
0045 { Main Code }
0046
{=========================================================================}
0047 procedure TimeBarNewTrack(TrackNo: longint);
0048 begin
0049 BarSetRange(Time, iAudioTrackLengthfTrackNo]);
0050 BarSetPositiontTime, 0);
0051 BarEnable(Time);
0052 CounterNewTrack;
0053 CounterSetTime(O);
0054 TubeSetTime(TheWords[TrackNo], 0)
0055 end;
0056 { }
0057 procedure TimeBarPosition(TrackTime: longint);
0058 begin
0059 if not bTimeBarMouseDown then begin
0060 BarSetPosition(Time, TrackTime);
0061 CounterSetTime(TrackTime);
0062 TubeSetTime(TheWords[iLastTrackNo], TrackTime)
0063 end
0064 end;
0065 { }
0066 function TimeBarGetPosition: longint;
0067 begin
0068 result := BarGetPosition(Time)
0069 end; 0070
0071 { Mouse Handling }
0072
{=========================================================================}
0073 procedure TimeBarMouseDown;
0074 begin 0075 if BarButtonHitiTime) then begin
0076 iHintltem := 0;
0077 iHintDelayTimer := 0;
0078 if bHintVisible then begin
0079 frmRun.blobHint.HideMessage;
0080 bHintVisible := false
0081 end;
0082 BarMouseMoveStarttTime);
0083 bTimeBarMouseDown := true;
0084 frmRun.TimeMoveStart;
0085 end
0086 end;
0087 { }
0088 procedure TimeBarMouseUp;
0089 begin
0090 if not bTimeBarMouseDown then
0091 exit;
0092 bTimeBarMouseDown := false;
0093 frmRun. TimeMoveEnd;
0094 end;
0095 { }
0096 procedure TimeBarMouseDrag( x, y: longint);
0097 begin
0098 if bTimeBarMouseDown then begin
0099 ScrollBarAbort;
0100 BarMouseMoveDraw(Time,x,y);
0101 CounterSetTime(BarGetposition(Time));
0102 TubeSetTime(TheWords[iLastTrackNo], BarGetPosition(Time))
0103 end
0104 end;
0105 { }
0106 procedure TimeBarMouseMove(X,Y: longint);
0107 var
0108 iltem: longint;
0109 x1 ,y1 : longint;
0110 label
0111 exitl ;
0112 begin
0113 if bTimeBarMouseDown then
0114 goto exitl ;
0115 iHintX := frmRun.Left+X+5; 0116 if Y>=Time.spriteBack.Top then
0117 iHintY := frmRun.Top+Time.spriteBack.Top
0118 else
0119 iHintY := frmRun. Top+Y-0;
0120 iltem := 0;
0121 with Time.spriteBack do begin
0122 x1 := X-Left;
0123 y1 := Y-Top;
0124 if (x1>=0) and (x1-Width-1<=0) and (y1>=0) and (y1-Height-1<=0) then
0125 iltem := 1
0126 end;
0127 if iltem>0 then begin
0128 if MtemoiHintltem then begin
0129 iHintDelayTimer := HINT_DELAY;
0130 iHintltem := iltem
0131 end;
0132 exit
0133 end;
0134 exitl:
0135 iHintDelayTimer := 0;
0136 iHintltem := 0;
0137 if bHintVisible then begin
0138 frmRun.blobHint.HideMessage;
0139 bHintVisible := false
0140 end
0141 end;
0142 { }
0143 procedure TimeBarTimerTick;
0144 begin
0145 if iHintDelayTimer=0 then
0146 exit;
0147 Dec(iHintDelayTimer);
0148 if iHintDelayTimer=0 then begin
0149 if bHintVisible then
0150 frmRun.blobHint.HideMessage;
0151 iHintLastX := iHintX;
0152 iHintLastY := iHintY;
0153 sHintLastMsg := sHintMsg;
0154 frmRun. blobHint.Position := hpAboveRight;
0155 frmRun. blobHint.ShowMessage(sHintMsg, iHintX, iHintY);
0156 bHintVisible := true 0157 end
0158 end; 0159
{======================================================================:
0160 { Initalize / Exit }
0161 {======================================================================:
0162 procedure TimeBarlnitialize;
0163 begin
0164 BarlnitializeiTime, frmMain. imgTime_Back,
0165 frmMain. imgTime_Rod, frmMain. imgTime_Button,
0166 frmMain. imgTime_End1 , frmMain. imgTime_End2);
0167 sHintMsg := 'Drag button to move track time.';
0168 iHintltem := 0;
0169 iHintDelayTimer := 0;
0170 bHintVisible := false;
0171 blnHintArea := false;
0172 bTimeBarMouseDown := false
0173 end;
0174 { }
0175 procedure TimeBarExit;
0176 begin
0177 BarExitiTime)
0178 end;
0179 end.
0001 unit Tracks;
0002
{=============== ============================================ }
0003 interface
0004 {=========================================================================}
0005 {$IFDEF WINDOWS}
0006 uses
0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
0008 Forms, Dialogs, LMDnonvS,
0009 Run, Main, CDPIayer, Bitmaps, Tube;
0010 {$ELSE}
0011 uses
0012 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
0013 ExtCtrls, StdCtris, LMDnonvS,
0014 Run, Main, CDPIayer, Bitmaps, Tube;
0015 {$ENDIF}
0016 { }
0017 procedure Tracksinitialize;
0018 procedure TracksEΞxit;
0019 procedure TracksNewTrack(TrackNo: longint);
0020 procedure TracksMouseDown;
0021 procedure TracksMouseMove(X,Y: longint);
0022 procedure TracksTimerTick;
0023 {=========================================================================}
0024 implementation
0025
{===== ========= =================================================}
0026 uses
0027 PlayList;
0028 { }
0029 const
0030 LEDTEXT_ADJUST = 3;
0031 TRACKCLICK_ADJUST = 1 ;
0032 { }
0033 var
0034 spriteTracks_Back,
0035 spriteTracks_LedOn,
0036 spriteTracks_LedOff: TSprite;
0037 bTracksMouseDown: boolean; 0038 iTracksTop, iTracksSpacing: longint;
0039 iTracksTextLeft, iTracksTextWidth: longint;
0040 iTracksLEDLeft, iTracksLEDWidth: longint;
0041 iHintltem: longint;
0042 iHintX, iHintY: longint;
0043 iHintDelayTimer: longint;
0044 sHintMsg: string[250];
0045 bHintVisible: boolean;
0046 blnHintArea: boolean;
0047 {- }
0048 procedure DrawTrack(TrackNo: longint; SelectedState: boolean); forward;
0049 procedure DrawLED(TrackNo: longint; EnabledState: boolean); forward;
0050 function TrackMouseHit(X,Y: longint): longint; forward;
0051 function LedMouseHit(X,Y: longint): longint; forward;
0052 {=======================================================================!
0053 { Local Routines }
0054
{=======================================================================
0055 procedure DrawTrackfTrackNo: longint; SelectedState: boolean);
0056 var
0057 TextAlignFlags: word;
0058 iBitmapLine: longint;
0059 TrackRect: TRect;
0060 sTrack: string[4];
0061 begin
0062 with bmpPlayer.Canvas do begin
0063 TextAlignFlags := SetTextAlign(Handle, TA_RIGHT+TA_TOP+TA_NOUPDATECP);
0064 Brush.Style := bsClear;
0065 Font.Size := iTextFontSize;
0066 Font.Style := [fsBold];
0067 if bTrackEnabledfTrackNo] then
0068 if SelectedState then
0069 Font.Color := TEXTJHIGHLIGHT
0070 else
0071 Fontcolor := TEXT_NORMAL
0072 else
0073 Font.Color := TEXT_DISSABLED;
0074 sTrack := IntToStrtTrackNo);
0075 iBitmapLine := iTracksTop + (TrackNo-1)*iTracksSpacing - LEDTEXT_ADJUST;
0076 TrackRect := bounds(iTracksTextLeft, iBitmapLine, 0077 iTracksTextWidth, iTracksSpacing);
0078 ExtTextOut(Handle,
0079 iTracksTextLeft+iTracksTextWidth-1 , iBitmapLine,
0080 ETO_CLIPPED, ©TrackRect, Pointer(@sTrack[1]), Length(sTrack), nil);
0081 SetTextAlign(Handie, TextAlignFlags);
0082 BitmapUpdateScreen(Trackrect)
0083 end;
0084 end;
0086 procedure DrawLED(TrackNo: longint; EnabledState: boolean);
0087 var
0088 iBitmapLine: longint;
0089 begin
0090 iBitmapLine := iTracksTop + (TrackNo-1)*iTracksSpacing;
0091 if EnabledState then begin
0092 spriteTracks_LedOn.Top := iBitmapLine;
0093 BitmapDraw(spriteTracks_LedOn)
0094 end
0095 else begin
0096 spriteTracks_LedOff.Top := iBitmapLine;
0097 BitmapDraw(spriteTracks_LedOff)
0098 end
0099 end;
0100 { }
0101 function TrackMouseHit(X,Y: longint): longint;
0102 var
0103 iTrack: longint;
0104 iTrackLine: longint;
0105 begin
0106 result := 0;
0107 if (X<iTracksTextLeft) or
0108 (X>iTracksTextLeft+iTracksTextWidth-1-TRACKCLICK_ADJUST) then
0109 exit;
0110 for iTrack := 1 to iAudioTracks do begin
0111 iTrackLine := iTracksTop + (iTrack-1 )*iTracksSpacing;
0112 if (Y>=iTrackLine) and (Y<=iTrackLine+iTracksSpacing-1) then begin
0113 result := iTrack;
0114 exit
0115 end
0116 end
0117 end; 0118 { }
0119 function LedMouseHit(X,Y: longint): longint;
0120 var
0121 iTrack: longint;
0122 iTrackLine: longint;
0123 begin
0124 result := 0;
0125 if (X<iTracksLEDLeft) or (X>iTracksLEDLeft+iTracksLEDWidth-1) then
0126 exit;
0127 for iTrack := 1 to iAudioTracks do begin
0128 iTrackLine := iTracksTop + (iTrack-1)*iTracksSpacing;
0129 if (Y>=iTrackLine) and (Y<=iTrackLine+iTracksSpacing-1) then begin
0130 result := iTrack;
0131 exit
0132 end
0133 end
0134 end;
0135 {=======================================================================
0136 { Main code }
0137
{======================================================================.
0138 procedure TracksNewTrack(TrackNo: longint);
0139 begin
0140 if TrackNooiLastTrackNo then begin
0141 if iLastTrackNo>0 then
0142 DrawTrack(iLastTrackNo, false);
0143 DrawTrack(TrackNo, true)
0144 end
0145 end;
0146 {=======================================================================
0147 { Mouse Handling }
0148
{=======================================================================
0149 procedure TracksMouseDown;
0150 var
0151 iTrack, iTrackE: longint;
0152 iTracksEnabled: longint;
0153 begin
0154 iTrack := TrackMouseHit(iMouseDownX, IMouseDownY); 0155 if iTrack>0 then begin
0156 iHintDelayTimer := 0;
0157
0158 if bHintVisible then begin
0159 frmRun.blobHint.HideMessage;
0160 bHintVisible := false
0161 end;
0162 if bTrackEnabledfitrack] then
0163 frmRun.TrackClicked(iTrack);
0164 exit
0165 end;
0166 iTrack := LedMouseHit(iMouseDownX, iMouseDownY);
0167 if iTrack>0 then begin
0168 iTracksEnabled := 0;
0169 for iTrackE := 1 to iAudioTracks do
0170 if bTrackEnabled[iTrackE] then
0171 Inc(iTracksEnabled);
0172 if (iTracksEnabled=1) and bTrackEnabled[iTrack] then begin
0173 frmRun. ErrorMessage(
0174 'How can I play anything if you dissable all the tracks!');
0175 exit
0176 end;
0177 iHintDelayTimer := 0;
0178 if bHintVisible then begin
0179 frmRun.blobHint.HideMessage;
0180 bHintVisible := false
0181 end;
0182 bTrackEnabled[iTrack] := not bTrackEnabled[iTrack];
0183 DrawTrack(iTrack, (iLastTrackNO=iTrack));
0184 DrawLED(iTrack, bTrackEnabled[iTrack]);
0185 if bTrackEnabled[iTrack] then
0186 PlayListTrackEnable(iTrack)
0187 else
0188 PlayListTrackDissable(iTrack);
0189 exit
0190 end
0191 end;
0192 { }
0193 procedure TracksMouseMove(X,Y: longint);
0194 var
0195 iltem: longint; 0196 I begin
0197 iHintX := frmRun.Left+X-5;
0198 iHintY := frmRun.Top+Y-O;
0199 iltem := -TrackMouseHit(X,Y);
0200 if iltem<0 then begin
0201 if iltemoiHintltem then begin
0202 if bHintVisible then begin
0203 frmRun.blobHint.HideMessage;
0204 bHintVisible := false
0205 end;
0206 iHintDelayTimer := HINT_DELAY;
0207 iHintltem := iltem
0208 end;
0209 exit
0210 end;
0211 iltem := LedMouseHit(X,Y);
0212 if iltem>0 then begin
0213 if iltemoiHintltem then begin
0214 if bHintVisible then begin
0215 frmRun.blobHint.HideMessage;
0216 bHintVisible := false
0217 end;
0218 iHintDelayTimer := HINT.DELAY;
0219 iHintltem := iltem
0220 end;
0221 exit
0222 end;
0223 iHintDelayTimer := 0;
0224 iHintltem := 0;
0225 if bHintVisible then begin
0226 frmRun.blobHint.HideMessage;
0227 bHintVisible := false
0228 end
0229 end;
0230 / }
0231 procedure TracksTimerTick;
0232 begin
0233 if iHintDelayTimer=0 then
0234 exit;
0235 Dec(iHintDelayTimer);
0236 if iHintDelayTimer=0 then begin 0237 if bHintVisible then
0238 frmRun.blobHint.HideMessage;
0239 sHintMsg := 'No hint, sorry.';
0240 if iHintltem>0 then
0241 if bTrackEnabled[iHintltem] then
0242 sHintMsg := 'Click indicator to disable the track'
0243 else
0244 sHintMsg := 'Click indicator to enable the track.';
0245 if iHintltem<0 then
0246 sHintMsg := 'Click number to select the track.';
0247 iHintLastX := iHintX;
0248 iHintLastY := iHintY;
0249 sHintLastMsg := sHintMsg;
0250 frmRun. blobHint.Position := hpAboveLeft;
0251 frmRun. blobHint.ShowMessage(sHintMsg, iHintX, iHintY);
0252 bHintVisible := true
0253 end
0254 end; 0255 =======================================================================
0256 { Initalize / Exit }
0257
{=======================================================================
0258 procedure Trackslnitialize;
0259 var
0260 TrackNo: longint;
0261 sTrack: string[4];
0262 begin
0263 BitmapCreate(spriteTracks_Back, frmMain. imgTracks_Back, false);
0264 BitmapCreate(spriteTracks_LedOn, frmMain. imgTracks_LedOn, true);
0265 BitmapCreate(spriteTracks_LedOff, frmMain.imgTracks_LedOff, true);
0266 iTracksTop := iTextBlockTop;
0267 iTracksSpacing := iTextBlockHeight div iAudioTracks;
0268 iTracksLEDLeft := spriteTracks_LedOn.Left;
0269 iTracksLEDWidth := spriteTracks_LedOn. Width;
0270 iTracksTextLeft := spriteTracks_Back.Left +
0271 ((spriteTracks_Back.Left+spriteTracks_Back. Width-1) -
0272 (iTracksLEDLeft+ITracksLEDWIdth-1));
0273 with frmRun. Canvas do begin
0274 Font.Size := iTextFontSize;
0275 Font.Style := [fsBold]; 0276 sTrack := '10';
0277 iTracksTextWidth := TextWidth(sTrack)
0278 end;
0279 for TrackNo := 1 to iAudioTracks do begin
0280 bTrackEnabled[TrackNo] := true;
0281 DrawTrack( TrackNo, false);
0282 DrawLED( TrackNo, true)
0283 end;
0284 iHintltem := 0;
0285 iHintDelayTimer := 0;
0286 bHintVisible := false;
0287 blnHintArea := false;
0288 bTracksMouseDown := false
0289 end;
0290 { }
0291 procedure TracksExit;
0292 begin
0293 BitmapDestroy(spriteTracks_LedOff);
0294 BitmapDestroy(spriteTracks_LedOn);
0295 BitmapDestroy(spriteTracks_Back)
0296 end;
0297 end.
0001 unit TrkMedia;
0002
{======================================================================:
0003 interface
0004
{=====================================================================-
0005 {$IFDEF WINDOWS}
0006 uses
0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
0008 Forms, Dialogs,
0009 Run, Main, Bitmaps, Tube, Video, Comment;
0010 {$ELSE}
0011 uses
0012 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
0013 ExtCtrls, StdCtris,
0014 Run, Main, Bitmaps, Tube, Video, Comment;
0015 {$ENDIF}
0016 { }
0017 procedure Medialnitialize;
0018 procedure MediaEΞxit;
0019 procedure MediaDraw(TrackNo: longint);
0020 procedure MediaNewTrackfTrackNo: longint);
0021 {======================================================================
0022 implementation
0023 ======================================================================
0024 var
0025 spriteMedia_Video,
0026 spriteMedia_Comment,
0027 spriteMedia_Vyes,
0028 spriteMedia_Vno,
0029 spriteMedia_Cyes,
0030 spriteMedia_cno,
0031 spriteMedia_Block: TSprite;
0032 bmpBlockO: TBitmap; 0033 (======================================================================
0034 { Main code }
0035
{====================================================================== 0036 procedure MediaDraw(TrackNo: longint);
0037 begin
0038 with spriteMedia_Block.lmage do
0039 BitBlt(Canvas.Handle, 0, 0, Width, Height,
0040 bmpBlockO.Canvas.Handle, 0, 0, srcCopy);
0041 with spriteMedia_Block do begin
0042 BitmapOveriay(lmage, spriteMedia_Video, TSprite(nilΛ));
0043 BitmapOverlay(image, spriteMedia_Comment, TSprite(nilΛ));
0044 if not bVideoAvailablefTrackNo] then
0045 BitmapOveriay(lmage, spriteMedia_Vno, TSprite(nilΛ));
0046 if not bCommentaryAvailable[TrackNo] then
0047 BitmapOverlay(lmage, spriteMedia_Cno, TSprite(nilΛ))
0048 end;
0049 BitmapDraw(spriteMedia_Block)
0050 end;
0051 { }
0052 procedure MediaNewTrack(TrackNo: longint);
0053 begin
0054 if ((eTubeModeState=tmTRACKS) or
0055 (eTubeModeState=tmWORDS) or
0056 (eTubeModeState=tmlNFO)) then
0057 if TrackNooiLastTrackNo then
0058 MediaDraw(TrackNo)
0059 end; 0060
0061 { Initalize / Exit }
0062
{==================================================================== }
0063 procedure Medialnitialize;
0064 var
0065 I: string[50];
0066 p: integer;
0067 x,y: longint;
0068 Rectl , Rect2: Trect;
0069 begin
0070 BitmapCreate(spriteMedia_Video, frmMain. imgTracks_Video, true);
0071 BitmapCreate(spriteMedia_Comment, frmMain. imgTracks_Comment, true);
0072 BitmapCreate(spriteMedia_Vyes, frmMain. imgTracks_Vyes, true);
0073 BitmapCreate(spriteMedia_Vno, frmMain. imgTracks_Vno, true);
0074 BitmapCreate(spriteMedia_Cyes, frmMain. imgTracks_Cyes, true); 0075 BitmapCreate(spriteMedia_Cno, frmMain. imgTracks_Cno, true);
0076 with frmMain. imgTracks_Block do begin
0077 I := Hint;
0078 p := PosC I);
0079 x := StrTolnt(Copy(l,1 ,p-1));
0080 y := StrTolnt(Copy(l,p+1 ,99));
0081 Rectl := Bounds(0, 0, Width, Height);
0082 Rect2 := Bounds(x-spriteTubeText.Left, y-spriteTubeText.Top, Width, Height);
0083 Canvas.CopyRect(Rect1 , frmMain.imgTube_Text.Canvas, Rect2)
0084 end;
0085 BitmapCreate(spriteMedia_Block, frmMain. imgTracks_Block, true);
0086 bmpBlockO := TBitmap.Create;
0087 bmpBlockO.Assign(spriteMedia_Block.lmage)
0088 end;
0089 { }
0090 procedure MediaExit;
0091 begin
0092 BitmapDestroy(spriteMedia_Video);
0093 BitmapDestroy(spriteMedia_Comment);
0094 BitmapDestroy(spriteMedia_Vyes);
0095 BitmapDestroy(spriteMedia_Vno);
0096 BitmapDestroy(spriteMedia_Cyes);
0097 BitmapDestroy(spriteMedia_Cno);
0098 BitmapDestroy(spriteMedia_Block);
0099 bmpBlockO.Free
0100 end;
0101 end.
0001 unit Tube;
0002 {$DEFINE NOSCROLLJ.EΞADER}
0003 {SDEFINE NOSCROLL_TRAILER} 0004 {======================================================================
0005 interface
0006
{======================================================================
0007 {$IFDEF WINDOWS}
0008 uses
0009 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
0010 Forms, Dialogs, Printers,
0011 Run, Main, CDPIayer, Bitmaps, ScrolBar, BitBars;
0012 {$ELSE}
0013 uses
0014 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
0015 ExtCtrls, StdCtris, Printers,
0016 Run, Main, CDPIayer, Bitmaps, ScrolBar, BitBars;
0017 {$ENDIF}
0018 { }
0019 type
0020 TTubeList = record
0021 iCurrentBitmapTop: longint;
0022 iCurrentSteppedTop: longint;
0023 iBottomBitmapLine: longint;
0024 iBitmapMaxTop: longint;
0025 pTube: pTSprite;
0026 TextList: TStringList
0027 end;
0028 TTubeLine = record
0029 bEnabled: boolean;
0030 bHighlight: boolean;
0031 iMaxFontSize: longint;
0032 iBitmapHeight: longint;
0033 iBitmapLeft, iBitmapTop: longint;
0034 iTimeStamp: longint
0035 end;
0036 pTTubeϋne = TTubeLine;
0038 var
0039 iTextFontSize: longint; 0040 iTextBlockLeft, iTextBlockTop,
0041 iTextBlockWidth, iTextBlockHeight: longint;
0042 spriteTubelntro,
0043 spriteTubeText,
0044 spriteTubeMenu: TSprite;
0045 spriteMenuBullet: TSprite;
0046 pCurrentTubeList: ΛTTubeList;
0047 pCurrentTube: pTSprite;
0048 iLastTubeScroll: longint;
0049 {■ }
0050 procedure Tubelnitialize;
0051 procedure TubeEΞxit;
0052 procedure TubelnitList(var spriteTube; var TubeList: TTubeList;
0053 LineSpacing, LeftOffset: longint);
0054 procedure TubeEΞxitList(var TubeList: TTubeList);
0055 procedure TubeRefresh(var TubeList: TTubeList);
0056 procedure TubeDisplay(var TubeList: TTubeList);
0057 procedure TubeSetTopLine(var TubeList: TTubeList; TopTextLine: longint);
0058 procedure TubeSetAIINormal(var TubeList: TTubeList);
0059 procedure TubeSetHighlight(var TubeList: TTubeList; TextLine: longint);
0060 procedure TubeSetNormal(var TubeList: TTubeList; TextLine: longint);
0061 procedure TubeSetEnable(var TubeList: TTubeList; TextLine: longint);
0062 procedure TubeSetDissable(var TubeList: TTubeList; TextLine: longint);
0063 procedure TubeSetTime(var TubeList: TTubeList; LineTime: longint);
0064 procedure TubePrint;
0065 function TubeHit(X,Y: longint): longint;
0066 function TubeltemHit(X,Y: longint): longint;
0067 procedure TubeScroll(TopBitmapLine: longint); 0068
0069 implementation
0070
{====== = =========================== ======= =========}
0071 uses
0072 Words;
0073 {- }
0074 const
0075 FORCE_DRAW = -9999;
0076 { }
0077 function SteppedBitmapLine(var TubeList: TTUbeList; BitmapLine: longint):
0078 longint; forward; 0079 procedure GetVisibleLinesRange(var iStartUne, iLastLine: longint); forward;
0080 procedure GetLineSizes(const sText: string; var iSpace: longint; var iSize: longint);
0081 forward;
0082 procedure Formatlt(const sText: string; iStart, iEnd: longint); forward;
0083 function Drawlt(pTubeLine: pTTUbeLine;
0084 const sText: string; iStart, iEnd: longint;
0085 iBitmapLine, iLeftOffset: longint;
0086 ScreenUpdate: boolean): longint; forward;
0087 procedure DrawLinefTextLine: longint; ScreenUpdate: boolean); forward;
0088 procedure DrawList(var TubeList: TTubeList); forward;
0089 procedure SetTopLine(var TubeList: TTubeList; TopBitmapLine: longint); forward;
0090 procedure UpdateScrollBar(var TubeList: TTubeList; BitmapLine: longint); forward; 0091 {=================================================================== ==}
0092 { Local Routines }
0093
{========== ============================================================}
0094 function SteppedBitmapLine(var TubeList: TTUbeList; BitmapLine: longint): longint;
0095 {$IFDEF WINDOWS}
0096 var
0097 iStartLine, iLastLine, iLine: longint;
0098 pTubeLine: pTTubeLine;
0099 begin
0100 iLastLine := TubeList.TextList.Count-1 ;
0101 iStartLine := iLastLine+1 ;
0102 for iLine := 0 to iLastLine do begin
0103 pTubeLine := pTTubeϋne(TubeList.TextList.Objects[iLine]);
0104 if pTubeLineMBitmapTop = BitmapLine then begin
0105 iStartLine := iLine;
0106 break
0107 end;
0108 if pTubeLine*. iBitmapTop > BitmapLine then begin
0109 iStartLine := iLine-1 ;
0110 break
0111 end
0112 end;
0113 result := pTTubeLine(TubeList.Textϋst.Objects[iStartLine])Λ.iBitmapTop
0114 {$ELSE}
0115 begin
0116 result := BitmapLine
0117 {$ENDIF} 0118 end;
0119 { }
0120 procedure GetVisibleLinesRange(var iStartLine: longint; var iLastLine: longint);
0121 var
0122 iBitmapTop, iBitmapBottom: longint;
0123 iMaxLine, iLine: longint;
0124 pTubeLine: pTTubeϋne;
0125 begin
0126 iBitmapTop := pCurrentTubeListMCurrentSteppedTop;
0127 iBitmapBottom := iBitmapTop + (iTextBlockHeight-1);
0128 iMaxLine := pCurrentTubeListA.TextList.Count-1 ;
0129 iStartLine := iLastLine+1 ;
0130 for iLine := 0 to iMaxLine do begin
0131 pTubeLine := pTTubeLine(pCurrentTubeListΛTextList.Objects[iLine]);
0132 if pTubeϋneΛ. iBitmapTop = iBitmapTop then begin
0133 iStartLine := iLine;
0134 break
0135 end;
0136 if pTubeLineΛ. iBitmapTop > iBitmapTop then begin
0137 iStartLine := iϋne-1 ;
0138 break
0139 end
0140 end;
0141 if iStartϋne<0 then
0142 iStartLine := 0;
0143 iLastLine := iMaxLine;
0144 for iLine := iStartLine+1 to iMaxLine do begin
0145 pTubeLine := pTTubeLine(pCurrentTubeListΛTextList.Objects[iLine]);
0146 if pTubeLineΛ.iBitmapTop > iBitmapBottom then begin
0147 iLastLine := iLine-1 ;
0148 break
0149 end
0150 end
0151 end;
0152 { }
0153 procedure GetϋneSizes(const sText: string; var iSpace: longint; var iSize: longint);
0154 var
0155 pO, p1 , p2, p9: longint;
0156 cO, c9, n: longint;
0157 s: string[250];
0158 begin 0159 p0 := 1 ;
0160 p9 := Length(sText);
0161 while p0<=p9 do begin
0162 p1 := (p0-1)+Pos('{',Copy(sText,p0,249));
0163 if p1=(p0-1) then
0164 break;
0165 p2 := ((p1+1)-1)+Pos('}',Copy(sText,p1 +1 ,249));
0166 if p2=((p1+1)-1) then
0167 break;
0168 s := Copy(sText,p1+1 ,(p2-p1+1)-2);
0169 p0 := p2+1 ;
0170 c0 := 1 ;
0171 c9 := Length(s);
0172 while c0<=c9 do begin
0173 case s[cO] of
0174 's': begin
0175 if [s[c0+1]] <= [O'..'9'l then begin
0176 n := StrTolnt(Copy(s,cO+1 ,2));
0177 Inc(c0,3)
0178 end
0179 else begin
0180 n := iTextFontSize;
0181 Inc(c0,1)
0182 end;
0183 if n>iSize then
0184 iSize := n
0185 end;
0186 'h': begin
0187 iSpace := StrTolnt(Copy(s,cO+1 ,2));
0188 Inc(c0,3)
0189 end
0190 else
0191 lnc(cθ)
0192 end
0193 end
0194 end
0195 end;
0196 { }
0197 procedure Formatlt(const sText: string; iStart, iEnd: longint);
0198 var
0199 pO: longint; 0200 red, green, blue: byte;
0201 Style1 : TFontStyles;
0202 begin
0203 with bmpPlayer.Canvas do begin
0204 pO := iStart;
0205 while pO<=iEnd do begin
0206 Stylel := [];
0207 case sTextfpO] of
0208 *!': begin
0209 Stylel := [fsBold];
0210 lnc(pθ)
0211 end;
0212 ϊ: begin
0213 Stylel := [fsltalic];
0214 lnc(pθ)
0215 end;
0216 '_': begin
0217 Stylel := [fsUnderline];
0218 lnc(pθ)
0219 end;
0220 'c': begin
0221 red := byte(sText[pO+1])-byte('0');
0222 green := byte(sText[pO+2])-byte('0');
0223 blue := byte(sText[pO+3])-byte('0');
0224 Font.Color := RGB(28*red, 28*green, 28*blue);
0225 Inc(p0,4)
0226 end;
0227 's': begin
0228 if [sText[p0+1]] <= ['0'..'9'] then begin
0229 Font.Size := StrTolnt(Copy(sText,p0+1 ,2));
0230 Inc(p0,3)
0231 end
0232 else begin
0233 Font.Size := iTextFontSize;
0234 Inc(p0,1)
0235 end
0236 end;
0237 'q': begin
0238 if [sText[pO+1]] <= ['0'..'9'] then begin
0239 red := byte(sText[pO+1])-byte('0');
0240 green := byte(sText[pO+2])-byte('0'); 0241 blue := byte(sText[pO+3])-byte('0');
0242 Brush.Color := RGB(28*red, 28*green, 28*blue);
0243 Brush.Style := bsSolid;
0244 Inc(p0,4)
0245 end
0246 else begin
0247 Brush.Style := bsClear;
0248 lnc(pθ)
0249 end
0250 end
0251 else
0252 lnc(pθ)
0253 end;
0254 if Stylel <= Font.Style then
0255 Font.Style := Font.Style-Stylel
0256 else
0257 Font.Style := Font.Style+Stylel
0258 end
0259 end
0260 end;
0261 { }
0262 function Drawlt TubeLine: pTTUbeLine;
0263 const sText: string; iStart, iEnd: longint;
0264 iBitmapLine, iLeftOffset: longint;
0265 ScreenUpdate: boolean): longint;
0266 var
0267 iTextLeft, iTextTop,
0268 iTextWidth, iTextHeight: longint;
0269 iLength: longint;
0270 TextEx: TSize;
0271 TextLineRect: TRect;
0272 TextAlignFlags: word;
0273 TextBlockRect: TRect;
0274 label
0275 Exit Text;
0276 begin
0277 with bmpPlayer.Canvas do begin
0278 TextAlignFlags := SetTextAlign(Handle, TA_LEFT+TA_BASELINE+TA_NOUPDATECP);
0279 SetTextJustification(Handle, 0, 0);
0280 result := iLeftOffset;
0281 if pTubeLine\bHighlight then 0282 Font.Color := TEXTJHIGHLIGHT;
0283 if not pTubeϋneΛ.bEnabled then
0284 Font.Color := TEXT_DISSABLED;
0285 iTextLeft := pTubeLineMBitmapLeft+iLeftOffset;
0286 iTextTop := iBitmapLine;
0287 if iEnd>Length(sText) then
0288 iEnd := Length(sText);
0289 iLength := iEnd-iStart+1 ;
0290 {$IFDEF WINDOWS}
0291 GetTextEΞxtentPoint(Handle, @sText[iStart], iLength, TextEΞx);
0292 {$ELSE}
0293 GetTextExtentPoint32(Handle, @sText[iStart], iLength, TextEΞx);
0294 {$ENDIF}
0295 iTextWidth := TextEx.cx;
0296 iTextHeight := pTubeLineΛ.iBitmapHeight;
0297 if (iTextLeft+iTextWidth)>(iTextBlockWidth-1) then begin
0298 iTextWidth := (iTextBlockWidth-1 )-iTextLeft;
0299 font.Color := clFuchsia
0300 end;
0301 if iTextWidth<=0 then
0302 goto Exit Text;
0303 if (JTextTop+iTextHeight-1)>(iTextBlockHeight-1) then
0304 iTextHeight := .TextBlockHeight-iTextTop;
0305 if iTextHeight<=0 then
0306 goto EΞxit Text;
0307 TextLineRect := Bounds(iTextBlockLeft+iTextLeft,
0308 iTextBlockTop+iTextTop,
0309 iTextWidth, iTextHeight);
0310 if ScreenUpdate then
0311 BitBlt mpPlayer.Canvas.Handle,
0312 TextLineRect.Left, TextLineRect.Top,
0313 iTextWidth, iTextHeight,
0314 pCurrentTubeMmage.Canvas.Handle,
0315 (iTextBlockLeft-pCurrentTubeΛ.Left)+iTextLeft,
0316 (iTextBlockTop-pCurrentTubeΛTop)+iTextTop,
0317 srcCOPY);
0318 ExtTextOut(Handle,
0319 .TextBlockLeft+iTextLeft,
0320 JTextBlockTop+iTextTop+pTubeLineΛ.iMaxFontSize,
0321 ETO_CLIPPED, ©TextLineRect, ©sTextfiStart], iLength, nil);
0322 result := iLeftOffset+iTextWidth; 0323 TextBlockRect := Bounds(iTextBlockLeft, iTextBlockTop,
0324 iTextBlockWidth, iTextBlockHeight);
0325 if ScreenUpdate then
0326 BitmapUpdateScreen(TextLineRect);
0327 EΞxit Text:
0328 SetTextAlign(Handle, TextAlignFlags)
0329 end
0330 end;
0331 {- }
0332 procedure DrawLinefTextLine: longint; ScreenUpdate: boolean);
0333 var
0334 pTubeLine: pTTubeϋne;
0335 iBitmapLine: longint;
0336 iBitmapHeight: longint;
0337 p0,p1 ,p2,o: longint;
0338 sText: string[255];
0339 iltem: longint;
0340 begin
0341 pTubeLine := pTTubeLine(pCurrentTubeListΛ.TextList.Objects[TextLine-1]);
0342 iBitmapLine := pTubeLineΛ.iBitmapTop-pCurrentTubeListΛ.iCurrentSteppedTop;
0343 iBitmapHeight := pTubeLineΛ. iBitmapHeight;
0344 if (iBitmapLine+iBitmapHeight<0) or (iBitmapLine>iTextBlockHeight-1 ) then
0345 exit;
0346 {$IFDEF NOSCROLL_LEADER}
0347 if iBitmapϋne<0 then
0348 exit;
0349 {$ENDIF}
0350 {$IFDEF NOSCROLL TRAILER}
0351 if iBitmapLine+iBitmapHeight>(iTextBlockHeight-1) then
0352 exit;
0353 {$ENDIF}
0354 sText := pCurτentTubeListΛ.TextList.Strings[TextLine-1];
0355 iltem := pTubeLineΛ.iTimeStamp;
0356 with bmpPlayer.Canvas do begin
0357 Brush.Style := bsClear;
0358 Font.Size := iTextFontSize;
0359 Font.Color := TEXT_NORMAL;
0360 Font.Style := [];
0361 p0 := 1 ;
0362 o:= pTubeLineMBitmapLeft;
0363 if (o>0) and (iltem>0) then begin 0364 with spriteMenuBullet do begin
0365 Left := iTextBlockLeft+2*o;
0366 Top := ϊTextBlockTop+iBitmapLine+2;
0367 o := o+Width+7
0368 end;
0369 BitmapDraw(spriteMenuBullet)
0370 end;
0371 while pO<=Length(sText) do begin
0372 p1 := (pO-1) + Pos('{', Copy(sText,pO,249));
0373 p2 := ((p1+1)-1) + Pos('}',Copy(sText,p1 +1 ,249));
0374 if p2>p1 then begin
0375 o := Drawlt(pTubeLine,sText,pO,p1-1 , iBitmapLine, o, ScreenUpdate);
0376 Formatlt(sText,p1+1 ,p2-1);
0377 pO := p2+1
0378 end
0379 else begin
0380 o := Drawlt(pTubeLine,sText,pO,249,iBitmapLine,o,ScreenUpdate);
0381 pO := 249
0382 end
0383 end
0384 end
0385 end;
0386 { }
0387 procedure DrawList(var TubeList: TTubeList);
0388 var
0389 iStartLine, iLastLine, iLine: longint;
0390 TextBlockRect: TRect;
0391 begin
0392 if ©TubeListopCurrentTubeList then
0393 exit;
0394 with pCurrentTubeΛ do begin
0395 BitBlt(bmpPlayer.Canvas.Handle,
0396 iTextBlockLeft, iTextBlockTop, iTextBlockWidth, iTextBlockHeight,
0397 Image.Canvas.Handle, (iTextBlockLeft-Left)+0, (iTextBlockTop-Top)+0,
0398 srcCOPY);
0399 GetVisibleLinesRange(iStartLine, iLastLine);
0400 for iLine := iStartLine to iLastLine do
0401 DrawLine(iLine+1 , false);
0402 TextBlockRect := Bounds(iTextBlockLeft, iTextBlockTop,
0403 iTextBlockWidth, iTextBlockHeight);
0404 BitmapUpdateScreen(TextBlockRect) 0405 end
0406 end;
0407 { }
0408 procedure SetTopLine(var TubeList: TTubeList; TopBitmapLine: longint);
0409 begin
0410 TubeList.iCurrentBitmapTop := TopBitmapLine;
0411 TopBitmapLine — SteppedBitmapLinefTubeList, TopBitmapLine);
0412 if TopBitmapLine = TubeList.iCurrentSteppedTop then
0413 exit;
0414 TubeList.iCurrentSteppedTop := TopBitmapLine
0415 end;
0416 { }
0417 procedure UpdateScrollBar(var TubeList: TTubeList; BitmapLine: longint);
0418 begin
0419 if @TubeList=pCurrentTubeList then
0420 ScrollBarPosition(BitmapLine)
0421 end; 0422 {======================================================================
0423 { Main code }
0424 {======================================================================
0425 procedure TubelnitList(var spriteTube; var TubeList: TTubeList;
0426 LineSpacing, LeftOffset: longint);
0427 var
0428 iLastLine, iLine: longint;
0429 Time: longint;
0430 Top: longint;
0431 pTubeLine: pTTubeLine;
0432 iSpace, iSize: longint;
0433 begin
0434 TubeList.pTube := ©spriteTube;
0435 iTop := 0;
0436 iLastLine := TubeList.TextList.Count-1 ;
0437 for iLine := 0 to iLastLine do begin
0438 pTubeLine := new(pTTubeLine);
0439 Time := longint(TubeList.TextList.Objects[iLine]);
0440 TubeL!st.TextLlst.Objects[ILIne] := TObject(pTubeLlne);
0441 pTubeLineΛ.iTimeStamp := Time;
0442 iSpace := -1 ;
0443 iSize := TextFontSize; 0444 GetLineSizes(TubeList.TextList.Strings[iLine], iSpace, iSize);
0445 if iSpace=-1 then
0446 if LineSpacing<0 then
0447 iSpace := (iSize - LineSpacing)
0448 else
0449 iSpace := LineSpacing;
0450 pTubeϋneΛ.bEnabled := true;
0451 pTubeLineΛ.bHighlight := false;
0452 pTubeLineMMaxFontSize := iSize;
0453 pTubeLineMBitmapLeft := LeftOffset;
0454 pTubeLineMBitmapTop := iTop;
0455 pTubeLineMBitmapHeight := iSpace;
0456 lnc(iTop,iSpace)
0457 end;
0458 TubeList.iCurrentBitmapTop := 0;
0459 TubeList.iCurrentSteppedTop := 0;
0460 TubeList.iBitmapMaxTop := (iTop-l)-iTextBlockHeight;
0461 if TubeList. iBitmapMaxTop<0 then
0462 TubeList.iBitmapMaxTop := 0;
0463 TubeList.iBottomBitmapLine := iTop-1
0464 end;
0465 { }
0466 procedure TubeExitList(var TubeList: TTubeList);
0467 var
0468 iLastLine, iLine: longint;
0469 pTubeLine: pTTubeLine;
0470 begin
0471 iLastLine := TubeList.TextList.Count-1 ;
0472 for iLine := 0 to iLastLine do begin
0473 pTubeLine := pTTubeLine(TubeList.TextList.Objects[iLine]);
0474 Dispose(pTubeLine);
0475 TubeList.TextList.ObjectsfiLine] := nil;
0476 end;
0477 TubeList.TextList.Free;
0478 TubeList.TextList := nil
0479 end;
0480 { }
0481 procedure TubeRefresh(var TubeList: TTubeList);
0482 begin
0483 ScrollBarAbort;
0484 iLastTubeScroll := -1 ; 0485 BitmapDraw(pCurrentTubeΛ);
0486 TubeList.iCurrentSteppedTop := FORCE_DRAW;
0487 BarSetRange(Scroll, TubeList.iBitmapMaxTop);
0488 UpdateScrollBar(TubeList, TubeList.iCurrentBitmapTop);
0489 BarEnable(Scroll)
0490 end;
0491 { }
0492 procedure TubeDisplay(var TubeList: TTubeList);
0493 begin
0494 if ©TubeListopCurrentTubeList then begin
0495 ScrollBarAbort;
0496 pCurrentTubeList := ©TubeList;
0497 iLastTubeScroll := -1 ;
0498 if pCurrentTubeoTubeList.pTube then begin
0499 pCurrentTube := TubeList.pTube;
0500 BitmapDraw(pCurrentTubeΛ)
0501 end;
0502 TubeList.iCurrentSteppedTop := FORCE_DRAW;
0503 BarSetRange(Scroll, TubeList.iBitmapMaxTop);
0504 UpdateScrollBarfJubeList, TubeList.iCurrentBitmapTop);
0505 BarEnable(Scroll)
0506 end
0507 end;
0508 { }
0509 procedure TubeSetTopLine(var TubeList: TTubeList; TopTextLine: longint);
0510 begin
0511 UpdateScrollBar(TubeList,
0512 pTTubeLine(TubeList.TextList.Objects[TopTextLine-1])Λ.iBitmapTop)
0513 end;
0514 { }
0515 procedure TubeSetAIINormal(var TubeList: TTubeList);
0516 var
0517 iLastLine, iLine: longint;
0518 begin
0519 iLastLine := TubeList.TextList.Count-1 ;
0520 for iLine := 0 to iLastLine do
0521 if pTTubeLine(TubeList.TextList.Objects[iLine])Λ.bHighlight then
0522 TubeSetNormal(TubeList,iLine+1 )
0523 end;
0524 { }
0525 procedure TubeSetHighlight(var TubeList: TTubeList; TextLine: longint); 0526 begin
0527 with pTTubeϋne(TubeList.TextList.Objects[TextLine-1])Λ do
0528 if not bHighlight then begin
0529 bHighlight := true;
0530 if @TubeList=pCurrentTubeList then
0531 DrawLine(TextLine,true)
0532 end
0533 end;
0534 { }
0535 procedure TubeSetNormal(var TubeList: TTubeList; TextLine: longint);
0536 begin
0537 with pTTubeLine(TubeList.TextList.Objects[TextLine-1])Λ do
0538 if bHighlight then begin
0539 bHighlight := false;
0540 if @TubeList=pCurrentTubeList then
0541 DrawLine(TextLine,true)
0542 end
0543 end;
0544 {- }
0545 procedure TubeSetEnable(var TubeList: TTubeList; TextLine: longint);
0546 begin
0547 with pTTubeLine(TubeList.TextList.Objects[TextLine-1])Λ o
0548 if not bEnabled then begin
0549 bEnabled := true;
0550 if @TubeList=pCurrentTubeList then
0551 DrawLine(TextLine,true)
0552 end
0553 end;
0554 { }
0555 procedure TubeSetDissable(var TubeList: TTubeList; TextLine: longint);
0556 begin
0557 with pTTubeLine(TubeList.TextList.Objects[TextLine-1])Λ do
0558 if bEnabled then begin
0559 bEnabled := false;
0560 if @TubeList=pCurrentTubeList then
0561 DrawLine(TextLine,true)
0562 end
0563 end;
0564 { }
0565 procedure TubeSetTime(var TubeList: TTubeList; LineTime: longint);
0566 var 0567 iLastLine, iLine: longint;
0568 pTubeLine: pTTubeLine;
0569 iTimePrev: longint;
0570 iTimel , iTime2, iTime3: longint;
0571 iLinel , iLine2: longint;
0572 iTimeSpan, iLineSpan: longint;
0573 iTextLine: longint;
0574 iScroll: longint;
0575 begin
0576 iLastLine := TubeList.TextList.Count-1 ;
0577 iTextLine := -1 ;
0578 iϋne2 := -1 ;
0579 iTime3 := 0; {kill compiler warning}
0580 iTimePrev := 0; {kill compiler warning}
0581 for iLine := 0 to iLastLine do begin
0582 pTubeLine := pTTubeLine(TubeList.TextList.Objects[iLine]);
0583 if (iLine>0) and (iLine<iLastLine) and
0584 (TubeList.TextList.Strings[iLine]=") then begin
0585 iTime2 := pTTubeϋne(TubeList.TextList.Objects[iLine+1]).iTimeStamp;
0586 iTime3 := (iTimePrev+iTime2) div 2
0587 end
0588 else begin
0589 iTime2 := pTubeLineMTimeStamp;
0590 iTime3 := iTime2
0591 end;
0592 iTimePrev := pTubeLineMTimeStamp;
0593 if iTime2>LineTime then begin
0594 iLine2 := pTubeLineΛ.iBitmapTop;
0595 iTextLine := iLine-1 ;
0596 break
0597 end
0598 end;
0599 if iϋne2=-1 then begin
0600 iScroll := TubeList.iBottomBitmapLine+1
0601 end
0602 else begin
0603 if iTextLine>=0 then begin
0604 pTubeLine := pTTubeLine(TubeList.TextList.Objects[iTextLine]);
0605 iTimel := pTubeLineMTimeStamp;
0606 iLinel := pTubeLineΛ. iBitmapTop
0607 end 0608 else begin
0609 iTimel := 0;
0610 iLinel := 0
0611 end;
0612 iTimeSpan := iTime3-iTime1 ;
0613 iLineSpaπ := iLine2-iLine1 ;
0614 if iTimeSpan=0 then
0615 iScroll := iϋne2
0616 else
0617 iScroll := iLinel + (iLineSpan*(LineTime-iTime1)) div iTimeSpan
0618 end;
0619 iScroll := iScroll - ((iTextBlockHeight-iTextFontSize) div 2);
0620 if iScroll<0 then
0621 iScroll := 0;
0622 if iScroll>TubeList.iBitmapMaxTop then
0623 iScroll := TubeList.iBitmapMaxTop;
0624 if @TubeList=pCurrentTubeList then
0625 UpdateScrollBar(TubeList, iScroll)
0626 else
0627 SetTopLine(TubeList, iScroll);
0628 for iLine := 0 to iLastLine do
0629 if iLineoiTextLine then
0630 TubeSetNormal(TubeList, iLine+1);
0631 if iTextLine>=0 then
0632 TubeSetHighlight(TubeList, iTextϋne+1)
0633 end;
0634
{========================= =========================================
0635 { Printer support }
0636
{============== =====================================================
0637 procedure TubePrint;
0638 var
0639 Printer: TextFile;
0640 iLine, iLastLine: longint;
0641 pO, p1 , p2, p9: longint;
0642 sText, sPrint: string[250];
0643 begin
0644 frmRun. PrintDialog. Options := [poWaming];
0645 if frmRun. PrintDialog. Execute=False then
0646 exit; 0647 try
0648 AssignPm(Printer)
0649 except
0650 frmRun. ErrorMessage(There is a problem with the printer!');
0651 exit
0652 end;
0653 iLastLine := pCurrentTubeListΛ.TextList.Count-1 ;
0654 try
0655 Rewrite(printer)
0656 except
0657 frmRun. ErrorMessage(There is a problem with the printer!');
0658 try
0659 CloseFile(Printer);
0660 except
0661 end;
0662 exit
0663 end;
0664 for iLine := 0 to iLastLine do begin
0665 sText := pCurrentTubeListΛTextList.Strings[iLine];
0666 sPrint := ";
0667 p0 := 1 ;
0668 p9 := Length (sText);
0669 while p0<=p9 do begin
0670 p1 := (pO-1)+PosC{',Copy(sText,pO,249));
0671 if p1=(p0-1) then begin
0672 sPrint := sPrint + Copy(sText,p0,249);
0673 break
0674 end;
0675 sPrint := sPrint + Copy(sText,pO,(p1-pO));
0676 p2 := ((p1+1)-1)+Pos('}',Copy(sText,p1 +1 ,249));
0677 if p2=((p1+1)-1) then
0678 break;
0679 pO := p2+1 ;
0680 end;
0681 try
0682 WriteLn(Printer, sPrint)
0683 except
0684 frmRun. ErrorMessage(There is a problem printing to the printer!');
0685 try
0686 CloseFile(Printer);
0687 except 0688 end;
0689 exit
0690 end
0691 end;
0692 try
0693 CloseFile(Printer);
0694 except
0695 end
0696 end;
0697
{==================================================================
0698 { Mouse support }
0699
{==================================================================
0700 function TubeHit(X,Y: longint): longint;
0701 var
0702 iMouseX, iMouseY: longint;
0703 iBitmapLine: longint;
0704 begin
0705 result := 0;
0706 iMouseX := X-iTextBlockLeft;
0707 iMouseY := Y-iTextBlockTop;
0708 if (iMouseX<0) or (iMouseX>iTextBlockWidth-1) then
0709 exit;
0710 if (iMouseY<0) or (iMouseY>iTextBlockHeight-1) then
0711 exit;
0712 iBitmapLine := iMouseY + pCurrentTubeListMCurrentSteppedTop;
0713 if (iBitmapLine<0) or (iBitmapLine>pCurrentTubeϋstMBottomBitmapLine) then
0714 exit;
0715 result := 1
0716 end;
0717 { }
0718 function TubeltemHit(X,Y: longint): longint;
0719 var
0720 iMouseX, iMouseY: longint;
0721 iBitmapLine: longint;
0722 iLastLine, iLine: longint;
0723 iFoundLine: longint;
0724 pTubeLine: pTTubeLine;
0725 begin
0726 result := 0; 0727 iMouseX := X-iTextBlockLeft;
0728 iMouseY := Y-iTextBlockTop;
0729 if (iMouseX<0) or (iMouseX>iTextBlockWidth-1) then
0730 exit;
0731 if (iMouseY<0) or (iMouseY>iTextBlockHeight-1 ) then
0732 exit;
0733 iBitmapLine := iMouseY + pCurrentTubeϋstMCurrentSteppedTop;
0734 if (iBitmapLine<0) or (iBitmapLine>pCurrentTubeListMBottomBitmapLine) then
0735 exit;
0736 iLastLine := pCurτentTubeListΛTextList.Count-1 ;
0737 iFoundLine := -2;
0738 for iLine := 0 to iLastLine do begin
0739 pTubeLine := pTTubeLine(pCurrentTubeListΛTextList.Objects[iLine]);
0740 if pTubeLineMBitmapTop = iBitmapLine then begin
0741 iFoundLine := iLine;
0742 break
0743 end;
0744 if pTubeLineMBitmapTop > iBitmapLine then begin
0745 iFoundLine := iLine-1 ;
0746 break
0747 end
0748 end;
0749 if iFoundLine=-2 then
0750 iFoundLine := iLastLine;
0751 if iFoundLine<0 then begin
0752 frmRun.SevereError(TubeltemHit - Mouse hit line -ve found!');
0753 exit
0754 end;
0755 with pTTubeLine(pCurrentTubeListΛTextList.Objects[iFoundLine])Λ do
0756 if bEnabled then
0757 result := iTimeStamp
0758 end; 0759
0760 { ScrollBar support } 0761
0762 procedure TubeScrollfTopBitmapLine: longint);
0763 begin
0764 SetTopLine(pCurrentTubeListΛ, TopBitmapLine);
0765 DrawList(pCurrentTubeListΛ); 0766 if eCDPIayerStateopsPLAYING then
0767 with frmRun. blobHint do
0768 if TopBitmapLineoiLastTubeScroll then begin
0769 if IsDisplaying then
0770 ShowMessage(sHintLastMsg, iHintLastX, iHintLastY);
0771 iLastTubeScroll := TopBitmapLine
0772 end
0773 end;
0774
{===== ================= ====== ========================== ==
0775 { Initalize / EΞxit }
0776
{======================================================================
0777 procedure Tubelnitialize;
0778 var
0779 I: string[50];
0780 p: integer;
0781 begin
0782 BitmapCreate(spriteTubelntro, frmMain. imgTubeJntro, true);
0783 BitmapCreate(spriteTubeText, frmMain. imgTube_Text, true);
0784 BitmapCreate(spriteTubeMenu, frmMain. imgTube_Menu, true);
0785 BitmapCreate(spriteMenuBullet, frmMain. imgMenu_Bullet, true);
0786 with bmpPlayer.Canvas do begin
0787 Font.Assign(frmRun.Font);
0788 iTextFontSize := Font.Size
0789 end;
0790 I := frmMain. imgPlayer.Hint;
0791 p := PosC'.l);
0792 iTextBlockLeft := StrTolnt(Copy(l,1 ,p-1));
0793 l := Copy(l,p+1 ,99);
0794 p := Pos(7,l);
0795 iTextBlockTop := StrTolnt(Copy(l,1 ,p-1));
0796 l := Copy(l,p+1 ,99);
0797 p := Pos(7,l);
0798 iTextBlockWidth := StrTolnt(Copy(l,1 ,p-1));
0799 iTextBlockHeight := StrTolnt(Copy(l,p+1 ,99));
0800 pCurrentTube := nil;
0801 pCurrentTubeList := nil;
0802 iLastTubeScroll := -1 ;
0803 end;
0804 { } 0805 procedure TubeExit;
0806 begin
0807 BitmapDestroy(spriteMenuBullet);
0808 BitmapDestroy(spriteTubeText);
0809 BitmapDestroy(spriteTubelntro)
0810 end;
0811 end.
0001 unit Video;
0002 {-$DEFINE KILLERASE} 0003
{======================================================================
0004 interface
0005
{======================================================================
0006 {$IFDEF WINDOWS}
0007 uses
0008 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
0009 Forms, Dialogs, ExtCtrls, Registry, MPIayer,
0010 Run, Main, CDPIayer, Tube, Regions, Bitmaps, SysFig, Logging;
0011 {$ELSE}
0012 uses
0013 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
0014 ExtCtrls, StdCtris, Registry, MPIayer,
0015 Run, Main, CDPIayer, Tube, Regions, Bitmaps, SysFig, Logging;
0016 {$ENDIF}
0017 { }
0018 type
0019 TfrmVideo = classfTForm)
0020 pnVideo: TPanel;
0021 mmVideo: TMediaPlayer;
0022 imgVideo: Tlmage;
0023 { }
0024 procedure FormCreate(Sender: TObject);
0025 procedure mmVideoNotify(Sender: TObject);
0026 {- }
0027 protected
0028 {$IFDEF KILLERASE}
0029 procedure FormErase(var Msg: TWMEraseBkgnd);
0030 message WM_EraseBkgnd;
0031 {$ENDIF}
0032 end;
0033 type
0034 {- }
0035 TProc = Procedure;
0036 { }
0037 const
0038 INTROVIDEO = 90;
0039 { } 0040 var
0041 bVideoAvailable: array [1..MAX_TRACKS] of boolean;
0042 { }
0043 procedure VideoStop;
0044 procedure VideoPlayfTrackNo: longint; xFinished: Tproc);
0045 procedure VideolnitializeO;
0046 procedure Videolnitialize;
0047 procedure VideoEΞxit;
0048 { }
0049 var
0050 frmVideo: TfrmVideo; 0051
{========================== ========================================}
0052 implementation
0053 {$R *.DFM} 0054 {=========================================================================}
0055 var
0056 VideoRegion: hRGN;
0057 end Video: TProc;
0058 iVideoOffsetLeft, iVideoOffsetTop: longint;
0059 iVideoWidth, iVideoHeight: longint;
0060 {=========================================================================}
0061 { Main Code }
0062 {=========================================================================}
0063 procedure VideoStop;
0064 var
0065 TubeRect: TRect;
0066 begin
0067 with frmVideo. mmVideo do begin
0068 TimeFormat := tfMilliseconds;
0069 LoggingLoglt(leVIDEO, Position div 100);
0070 try
0071 Wait := true;
0072 Notify := false;
0073 Stop;
0074 except
0075 end
0076 end; 0077 frmVideo.Hide;
0078 with spriteTubeText do begin
0079 TubeRect := Bounds(Left, Top, Width, Height);
0080 BitmapUpdateScreen(TubeRect)
0081 end
0082 end;
0083 { }
0084 procedure VideoPlay(TrackNo: longint; xFinished: Tproc);
0085 begin
0086 with frmVideo.mmVideo do begin
0087 TimeFormat := tfMilliseconds;
0088 LoggingLoglt(leVIDEO, Position div 100);
0089 try
0090 Wait := true;
0091 Notify := false;
0092 Stop
0093 except
0094 end
0095 end;
0096 {$IFDEF WINDOWS}
0097 with frmVideo do begin
0098 Left := frmRun.Left + spriteText.Left;
0099 Top := frmRun.Top + spriteText.Top;
0100 Width := spriteText. Width;
0101 Height := spriteText. Height
0102 end;
0103 with frmVideo.pnVideo do begin
0104 Left := -((iVideoWidth-spriteText.Width) div 2);
0105 Top := -((iVideoHeight-spriteText.Height) div 2)
0106 end;
0107 {$ELSE}
0108 with frmVideo do begin
0109 Left := frmRun.Left + iVideoOffsetLeft;
0110 Top := frmRun.Top + iVideoOffsetTop
0111 end;
0112 {$ENDIF}
0113 with frmVideo.mmVideo do begin
0114 try
0115 if TrackNo=INTROVIDEO then
0116 FileName := sRunDirectory+'Stuff ntro.mpg'
0117 else 0118 FileName := sRunDirectory+'Stuff\Video'+lntToStr(TrackNo)+'.mpg';
0119 Wait := true;
0120 Notify := false;
0121 Open
0122 except
0123 if TrackNoolNTROVIDEO then
0124 frmRun.ErrorMessageCThere is a problem with video playback!');
0125 xFinished;
0126 exit
0127 end;
0128 frmVideo.Show;
0129 try
0130 Wait := false;
0131 Notify := true;
0132 Play;
0133 endVideo := xFinished;
0134 except
0135 frmVideo.Hide;
0136 frmRun.ErrorMessageCThere is a problem with video playback!');
0137 xFinished
0138 end;
0139 LoggingEvent(leVIDEO, IsOTHER, TrackNo, 0)
0140 end
0141 end;
0142 {=========================================================================}
0143 { Video Play end processing }
0144
{=========================================================================}
0145 procedure TFrmVideo.mmVideoNotify(Sender: TObject);
0146 var
0147 ev: TProc;
0148 begin
0149 frmVideo.Hide;
0150 with frmVideo.mmVideo do begin
0151 TimeFormat := tfMilliseconds;
0152 LoggingLoglt(leVIDEO, Position div 100)
0153 end;
0154 ev := endVideo;
0155 endVideo := nil;
0156 if Assigned(ev) then 0157 ev
0158 end;
0159 { }
0160 {$IFDEF KILLERASE}
0161 procedure TfrmVideo.FormErase(var Msg: TWMEraseBkgnd);
0162 begin
0163 Msg.Result := LRESULT(False)
0164 end;
0165 {$ENDIF} 0166 {======================================================================
0167 { Initialize and exit }
0168
{======================================================================
0169 procedure TfrmVideo.FormCreate(Sender: TObject);
0170 var
0171 p: longint;
0172 I: string[50];
0173 begin
0174 I := imgVideo.Hint;
0175 p := PosCM);
0176 iVideoOffsetLeft := StrTolnt(Copy(l,1 ,p-1));
0177 iVideoOffsetTop := StrTolnt(Copy(l,p+1 ,99));
0178 iVideoWidth := img Video. Width;
0179 iVideoHeight := imgVideo.Height;
0180 {$IFNDEF WINDOWS}
0181 Outlinelmage( imgVideo. Canvas,
0182 imgVideo.Height, imgVideo. Width,
0183 VideoRegion);
0184 SetWindowRgn( Handle, VideoRegion, False);
0185 {SENDIF}
0186 end;
0187 { }
0188 procedure VideolnitializeO;
0189 var
0190 Reg: TRegistry;
0191 sKey, sValue: string;
0192 begin
0193 Reg := TRegistry.Create;
0194 Reg.RootKey := HKEY_CURRENT_USER;
0195 sKey := '\Software\Microsoft\Multimedia\ActiveMovie Filters\MPEG Decoder1; 0196 sValue := 'AudioChannels';
0197 try
0198 if Reg.OpenKey(sKey,false) then
0199 if Reg.ValueExists(sValue) then begin
0200 Reg.Readlnteger(sValue);
0201 Reg.Writelnteger(sValue,2)
0202 end
0203 except
0204 end;
0205 sValue := 'AudioFreqDivider';
0206 try
0207 if Reg.OpenKey(sKey.false) then
0208 if Reg.ValueExists(sValue) then begin
0209 Reg.Readlnteger(sValue);
0210 Reg.Writelnteger(sValue,1)
0211 end
0212 except
0213 end;
0214 Reg.Free;
0215 frmVideo := TfrmVideo.Create(nil);
0216 with frmVideo.mmVideo do
0217 try
0218 FileName := sRunDirectory+'StufΛlntro.mpg';
0219 Wait := true;
0220 Notify := false;
0221 Open
0222 except
0223 end
0224 end;
0225 { }
0226 procedure Videolnitialize;
0227 var
0228 fVideo: TextFile;
0229 iTrack: Integer;
0230 begin
0231 for iTrack := 1 to iAudioTracks do begin
0232 bVideoAvailable[iTrack] := true;
0233 try
0234 AssignFile(fVideo, sRunDirectory+'StufΛVideo'+lntToStr(iTrack)+'.mpg');
0235 Reset(fVideo);
0236 CloseFile(fVideo) 0237 except
0238 bVideoAvailable[iTrack] := false
0239 end
0240 end;
0241 endVideo := nil;
0242 end;
0243 { }
0244 procedure VideoExit;
0245 begin
0246 frmVideo.Free
0247 end;
0248 end.
0001 unit Volumbar;
0002 {=========================================================================}
0003 interface
0004
<=============== ================================================ ==}
0005 {$IFDEF WINDOWS}
0006 uses
0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
0008 Forms, Dialogs, MMSystem, MPIayer, LMDnonvS,
0009 Run, Main, BitBars, Video;
0010 {$ELSE}
0011 uses
0012 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
0013 ExtCtrls, StdCtris, MMSystem, MPIayer, LMDnonvS,
0014 Run, Main, BitBars, Video;
0015 {$ENDIF}
0016 { }
0017 procedure VolumeBarlnitialize;
0018 procedure VolumeBarEΞxit;
0019 procedure VolumeBackgroundProcess;
0020 procedure VolumeBarMouseDown;
0021 procedure VolumeBarMouseUp;
0022 procedure VolumeBarMouseDrag( x, y: longint);
0023 procedure VolumeBarMouseMove(X,Y: longint);
0024 procedure VolumeBarTimerTick;
0025 { }
0026 var
0027 Volume: TBar; 0028
{================== ======== ================================== }
0029 implementation
0030
{====================== =============================================}
0031 const
0032 NO_VOLUME = $FFFF;
0033 { }
0034 var
0035 wCDVolumeld: word;
0036 bVolumeBarMouseDown: boolean;
0037 iHintltem: longint;

Claims

0038 iHintX, iHintY: longint;0039 iHintDelayTimer: longint;0040 sHintMsg: string[250];0041 bHintVisible: boolean;0042 blnHintArea: boolean;0043 { }0044 procedure SetVolume(NewVolume: longint); forward;0045 function GetVolume: longint; forward; 0046 {=========================================================================}0047 { Local Routines }0048{=========================================================================}0049 procedure SetVolume(NewVolume: longint);0050 begin0051 auxSetVolume(wCDVolumelD, (NewVolume shl 16) or NewVolume)0052 end;0053 { }0054 function GetVolume: longint;0055 var0056 dwVolume: longint;0057 begin0058 auxGetVolume(wCDVolumeld, ©dwVolume);0059 result := (dwVolume and longint($FFFF))0060 end; 0061{======= ==============================================================}0062 { Background processing }0063{=========================================================================}0064 procedure VolumeBackgroundProcess;0065 begin0066 if (frmRun.mmCommentary.Mode=mpPLAYING) or0067 (frmVideo.mmVideo.Mode=mpPLAYING) then begin0068 BarDissable(Volume);0069 exit0070 end0071 else begin0072 BarEnable(Volume)0073 end;0074 if not bVolumeBarMouseDown then 0075 BarSetPosition(Volume, longint($FFFF)-GetVolume)0076 end;0077 {======================================================================0078 { Mouse Handling }0079{======================================================================0080 procedure VolumeBarMouseDown;0081 begin0082 if not Volume. bEnabled then0083 exit;0084 if BarButtonHit(Volume) then begin0085 iHintltem := 0;0086 iHintDelayTimer := 0;0087 if bHintVisible then begin0088 frmRun.blobHint.HideMessage;0089 bHintVisible := false0090 end;0091 BarMouseMoveStart(Volume);0092 bVolumeBarMouseDown := true;0093 end0094 end;0095 { }0096 procedure VolumeBarMouseUp;0097 begin0098 if not Volume.bEnabled then0099 exit;0100 bVolumeBarMouseDown := false0101 end;0102 { }0103 procedure VolumeBarMouseDrag( x, y: longint);0104 begin0105 if not Volume.bEnabled then0106 exit;0107 if bVolumeBarMouseDown then begin0108 BarMouseMoveDraw(Volume,x,y);0109 SetVolume(longint($FFFF)-Volume.iSlidePosition)0110 end0111 end;0112 { }0113 procedure VolumeBarMouseMove(X,Y: longint); 0114 var0115 iltem: longint;0116 x1 ,y1 : longint;0117 label0118 exitl ;0119 begin0120 if not Volume.bEnabled then0121 goto exitl ;0122 if not Volume.bEnabled then0123 goto exitl ;0124 if bVolumeBarMouseDown then0125 goto exitl ;0126 iHintX := frmRun.Left+X+5;0127 iHintY := frmRun.Top+Y-0;0128 iltem := 0;0129 with Volume.spriteBack do begin0130 x1 := X-Left;0131 y1 := Y-Top;0132 if (x1>=0) and (x1-Width-1 <=0) and (y1>=0) and (y1-Height-1<=0) then0133 iltem := 10134 end;0135 if iltem>0 then begin0136 if iltemoiHintltem then begin0137 iHintDelayTimer := HINT_DELAY;0138 iHintltem := iltem0139 end;0140 exit0141 end;0142 exitl :0143 iHintDelayTimer := 0;0144 iHintltem := 0;0145 if bHintVisible then begin0146 frmRun.blobHint.HideMessage;0147 bHintVisible := false0148 end0149 end;0150 { }0151 procedure VolumeBarTimerTick;0152 begin0153 if not Volume.bEnabled then0154 exit; 0155 if iHintDelayTimer=0 then0156 exit;0157 Dec(iHintDelayTimer);0158 if iHintDelayTimer=0 then begin0159 if bHintVisible then0160 frmRun.blobHint.HideMessage;0161 iHintLastX := iHintX;0162 iHintLastY := iHintY;0163 sHintLastMsg := sHintMsg;0164 frmRun. blobHint.Position := hpAboveRight;0165 frmRun. blobHint.ShowMessage(sHintMsg, iHintX, iHintY);0166 bHintVisible := true0167 end0168 end; 0169 {======================================================================0170 { Initialize and exit }0171 {============___====================================================0172 procedure VolumeBarlnitialize;0173 var0174 iLastAux, iAux: shortlnt;0175 AuxCaps: TAuxCaps;0176 begin0177 bVolumeBarMouseDown := false;0178 wCDVolumeld := NO_VOLUME;0179 iLastAux := auxGetNumDevs-1 ;0180 for iAux := 0 to iLastAux do begin0181 if auxGetDevCaps(iAux, ©AuxCaps, SizeOf(TAuxCaps))=0 then0182 if (auxcaps.wTechnology=AUXCAPS_CDAUDIO) and0183 ((AuxCaps.dwSupport and AUXCAPS_VOLUME)<>0) then begin0184 wCDVolumeld := iAux;0185 break0186 end0187 end;0188 if wCDVolumeld=NO_VOLUME then0189 for iAux := 0 to iLastAux do begin0190 if auxGetDevCaps(iAux, ©AuxCaps, SizeOf(TAuxCaps))=0 then0191 if (AuxCaps.dwSupport and AUXCAPS_VOLUME)<>0 then begin0192 wCDVolumeld := iAux;0193 break 0194 end0195 end;0196 Barlnitialize(Volume, frmMain. imgVolume_Back,0197 frmMain. imgVolume_Rod, frmMain. imgVolume_Button,0198 frmMain. imgVolume_End1 , frmMain. imgVolume_End2);0199 BarSetRange(Volume, longint($FFFF));0200 if wCDVolumeld<>NO_VOLUME then begin0201 BarSetPosition(Volume, longint($FFFF)-GetVolume);0202 BarEnable(Volume)0203 end;0204 sHintMsg := 'Drag button to adjust volume.';0205 iHintltem := 0;0206 iHintDelayTimer := 0;0207 bHintVisible := false;0208 blnHintArea := false0209 end;0210 { }0211 procedure VolumeBarExit;0212 begin0213 BarExit(Volume)0214 end;0215 end. 0001 unit Wall;0002 ,========================================================================>0003 interface0004{=========================================================================}0005 {$IFDEF WINDOWS}0006 uses0007 WinTypes, WinProcs, SysUtils, Messages, Classes, Controls,0008 Run, IniFig;0009 {$ELSE}0010 uses0011 Windows, SysUtils, Messages, Classes, Controls, Registry,0012 Run, IniFig;0013 {$ENDIF}0014 { }0015 function WallpaperOurslnstalled: boolean;0016 function UsingThisWallpaper(const ThisWallpaper: string): boolean;0017 function UsingWallpaper: boolean;0018 function UsingOurWallpaper: boolean;0019 function SetWallpaper(const WallpaperName, WallpaperTile: string): boolean;0020 procedure GetWallpaper( var WallpaperName, WallpaperTile: string);0021 {====================================================================== }0022 implementation0023{=========================================================================}0024 uses0025 Sysfig;0026{======= ============ =============================================}0027 { Code }0028 {=========================================================================}0029 function WallpaperOurslnstalled: boolean;0030 var0031 fWallpaper: TextFile;0032 begin0033 try0034 AssignFile(fWallpaper, sWindowsDirectory+iniWallpaper);0035 Reset(fWallpaper); 0036 CloseFile(fWallpaper);0037 result := true0038 except0039 result := false0040 end0041 end;0042 { }0043 function UsingThisWallpaper(const ThisWallpaper: string): boolean;0044 var0045 Reglni: TReglniFile;0046 begin0047 Reglni := TreglniFile.Create('Control Panel');0048 result := (Reglni. ReadString('desktop', 'Wallpaper', ")=ThisWallpaper);0049 Reglni.Free0050 end;0051 { }0052 function UsingWallpaper: boolean;0053 begin0054 result := not UsingThisWallpaperf);0055 end;0056 { }0057 function UsingOurWallpaper: boolean;0058 begin0059 result := UsingThisWallpaper(sWindowsDirectory+iniWallpaper+'.bmp');0060 end;0061 { }0062 function SetWallpaper( const WallpaperName, WallpaperTile: string): boolean;0063 var0064 Reglni: TReglniFile;0065 begin0066 result := true;0067 try0068 Reglni := TreglniFile.Create('Control Panel')0069 except0070 exit0071 end;0072 try0073 Reglni.WriteString('desktop', 'Wallpaper', WallpaperName);0074 Reglni.WriteStringCdesktop', TileWallpaper', WallpaperTile);0075 SystemParameterslnfo(SPI_SETDESKWALLPAPER, 0, nil, SPIF_SENDWININICHANGE)0076 except 0077 Reglni.Free;0078 exit0079 end;0080 Reglni.Free;0081 result := false0082 end;0083 { }0084 procedure GetWallpaper( var WallpaperName, WallpaperTile: string);0085 var0086 Reglni: TReglniFile;0087 begin0088 WallpaperName := ";0089 WallpaperTile := O';0090 try0091 Reglni := TreglniFile.CreateCControl Panel')0092 except0093 exit0094 end;0095 try0096 WallpaperName := Reglni. ReadString('desktop', 'Wallpaper1, ");0097 WallpaperTile := Reglni.ReadString('desktop', TileWallpaper', '0')0098 except0099 end;0100 Reglni.Free0101 end;0102 end. 0103 0001 unit Words;0002 =========================================================================}0003 interface0004<=========================================================================}0005 {$IFDEF WINDOWS}0006 uses0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,0008 Forms, Dialogs, LMDnonvS,0009 Run, Main, Tube, CDPIayer, SysFig;0010 {$ELSE}0011 uses0012 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,0013 ExtCtrls, StdCtris, LMDnonvS,0014 Run, Main, Tube, CDPIayer, SysFig;0015 {$ENDIF}0016 { }0017 var0018 TheWords: array [1..MAX_TRACKS] of TTubeList;0019 { }0020 procedure Wordslnitialize;0021 procedure WordsExit;0022 procedure WordsNewTrackfTrackNo: longint);0023 procedure WordsMouseDown;0024 procedure WordsMouseMove(X,Y: longint);0025 procedure WordsTimerTick; 0026<========================= ===========================================}0027 implementation0028{====== ======= ==================================================}0029 var0030 iHintX, iHintY: longint;0031 iHintDelayTimer: longint;0032 sHintMsg: string[250];0033 bHintVisible: boolean;0034 blnHintArea: boolean;0035 {=========================================================================}0036 { Code } 0037{======================================================================0038 procedure WordsNewTrack(TrackNo: longint);0039 begin0040 if eTubeModeState=tmWORDS then begin0041 TubeSetTopLine(TheWords[TrackNo], 1);0042 TubeDisplay(TheWords[TrackNo])0043 end0044 end; 0045 {======================================================================0046 { Mouse Handling }0047{======================================================================0048 procedure WordsMouseDown;0049 var0050 iWordsTime: longint;0051 begin0052 if eTubeModeStateotmWORDS then0053 exit;0054 iWordsTime := TubeltemHit(iMOuseDownX,iMOuseDownY);0055 if (iWordsTime>0) and (iWordsTime<9999) then begin0056 iHintDelayTimer := 0;0057 if bHintVisible then begin0058 frmRun.blobHint.HideMessage;0059 bHintVisible := false0060 end;0061 frmRun.WordsClicked(iWordsTime)0062 end0063 end;0064 { }0065 procedure WordsMouseMove(X,Y: longint);0066 label0067 exitl ;0068 begin0069 if eTubeModeStateotmWORDS then0070 goto exitl ;0071 if TubeHit(X,Y)=0 then0072 goto exitl ;0073 iHintX := frmRun.Left+X+5;0074 iHintY := frmRun.Top+Y-0; 0075 if bHintVisible then begin0076 frmRun.blobHint.HideMessage;0077 bHintVisible := false0078 end;0079 iHintDelayTimer := HINT_DELAY;0080 exit;0081 exitl :0082 iHintDelayTimer := 0;0083 if bHintVisible then begin0084 frmRun.blobHint.HideMessage;0085 bHintVisible := false0086 end0087 end;0088 { }0089 procedure WordsTimerTick;0090 begin0091 if iHintDelayTimer=0 then0092 exit;0093 Dec(iHintDelayTimer);0094 if iHintDelayTimer=0 then begin0095 if bHintVisible then0096 frmRun.blobHint.HideMessage;0097 iHintLastX := iHintX;0098 iHintLastY := iHintY;0099 sHintLastMsg := sHintMsg;0100 if eCDPIayerState=psPLAYING then begin0101 frmRun. blobHint.Position := hpAboveLeft;0102 frmRun.blobHint.ShowMessage(sHintMsg, frmRun.Left+312, frmRun.Top+55)0103 end0104 else begin0105 frmRun. blobHint.Position := hpAboveRight;0106 frmRun.blobHint.ShowMessage(sHintMsg, iHintX, iHintY)0107 end;0108 bHintVisible := true0109 end0110 end;0111 i=------------ ================== ================================0112 { Initalize / Exit }0113 {====================================================================== 0114 procedure Wordslnitialize;0115 var0116 fWords: TextFile;0117 iTrack: Integer;0118 I: string[250];0119 begin0120 for iTrack := 1 to iAudioTracks do begin0121 AssignFile(fWords, sRunDirectory+'StufAWords'+lntToStr(iTrack)+'.txt');0122 Reset(fWords);0123 ReadLn(fWords, I);0124 iAudioTrackLengthpTrack] := 10*StrTolnt(l);0125 TheWords[iTrack]TextList := TStringList.Create;0126 while not Eof(fWords) do begin0127 ReadLn(fWords, I);0128 TheWords[iTrack]TextList.AddObject(Copy(l,7,255),0129 Pointer(StrTolnt(Copy(l,1 ,5))));0130 end;0131 CloseFile(fWords);0132 TubelnitList(spriteTubeText, TheWords[iTrack], -3, 0);0133 end;0134 sHintMsg := 'Click the words to jump there.';0135 iHintDelayTimer := 0;0136 bHintVisible := false;0137 blnHintArea := false0138 end;0139 { }0140 procedure WordsExit;0141 var0142 iTrack: Integer;0143 begin0144 for iTrack := 1 to iAudioTracks do0145 TubeExitList(The Words[iTrack])0146 end;0147 end. 0001 unit Loglt;0002 {=========================================================================}0003 interface0004 =========================================================================}0005 uses Forms, Windows, SysUtils, Registry, ipwHTTP,0006 Main;0007 { }0008 procedure LogSend(const CDhandle: string);0009 procedure Log_ipwHTTPStartTransfer;0010 procedure Log_ipwHTTPTransfer(const Text: String);0011 procedure Log pwHTTPEndTransfer;0012 procedure LogjpwHTTPError; 0013 {=========================================================================}0014 implementation0015{=========================================================================}0016 type0017 EVoteSendFailure = class(Exception);0018 { }0019 var0020 bHTTPDone,0021 bHTTPAckOK: boolean;0022 sResponse: string;0023 sAckOK: string = 'Status: Complete'; 0024 {=========================================================================}0025 { Main Code }0026 {=========================================================================}0027 procedure logSend(const CDhandle: string);0028 var0029 iln, iOut: longint;0030 iOutNew, iOutOld: longint;0031 iEntry: longint;0032 sURLVote: string;0033 sVote: string;0034 iChunk: integer;0035 bNoEntries: boolean; 0036 bVoteEnabled: boolean;0037 begin0038 bVoteEnabled := false;0039 TheRegistry.RootKey := HKEY_LOCAL_MACHINE;0040 sKey := '\SOFTWARE\Palantir\IQcd\'+CDhandle+'\Flags';0041 sValue := 'VoteEnabled';0042 try0043 if TheRegistry.OpenKey(sKey,true) then0044 if TheRegistry.ValueExists(sValue) then0045 bVoteEnabled := TheRegistry.ReadBool(sValue)0046 except0047 TheRegistry.CloseKey;0048 exit0049 end;0050 TheRegistry.CloseKey;0051 if not bVoteEnabled then0052 exit;0053 TheRegistry.RootKey := HKEY_LOCAL_MACHINE;0054 sKey := '\SOFTWARE\Palantir\IQcdY+CDhandle+'\Vote';0055 sValue := 'URL';0056 try0057 if TheRegistry.OpenKey(sKey,true) then0058 if TheRegistry.ValueExists(sValue) then0059 sURLVote := TheRegistry.ReadString(sValue)0060 except0061 TheRegistry.CloseKey;0062 exit0063 end;0064 TheRegistry.CloseKey;0065 TheRegistry.RootKey := HKEY_LOCAL_MACHINE;0066 sKey := '\SOFTWARE\Palantir\IQcd\'+CDhandle+'\Vote';0067 sValue := 'Chunk';0068 iChunk := 10;0069 try0070 if TheRegistry.OpenKey(sKey.true) then0071 if TheRegistry.ValueExists(sValue) then0072 iChunk := TheRegistry.Readlnteger(sValue)0073 except0074 TheRegistry.CloseKey;0075 exit0076 end; 0077 TheRegistry.CloseKey;0078 TheRegistry.RootKey := HKEY_LOCAL_MACHINE;0079 sKey := '\SOFTWARE\Palantir\IQcd\'+CDhandle+'\Vote';0080 try0081 if TheRegistry.OpenKey(sKey.true) then begin0082 if not TheRegistry.ValueExists('ln') then begin0083 TheRegistry.Writelnteger('ln',1);0084 iln := 10085 end0086 else begin0087 iln := TheRegistry.Readlnteger('ln')0088 end;0089 if not TheRegistry.ValueExists('Out') then begin0090 TheRegistry.Writelnteger('Out',1);0091 iOut := 10092 end0093 else begin0094 iOut := TheRegistry.Readlnteger('Out')0095 end0096 end0097 else begin0098 exit0099 end0100 except0101 TheRegistry.CloseKey;0102 exit0103 end;0104 if iOut>=iln then begin0105 TheRegistry.CloseKey;0106 exit0107 end;0108 if regTrace then0109 frmMain.lbTrace.ltems.AddC ... send log for '+CDhandle);0110 if regTrace then0111 frmMain.lbTrace.ltems.AddC '+lntToStr(iOut)+','+lntToStr(iln-1));0112 iOutOld := iOut;0113 iOutNew := iOut;0114 bNoEntrles := true;0115 sVote := sURLVote;0116 try0117 for iEntry := iOut to iOut+(iChunk-1) do begin 0118 if iEntry>=iln then0119 break;0120 try0121 sVote := sVote+0122 TheRegistry.ReadString(Format('x%.9d', [iEntry]))+0123 '%0A'0124 except0125 end;0126 iOutNew := iEntry+1 ;0127 bNoEntries := false0128 end;0129 if bNoEntries then begin0130 TheRegistry.CloseKey;0131 exit0132 end;0133 bAIIVotesEmpty := false;0134 if frmMain. ipwHTTP.Actionohttpldle then0135 raise EVoteSendFailure.CreateCHTTP not idle at start.');0136 sResponse := 'None';0137 bHTTPDone := false;0138 bHTTPAckOK := false;0139 frmMain. ipwHTTP .Action := httpResetHeaders;0140 while frmMain. ipwHTTP.Actionohttpldle do;0141 frmMain.ipwHTTP.URL := sVote;0142 frmMain. ipwHTTP.Action := httpGet;0143 while not bHTTPDone do;0144 if bHTTPAckOk then begin0145 iOut := iOutNew;0146 TheRegistry.Writelnteger('Out', iOut);0147 try0148 for iEntry := iOutOld to iOutNew-1 do begin0149 sValue := Format('x%.9d', [iEntry]);0150 if TheRegistry.ValueExists(sValue) then0151 TheRegistry.DeleteValue(sValue)0152 end0153 except0154 end0155 end0156 else begin0157 raise EVoteSendFailure.CreateCVote send failure.')0158 end 0159 except0160 TheRegistry.CloseKey;0161 exit0162 end0163 end;0164 { }0165 procedure LogjpwHTTPStartTransfer;0166 begin0167 sResponse := "0168 end;0169 { }0170 procedure Log_ipwHTTPTransfer(const Text: String);0171 begin0172 sResponse := sResponse+Text0173 end;0174 { }0175 procedure Log_ipwHTTPEndTransfer;0176 begin0177 if Length(sResponse)>=Length(sAckOk) then0178 if Copy (sResponse, 1 ,Length(sAckOk))=sAckOk then0179 bHTTPAckOk := true;0180 bHTTPDone := true;0181 frmMain. IbTrace.ltems.AddCResponse - '+sResponse)0182 end;0183 { }0184 procedure LogjpwHTTPError;0185 begin0186 bHTTPDone := true;0187 bHTTPAckOK := false0188 end;0189 end. 0001 unit Main;0002{======================================================================:0003 interface0004 {===============================================================0005 uses0006 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,0007 StdCtris, Registry, ExtCtrls, devSBase, ipwNetDial, ipwCWinsck,0008 ipwiPPort, ipwCIPPMsg, ipwHTTP, TCPinfo, Imdclass, ImdnonvS;0009 type0010 TfrmMain = class(TForm)0011 IbTrace: TListBox;0012 tmTimer: TTimer;0013 ipwNetDialer: TipwNetDial;0014 ipwHTTP: TipwHTTP;0015 TCPinfo: TpsTCPinfo;0016 Onelnstance: TLMDOnelnstance;0017 procedure FormCreate(Sender: TObject);0018 procedure tmTimerTimer(Sender: TObject);0019 procedure FormClose(Sender: TObject; var Action: TCIoseAction);0020 procedure ipwNetDialerConnectedEntry(Sender: TObject; Handle: Integer;0021 const Entry, DeviceName, DeviceType, StatusDescription: String);0022 procedure ipwHTTPError(Sender: TObject; ErrorCode: Integer;0023 const Description: String);0024 procedure ipwHTTPEndTransfer(Sender: TObject);0025 procedure ipwHTTPStartTransfer(Sender: TObject);0026 procedure ipwHTTPTransfer(Sender: TObject; BytesTransf erred: Integer;0027 Text: String);0028 end;0029 { }0030 var0031 frmMain: TfrmMain;0032 TheRegistry: TRegistry;0033 sKey, sValue: string;0034 regHandle: string;0035 regTrace: boolean;0036 regExitOnEmpty: boolean;0037 bWinsockAccessOk: boolean = false;0038 sPalHandle: string;0039 sPalZip, sPalAge, sPalSex: string; 0040 bAIIVotesEmptyO, bAllVotesEmpty: boolean;0041 {=========================================^===============================}0042 implementation0043 {$R *.DFM} 0044 {=========================================================================}0045 uses0046 Loglt;0047 {- }0048 var0049 bDialerCheck: boolean = false;0050 bWinsockAccessOkO: boolean = false;0051 CD: TStrings;0052 iTimerBusy: integer = 0;0053{=============== ======================================================}0054 { Local Routines }0055{=================== ==================================================}0056 function GetPalUser(const Value: string): string;0057 begin0058 result := '?';0059 TheRegistry.RootKey := HKEY_LOCAL_MACHINE;0060 sKey := '\SOFTWARE\Palantir\User';0061 try try0062 if TheRegistry.OpenKey(sKey,false) then0063 if TheRegistry.ValueExists(Value) then0064 result := TheRegistry.ReadStringfValue)0065 except0066 end0067 finally0068 TheRegistry.CloseKey0069 end0070 end;0071 { }0072 procedure GetPallnfo;0073 var0074 i: integer;0075 begin0076 sPalHandle := "; 0077 TheRegistry.RootKey := HKEY_LOCAL_MACHINE;0078 sKey := '\SOFTWARE\Palantir';0079 sValue := 'Handle';0080 try try0081 if TheRegistry.OpenKey(sKey.true) then0082 if TheRegistry.ValueExists(sValue) then begin0083 sPalHandle := TheRegistry.ReadString(sValue)0084 end0085 else begin0086 for i := 1 to 10 do0087 sPalHandle := sPalHandle + Chr(Ord('A')+Random(26));0088 TheRegistry.WriteString(sValue, sPalHandle)0089 end0090 except0091 end0092 finally0093 TheRegistry.CloseKey0094 end;0095 if sPalHandle=" then0096 sPalHandle := 'XXXXXXXXXX';0097 sPalZip := GetPalUser('Zip');0098 sPalAge := GetPalUser('Age');0099 sPalSex := GetPalUser('Sex');0100 end; 0101 {=======================================================================0102 { Main Code }0103{=======================================================================0104 procedure TfrmMain.tmTimerTimer(Sender: TObject);0105 var0106 iCD1 , iCD: integer;0107 label0108 WinsockUpdate; 01090110 begin0111 if iTimerBusy>0 then0112 exit;0113 Inc(iTimerBusy);0114 if not bWinsockAccessOk then0115 goto WinsockUpdate; 0116 if regTrace then begin0117 if bWinsockAccessOk and not bWinsockAccessOkO then begin0118 lbTrace.ltems.Add('<Dialer activated>');0119 lbTrace.!tems.Add(")0120 end;0121 if bWinsockAccessOkO and not bWinsockAccessOk then begin0122 lbTrace.ltems.AddC<Dialer shut down>');0123 lbTrace.ltems.AddO0124 end0125 end;0126 bWinsockAccessOkO := bWinsockAccessOk;0127 TheRegistry.RootKey := HKEY_LOCAL_MACHINE;0128 sKey := '\SOFTWARE\Palantir\IQcd';0129 try0130 if not TheRegistry.OpenKey(sKey,false) then begin0131 if iTimerBusy>0 then0132 Dec(iTimerBusy);0133 exit0134 end;0135 TheRegistry.GetKeyNames(CD)0136 except0137 TheRegistry.CloseKey;0138 if iTimerBusy>0 then0139 Dec(iTimerBusy);0140 exit0141 end;0142 TheRegistry.CloseKey;0143 GetPallnfo;0144 bAIIVotesEmptyO := bAllVotesEmpty;0145 bAllVotesEmpty := true;0146 iCD1 := CD.Count-1 ;0147 frmMain. ipwHTTP.WinsockLoaded := true;0148 for iCD := 0 to iCD1 do0149 LogSend(CD.Strings[iCD]);0150 frmMain. ipwHTTP.WinsockLoaded := false;0151 if bAllVotesEmpty and not bAIIVotesEmptyO then begin0152 if regTrace then begin0153 IbTrace. Items. Addf);0154 lbTrace.ltems.Add('<AII Votes Empty>');0155 IbTrace. Items. Addf)0156 end; 0157 if regExitOnEmpty then begin0158 tmTimer.Enabled := false;0159 close;0160 exit0161 end;0162 end;0163 WinsockUpdate:0164 if bDialerCheck then0165 try0166 if ipwNetDialer.Action=ntdldle then begin0167 bWinsockAccessOk := false;0168 ipwNetDialer. Action := ntdListConnections0169 end0170 except0171 end;0172 if iTimerBusy>0 then0173 Dec(iTimerBusy);0174 end;0175 { }0176 procedure TfrmMain. ipwNetDialerConnectedEntry(Sender: TObject;0177 Handle: Integer; const Entry, DeviceName, DeviceType,0178 StatusDescription: String);0179 begin0180 if (DeviceNameo") or (DeviceTypeo") or (StatusDescriptiono") then0181 bWinsockAccessOk := true0182 end;0183 { }0184 procedure TfrmMain. ipwHTTPStartTransfer(Sender: TObject);0185 begin0186 Log_ipwHTTPStartTransfer0187 end;0188 { }0189 procedure TfrmMain. ipwHTTPTransfer(Sender: TObject;0190 BytesTransferred: Integer; Text: String);0191 begin0192 Log_ipwHTTPTransfer(Text)0193 end;0194 {- }0195 procedure TfrmMain. ipwHTTPEndTransfer(Sender: TObject);0196 begin0197 Log_ipwHTTPEndTransfer 0198 end;0199 { }0200 procedure TfrmMain. ipwHTTPError(Sender: TObject; ErrorCode: Integer;0201 const Description: String);0202 begin0203 Log_ipwHTTPError0204 end; 0205 {=========================================================================}0206 { Initalize / EΞxit }0207 {=========================================================================}0208 procedure TfrmMain. FormCreate(Sender: TObject);0209 begin0210 Top := 0;0211 Left := Screen. Width-Width;0212 Randomize;0213 bDialerCheck := false;0214 bWinsockAccessOk := false;0215 bWinsockAccessOkO := false;0216 bAllVotesEmpty := false;0217 bAIIVotesEmptyO := false;0218 TheRegistry := TRegistry.Create;0219 CD := TStringList.Create;0220 { set send control flags }0221 regTrace := false;0222 regExitOnEmpty := true;0223 TheRegistry.RootKey := HKEY_LOCAL_MACHINE;0224 sKey := '\SOFTWARE\Palantir\IQcd';0225 sValue := 'Trace1;0226 try0227 if TheRegistry.OpenKey(sKey.true) then0228 if TheRegistry.ValueExists(sValue) then0229 regTrace := TheRegistry.ReadBool(sValue)0230 except0231 end;0232 Application. ShowMainForm := regTrace;0233 TheRegistry.RootKey := HKEY_LOCAL_MACHINE;0234 sKey := '\SOFTWARE\Palantir\IQcd1;0235 sValue := ΕxitOnEmpty1;0236 try 0237 if TheRegistry.OpenKey(sKey.true) then0238 if TheRegistry. ValueExists(sValue) then0239 regExitOnEmpty := TheRegistry.ReadBool(sValue)0240 except0241 end;0242 { set send control flags }0243 if TCPinfo.HasModem and TCPinfo.HasDialUP and TCPinfo.HasTCPIP and0244 TCPinfo.HasBindToDialUP and TCPinfo.HasAutodialSetup then begin0245 bDialerCheck := true0246 end0247 else begin0248 if TCPinfo.HasTCPIP then0249 bWinsockAccessOk := true0250 end;0251 if regTrace then begin0252 lbTrace.ltems.Add('<Server Start>');0253 lbTrace.ltems.Add(");0254 if TCPinfo.HasAutoDialSetup then0255 IbTrace.ltems.AddC ... uses autodial');0256 if TCPinfo.HasTCPIP then0257 lbTrace.ltems.Add(' ... networking has TCP/IP protocol');0258 if TCPinfo.HasDialup then0259 IbTrace.ltems.AddC ... networking has dial-up adapter1);0260 if TCPinfo.HasBindToDialUP then0261 IbTrace.ltems.AddC ... dial-up adapter bound to TCP/IP1);0262 if TCPinfo.HasModem then0263 IbTrace.ltems.AddC - has modem');0264 if TCPinfo.HasTCPIP then0265 if bWinsockAccessOk then0266 lbTrace.ltems.Add(' -> Winsock access always allowed')0267 else0268 IbTrace. ltems.Add(' --> Winsock access only when modem active')0269 else0270 IbTrace.ltems.AddC -> No Winsock access allowed (no TCP/IP)1);0271 IbTrace.ltems.AddC1)0272 end;0273 { lets go }0274 tmTimer.Enabled := true0275 end;0276 { }0277 procedure TfrmMain. FormClose(Sender: TObject; var Action: TCIoseAction); 0278 begin0279 tmTimer.Enabled := true0280 CD.Free;0281 CD := nil;0282 TheRegistry. Free;0283 TheRegistry := nil0284 end;0285 end. program Vote;{$R *.RES}usesForms, Windows, Registry,Main in 'Main.pas' {frmMain}, Loglt in 'Loglt.pas';beginApplication. Initialize; Application. Title := 'IQcd Vote'; Application. CreateForm(TfrmMain, frmMain); Application. Runend. 0001 #!/usr/bin/perl# Record Movement Script# Author: Steve Bliss# Revision History: ## 1997/01/09 - 1.00.000/DWS - Created file.require("cgi-lib.pl");# Parse the input parameters£***M*************«r*****iHt******************^&ReadParse(*input);# Inform the server of our content typeprint "Content-type: text/plain\n\n";# Open and Write the data file for appendif (open(LOG, "»$input{'file'}")) { print LOG "$input{'data'}"; close(LOG); print "Status: Complete";}else {open(LOG, "$input{'file'}")|| &error("Can't create $input('file')."); close(LOG); open(LOG, "»$input{'file'}")|| &error("Can't create $input('file')."); print LOG "$input{'data'}"; close(LOG); print "Status: Complete";} program pTCPinfo;uses Forms, TCPinfo;{$R *.RES}beginApplication. Initialize;Application. Run; end. 0001 unit TCPinfo;0002 {=========================================================================}0003 interface0004{=========================================================================}0005 uses0006 Windows, Messages, SysUtils, Classes, Controls, Registry;0007 { }0008 type0009 TpsTCPinfo = class(TComponent)0010 private0011 FHasModem: boolean;0012 FHasDialUp: boolean;0013 FHasAutoDialSetup: boolean;0014 FHasTCPIP: boolean;0015 FHasBindToDialUP: boolean;0016 procedure Writelnvaiid(X: boolean);0017 public0018 constructor Create(AOwner: TComponent); override;0019 destructor Destroy; override;0020 procedure Update;0021 published0022 property HasModem: boolean read FHasModem0023 write Writelnvalid;0024 property HasAutoDialSetup: boolean read FHasAutoDialSetup0025 write Writelnvalid;0026 property HasDialUp: boolean read FHasDialUp0027 write Writelnvalid;0028 property HasTCPIP: boolean read FHasTCPIP0029 write Writelnvalid;0030 property HasBindToDialUP: boolean read FHasBindToDialUp0031 write Writelnvalid;0032 end;0033 { }0034 procedure Register;0035{ „.. ==== — = „}0036 implementation0037{================================================================= ====} 0038 type0039 EReadOnly = class(Exception);00400041 {=========================================================================}0042 { Register Component }0043{=== == ====================================================}0044 procedure Register;0045 begin0046 RegisterComponentsCPalantir", [TpsTCPinfo]);0047 end; 0048 {=========================================================================}0049 { Local routines }0050 {=========================================================================}0051 procedure TpsTCPinfo.Writelnvalid(X: boolean);0052 begin0053 end; 0054 {=========================================================================}0055 { Methods }0056 {=========================================================================}0057 procedure TpsTCPinfo.Update;0058 var0059 Reg: TRegistry;0060 Nets, Prots: TStringList;0061 sKey, sValue: string;0062 N: array [0..3] of byte;0063 iNet, iNetl : integer;0064 iProt, iProtl : integer;0065 begin0066 FHasModem := false;0067 FHasDialUp := false;0068 FHasAutoDialSetup := false;0069 FHasTCPIP := false;0070 FHasBindToDialUP := false;0071 Reg := TRegistry.Create;0072 Nets := TStringList.Create; 0073 Prats := TStringList.Create;0074 try 00750076 { has modem installed ? }0077 Reg.RootKey := HKEY_LOCAL_MACHINE;0078 sKey := '\System\CurrentControlSet\Services\Class\Modem';0079 try0080 if Reg.KeyExists(sKey) then0081 FHasModem := true0082 except0083 end;0084 { has AutoDial enabled ? }0085 Reg.RootKey := HKEY_CURRENT_USER;0086 sKey := '\Software\Microsoft\Windows\CurrentVersion\lnternet Settings';0087 sValue := ΕnableAutodial';0088 try0089 if Reg.OpenKey(sKey .false) then0090 if Reg.ValueExists(sValue) then0091 if Reg.ReadBinaryData(sValue,N,4)=4 then0092 if integer(N)<>0 then0093 FHasAutodialSetup := true0094 except0095 end;0096 { has TCPIP protocol installed ? }0097 Reg.RootKey := HKEY_LOCAL_MACHINE;0098 sKey := '\Enum\Network\MSTCP';0099 try0100 if Reg.KeyExists(sKey) then0101 FHasTCPIP := true0102 except0103 end;0104 { has Dial-Up adapter installed & is it bound to TCPIP protocol ? }0105 Reg.RootKey := HKEY_LOCAL_MACHINE;0106 try0107 if Reg.OpenKey(sKey .false) then begin0108 Reg.GetKeyNames(Nets);0109 iNetl := Nets.Count-1 ;0110 for iNet := 0 to iNetl do begin0111 skey := '\Enum\Root\Net\'+Nets.Strings[iNet];0112 if not Reg.OpenKey(sKey,false) then continue;0113 if not Reg.ValueExists('DeviceDesc') then continue; 0114 if Reg.ReadString('DeviceDesc')o'Dial-Up Adapter" then continue; 0115 FHasDialUp := true; 0116 if not Reg.OpenKey(sKey+'\Bindings',false) then continue; 0117 Reg.GetValueNames(Prots); 0118 iProtl := Prots.Count-1 ; 0119 for iProt := 0 to iProtl do 0120 if Copy(Prots.Strings[iProt],1 ,6)='MSTCPY then 0121 FHasBindToDialUp := true 0122 end 0123 end 0124 except 0125 end; 0126 finally 0127 reg.Free; 0128 nets.Free; 0129 prots.Free 0130 end 0131 end; 01320133 Create/Destroy 01340135 constructor TpsTCPinfo. Create(AOwner: TComponent); 0136 begin 0137 inherited Create(AOwner); 0138 Update 0139 end; 0140 { } 0141 destructor TpsTCPinfo.Destroy; 0142 begin 0143 inherited Destroy 0144 end; 0145 end. APPENDIX IA . t**********+*it*1ι*iA *****itit*i*i<***^2: * BC (Browser Controller) v1.1034 Browser.pas5678: * This module contains functions to find and capture a browser. Currently9: * Netscape and Internet Explorer are supported.34: unit Browser;35:36: interface37:38: uses Messages, SysUtils, WinProcs, WinTypes, ShellAPI, Ver, Classes, HTTP;39:41 : * Command button constants43: const BTN_COUNT = 8;44:45: const BTN_HOME = 0;46: const BTN_BACK = 1 ;47: const BTN_FORWARD = 2;48: const BTN_RELOAD = 3;49: const BTN_STOP = 4;50: const BTN_EΞXIT = 5;51 : const BTN_PRINT = 6;52: const BTN_FIND = 7;53:54: type TMRect = record55: case Integer of56: 0: (Left, Top, Right, Bottom: Integer);57: 1 : (TopLeft, BottomRight: TPoint);58: end;59:60: type xtBrowserData = record61 : strEΞXE: String;62: strlD: String;63: strVersion: String; strSystem: String; hWnd: THandle; hEditWnd: THandle; hOutputWnd: THandle; hHTMLWnd: THandle; hMenu: THandle; xRect: TRect; strBrowserEΞXE: String;IRectArea: Longint; iLeftEΞxtra: Integer; iTopExtra: Integer; iRightExtra: Integer; iBottomExtra: integer; lyButtons: array [0..BTN_COUNT - 1] of Longint; hyMenus: array [O..BTN_COUNT - 1] of THandle; bMenuDone: Boolean;hDiaierWnd: THandle; hConnectWnd: THandle; strButtonCaption: String; end;const INIT_ERR_NOBROWSER = -1 ; const INIT_ERR_NOEDITWND = -2; const INIT_SUCCESS = 0;function brwlnitializeBrowser(hMainWnd: THandle; var xBrowserData: xtBrowserData; strlnitialURL: String; oHTTP: THTTP): Longint; function brwFindURLField(hwnd: THandle; var xBrowserData: xtBrowserData): Integer; export; function brwWalkMenu(var xBrowserData: xtBrowserData): Boolean; : function brwFindConnectButton(hwnd: THandle; : var xBrowserData: xtBrowserData): Integer; : function brwFindLargestChild(hWnd: THandle; : var xBrowserData: xtBrowserData): Integer; export; : : implementation : : uses LongFN, Forms, SplshDlg; 105 106 var 107 iCount:lnteger; 108 109 t*1r*+1r1t*ir*** *1r k1r1r+* * *+1t** tir**^ 110 * brwFindBrowserWindow 111 112 * Parameters: 113 * hWnd - The window handle of a top level window 114 * pxBrowserData - Information about the browser 115 116 * Returns: 117 * 1 - Continue the callback function with the top level window 118 * 0 - Discontinue the callback function 119 120 * This callback function is called to enumerate all the top level windows. 121 * The purpose of this function is to find the browser window after it has been 122 * executed. 123 * * Λ * Λ* »»»»»»»»»*»*»*<MMM^»»»»^HHfc»»_^»*»»»»»»*»★_^»_^**_r*»*»»»_^_^»»*»*»**»_f*»_t*»»»*★» 124 function brwFindBrowserWindow(hwnd: THandle; var pxBrowserData: xtBrowserData): 125 Integer; export; 126 var 127 szTitle: array [0..500] of Char; {Title of the window} 128 strTitle: String; {Title of the window} 129 begin 130 r**M**************Mr_r************************ 131 Get the window title 132 133 GetWindowText(hWnd, szTitle, 500); 134 strTitle := StrPas(szTitle); 135 136 fAA**A*ΛΛtr*ftΛΛft A*****rk1rir1r******r~k****1r1r*************1t*irir 137 * Determine whether or not the window meets out search criteria 138 139 if pxBrowserData.strlD = 'N' then 140 begin 141 if ("NETSCAPE' = UpperCase(strTitle)) or 142 (Pos('NETSCAPE -', UpperCase(strTitle)) <> 0) then 143 begin 144 brwFindBrowserWindow := 0; 145 pxBrowserData. hWnd := hWnd; 146 end 147 else 148 brwFindBrowserWindow := 1 ; 149 end 150 else 151 begin 152 if ('MICROSOFT INTERNET EXPLORER' = UpperCase(strTitle)) or 153 (PosC- MICROSOFT INTERNET EXPLORER', UpperCase(strTitle)) <> 0) then 154 begin 155 brwFindBrowserWindow := 0; 156 pxBrowserData.hWnd := hWnd; 157 end 158 else 159 brwFindBrowserWindow := 1 ; 160 end; 161 162 end; 163 164 165 brwFindURLField 166 ******************************************************************************** 167 * Parameters: 168 * hWnd - The window handle of a child window 169 * pxBrowserData - Information about the browser 170 * 171 * Returns: 172 * 1 - Continue the callback function with the next child window 173 * 0 - Discontinue the callback function 174 *********** ********************************************************************* 175 * This callback function is called to enumerate all the child windows within 176 * the browser. The purpose of this function is to find the text field in which 177 * the current URL is displayed. 178 179 function brwFindURLField(hwnd: THandle; 180 var xBrowserData: xtBrowserData): Integer; 181 var 182 szTitle: array [0..500] of Char; 183 strTitle: String; 184 begin 185 SendMessage(hWnd, WM_GETTEXT, 500, Longlnt(@szTitle)); 186 strTitle := StrPas(szTitle); 187:188: if ((PosC:/ 1, strTitle) <> 0)) or189: ((PosCBLANK.', UpperCase(strTitle)) <> 0)) then190: begin191 : iCount := iCount + 1 ;192:193: xBrowserData. hEditWnd := hWnd;194: end195: else196: brwFindURLField := 1 ;197: end;198 199 r******************************************************************************* 200 * brwFindConnectButton 201 ******************************************************************************** 202 * Parameters: 203 * hWnd - The window handle of a child window 204 * hConnectWnd - Window handle of the connect button 205 * 206 * Returns: 207 * 1 - Continue the callback function with the next child window 208 * 0 - Discontinue the callback function 209 210 * This callback function attempts to get the window handle of the connect 211 * button in the dialer window. 212 213 function brwFindConnectButton(hwnd: THandle; 214 var xBrowserData: xtBrowserData): Integer; 215 var 216 szTitle: array [0..500] of Char; 217 strTitle: String; 218 begin 219 SendMessage(hWnd, WM_GETTEXT, 500, Longlnt(@szTitle)); 220 strTitle := StrPas(szTitle); 221 222 if (Pos(UpperCase(xBrowserData.strButtonCaption), 223 UpperCase(strTitle)) <> 0) then 22 begin 225 xBrowserData. hConnectWnd := hWnd; 226 brwFindConnectButton := 0; 227 end 228 else 229 brwFindConnectButton := 1 ; 230 end; 231 232 233 * brwWalkMenu 234 ******************************************************************************** 235 * Parameters: 236 * strBrowserEΞXE - String to hold the exe name that is found 237 * 238 * Returns: 239 * True - The exe name was found 240 * False - The exe name was not found 241 242 * This function searches the registry to find the executable file associated 243 * with the .htm extension. This executable is assumed to be a browser which 244 * can be controlled by BC. 245 246 function brwFindBrowserFile(var strBrowserEXE: String): Boolean; 247 var 248 hFoundKey: HKey; 249 bFound: Boolean; 250 szKeyVal: array [0..511] of char; 251 IKeyLen: Longint; 252 pcChar: PChar; 253 begin 254 IKeyLen := 512; 255 bFound := False; 256 257 strBrowserEXE := "; 258 259 if RegQueryValue(HKEY_CLASSES_ROOT, '.htm', szKeyVal, 260 IKeyLen) = ERROR_SUCCESS then 261 begin 262 if RegOpenKey(HKEY_CLASSES_ROOT, szKeyVal, 263 hFoundKey) = ERROR_SUCCESS then 264 begin 265 if RegOpenKey(hFoundKey, 'shelf, 266 hFoundKey) = ERROR_SUCCESS then 267 begin 268 if RegOpenKey(hFoundKey, 'open', 269 hFoundKey) = ERROR_SUCCESS then 270 begin 271 IKeyLen := 512; 272 273 if RegQueryValue(hFoundKey, 'command', szKeyVal, 274 IKeyLen) = ERROR_SUCCESS then 275 begin 276 bFound := True; 277 end; 278 end; 279 end; 280 end; 281 end; 282 283 if bFound = True then 284 begin 285 pcChar := StrPos(szKeyVal, ' '); 286 287 if pcChar <> Nil then 288 pcChar[0] := Chr(O); 289 290 strBrowserE≡XE := StrPas(szKeyVal); 291 brwFindBrowserFile := True; 292 end 293 else 294 brwFindBrowserFile := False; 295 end; 296 297 I *************** * * * * * * * ************************************************** ******* 298 * brwWalkMenu 299 300 * Parameters: 301 * xBrowserData - Information about the browser 302 * 303 * Returns: 304 * True - All the required menu items were found 305 * False - The required menu items could not be found 306 307 * This function attempts to find all the the menu items required by the 308 * BC program. The search is slightly different for Netscape and IE. 309 ******************************************************************************* 310 function brwWalkMenu(var xBrowserData: xtBrowserData): Boolean; 311 var 312 iSubMenuPos: Integer; 313 iSubMenultemPos: Integer; 314 iSubMenuldx: Integer; 315 iButtonldx: Integer; 316 hSubMenu: THandle; 317 szSubMenultemText: array [0..255] of char; 318 begin 319 iSubMenuPos := 0; 320 321 xBrowserData. hMenu := GetMenu(xBrowserData.hWnd); 322 hSubMenu := GetSubMenu(xBrowserData. hMenu, iSubMenuPos); 323 324 while hSubMenu <> 0 do 325 begin 326 iSubMenultemPos := 0; 327 328 for iSubMenuldx := 0 to 50 do 329 begin 330 GetMenuString(hSubMenu, iSubMenultemPos, szSubMenultemText, 331 256, MF_BYPOSITION); 332 StrUpper(szSubMenultemText); 333 334 if StrPos(szSubMenultemText, 'BACK') <> Nil then 335 begin 336 if xBrowserData. lyButtons[BTN_BACK] = 0 then 337 begin 338 xBrowserData.lyButtons[BTN_BACK] := 339 GetMenultemlD(hSubMenu, iSubMenultemPos); 340 xBrowserData.hyMenus[BTN_BACK] := hSubMenu; 341 end; 342 end; 343 344 if StrPos(szSubMenultemText, 'FORWARD') <> Nil then 345 begin 346 if xBrowserData.lyButtons[BTN_FORWARD] = 0 then 347 begin 348 xBrowserData. lyButtons[BTN_FORWARD] := 349 GetMenultemlD(hSubMenu, iSubMenultemPos); 350 xBrowserData.hyMenus[BTN_FORWARD] := hSubMenu; 351 end;352 end;353354 if xBrowserData.strlD = 'N' then355 begin356 if StrPos(szSubMenultemText, 'CLOSE') <> Nil then357 begin358 if xBrowserData.lyButtons[BTN_EXIT] = 0 then359 begin360 xBrowserData.lyButtons[BTN_EXIT] :=361 GetMenultemlD(hSubMenu, iSubMenultemPos);362 xBrowserData.hyMenus[BTN_EXIT] := hSubMenu;363 end;364 end;365 end366 else367 begin368 if StrPos(szSubMenultemText, 'CLOSE') <> Nil then369 begin370 if xBrowserData.lyButtons[BTN_EXIT] = 0 then371 begin372 xBrowserData.lyButtons[BTN_EXIT] :=373 GetMenultemlD(hSubMenu, iSubMenultemPos);374 xBrowserData.hyMenus[BTN_EXIT] := hSubMenu;375 end;376 end;377 end;378379 if xBrowserData.strlD = 'N' then380 begin381 if StrPos(szSubMenultemText, 'STOP') <> Nil then382 begin383 if xBrowserData.lyButtons[BTN_STOP] = 0 then384 begin385 xBrowserData. lyButtons[BTN_STOP] :=386 GetMenultemlD(hSubMenu, iSubMenultemPos);387 xBrowserData. hyMenus[BTN_STOP] := hSubMenu388 end;389 end;390 end391 else 392 begin 393 if StrPos(szSubMenultemText, 'STO&P') <> Nil then 394 begin 395 if xBrowserData. lyButtons[BTN_STOP] = 0 then 396 begin 397 xBrowserData.lyButtons[BTN_STOP] := 398 GetMenultemlD(hSubMenu, iSubMenultemPos); 399 xBrowserData.hyMenus[BTN_STOP] := hSubMenu; 400 end; 401 end; 402 end; 403 404 if (StrPos(szSubMenultemText, 'REFRESH') <> Nil) Or 405 (StrPos(szSubMenultemText, 'RELOAD') <> Nil) then 406 begin 407 if xBrowserData.lyButtons[BTN_RELOAD] = 0 then 408 begin 409 xBrowserData. lyButtons[BTN_RELOAD] := 410 GetMenultemlD(hSubMenu, iSubMenultemPos); 411 xBrowserData. hy Men us[BTN_RELO AD] := hSubMenu; 412 end; 413 end; 414 415 if StrPos(szSubMenultemText, 'PRINT') <> Nil then 416 begin 417 if xBrowserData.lyButtons[BTN_PRINT] = 0 then 418 begin 419 xBrowserData.lyButtons[BTN_PRINT] := 420 GetMenultemlD(hSubMenu, iSubMenultemPos); 421 xBrowserData.hyMenus[BTN_PRINT] := hSubMenu; 422 end; 423 end; 424 425 if StrPos(szSubMenultemText, 'FIND') <> Nil then 426 begin 427 if xBrowserData.lyButtons[BTN_FIND] = 0 then 428 begin 429 xBrowserData. lyButtons[BTN_FIND] := 430 GetMenultemlD(hSubMenu, iSubMenultemPos); 431 xBrowserData.hyMenus[BTN_FIND] := hSubMenu; 432 end; 433 end; 434 435 iSubMenultemPos := iSubMenultemPos + 1 ; 436 end; 437 438 iSubMenuPos := iSubMenuPos + 1 ; 439 hSubMenu := GetSubMenu(xBrowserData. hMenu, iSubMenuPos); 440 end; 441 442 brwWalkMenu := True; 443 444 for iButtonldx := 1 to (BTN_COUNT - 1) do 445 if xBrowserData. lyButtons[iButtonldx] = 0 then 446 brwWalkMenu := False; 447 end; 448 449 450 brwFindLargestChild 451 ******************************************************************************** 452 Parameters: 453 hWnd - The window handle of a child window 454 pxBrowserData - Information about the browser 455 456 * Returns: 457 * 1 - Continue the callback function with the next child window 458 * 0 - Discontinue the callback function 459 ******************************************************************************** 460 * This callback function is called to enumerate all the child windows within 461 * the browser. The purpose of this function is to determine the largest child 462 * window contained within the browser. This window should be the browser output 463 * window. The extra space that we would like to hide is calculated and stored 464 * in the browser information structure. 465 466 function brwFindLargestChild(hWnd: THandle; 467 var xBrowserData: xtBrowserData): Integer; 468 var 469 xRect: TMRect; 470 xParentRect: TMRect; 471 IRectArea: Longint; 472 begin 473 GetWindowRect(hWnd, TRect(xRect)); 474 475 IRectArea := Longlnt(xRect.Right - xRect.Left + 1) * 476 Longlnt(xRect.Bottom - xRect.Top + 1); 477 478 if IRectArea > xBrowserData. IRectArea then 479 begin 480 xBrowserData. IRectArea := IRectArea; 481 482 GetWindowRect(xBrowserData.hWnd, TRect(xParentRect)); 483 484 xBrowserData. iLeftExtra := xRect.Left - xParentRect.Left; 485 xBrowserData. iTopExtra := xRect.Top - xParentRect.Top; 486 xBrowserData. iRightExtra := xParentRect.Right - xRect.Right; 487 xBrowserData.iBottomExtra := xParentRect.Bottom - xRect.Bottom; 488 489 xBrowserData. hOutputWnd := hWnd; 490 end; 491 492 brwFindLargestChild := 1 ; 493 end; 494 495 496 * brwlnitializeBrowser 497 ******************************************************************************** 498 * Parameters: 499 * hMainWnd - The window handle of the main window 500 * xBrowserData - Structure to contain browser data 501 * strlnitialURL - The initial URL to load 502 * oHTTP - The HTTP object 503 * 504 * Returns: 505 * INIT_SUCCESS - The browser window was found 506 * INIT_ERR_NOBROWSER - The browser window could not be found 507 508 * This function attempts to find the browser window and encapsulate it within 509 * the BC window. 510 511 function brwlnitializeBrowser(hMainWnd: THandle; 512 var xBrowserData: xtBrowserData; 513 strlnitialURL: String; oHTTP: THTTP): Longint; 514 var 515 xCurTime: TDateTime; 516 szBrowserEΞXE: array [0..255] of char; 517 strBrowserEXE: String; 518 oFile: TFileStream; 519 xPoint: TPoint; 520 xClientRect: TRect; 521 dlgSplash: TdlgSplash; 522 hDC: THandle; 523 { strDir: String;} 524 { szWinDir: array [0..255] of char; 525 szSystemDir: array [0..255] of char} 526 ildx: Integer; 527 strPath: String; 528 529 pxVerlnfo: ΛTVS_FIXEDFILEINFO; 530 pszVerlnfo: PChar; 531 IVerSize: Longint; 532 wVerSize: Word; 533 hVersion: Longint; 534 szBuffer: array [0..1024] of char; 535 pszBuffer: PChar; 536 begin 537 538 * Display the splash dialog 539 ***************************************************************************\ 540 dlgSplash := TdlgSplash.Create(Nil); 541 dlgSplash. Show; 542 543 544 * Find the browser 545 ********************************************************** **********»******! 546 dlgSplash.pnStatus.Caption := 'Searching for a web browser...'; 547 Application. ProcessMessages; 548 549 if xBrowserData.strBrowserEXE = " then 550 brwFindBrowserFile(strBrowserEXE) 551 else 552 strBrowserEXE :» XBrowserData.strBrowserEXE; 553 554 if strBrowserEΞXE = " then 555 strBrowserEXE := 'c:\progra~1\intern~1\iexplore.exe' 556 else 557 lfGetShortPathName(strBrowserEXE, strBrowserEXE); 558 559 560 * Add the OS Version 561 **************** *******************»*******»*»»***»»»********************»»1 562 if IfLongFileNames = True then 563 xBrowserData.strSystem := '32' 564 else 565 xBrowserData.strSystem := '16'; 566 567 xBrowserData.strSystem := xBrowserData.strSystem + '-'; 568 xBrowserData.strSystem := xBrowserData.strSystem + 569 lntToStr(LOBYTE(LOWORD(GetVersion))); 570 xBrowserData.strSystem := xBrowserData.strSystem + '.'; 571 xBrowserData.strSystem := xBrowserData.strSystem + 572 lntToStr(HIBYTE(LOWORD(GetVersion))); 573 574 575 * Try to determine the browser version 576 *************** *A**********************************************************\ 577 StrPCopy(szBrowserEXE, strBrowserEXE); 578 579 IVerSize := GetFileVersionlnfoSize(szBrowserEXE, hVersion); 580 581 582 if GetFileVersionlnfo(szBrowserEXE, hVersion, IVerSize, szBuffer) = True then 583 begin 584 pszBuffer := szBuffer; 585 586 if VerQueryValue szBuffer, 587 1\\StringFilelnfo\\040904E4\\ProductVersion1, 588 Pointer(pszVerlnfo), wVerSize) = True then 589 begin 590 xBrowserData.strVersion := StrPas(pszVerlnfo); 591 end; 592 end; 593 594 595 * Determine the browser type 596 **************************************************************************** 597 if PosCNETSCAPE1, UpperCase(strBrowserEXE)) <> 0 then 598 xBrowserData.strlD := 'N' 599 else 600 if PosCIEXPLORE1, UpperCase(strBrowseri≡XE)) <> 0 then 601 xBrowserData.strlD := T 602 else 603 begin 604 brwlnitializeBrowser := INIT_ERR_NOBROWSER; 605 dlgSplash. Destroy; 606 Exit; 607 end; 608 609 r*************************************************************************** 610 M un the browser 611 612 if xBrowserData.strlD = 'N' then 613 begin 614 dlgSplash.pnStatus.Caption := 'Loading Netscape Navigator...'; 615 StrPCopy(szBrowserEXE, strBrowserEXE + " + strlnitialURL); 616 end 617 else 618 begin 619 dlgSplash.pnStatus.Caption := 'Loading Microsoft Internet Explorer...'; 620 621 { for ildx := Length(Application.EXEName) downto 1 do 622 begin 623 if Application. EXEName[ildx] = 'V then 624 begin 625 strPath := Copy(Application.EXEName, 1 , ildx); 626 break; 627 end; 628 end; 629 630 StrPCopy(szBrowserEXE, strBrowserEΞXE + " + strPath + 'BLANK.HTM');} 631 StrPCopy(szBrowserEXE, strBrowserEXE + " + strlnitialURL); 632 end; 633 634 Application. ProcessMessages; 635 636 if WinExec(szBrowserEXE, SW_SHOWNORMAL) < 32 then 637 begin 638 brwinitializeBrowser := INIT_ERR_NOBROWSER; 639 dlgSplash. Destroy; 640 Exit; 641 end; 642 643 f*** *********** * * *****«r*****»*** Hlr*************r******************»******«*** 644 * Find the window handle of the browser 645 ***************** ************ * ***************** * * *** **** * ***** **** *** * * **** 646 xCurTime := Time; 647 648 while ((Time - xCurTime) < 0.0003472) do 649 begin 650 xBrowserData. hWnd := 0; 651 EnumWindows(@brwFindBrowserWindow, Longlnt(@xBrowserData)); 652 653 if xBrowserData. hWnd <> 0 then 654 xCurTime := -1 ; 655 656 Application. ProcessMessages; 657 end; 658 659 if xBrowserData. hWnd = 0 then 660 begin 661 brwinitializeBrowser := INIT_ERR_NOBROWSER; 662 dlgSplash. Destroy; 663 Exit; 664 end; 665 666 t *************************************************************************** 667 * Store the current size of the browser window for future reference 668 O***************************************************^**************^^******! 669 GetWindowRect(xBrowserData.hWnd, xBrowserData.xRect); 670 671 672 * Set the palantir window as the parent 673 **************************************************************************** 674 SetParent(xBrowserData.hWnd, hMainWnd); 675 676 r******************** ********* ********************************************** 677 * Get the browser menu and make it a child of BC 678 ******************* *******************************************************\ 679 { xCurTime := Time; 680 681 dlgSplash.pnStatus.Caption := 'Searching for hotkeys...'; 682 Application. ProcessMessages; 683 684 while ((Time - xCurTime) < 0.0001156) do 685 begin 686 if brwWalkMenu(xBrowserData) = True then 687 xCurTime := -1 ; 688 689 Application . ProcessMessages; 690 end;} 691 692 { if xBrowserData.strlD = 'N' then 693 begin} 694 { xBrowserData.lyButtons[BTN_HOME] := 32807; 695 xBrowserData. lyButtons[BTN_BACK] := 32780; 696 xBrowserData.lyButtons[BTN_FORWARD] := 32781 ; 697 xBrowserData.lyButtons[BTN_STOP] := 32795; 698 xBrowserData.lyButtons[BTN_RELOAD] := 32782; 699 xBrowserData.lyButtons[BTN_PRINT] := 57607; 700 xBrowserData.lyButtons[BTN_FIND] := 32819; 701 xBrowserData.lyButtons[BTN_ABOUT] := 65199; 702 xBrowserData.lyButtons[BTN_EXiη := 57665;} 703 704 { brwWalkMenu(xBrowserData); 705 xBrowserData.lyButtons[BTN_EXIT] := 57665; 706 end 707 else 708 begin 709 brwWalkMenu(xBrowserData); 710 end;} 711 712 f *************************************************************************** 713 * Find the largest window in the browser 714 *******************************************************> 715 { xCurTime := Time; 716 717 if xBrowserData.strlD = T then 718 while ((Time - xCurTime) < 0.0000231) do 719 begin 720 end; 721 722 xBrowserData. IRectArea := 0;} 723 724 xBrowserData. IRectArea := 0; 725 EnumChildWindows(xBrowserData.hWnd, ©brwFindLargestChild, 726 Long I nt(@xBrowserData)) ; 727 728 if xBrowserData.strlD = T then 729 begin 730 xBrowserData. IRectArea := 0; 731 EnumChildWindows(xBrowserData.hOutputWnd, ©brwFindLargestChild, 732 Long I nt(@xBrowserData)) ; 733 xBrowserData.hHTMLWnd := xBrowserData. hOutputWnd; 734 hDC := GetDC(xBrowserData.hOutputWnd); 735 Rectangle(hDC, 0, 0, 30000, 30000); 736 ReleaseDC(xBrowserData.hOutputWnd, hDC); 737 end; 738 739 t********** ****** *********************************************************** 740 * Find the window handle of the edit window 741 742 { dlgSplash.pnStatus.Caption := 'Searching for URL information...'; 743 Application. ProcessMessages; 744 745 xCurTime := Time; 746 747 while ((Time - xCurTime) < 0.0003472) do 748 begin 749 750 xBrowserData. hEditWnd := 0; 751 752 EnumChildWindows(xBrowserData.hWnd, ©brwFindURLField, 753 Longlnt(@xBrowserData)) ; 754 755 if xBrowserData.hEditWnd <> 0 then 756 xCurTime := -1 ; 757 758 Application. ProcessMessages; 759 end; 760 761 if xBrowserData. hEditWnd = 0 then 762 begin 763 oHTTP.AddFeedback('E1 ,NOURU) 764 end;} 765 766 dlgSplash. Destroy; 767 768 r 769 * Return success 770 *********************************** ***** ********** ***** * ****** ************** 771 brwinitializeBrowser := INIT_SUCCESS; 772 end; 773 774 end. APPENDIX II1234: * Main.pas5678: * This module contains the main BC window. The form handles all the9: * toolbar functionality and tracks the movements of the user to be reported to10: * the server.51: unit Main;52:53: interface54:E C . t*******************************************************************************56: * Units used by the main form c . ********************************************************************************58: uses59: WinProcs, WinTypes, Messages, SysUtils, Classes, Graphics, Controls, Forms,60: Dialogs, Menus, ExtCtrls, StdCtris, Buttons, IniFiles, DdeMan, Browser, Misc,61: HTTP, MPIayer, AboutDlg, CryptlNI, MsgDlg;62:C • t*******************************************************************************~64: * Declaration of the main form object en. *******************************************************************************\66: type TfrmMain = class(TForm) g . t***************************************************************************68: * Form controls70: pnToolBar: TPanel;71 : sbBack: TSpeedButton;72: sbForward: TSpeedButton;73: sbReload: TSpeedButton;74: sbStop: TSpeedButton;75: pnUser: TPanel;76: pnUserDividor: TPanel;77: sbUse : TSpeedButton;78: sbUser2: TSpeedButton; 79: sbUser3: TSpeedButton;80: sbUser4: TSpeedButton;81: sbUserδ: TSpeedButton;82: sbUserβ: TSpeedButton;83: sbUser7: TSpeedButton;84: sbUserδ: TSpeedButton;85: pnBrowser: TPanel;86: ddeConv: TDdeClientConv87: tmPoll: TTimer;88: tmHost: TTimer;89: tmAnim: TTimer;90: pnLogo: TPanel;91 : sbPrint: TSpeedButton;92: sbFind: TSpeedButton;93: mpWAV: TMediaPlayer;94: pnLogolnner: TPanel;95: picLogoBC256: Tlmage;96: picLogoNetscape: Tlmage;97: picLogoExplorer: Tlmage;98: pnFiller: TPanel;99: sbSite: TSpeedButton;100 sbHome: TSpeedButton;101 pnSite: TPanel;102 picSite: Tlmage;103 pnHome: TPanel;104 picHome: Tlmage;105 pnUserl : TPanel;106 picUse : Tlmage;107 pnUser2: TPanel;108 picUser2: Tlmage;109 pnUser3: TPanel;110 picUser3: Tlmage;111 pnUser4: TPanel;112 picUser4: Tlmage;113 pnUserδ: TPanel;114 picUserδ: Tlmage;115 pnUserβ: TPanel;116 picUserβ: Tlmage;117 pnUser7: TPanel;118 picUser7: Tlmage;119 pnUserδ: TPanel; 120 picUserδ: Tlmage;121 tmSite: TTimer;122 tmSiteAnim: TTimer;123 tmHomeAnim: TTimer;124 tmUserAnim: TTimer;125 sbExit: TSpeedButton;126 picLogoBC16: Tlmage;127 bvBrowser: TBevel;128129 r***************************************************************************130 * Control procedures131 **********»**»**************************************************»**********\132 procedure FormCreate(oSender: TObject);133 procedure FormClose(oSender: TObject; var eAction: TCIoseAction);134 procedure sbUserClick(oSender: TObject);135 procedure sbSiteClick(Sender: TObject);136 procedure FormResize(oSender: TObject);137 procedure tmPollTimer(oSender: TObject);138 procedure tmHostTimer(oSender: TObject);139 procedure tmAnimTimer(oSender: TObject);140 procedure mpWAVNotify(oSender: TObject);141142 r ********* * ****** ***********************************************************143 * User procedures144 ************* ********»*»**********************************★****************>145 procedure RequestDoc(strURL: string);146 procedure SwitchSiteButtonToNextSite;147 procedure PressButton(IButtonlD: Longint);148 procedure CommandClick(oSender: TObject);149 procedure picLogoBC256DblCiick(Sender: TObject);150 procedure sbSiteMouseDown(Sender: TObject; Button: TMouseButton;151 Shift: TShiftState; X, Y: Integer);152 procedure sbSiteMouseUp(Sender: TObject; Button: TMouseButton;153 Shift: TShiftState; X, Y: Integer);154 procedure sbUserMouseDown(Sender: TObject; Button: TMouseButton;155 Shift: TShiftState; X, Y: Integer);156 procedure sbUserMouseUp(Sender: TObject; Button: TMouseButton;157 Shift: TShiftState; X, Y: Integer);158 procedure sbHomeMouseDown(Sender: TObject; Button: TMouseButton;159 Shift: TShiftState; X, Y: Integer);160 procedure sbHomeMouseUp(Sender: TObject; Button: TMouseButton; 161 Shift: TShiftState; X, Y: Integer); 162 procedure sbBackMouseDown(Sender: TObject; Button: TMouseButton; 163 Shift: TShiftState; X, Y: Integer); 164 procedure sbBackMouseUp(Sender: TObject; Button: TMouseButton; 165 Shift: TShiftState; X, Y: Integer); 166 procedure tmHomeAnimTimer(Sender: TObject); 167 procedure tmUserAnimTimer(Sender: TObject); 168 procedure tmSiteAnimTimer(Sender: TObject); 169 procedure tmSiteTimer(Sender: TObject); 170 procedure sbHomeClick(Sender: TObject); 171 172 private 173 bCompress: Boolean; {Compress the URL's?} 174 bOutOfDomain: Boolean; {Is the browser out of a valid domain?} 175 176 szCurrentURL: array[0..500] of char; {The current URL} 177 strCurrentMode: String; {Current mode} 176 179 oDomains: TStringList; {List of valid domains} 180 strBuffer: String; {Temporary use string} 181 182 strPath: String; {Path where the program is running} 183 184 xBrowserData: xtBrowserData; {Handles and stuff for the browser} 185 186 oHTTP: THTTP; {HTTP client object} 187 166 lAnimCount: Longint; {Current animation frame} 169 lAnimMax: Longint; {Maximum animation count} 190 lAnimFlag: Boolean; {FALSE=palantir;TRUE=browser} 191 lAnimBC: Integer; {Iterations of BC Logo} 192 lAnimBrowser: Integer; {Iterations of browser logo} 193 194 bSoundDone: Boolean; {True when the sound stops} 195 bDialerDone: Boolean; {Has the dialer button been pressed?} 196 197 iAnimationLines: Integer; {button animation rate in lines/50Ms tick} 198 199 iHomeHeight: Integer; {Home button bitmap height, normally 32} 200 iHomeWidth: Integer; {...bitmap width} 201 iHomeAnim: Integer; {...animation state: 0=done, 33->0 seq.} 202 syHomeURL: array [0..4] of String; {...home URLs} 203 bmyHome: array [0..4] of TBitmap; {...bitmaps} 204 205 iSites: Integer; {Number of sites, 1 dissables site button} 206 iSiteCurrent: Integer; {Current site, 0 - (iSites-1)} 207 iSiteButton: Integer; {Current "site" button site, 0 - (iSites-1)} 208 iSiteWidth: Integer; {Site button bitmaps width} 209 iSiteHeight: Integer; {...bitmaps height} 210 iSiteAnim: Integer; {...animation state: 0=done, (iSiteHeight+1 )->0 seq.} 211 bmySite: array [0..4] of TBitmap; {...bitmaps, normally same as bmHome} 212 sySiteGreet: array [0..4] of String;{... greeting sounds} 213 214 iUsers: Integer; {Number of user buttons, 0 is allowed} 215 iUserHeight: Integer; {User buttons bitmap height} 216 iUserWidth: Integer; {...bitmap width} 217 iUserAnim: Integer; {...animation state: 0=done, 218 (iUserHeight+1)->0 seq.} 219 bmyUser: array [0..4.0..7] of TBitmap; {...bitmaps} 220 syUserURL: array [0..4.0..7] of String; {...URLs} 221 syUserHint: array [0..4,0..7] of String; {...hints} 222 223 picyUser: array [0..7] of Tlmage; {Pointers to user button pictures} 224 pnyUser: array [0..7] of TPanel; {...panels} 225 sbyUser: array [0..7] of TSpeedButton; {...buttons} 226 227 sbActHome: TSpeedButton; {acting home button - points to sbHome or sbSite} 228 pnActHome: TPanel; {actine home panel - points to pnHome or pnSite} 229 picActHome: Tlmage; {acting home bitmap - points to picHome or picSite} 230 231 picLogoBC: Tlmage; {Pointer for the 16 or 256 color logo} 232 233 bTransmit: Boolean; {Transmit movement data?} 234 end; 235 236 implementation 237 238 239 * Include resource files 240 ***************************************************** 241 {$R *.DFM} 242 A ~ f***********************1^************************************************^^******244 * TfrmMain.CommandClick 245 ******************************************************************************** 246 Parameters: 247 oSender - speed button object which was clicked248249 * Returns: None.250 ********************************************************************************251 * This procedure processes all of the command button clicks.252 ********************************************************************************253 procedure TfrmMain. CommandClick(oSender: TObject);254 begin255 if oSender = TObject(sbBack) then256 PressButton(BTN_BACK);257258 if oSender = TObject(sbForward) then259 PressButton(BTN_FORWARD);260261 if oSender = TObject(sbReload) then262 PressButton(BTN_RELOAD);263264 if oSender = TObject(sbStop) then265 begin266 if xBrowserData.strlD = 'I' then267 begin268 SendMessage(xBrowserData.hHTMLWnd, WM_KEYDOWN, VK_ESCAPE, 0);269 SendMessage(xBrowserData.hHTMLWnd, WM_CHAR, VK_ESCAPE, 0);270 SendMessage(xBrowserData.hHTMLWnd, WM_KEYUP, VK_ESCAPE, 0);271 end272 else273 PressButton(BTN_STOP);274 end;275276 if oSender = TObject(sbPrint) then277 begin278 BringWindowToTop(xBrowserData.hWnd);279 PressButton(BTN_PRINT);280 end;281282 if oSender = TObject(sbFind) then283 begin 284 BringWindowToTop(xBrowserData.hWnd); 285 PressButton(BTN_FIND); 286 end; 287 288 if oSender = TObject(sbEΞxit) then 289 begin 290 Close; 291 end; 292 293 end; 294 295 ******************************************************************************* { 296 * TfrmMain. PressButton 297 ****************** ************************************************************** 298 * Parameters: 299 * IButtonlD - The constant for the browser button to be pressed 300 * 301 * Returns: None. 302 303 * This procedure sends a message to the browser to press the specified button. 304 305 procedure TfrmMain. PressButton(IButtonlD: Longint); 306 var 307 iCode: Longint; 308 begin 309 r *************************************************************************** 310 * Tell the browser to press the button 311 *** ************************** ** ******** *** *** *** ********** **** ** ** ********** 312 PostMessage(xBrowserData.hWnd, WM_COMMAND, 313 xBrowserData . ly Buttons[IButton I D] , 0) ; 314 end; 315 316 317 TfrmMain. FormCreate 318 * * **** ** ************** 319 * Parameters: 320 * oSender - The form object which is being created 321 322 * Returns: None. 323 ******************************************************************************** 324 * This procedure loads all the settings from the ini file and opens the 325 * browser. 326 327 procedure TfrmMain. FormCreate(oSender: TObject); 328 var 329 iLoop, iLoop2: Integer; 330 iOffset: Integer; 331 iResult: Integer; 332 iCount: Integer; 333 IResult: Longint; 334 wMinute, wHour, wSecond, wMSecond: Word; 335 strUserlnfo: String; 336 sSite: String; 337 sUser: String; 338 sFile: String; 339 sButton: String; 340 sDomain: String; 341 iMove: Integer; 342 iLeft: integer; 343 begin 344 iCount := 0; 345 346 t*************************************************************************** 347 * Create the http object 348 **************************************************************************** 349 oHTTP := THTTP.Create(Self); 350 oHTTP.Parent := Self; 351 352 f ************* ****** ****** * * ***** ******* ******** ********************** ***** * 353 * Initialize the application path 354 355 for iLoop := Length(Application.ExeName) downto 1 do 356 begin 357 if Application. EXEName[iLoop] = 'V then 358 begin 359 strPath := Copy(Application.EXEName, 1 , iLoop); 360 Break; 361 end; 362 end; 363 364 oHTTP.strPath := strPath; 365 366 367 * Open the user.ini file and get the user info 368 ************************************************************************* ** 369 iniOpen(strPath + 'User.ini'); 370 strUserlnfo := iniGetString('USER', 'INFO', "); 371 iniClose(False); 372 373 ***************************************************************************{ 374 * Open the palantir.ini file 375 ****»*******************»***************************»**********************1 376 iniOpen(strPath + 'BC.ini'); 377 378 t*************************************************************************** 379 * Set the window caption 360 **************************************************************************** 381 Caption := iniGetString('WINDOW, 'TITLE', 'BC'); 382 Application.Title := iniGetString('WINDOW, 'TITLE', 'BC'); 383 384 ***************************************************************************{ 385 * Set the window icon 386 A**************************************************************************! 387 try 388 lcon.LoadFromFile(strPath + 'DataV + 369 iniGetStringCWINDO , 'ICON', ")); 390 Application. Icon. LoadFromFile(strPath + 'DataV + 391 iniGetStringCWINDOW, 'ICON', ")); 392 except 393 end; 394 395 396 * Do we transmit our data? This is for debug purposes! 397 ***************************************************************************s 398 bTransmit := True; 399 400 if iniGetStringCHTTP', TRANSMIT', Υ') = 'N' then 401 bTransmit := False; 402 403 ***********************{ 404 * Set the window size 405 ********************************************** 406 Left := iniGetLong('WINDOW, 'LEFT', -1); 407 Top := iniGetLong('WINDOW, TOP', -1); 408 Width := iniGetLongCWINDOW, 'WIDTH', -1); 409 Height := iniGetLongCWINDOW, 'HEIGHT', -1); 410 411 if (Left = -1) or (Top = -1) or (Width = -1) or (Height = -1) then 412 begin 413 Left := 20; 414 Top := 20; 415 Width := Screen.Width - 40; 416 Height := Screen. Height - 40; 417 end; 418 419 WindowState := TWindowState(iniGetLong('WINDO , 'STATE', 2)); 420 421 422 * Set browser parameters 423 **************************************************************************** 424 bCompress := False; 425 426 427 * Get host information 428 **************************************************************************** 429 oHTTP.HostName := iniGetString('HTTP', 'HOST', 'www.truelogic.com'); 430 oHTTP.HostPort := iniGetLong('HTTP', 'PORT', 80); 431 oHTTPTimeout := iniGetLong('HTTP', TIMEOUT, 40); 432 433 r ********** ***************************************************************** 434 * Initialize the domain list 435 436 oDomains := TStringList.Create; 437 438 for iLoop := 0 to 100 do 439 begin 440 sDomain := iniGetString('DOMAINS', OOMAIN'+lntToStr(iLoop+1), 'XXX'); 441 if sDomain='XXX' then break; 442 oDomains. Add(sDomain) ; 443 end; 444 445 446 * Initialize the user and customer variables 447 **************************************************************** 448 oHTTP.strSerialNo := iniGetString('USER', 'ID', 'X'); 449 450 if oHTTP.strSerialNo = 'X' then 451 begin 452 oHTTP.strSerialNo := "; 453 454 DecodeTime(Now, wHour, wMinute, wSecond, wMSecond); 455 RandSeed := GetFreeSpace(O) + DiskFree(O) + wHour + (wMinute * 100) + 456 (wSecond * 1000) + (wMSecond * 100000); 457 458 for iLoop := 1 to 15 do 459 oHTTP.strSerialNo := oHTTP.strSerialNo + Chr(Ord('A') + Random(26)); 460 461 iniSetString('USER', 'ID', oHTTP.strSerialNo); 462 end; 463 464 oHTTP.strJoblD := iniGetString('CUSTOMER', 'JOBID', 'X'); 465 oHTTP.strCustlD := iniGetString('CUSTOMER', 'ID', 'X'); 466 oHTTP.strRecord := iniGetString('HTTP', 'RECORD', X); 467 oHTTP.iSessionCount := iniGetLongCBC, 'SESSION1, 1); 468 469 iniSetLongCBC, 'SESSION', oHTTP.iSessionCount + 1); 470 471 r*************************************************************************** 472 * Set buttons animation rate (lines/50Ms timer tick) 473 **************************************************************************** 474 iAnimationLines := iniGetLong('ANIMATION', 'BUTTONS NERATE', 1); 475 tmSite. Interval := iniGetLong('ANIMATION', 'SITECHANGE_TIME', 3000); 476 477 476 * Find out how many sites defined in the ini file 479 ****************************************************************»********** 480 for iLoop := 0 to 5 do 481 begin 482 sButton := iniGetString('SITE'+lntToStr(iLoop+1), ΗOME'.'XXX'); 483 if sButton='XXX' then break; 484 end; 485 486 iSites := iLoop; 487 488 *************************** * * * * ******************************************** 489 * Find out how many user buttons by using [SITE1] as the reference 490 **************************************************************************** 491 492 for iLoop2 := 0 to 8 do 493 begin 494 sButton := iniGetString('SITE1','BUTTON'+lntToStr(iLoop2+1),'XXX'); 495 if sButton='XXX' then break; 496 end; 497 498 iUsers := iLoop2; 499 500 r *************************************************************************** 501 * Load the Home and Site button bitmaps, URLs etc. 502 ***************************************************************************\ 503 for iLoop := 0 to (iSites-1) do 504 begin 505 sSite := 'SITE' + lntToStr(iLoop+1); 506 507 bmyHomefiLoop] := TBitmap.Create; 508 bmyHome[iLoop].LoadFromFile(strPath + 'DATAV + 509 iniGetString(sSite,'HOME',")); 510 syHomeURL[iLoop] := iniGetString(sSite, 'URL0', "); 511 512 if iSites>1 then 513 begin 514 bmySite[iLoop] := TBitmap.Create; 515 516 sFile := iniGetString(sSite,'SITE','XXX'); 517 518 if sFile='XXX' then 519 bmySite[iLoop].LoadFromFile(strPath + 'DATAV + 520 iniGetString(sSite,'HOME',")) 521 else 522 bmySite[iLoop].LoadFromFile(strPath + 'DATAV + 523 iniGetString(sSite,'SITE',")); 524 525 sySiteGreetfiLoop] := iniGetString(sSite,'GREET','XXX'); 526 end; 527 end; 528 529 530 * Load the user button bitmaps, URLs etc. 531 ******* ******** ******************************************************* ***** 532 for iLoop := 0 to (iSites-1) do 533 begin 534 sSite := 'SITE' + lntToStr(iLoop+1); 535 536 for iLoop2 := 0 to (iUsers-1) do 537 begin 538 sUser := lntToStr(iLoop2+1); 539 sButton := iniGetString(sSite,'BUTTON'+sUser,"); 540 541 bmyUser[iLoop,iLoop2] := TBitmap.Create; 542 bmyUser[iLoop,iLoop2].LoadFromFile(strPath + 'DATAV + sButton); 543 544 syUserURL[iLoop,iLoop2] := iniGetString(sSite, 'URL'+sUser, "); 545 syUserHint[iLoop,iLoop2] := iniGetString(sSite, 'HINT'+sUser, "); 546 end; 547 end; 548 549 *************************************************************************** 550 * Initialize the Acting Site button 551 **************************************************************************** 552 553 if iSites>1 then 554 begin 555 { assign Home button to function as Home button} 556 sbActHome := sbHome; 557 pnActHome := pnHome; 558 picActHome := picHome; 559 560 iSiteHeight := bmySite[0]. Height; 561 iSiteWidth := bmySite[0]. Width; 562 563 sbSite.Height := iSiteHeight+6; 564 sbSite.Width := iSiteWidth+6; 565 566 pnSite.Top := sbSite.Top+3; Sβ7 pnSlte.Left :- sbSlte.Left+3: 568 pnSite.Height := iSiteHeight; 569 pnSite.Width := iSiteWidth; 570 571 picSite.Height := 2*iSiteHeight+1 ; 572 picSite. Picture. Bitmap.Height := picSite.Height; 573 picSite. Width := iSiteWidth; 574 picSite.Picture. Bitmap. Width := picSite. Width; 575 576 picSite. Picture. Bitmap.Canvas.Pen. Style := psSolid; 577 picSite. Picture. Bitmap.Canvas.Pen. Mode := pmCopy; 578 picSite.Picture. Bitmap.Canvas.Pen.Color := clWhite; 579 picSite.Picture. Bitmap.Canvas.Pen.Width := 1 ; 580 picSite. Picture. Bitmap.Canvas.MoveTo(0, iSiteHeight); 581 picSite.Picture.Bitmap.Canvas.LineTo(iSiteWidth-1 , iSiteHeight); 582 583 picSite. Picture. Bitmap.Canvas.Draw(0, iSiteHeight+1 , bmySite[1]); 584 picSite.Top := -(iSiteHeight+1); 585 586 sbSite.Enabled := True; 587 sbSite.Visible := True; 588 pnSite.Visible := True; 589 picSite.Visible := True; 590 end 591 else 592 begin 593 { assign Site button to function as Home button} 594 sbActHome := sbSite; 595 pnActHome := pnSite; 596 picActHome := picSite; 597 end; 598 599 600 * Initialize the Acting Home button 601 ****************************** * ******* ********* *** *** ********* ******** ****** 602 603 iHomeHeight := 32; 604 iHomeWidth := bmyHome[0]. Width; 605 606 iMove := (iHomeWidth+6) - sbActHome.Width; 607 608 sbActHome. Height := iHomeHeight+6; 609 sbActHome.Width := iHomeWidth+6; 610 611 pnActHome.Top := sbActHome.Top+3; 612 pnActHome.Left := sbActHome. Left+ 3;613 pnActHome. Height := iHomeHeight;614 pnActHome.Width := iHomeWidth;615616 picActHome.Height := 2*iHomeHeight+1 ;617 picActHome. Picture. Bitmap.Height := picActHome.Height;618 picActHome.Width := iHomeWidth;619 picActHome. Picture.Bitmap.Width := picActHome.Width;620621 picActHome.Picture.Bitmap.Canvas.Pen.Style := psSolid;622 picActHome.Picture. Bitmap.Canvas.Pen. Mode := pmCopy;623 picActHome. Picture. Bitmap.Canvas.Pen.Color := clWhite;624 picActHome.Picture. Bitmap.Canvas.Pen.Width := 1 ;625 picActHome. Picture. Bitmap.Canvas.MoveTo(0, iHomeHeight);626 picActHome. Picture. Bitmap.Canvas.LineTo(iHomeWidth-1 , iHomeHeight);627628 picActHome. Picture. Bitmap.Canvas.Draw(0, iHomeHeight+1 , bmyHome[0]);629 picActHome.Top := -(iHomeHeight+1);630631 sbActHome.Enabled := True;632 sbActHome.Visible := True;633 pnActHome.Visible := True;634 picActHome.Visible := True;635636 r ***************************************************************************637 * Adjust the control buttons position to accomodate the Home/Site button638 ************ ******** * A*****************************************************!*}639640 { iMove is set above (acting home button)641 { to adjust control buttons positions }642643 sbBack.Left := sbBack.Left + iMove;644 sbForward.Left := sbForward.Left + iMove;645 sbReload.Left ;= sbReload.Left + iMove;646 sbPrint.Left := sbPrint.Left + iMove;647 { sbFind.Left := sbFind.Left + iMove;648 sbStop.Left := sbStop.Left + iMove;} 649 sbExit.Left := sbExit.Left + iMove;650651 r ***************************************************************************652 * Initialize the User buttons 653 ******* ***** ***************************** **********************************} 654 sbyUser[0] sbUserl {} pnyUser[0] pnUserl {} picyUser[0] = picUserl ; 655 sbyUser[1] sbUser2 {} pnyUser[1] pnUser2 Q picyUser[1] = picUser2; 656 sbyUser[2] sbUser3 0 pnyUser[2] pnUser3 0 picyUser[2] = picUser3; 657 sbyUser[3] sbUser4 i) pnyUser[3] pnUser4 {} picyUser[3] = picUser4; 658 sbyUser[4] sbUserδ } pnyUser[4] pnUserδ {} picyUser[4] = picUserδ; 659 sbyUser[5] sbUserδ {} pnyUser[5] pnUserδ picyUser[5] = picUserβ; 660 sbyUser[6] sbUser7 0 pnyUser[6] pnUser7 {} picyUser[6] = picUser7; 661 sbyUser[7] sbUserδ; pnyUser[7] pnUserβ {} picyUser[7] = picUserβ; 662 663 if iUsers>0 then 664 begin 665 iUserHeight := bmyUser[0,0]. Height; 666 iUserWidth := bmyUser[0,0].Width; 667 668 if iUserHeight>iSiteHeight then 669 pnUser.Height := iUserHeight+12 670 else 671 pnUser.Height := iSiteHeight+12; 672 673 if iSites>1 then 674 iLeft := sbSite.Left + sbSite. Width 675 else 676 iLeft := -2; 677 678 for iLoop2 := 0 to (iUsers-1) do 679 begin 680 sbyUser[iLoop2].Left ;= iLeft+iniGetLongCSITE1l,,SPACE+lntToStr(iLoop2+1),5); 681 iLeft := sbyUser[iLoop2].Left + iUserWidth+6; 682 683 sbyUser[iLoop2]. Height := iUserHeight+6; 684 sbyUser[iLoop2].Width := iUserWidth+6; 685 686 pnyUser[iLoop2]Top := sbyUser[iLoop2]Top+3; 687 pnyUser[iLoop2].Left := sbyUserfjLoop2].Left+3; 68δ pnyUser[iLoop2]. Height := iUserHeight; 669 pnyUser[iLoop2].Width := iUserWidth; 690 681 picyUser[iLoop2]. Height := 2*iUserHeight+1 ; 692 picyUser[iLoop2]. Picture. Bitmap.Height := picyUser[iLoop2]. Height; 693 picyUser[iLoop2].Width := iUserWidth; 694 picyUser[iLoop2]. Picture. Bitmap.Width := picyUser[iLoop2].Width;695696 picyUser[iLoop2]. Picture. Bitmap.Canvas.Pen. Style := psSolid;697 picyUser[iLoop2]. Picture. Bitmap.Canvas.Pen. Mode := pmCopy;698 picyUser[iLoop2]. Picture. Bitmap.Canvas.Pen. Color := clWhite;699 picyUser[iLoop2]. Picture. Bitmap.Canvas.Pen.Width := 1 ;700 picyUser[iLoop2]. Picture. Bitmap.Canvas.MoveTo(0, iUserHeight);701 picyUser[iLoop2]. Picture. Bitmap.Canvas.LineTo(iUserWidth-1 , iUserHeight);702703 picyUser[iLoop2].Picture.Bitmap.Canvas.Draw(0, iUserHeight+1 , bmyUser[0,iLoop2]);704 picyUser[iLoop2]Top := -(iUserHeight+1);705706 sbyUser[iLoop2].Hint := syUserHint[0,iLoop2];707708 sbyUser[iLoop2]. Enabled := True;709 sbyUser[iLoop2].Visible := True;710 pnyUser[iLoop2].Visible := True;711 picyUser[iLoop2]. Visible := True;712 end;713 end714 else715 begin716 pnUser.Enabled := False;717 pnUser. Visible := False;718 end;719720 r ********** ********************************************************* ********721 * Setup logo animation722 ****************************************************************************723 if GetDeviceCaps(Canvas.Handle, NUMCOLORS) > 256 then724 begin725 picLogoBC := picLogoBC256;726 picLogoBCI 6. Visible := False;727 end728 else729 begin730 picLogoBC := picLogoBC16;731 picLogoBC256.Vislble := False;732 end;733734 lAnimBC := iniGetLongCANIMATION1, ΕC EPEAT, 1); 735 lAnimBrowser := iniGetLongCANIMATION1, 'BROWSER.REPEAT1, 0); 736 737 if lAnimBC < 1 then lAnimBC := 1 ; 738 if lAnimBC > 50 then lAnimBC := 50; 739 if lAnimBrowser < 0 then lAnimBrowser := 0; 740 if lAnimBrowser > 50 then lAnimBrowser := 50; 741 742 lAnimCount := 0; 743 lAnimMax := (picLogoBC.Width div picLogoBC.Height) * lAnimBC; 744 lAnimFlag := False; 745 746 747 * Initialize Home, Site and User button animation 748 **************************************************************************** 749 iSiteAnim := 0; 750 iHomeAnim := 0; 751 iUserAnim := 0; 752 753 754 * Set Current Site to the SITE1 755 **************************************************************************** 756 iSiteCurrent := 0; 757 iSiteButton := 1 ; 758 759 760 * Get the browser name from the command line and initialize the browser 761 **************************************************************************** 762 if PosC-b1, ParamStr(1)) = 1 then 763 xBrowserData.strBrowserEXE := Copy(ParamStr(1), 3, 764 Length(ParamStr(1)) - 2); 765 766 IResult := brwlnitializeBrowser(pnBrowser.Handle, xBrowserData, 767 iniGetStringCSITEI1, 'URL01, "), oHTTP); 768 769 770 * Create the connect string and the info string 771 * AB4V3C4FF343XC1 ,AW,1 ,2,19960116-200504,l1 ,42,M,11215,Netscape,32 772 773 strBuffer - 'LI1; 774 oHTTP.AddFeedback(strBuffer); 775 776 if strUserlnfo = " then 777 strBuffer - '11* 778 else 779 strBuffer := '11 ,' + strUserlnfo; 780 781 if xBrowserData.strlD = 'N' then 782 strBuffer := strBuffer + ',BN,' 783 else 784 if xBrowserData.strlD = T then 785 strBuffer := strBuffer + ',BI,' 786 else 787 strBuffer := strBuffer + ',BX,'; 788 789 strBuffer := strBuffer + 'V + xBrowserData.strVersion + ','; 790 strBuffer := strBuffer + 'O' + xBrowserData.strSystem; 791 792 oHTTP.AddFeedback(strBuffer); 793 794 if IResult <> INIT_SUCCESS then 795 begin 796 oHTTP.AddFeedback('E1.BROWSER'); 797 oHTTP.AddFeedback('01'); 79δ MsgBox(Nil, 'BC was unable to find a browser!' + 799 Chr(13) + Chr(10) + Chr(13) + Chr(10) + δOO 'BC requires an internet browser such as Netscape ' + δ01 'Navigator or Microsoft Internet Explorer. If you do ' + 602 'not have one of these browsers on your system then you ' + 603 'may not run BC, 'Browser Error', 804 MSG_OK or MSG_ICON_STOP); δ05 606 oHTTP.Connect; 807 while (oHTTP.Connected) do 808 Application. ProcessMessages; 809 Application.Terminate; 810 end; 811 812 813 * Get the current URL 814 ************ ******** *** **** **** 815 StrCopy(szCurrentURL, "); 816 817 81δ * Play the greeting 619 **************************************************************************** 620 if iniGetStringCSOUNDS', 'START, 'XXX') <> 'XXX' then 621 begin 622 mpWAV.Wait := False; 823 mpWAV.Notify := False; 824 mpWAV. FileName := strPath + 'DataV + 825 iniGetStringCSOUNDS', 'START1, "); 826 mpWAV.Open; 827 mpWAV.PIay; 828 end; 829 830 831 * Resize the window and make it visible 832 **************************************************************************** 633 strCurrentMode := 'B'; 634 { Application. ProcessMessages;} 835 { ShowWindow(Handle, SW_SHOW);} 836 ShowWindow(xBrowserData.hWnd, SW_SHOWNORMAL); 837 { SendMessage(xBrowserData.hWnd, WM_SIZE, SIZE_RESTORED, 0);} 838 Visible := True; 839 FormResize(Self); 840 841 bDialerDone := False; 842 843 r *************************************************************************** 844 * Enabled the timers 645 **************************************************************************** 646 tmPoll. Enabled := True; 847 846 if iSites>1 then 849 tmSite.Enabled := True; 650 851 end; 852 853 854 * TfrmMain. RequestDoc 855 ******************************* 856 * Parameters: 857 * strURL - The URL which should be loaded 858 859 Returns: None. 860 861 * This procedure forces the browser to request the specified URL. 662 ******************************************************************************** 863 procedure TfrmMain. RequestDoc(strURL: string); 864 var 865 szURL: array [0..255] of char; 866 begin 867 if strCurrentMode <> 'B' then 868 strCurrentMode := 'U'; 869 870 if xBrowserData.strlD = 'N' then 871 begin 872 ddeConv.SetLink('NETSCAPE', 'WWW_OpenURL'); 873 ddeConv.RequestData(strURL + '„0xFFFFFFFF,0x0' + chr(0)); 874 end 875 else 876 begin 877 StrPCopy(szURL, strURL); 678 SendMessage(xBrowserData. hEditWnd, WM_SETTEXT, 0, Longlnt(@szURL)); 879 SendMessage(xBrowserData.hEditWnd, WM_KEYDOWN, VK_RETURN, 0); 880 end; 881 end; 882 883 r ******************************************************************************* 884 * TfrmMain. FormClose 885 886 * Parameters: 887 * oSender - The form which is being closed 888 * oAction - The close action to be performed 889 * 890 * Returns: None. 891 ******************************************************************************** 892 * This procedure forces the browser to request the specified URL. 893 ******************************************************************************** 894 procedure TfrmMain. FormClose(oSender: TObject; var eAction: TCIoseAction); 8Θ5 var 896 eOldWindowState: TWindowState; 897 xCurTime: TDateTime; 898 begin 899 ***************************************************************************{ 900 * Play the valediction 901 **************************************************************************** 902 bSoundDone := True; 903 904 if iniGetStringCSOUNDS', 'END', 'XXX') <> 'XXX' then 905 begin 906 mpWAV.FileName := strPath + 'DataV + 907 iniGetStringCSOUNDS', 'END', 'XXX'); 906 mpWAV.Open; 909 bSoundDone := False; 910 mpWAV.Notify := True; 911 mpWAV.Wait := False; 912 mpWAV.PIay; 913 end; 914 915 r*************************************************************************** 916 * Restore the palantir window to its previous state 917 918 eOldWindowState := WindowState; 919 WindowState := wsNormal; 920 Visible := False; 921 922 r *************************************************************************** 923 * Make sure that the browser is not currently loading a URL 924 **************************************************************************** 925 PressButton(BTN_STOP) 926 PressButton(BTN_STOP) 927 PressButton(BTN_STOP) 928 PressButton(BTN_STOP) 929 930 xCurTime := Time; 931 while ((Time - xCurTime) < 0.0000115) do 932 Application. ProcessMessages; 933 934 Θ35 * Reset the window position of the browser 936 **************************************************************************** 937 SetWindowPos(xBrowserData.hWnd, HWND_TOP, xBrowserData.xRect.Left, 938 xBrowserData.xRect.Top, xBrowserData.xRect.Right - 939 xBrowserData.xRect.Left + 1 , xBrowserData.xRect.Bottom - 940 xBrowserData.xRect.Top + 1, SWP_NOREDRAW); 941 942 943 * Disable all timers 944 *********************************************************************** **** 945 tmPoll. Enabled := False; 946 tmHost.Enabled := False; 947 tmAnim. Enabled := False; 948 949 tmSite. Enabled := False; 950 tmSiteAnim. Enabled := False;951 tmHomeAnim. Enabled := False;952 tmUserAnim. Enabled := False; 953 954 j ************* ************************************************************** 955 * Wait while the HTTP object is busy 956 ********** * * * * * ********************************»*************************** 957 while (oHTTP. Connected) do 958 Application. ProcessMessages; 959 960 f *************************************************************************** 961 * Add the logoff feedback 962 **************************************************************************** 963 oHTTP.AddFeedback('01 '); 964 965 if bTransmit = True then 966 oHTTP.Connect; 967 968 r ******** * ***************** ************************************************* 969 * Wait while the logoff feedback is transmitted 970 ******************************************** ***********\ 971 while (oHTTP.Connected) do 972 Application. ProcessMessages; 973 974 / r*************************************★************************************* 975 * Wait for the valediction to complete 976 ********************************************************x 977 while bSoundDone = False do 978 Application. ProcessMessages; 979 980 f ************ *************************************************************** 981 * Store the position of the palantir window982 ************** ************* ****** * *****************************************983 iniSetLongCWINDOW, 'LEFT, Left);984 iniSetLongCWINDOW, TOP', Top);985 iniSetLongCWINDOW, 'WIDTH', Width);986 iniSetLongCWINDOW, 'HEIGHT, Height);987988 iniSetLongCWINDOW, 'STATE', Longlnt(eOldWindowState));989990 iniClose(False);991992 r ************* **************************************************************993 * Destroy all objects used by the program994 ***** ****** ************************************★***************************!995 oDomains.Destroy;996 oHTTP. Destroy;997998 ***************************************************************************999 * Exit the browser1000 *********************************************************************** ****\1001 PressButton(BTN_EXIT);1002 end;10031004 r*******************************************************************************1005 * TfrmMain.sbUserCiick1006 ********************************************************************************1007 * Parameters:1006 * oSender - The button which was pressed1009 *1010 * Returns: None.1011 ******************************* * * * **************************** ******************1012 * This procedure processes a click on the user buttons and changes the URL.1013 * ***********************1014 procedure TfrmMain.sbUserClick(oSender: TObject);1015 var1016 iLoop2: Integer;1017 begin1018 for ILoop2 :■ O to (IUsers-1) do1019 if Pointer(sbyUser[iLoop2]) = Pointer(oSender) then1020 begin1021 RequestDoc(syUserURL[iSiteCurrent,iLoop2]); 24δ1022 end; 1023 end; 1024 1025 r***** ************************************************************************** 1026 * TfrmMain. FormResize 1027 1028 * Parameters: 1029 * oSender - The form which is being resized 1030 * 1031 * Returns: None. 1032 ******************************************************************************** 1033 * This procedure resizes the palantir window and the browser window. 1034 ******************************************************************************** 1035 procedure TfrmMain. FormResize(oSender: TObject); 1036 begin 1037 r r*************************************************************************** 1038 * Make sure that the window is not too small 1039 1040 if Width < 500 then 1041 Width := 500; 1042 1043 if Height < 350 then 1044 Height := 350; 1045 1046 1047 * Resize the browser window 1048 **********> 1049 if xBrowserData.strlD = T then 1050 begin 1051 if xBrowserData. hEditWnd = 0 then 1052 SetWindowPos(xBrowserData.hWnd, 0, -10000, 1053 -10000, 1054 pnBrowser. Width + xBrowserData. iLeftExtra + 1055 xBrowserData. iRightExtra, 1056 pnBrowser.Height + xBrowserData. iTopExtra + 1057 xBrowserData.iBottomExtra, SWP_SHOWWINDOW) 1058 else 1059 begin 1060 SetWindowPos(xBrowserData.hWnd, 0, -xBrowserData. iLeftExtra, 1061 -xBrowserData.iTopExtra, 1062 pnBrowser. Width + xBrowserData. iLeftExtra + 1063 xBrowserData. iRightExtra, 1064 pnBrowser.Height + xBrowserData. iTopExtra + 1065 xBrowserData.iBottomExtra, SWP_SHOWWINDOW); 1066 1067 xBrowserData. IRectArea := 0; 1068 EnumChildWindows(xBrowserData.hWnd, ©brwFindLargestChild, 1069 Longlnt(@xBrowserData)); 1070 end; 1071 end; 1072 1073 1074 * Move the animation 1075 **************************************************************************** 1076 pnLogo.Left := pnToolBar. Width - pnLogo.Width - 3; 1077 107δ r *************************************************************************** 1079 * Figure out whether any filler is needed at the bottom of the screen 1060 **************************************************************************** 1081 if xBrowserData.strlD = 'N' then 1082 begin 1083 if (pnBrowser.Height + pnFiller.Height + xBrowserData. iTopExtra + 1084 xBrowserData.iBottomExtra) > Screen. Height then 10δ5 pnFiller.Height := (pnFiller.Height + pnBrowser.Height + 10δ6 xBrowserData. iTopExtra + 1087 xBrowserData.iBottomExtra) - Screen. Height 1086 else 1089 pnFiller.Height := 0; 1090 end; 1091 1092 1093 * Resize the browser window 1094 1095 if xBrowserData. hEditWnd = 0 then 1096 SetWindowPosfxBrowserData.hWnd, 0, -10000, 1097 -10000, 1098 pnBrowser. Width + xBrowserData. iLeftExtra + 1099 xBrowserData. iRightExtra, 1100 pnBrowser.Height + xBrowserData. iTopExtra + 1101 xBrowserData.iBottomExtra, SWP_SHOWWINDOW) 1102 else 1103 SetWindowPos(xBrowserData.hWnd, 0, -xBrowserData. iLeftEΞxtra, 1104 -xBrowserData . iTopExtra ,1105 pnBrowser.Width + xBrowserData. iLeftExtra +1106 xBrowserData. iRightExtra,1107 pnBrowser.Height + xBrowserData. iTopExtra +1108 xBrowserData.iBottomExtra, SWP_SHOWWINDOW);1109 end;111011111112 * TfrmMain.tmPollTimer1113 ********************************************************************************1114 * Parameters:1115 * oSender - The timer which has been fired1116 *1117 * Returns: None.1118 ********************************************************************************1119 * This procedure checks the state of the menu items and the URL box. If the1120 * URL has changed it sends feedback to the server.1121 ****************** ***************************************************************1122 procedure TfrmMain.tmPolITimer(oSender: TObject);1123 var1124 szURL: array [0..500] of char;1125 szTempURL: array [0..500] of char;1126 szDomain: array[0..100] of char;1127 iResult: Integer;1128 pszCGI: PChar;1129 pszDiff: PChar;1130 iSameCount: Integer;1131 iLoop: Integer;1132 bDomaiπTest: Boolean;1133 sConnect: String;1134 iConnectldx: Integer;1135 szCaption: array [0..100] of char;1136 begin1137 if WindowState = wsMinimized then1138 Exit;11391140 { ShowWindow(xBrowserData.hWnd, SW_SHOWNORMAL);1141 FormResize(Self);}114211431144 * Try to find all the menu items 1145 **************************************************************************** 1146 if xBrowserData. bMenuDone = False then 1147 xBrowserData. bMenuDone := brwWalkMenu(xBrowserData); 1146 1149 f *************************************************************************** 1150 * Attempt to find the URL edit window 1151 **************************************************************************** 1152 if xBrowserData. hEditWnd = 0 then 1153 begin 1154 EnumChildWindows(xBrowserData.hWnd, ©brwFindURLField, 1155 Long I nt(@xBrowserData)) ; 1156 1157 if xBrowserData.hEditWnd <> 0 then 1158 begin 1159 tmHost.Enabled := True; 1160 1161 ShowWindow(xBrowserData.hWnd, SW_SHOWNORMAL); 1162 FormResize(Self); 1163 end; 1164 end; 1165 1166 1167 * Attempt to bring the dialer window to the top if it exists 1168 **************************************************************************** 1169 if bDialerDone = False then 1170 begin 1171 for iConnectldx := 1 to 100 do 1172 begin 1173 sConnect := iniGetString('CONNECT', 'WINDOW+lntToStr(iConnectldx), 'XXX'); 1174 if sConnect='XXX' then break; 1175 1176 StrPCopy(szCaption, sConnect); 1177 xBrowserData. hDialerWnd := FindWindow(Nil, szCaption); 1178 1179 if (xBrowserData. hDialerWnd <> 0) and (bDialerDone = False) then 1180 begin 1181 BringWindowToTop(xBrowserData. hDialerWnd); 1182 mscSetFocus(xBrowserData. hDialerWnd); 1183 1184 xBrowserData. hConnectWnd := 0; 1185 xBrowserData.strButtonCaption := iniGetStringCCONNECT1, 1186 'BUTTON' + IntToStr(iConnectldx), "); 1187 1188 EnumChildWindows(xBrowserData. hDialerWnd, ©brwFindConnectButton, 1189 Longl nt(@xBrowserData)) ; 1190 1191 if xBrowserData. hConnectWnd <> 0 then 1192 begin 1193 SendMessage(xBrowserData.hConnectWnd, WM_LBUTTONDOWN, 0, 0); 1194 SendMessage(xBrowserData.hConnectWnd, WM_LBUTTONUP, 0, 0); 1195 end; 1196 1197 bDialerDone := True; 1198 end; 1199 end; 1200 1201 end; 1202 1203 if xBrowserData. hEditWnd = 0 then 1204 Exit; 1205 1206 t ******************************************************************** ******* 1207 * Get the current URL 1208 **************************************************************************** 1209 SendMessage(xBrowserData.hEditWnd, WM_GETTEXT, 500, Longlnt(@szURL)); 1210 1211 if StrComp(szURL, szCurrentURL) <> 0 then 1212 begin 1213 ************************************************************************ 1214 * Copy the old URL into a temp variable 1215 ************************************************************************ 1216 StrCopy(szTempURL, szCurrentURL); 1217 121δ r f ****************************************** ***************************** 1219 Reset the current URL 1220 1221 StrCopy(szCurrentURL, szURL); 1222 1223 r *************** ************************************** ****************** 1224 * Make sure that the URL is in a valid domain 1225 ************************************************************************ 1226 if oDomains.Count > 0 then 1227 begin 1226 bDomainTest := False; 1229 1230 for iLoop := 0 to oDomains.Count - 1 do 1231 begin 1232 StrPCopy(szDomain, oDomains.Strings[iLoop]); 1233 1234 if StrPos(szURL, szDomain) <> Nil then 1235 bDomainTest := True; 1236 end; 1237 1238 if bDomainTest = False then 1239 begin 1240 if bOutOfDomain = False then 1241 oHTTP.AddFeedback('DI'); 1242 1243 bOutOfDomain := True; 1244 Exit; 1245 end; 1246 1247 if bOutOfDomain = True then 1248 StrCopy(szTempURL, "); 1249 1250 bOutOfDomain := False; 1251 end; 1252 1253 t*********************************************************************** 1254 * Truncate any unwanted CGI name/value pairs 1255 1256 pszCGI := StrPos(szURL, '?'); 1257 1258 if pszCGI <> Nil then 1259 pszCGI.O] := Chr(0); 1260 1261 pszCGI := StrPos(szURL, '#'); 1262 1263 if pszCGI <> Nil then 1264 pszCGI[0] := Chr(0); 1265 1266 r ************************************** ********************************* 1267 * Truncate any unwanted CGI name/value pairs 1268 ******* * * * * *********** ******************************************************************** 1269 iSameCount := 0; 1270 1271 if (bCompress = True) and (strCurrentMode <> 'B') then 1272 begin 1273 1274 while StrLComp(szURL, szTempURL, iSameCount) = 0 do 1275 begin 1276 iSameCount := iSameCount + 1 ; 1277 end; 1278 end; 1279 1280 *********************************************************************** 1281 * Add the feedback 1262 ************************************************************************ 1283 if iSameCount > 1 then 1284 oHTTP.AddFeedback('M1 ,' + strCurrentMode + ',_' + 1285 lntToStr(iSameCount - 1) + '_' + 1286 StrPas(@szURL[iSameCount - 1])) 1267 else 1288 oHTTP.AddFeedbackCMI ,1 + strCurrentMode + ',' + StrPas(szURL)); 1289 1290 f *********************************************************************** 1291 * Set the mode back hyperlink 1292 1293 strCurrentMode := Η'; 1294 end; 1295 end; 1296 1297 r* **************** ************************************************************** 1298 * TfrmMain.tmHostTimer 1299 ******************************************************************************** 1300 * Parameters: 1301 * oSender - The timer which has been fired 1302 * 1303 * Returns: None. 1304 ******************************************************************************** 1305 * This procedure prompts the HTTP object to send feedback to the server. 1306 ******** ** ***} 1307 procedure TfrmMain.tmHostTimer(oSender: TObject); 1308 begin 1309 if bTransmit = True then 1310 begin 1311 if tmHost.Enabled = True then 1312 begin 1313 if oHTTP.Connected = False then 1314 oHTTP.Connect; 1315 end; 1316 end; 1317 end; 1318 1319 1320 * TfrmMain. tmAnimTimer 1321 1322 * Parameters: 1323 * oSender - The timer which has been fired 1324 * 1325 * Returns: None. 1326 ******************************************************************************** 1327 * This procedure prompts the HTTP object to send feedback to the server. 1328 1329 procedure TfrmMain.tmAnimTimer(oSender: TObject); 1330 begin 1331 r *************************************************************************** 1332 * Increment the frame counter and concatenate the new frame name 1333 1334 lAnimCount := lAnimCount + 1 ; 1335 1336 if lAnimCount >= lAnimMax then 1337 begin 1338 lAnimCount := 0; 1339 1340 if (lAnimFlag = False) and (lAnimBrowser > 0) then 1341 begin 1342 lAnimFlag := True; 1343 1344 if xBrowserData.strlD = 'N' then 1345 begin 1346 lAnimMax := (picLogoNetscape. Width div picLogoNetscape. Height) 1347 lAnimBrowser; 1348 picLogoNetscape. Visible := True; 1349 end 1350 else 1351 begin 1352 lAnimMax := (picLogoExplorer.Width div picLogoExplorer.Height) * 1353 lAnimBrowser; 1354 picLogoExplorer. Visible := True; 1355 end; 1356 1357 picLogoBC.Visible := False; 1358 end 1359 else 1360 begin 1361 lAnimFlag := False; 1362 1363 lAnimMax := (picLogoBC.Width div picLogoBC.Height) * 1364 lAnimBC; 1365 1366 picLogoBC.Visible := True; 1367 picLogoExplorer. Visible := False; 1368 picLogoNetscape.Visible := False; 1369 end; 1370 end; 1371 1372 /*************************************************************************** 1373 * Shift the visible part of the bitmap to show the correct frame 1374 ***************** *********************************************************** 1375 if lAnimFlag = False then 1376 picLogoBC.Left := -((lAnimCount mod (picLogoBC.Width div 1377 picLogoBC.Height)) * 32) 1378 else 1379 if xBrowserData.strlD = 'N' then 1380 picLogoNetscape.Left := -((lAnimCount mod (picLogoNetscape.Width div 1381 picLogoNetscape. Height)) * 32) 1382 else 1383 picLogoExplorer. Left := -((lAnimCount mod (picLogoExplorer.Width div 1384 picLogoExplorer.Height)) * 32); 1385 end; 1386 1387 1388 * TfrmMain. mpWAVNotify 1389 * * * * ************* * * * ******************************************** *********** 1390 * Parameters: 1391 oSender - The media player which has finished playing 1392 1393 * Returns: None. 1394 ******************************************************************************** 1395 * This procedure is called when the media player has finished playing. 1396 1397 procedure TfrmMain. mpWAVNotify(oSender: TObject); 1398 begin 1399 bSoundDone := True; 1400 end; 1401 1402 r******************************************************************************* 1403 * TfrmMain. picLogoBCDblClick 1404 ******************************************************************************** 1405 * Parameters: 1406 * oSender - The image which received the double click event 1407 * 1408 * Returns: None. 1409 ******************************************************************************** 1410 * This procedure displays the about dialog when the palantir animation is 1411 * double-clicked. 1412 *******************************************************************************! 1413 procedure TfrmMain. picLogoBC256DblClick(Sender: TObject); 1414 var 1415 dlgAbout: TdlgAbout; 1416 begin 1417 dlgAbout := TdlgAbout.Create(Self); 1418 1419 if xBrowserData.strlD = 'N' then 1420 dlgAbout.laBrowser.Caption := 'Running Netscape Navigator1 1421 else 1422 dlgAbout.laBrowser.Caption := 'Running Microsoft Internet Explorer1; 1423 1424 dlgAbout. ShowModal; 1425 dlgAbout.Destroy; 1426 end; 1427 1428 1429 * Button "fix up" procedures 1430 ************ ********************************************************************** 1431 procedure TfrmMain.sbUserMouseDown(Sender: TObject; Button: TMouseButton; 1432: Shift: TShiftState; X, Y: Integer);1433: var1434: iLoop2: Integer;1435: begin1436: tmPoll.Enabled := False;1437:1438: for iLoop2 := 0 to (iUsers-1) do1439: begin1440: if Pointer(sbyUser[iLoop2])=Pointer(Sender) then1441 : begin1442: pnyUser[iLoop2]Top := sbyUser[iloop2]Top+4;1443: pnyUser[iLoop2].Left := sbyUser[iLoop2].Left+4;1444: end;1445: end;1446: end;1447:1 AAR' **************************************\1449: procedure TfrmMain.sbUserMouseUp(Sender: TObject; Button: TMouseButton;1450: Shift: TShiftState; X, Y: Integer);1451: var1452: oop2: Integer;1453: begin1454: for iLoop2 := 0 to (iUsers-1) do1455: begin1456: if Pointer(sbyUser[iLoop2])=Pointer(Sender) then1457: begin1458: pnyUser[iLoop2].Top := sbyUser[iloop2]Top+3;1459: pnyUser[iLoop2].Left := sbyUser[iLoop2].Left+3;1460: end;1461: end;1462:1463: tmPoll.Enabled := True;1464: end;1465:14RR* J**************************************\1467: procedure TfrmMain.sbSiteMouseDown(Sender: TObject; Button: TMouseButton;1468: Shift: TShiftState; X, Y: Integer);1469: begin1470: tmPoll.Enabled := False;1471 :1472: pnSite.Top := sbSite.Top+4; 1473: pnSite.Left := sbSite.Left+4;1474: end;1475:147fi* **************** * **********************1477: procedure TfrmMain.sbSiteMouseUp(Sender: TObject; Button: TMouseButton;1478: Shift: TShiftState; X, Y: Integer);1479: begin1480: pnSite.Top := sbSite.Top+3;1481 : pnSite.Left := sbSite.Left+3;1482:1483: tmPoll.Enabled := True;1484: end;1485:1486: {**************************************}1487: procedure TfrmMain.sbHomeMouseDown(Sender: TObject; Button: TMouseButton;1488: Shift: TShiftState; X, Y: Integer);1489: begin1490: tmPoll.Enabled := False;1491 :1492: pnActHome.Top := sbActHome.Top+4;1493: pnActHome.Left := sbActHome. Left+4;1494: end;1495:1 Qβ* ***** ***********»*********************1497: procedure TfrmMain.sbHomeMouseUp(Sender: TObject; Button: TMouseButton;149δ: Shift: TShiftState; X, Y: Integer);1499: begin1500: pnActHome.Top := sbActHome.Top+3;1501 : pnActHome.Left := sbActHome.Left+3;1502:1503: tmPoll.Enabled := True;1504: end;1505:150B* ************************** ************\1507: procedure TfrmMain.sbBackMouseDown(Sender: TObject; Button: TMouseButton;150δ: Shift: TShiftState; X, Y: Integer);1509: begin1510: tmPoll.Enabled := False;1511 : end;1512: 1514: procedure TfrmMain.sbBackMouseUp(Sender: TObject; Button: TMouseButton;1515: Shift: TShiftState; X, Y: Integer);1516: begin1517: tmPoll.Enabled := True;1516: end;1519:1 *i_?Ω' i****************^********** ****************"^1521 : * Site button switch and animation initiator1 ^\ ' ********************************************************************************\1523: procedure TfrmMain.SwitchSiteButtonToNextSite;1524: var1525: iLastSiteButton: Integer;1526: begin1527: if tmSiteAnim.Enabled=True then exit;1526:1529: iLastSiteButton := iSiteButton;1530:1531 : repeat1532: iSiteButton := (iSiteButton+1) mod iSites;1533: until iSiteButtonoiSiteCurrent;1534:1535: if iSiteButton=iLastSiteButton then exit;1536:1537: picSite. Picture.Bitmap.Canvas.Draw(0, 0, bmySite[iSiteButton]);1538:1539: iSiteAnim := iSiteHeight+1 ;1540:1541 : {@@@ sbSite.Enabled := False;}1542: tmSiteAnim. Enabled := True;1543: end;1544:1546: * Switch to new site function, plus home and user buttons animation initiatorΛ .A"?' ****** *************** **************************************** *******************1548: procedure TfrmMain.sbSiteClick(Sender: TObject);1549: var1550: iLoop2: Integer;1551 : sSound: String;1552: begin1553:1554: { 1 site, process button like home} 1555 1556 if iSites=1 then 1557 begin 1558 RequestDoc(syHomeURL[0]); 1559 exit; 1560 end; 1561 1562 { — >1 site, process button as site select} 1563 1564 if iSiteCurrent=iSiteButton then exit; 1565 if (tmHomeAnim.Enabled=True) or (tmUserAnim.Enabled=True) then exit; 1566 1567 tmSite.Enabled := False; 1568 1569 sbSite. Enabled := False; 1570 1571 iSiteCurrent := iSiteButton; 1572 RequestDoc(syHomeURL[iSiteCurrent]); 1573 1574 sbActHome. Enabled := False;} 1575 picActHome. Picture. Bitmap.Canvas.Draw(0, 0, bmyHome[iSiteCurrent]); 1576 1577 for iLoop2 := 0 to (iUsers-1) do 1578 begin 1579 {@@@ sbyUser[iLoop2]. Enabled := False;} 1580 picyUser[iLoop2]. Picture. Bitmap.Canvas.Draw(0, 0, bmyUser[iSiteCurrent,iLoop2]); 1581 picyUser[iLoop2].Hint := syUserHint[iSiteCurrent,iLoop2]; 1582 end; 1583 1564 SwitchSiteButtonToNextSite; 1585 1586 iHomeAnim := iHomeHeight+1 ; 1587 iUserAnim := iUserHeight+1 ; 1588 1589 tmHomeAnim. Enabled := True; 1590 tmUserAnim. Enabled := True; 1591 1592 bSoundDone := True; 1593 1594 if sySiteGreet[iSiteCurrent]o'XXX' then 1595 begin 1596: mpWAV.FileName := st1597: mpWAV.Open;1598: bSoundDone := False;1599: mpWAV.Notify := True;1600: mpWAV.Wait := False;1601 : mpWAV.PIay;1602: end;1603:1604: sbSite.Enabled := True;1605: end;1606: fln . f *******************************************************************************1608: * go switch site button switch to next site16ΩQ ' ********************************************************************************1610: procedure TfrmMain.tmSiteTimer(Sender: TObject);1611 : begin1612: tmSite.Enabied := False;1613: SwitchSiteButtonToNextSite;1614: end;1615:1 R1 fi* *******************************************************************************1617: * Site button animation R1 ft* ********************************************************************************\1619: procedure TfrmMain.tmSiteAnimTimer(Sender: TObject);1620: begin1621 : iSiteAnim := iSiteAnim-iAnimationLines;1622:1623: if iSiteAnim>0 then1624: begin1625: picSite.Top := -iSiteAnim;1626: exit;1627: end;1628:1629: picSite.Picture.Bitmap.Canvas.Draw(0, iHomeHeight+1 , bmySitefiSiteButton]);1630: picSite.Top := -(iSiteHeight+1);1631 :1632: sbSite.Enabled := True;1633:1634: tmSiteAnim. Enabled := False;1635: tmSite.Enabied := True;1636: end; * Home button animationprocedure TfrmMain.tmHomeAnimTimer(Sender: TObject); begin iHomeAnim := iHomeAnim-iAnimationLines;if iHomeAnim>0 then begin picActHome.Top := -iHomeAnim; exit; end;picActHome.Picture. Bitmap.Canvas.Draw(0, iHomeHeight+1 , bmyHome[iSiteCurrent]); picActHome.Top := -(iHomeHeight+1);sbActHome. Enabled := True;tmHomeAnim. Enabled := False; end;********************************************************************************* User buttons animationprocedure TfrmMain.tmUserAnimTimer(Sender: TObject); var iLoop2: Integer; begin iUserAnim := iUserAnim-iAnimationLines;if iUserAnim>0 then begin for iLoop2 := 0 to (iUsers-1) do picyUser[lloop2]Top := -iUserAnim; exit; end;for iLoop2 := 0 to (iUsers-1) do begin picyUser[iLoop2].Picture.Bitmap.Canvas.Draw( 1678: 0, iUserHeight+1 , bmyUser[iSiteCurrent,iLoop2]);1679: picyUser[iLoop2]Top := -(iUserHeight+1);1680: sbyUser[iLoop2].Enabled := True;1681 : end;1682:1683: tmUserAnim. Enabled := False;1684: end;1685: procedure TfrmMain.sbHomeClick(Sender: TObject);1686: begin1687: RequestDoc(syHomeURL[iSiteCurrent]);1688: end;1689:1690: end. APPENDIX IIIHTTP.pas********************************************************************************* This module contains functions to talk to the HTTP server where the CGI* scripts that record feedback reside. Feedback can be added to the object 10: * and will be cached until it is sent off to the server.21 : unit HTTP;22:23: interface24:25: uses WinProcs, WinTypes, Messages, SysUtils, Classes, Graphics, Controls,26: Forms, Dialogs, Misc;27:28: {$l HTTP.inc}29:30: const WM_SOCKET = WM_USER + 100;31 :32: type TDocOutputEvent = procedure(Sender: TObject; strOutput: String) of object;33:34: type THTTP = class(TWinControl)35: private36: lAddress: Longint;37: strHostName: String; {HTTP host name}38: iHostPort: Integer; {HTTP host port}39: Timeout: Integer; {Transaction timeout}40: iState: Integer;41 :42: hSocket: Integer;43: bConnected: boolean;44: iLineCount: Integer;45: szBuffer: array [0..20000] of char;46: szBuffer2: array [0..20000] of char;47: szCRLF: array [0..2] of char;48: bLookup: Boolean; pxHostEntity: PTHostEntity;procedure AsyncSocket(var Message: TMessage); message WM_SOCKET; procedure Timer(var Message: TMessage); message WM_TIMER;public strSerialNo: String; TransCount: Integer; strJoblD: String; strCustlD: String; strRecord: String; strPath: String; iSessionCount: Integer;oFeedback: TStringList; function Connect: Boolean; property Connected: Boolean read bConnected; constructor Create(AOwner: TComponent); override; function GetDateTime: String; procedure AddFeedback(strFeedback: String);property HostName: String read strHostName write strHostName; property HostPort: Integer read iHostPort write iHostPort; property Timeout: Integer read Timeout write Timeout; end;procedure Register;implementationfunction sclosesocket (hSocket: TSOCKET): Integer; far; external 'WINSOCK' index 3; function sconnect(hSocket: TSOCKET; var pxSockAddr: TSockAddr; iNameLen: Integer): Integer; far; external 'WINSOCK' index 4; function gethostbyname(pszName: PChar): PTHostEntity; far; external 'WINSOCK' index 52; function htons(wHostShort: Word): Word; far; external 'WINSOCK' index 9; function recv(hSocket: TSOCKET; pszBuffer: PChar; 90: iLength, iFlags: Integer): Integer; far;91 : external 'WINSOCK' index 16;92: function ssend(hSocket: TSOCKET; pszBuffer: PChar;93: iLength, iFlags: Integer): Integer; far;94: external 'WINSOCK' index 19;95: function socket(iAddrFormat, Type, iProtocol: Integer): TSOCKET; far;96: external 'WINSOCK' index 23;97: function WSAAsyncSelect(hSocket: TSOCKET; hWnd: THandle; wMsg: Word;98: Event: Longint): Integer; far;99: external 'WINSOCK' index 101 ;100: function WSAGetLastError: Integer; far;101: external 'WINSOCK' index 111 ;102: function WSAStartup(wVersionRequired: Word;103: var IpWSAData: TWSAData): Integer; far;104: external 'WINSOCK' index 115;105: function inet_addr(pszAddress: PChar): Longint; far;106: external 'WINSOCK' index 10;107: const NP_MISC = 0;108: const NP_HEΞADER = 1 ;109: const NP_ARTICLE = 2;110: const NP_GROUPLIST = 3;111 :112: const STATE_CONNECTING = 1 ;113: const STATE_RECEI VING = 2;114:115: procedure Register;116: begin117: RegisterComponents('Samples', [THTTP]);118: end;119:120: function THTTP.GetDateTime: String;121 : begin122: GetDateTime := FormatDateTime('yyyymmdd"-"hhnnss', Now);123: end;124:125: procedure THTTP.AddFeedback(strFeedback: String);126: var127: strBuffer: String;128: begin129: strBuffer := strCustlD + ',' + strSerialNo + ',' + strJoblD + ',' +130: IntToStr(iSessionCount) + ',' + 131: IntToStr(iTransCount) + ',' +132 GetDateTime + ',' +133 strFeedback;134 oFeedback.Add(strBuffer);135136 try137 oFeedback.SaveToFile(strPath + 'palantir.fdk');138 except139 end;140141 TransCount := TransCount + 1 ;142 end;143144 constructor THTTP.Create(AOwner: TComponent);145 var146 xWSAData: TWSAData;147 begin148 inherited Create(AOwner);149 oFeedback := TStringList.Create;150 TransCount := 1 ;151 bLookup := False;152153 WSAStartup($0101 , xWSAData);154155 szCRLF[0] := Chr(13);156 szCRLF[1] := Chr(10);157 szCRLF[2] := Chr(0);158159 try160 oFeedback.LoadFromFile(strPath + 'palantir.fdk');161 except162 end;163 end;164165 procedure THTTP.AsyncSocket(var Message: TMessage);166 var167 iLineldx: Integer;168 strBuffer: String;169 begin170 case LOWORD(Message.lParam) of171 FD CONNECT: 172 begin173 if HIWORD(Message.lParam) <> 0 then174 begin175 bConnected := False;176 AddFeedback('E1.CONNECT,' + strHostName + ',' +177 IntToStr(iHostPort));178 EΞxit;179 end;180181 StrPCopy(szBuffer, 'GET ' + strRecord + '?file=');182183 StrPCopy(szBuffer2, 'palantir");184 StrCat(szBuffer, szBuffer2);185 StrCat(szBuffer, '&data=');186187 iLineCount := oFeedback.Count;188189 if iLineCount > 10 then190 iLineCount := 10;191192 for iLineldx := 0 to iLineCount - 1 do193 begin194 StrCat(szBuffer, '[');195 StrPCopy(szBuffer2, oFeedBack.Strings[iϋneldx]);196 StrCat(szBuffer, szBuffer2);197 StrCat(szBuffer, ']');198199 StrCat(szBuffer, '%0D%0A');200 end;201202 StrCat(szBuffer, ' HTTP/1.0');203204 StrCat(szBuffer, szCRLF);205 StrCat(szBuffer, szCRLF);206207 iState := STATE_RECEIVING;208 ssend(hSocket, szBuffer, StrLen(szBuffer), 0);209 end;210211 FD_READ:212 begin 213 recv(hSocket, szBuffer, 20000, 0); 214 215 if StrPos(szBuffer, 'Status: Complete') <> Nil then 216 begin 217 for iLineldx := 0 to iLineCount - 1 do 218 begin 219 oFeedback.Delete(O); 220 end; 221 222 oFeedback.SaveToFile(strPath + 'palantir.fdk'); 223 end 224 else 225 begin 226 strBuffer := Ε1, TRANSFER,1 + IntToStr(iLineCount); 227 AddFeedback(strBuffer); 228 end; 229 230 sclosesocket(hSocket) ; 231 KillTimer(Handle, 1); 232 bConnected := False; 233 end; 234 end; 235 end; 236 237 procedure THTTP.Timer(var Message: TMessage); 238 begin 239 if iState = STATE_CONNECTING then 240 AddFeedbackCEI .TIMEOUT.CONNECTING,' + IntToStr(Timeout)) 241 else 242 AddFeedbackCEI ,TIMEOUT,RECEIVING,' + IntToStr(Timeout)); 243 244 sclosesocket(hSocket) ; 245 bConnected := False; 246 KillTimer(Handle, 1); 247 end; 248 249 function THTTP.Connect: Boolean; 260 var 251 xSockAddr: TSockAddr; 252 pcAddress: PChar; 253 begin 254 if Connected = True then 255 begin 256 Connect := False; 257 EΞxit; 258 end; 259 260 if oFeedback.Count = 0 then 261 begin 262 Connect := True; 263 EΞxit; 264 end; 265 266 if bLookup = False then 267 begin 268 StrPCopy(szBuffer, strHostName); 269 270 lAddress := inet_addr(szBuffer); 271 272 if lAddress = INADDR_NONE then 273 begin 274 pxHostEntity := gethostbyname(szBuffer); 275 276 if pxHostEntity = Nil then 277 begin 278 Connect := False; 279 AddFeedbackCEI .LOOKUP," + strHostName + 7 + IntToStr(iHostPort)); 280 EΞxit; 281 end; 282 283 mscMemCpy(@pcAddress, pxHostEntityΛ.h_addr_list, 4); 284 PChar(@IAddress)[0] = pcAddressfO]; 285 PChar(@IAddress)[1] = pcAddress[1]; 286 PChar(@IAddress)[2] = pcAddress[2]; 287 PChar(@IAddress)[3] = pcAddress[3]; 288 end; 289 290 bLookup := True; 291 end; 292 293 xSockAddr.sin_family := AFJNET; 294 xSockAddr.sin_port := htons(iHostPort); 295 xSockAddr.sin_addr := lAddress; 296 297 hSocket := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP); 298 299 WSAAsyncSelect(hSocket, Handle, WM_SOCKET, FD_READ or FD_CONNECT or FD_CLOSE); 300:301 iState := STATE_CONNECTING; 302 sconnect(hSocket, xSockAddr, sizeof(xSockAddr)); 303 304 SetTimer(Handle, 1 , Timeout * 1000, Nil); 305 306 Connect := True; 307 bConnected := True; 308 end; 309 310 end. What is claimed is:As used herein, "interface" when used with an individual means interaction with the individual by one or more periferals as controled by a program. Otherwise, interface means a program.
1. A prerecorded distributed media comprising an interface for monitoring and/or controlling a user's interaction with operation of a program, and means for controlling presentation of medium content to the user in response to said interaction.
2. The media of claim 1 wherein said interface includes means for at least one of (i) interaction with the program, (ii) updating activity, (iii) listening habits of user and (iv) send data to host computer, wherein user is unaware of said interface and said interface activity is seamless to user.
3. The media of claim 1 wherein means are provided for optionally modifying said interaction while monitoring said interaction with the user, and for optionally modifying said interaction in response to said monitored interaction.
4. The media of claim 3 wherein means are provided for using the feedback of monitored interaction with the user directly within the program internally, and/or indirectly by passing the monitored data to another program which then returns data based on this and/or any previously sent data.
5. The media of claim 3 wherein means are provided for transmitting the monitored interactions with the user to a data base on a host computer or server.
6. The media of claim 3 wherein means are provided for profiling a recording on media to determine authenticity, said profiling including information about the placement of recorded data physically on the media.
7. The media of claim 3 wherein means are provided for translating factual data associated with media content into position location within that content.
8. The media of claim 3 wherein means are provided for sending information over the internet to a host computer without requiring the user to be on-line.
9. The media of claim 1 wherein said prerecorded media is one or more of disks, CD-ROM, CD-AUDIO, DVD, Solid State Media or an electronic form of media.
10. A multimedia supplement for computer accessible artist-recorded media comprising: program means added to recorded media and accessible by a computer
(a) for viewing an introduction video recorded by the artist;
(b) for installing a special link to the artist's web site, and an icon that quickly launches to the artist web site including;
(i) tracking the user's browsing of the Web site.
(c) for playing the artist(s) recorded rendition, including:
(i)displaying the title of each recorded event (e.g. song titles, acts and scenes of a play, musical, dance, etc),
(ii) a viewer optionally and selectively viewing and/or listening to any one or all of the recorded renditions, and
(iii) displaying words spoken or sung in sync with the performance; (iv) a viewer optionally playing a video of the rendition song if one is provided, (v) a viewer optionally playing an audio commentary of the rendition, and (vi) a viewer optionally displaying information about the rendition.
11. The multimedia supplement of claim 10 wherein the recorded media is a CD.
12. A method of directing a selected group of users to visit by installing a special link to the artist's web site, and an icon that quickly launches to the artist web site a web site comprising the steps of:
(A) encoding a plurality of a computer-readable media with at least:
(1) a browser controller program for (a) controlling the World Wide Web browser to access specified web page(s), (b) controlling the World Wide Web browser to retrieve the specified web page(s) from the Internet or intranet and to display the retrieved web page(s), (c) following any display or execution instructions that are on the web pages, (0 collecting information on web browsing movements of the user, and (g) sending the collected information to a central computer having a database for storing user-browsing-information; and
(2) installation information for use by the browser controller program including computer-readable data identifying (a) a Web Page address (URL) for the specified web page(s), (b) an Internet address of the computer having the database for storing user-browsing-information, and (c) a plurality of hot buttons that when pressed will take the user to specific web pages;
(B) distributing copies of the encoded computer-readable media to a targeted group of users;
(C) each user utilizing the copy of the encoded computer readable media to install the browser controller program on a computer having a World Wide Web browser program installed hereon;
(D) the browser controller program controlling the browser program to retrieve the specified web page(s); and
(E) the browser controller program monitoring movements of the user, and reporting details of browsing behavior of the user to the computer having the database for storing user-browsing information.
13. The method of claim 12 wherein the browser controller program detects unauthorized copies of the respective medium, and optionally prevents any further execution of detected unauthorized copies.
14. The method of claim 12 wherein the browser controller program decrypts any encrypted retrieved web pages.
15. The method of claim 12 wherein the installation information for use by the browser controller program includes computer-readable data identifying a serial number or Batch Code identifying the distribution medium copy as an authorized copy, the information optionally being used to prevent unauthorized copying of the program, the information being used to identify the user of the software by Batch Code indicating the group of individuals targeted for the media distribution, and an Internet address for a copy-protection host computer programmed to control access to the browser controller program.
16. A method of directing a selected group of users to visit a web site comprising the steps of:
(A) encoding a plurality of a computer-readable media with at least:
(1) a browser controller program for (a) controlling the World Wide Web browser to access specified web page(s), (b) detecting unauthorized copies of the respective medium, and optionally preventing any further execution of detected unauthorized copies, (c) controlling the World Wide Web browser to retrieve the specified web page(s) from the Internet or intranet and to display the retrieved web page(s), (d) decrypting any encrypted retrieved web pages, (e) following any display or execution instructions that are on the web pages, (f) collecting information on web browsing movements of the user, and (g) sending the collected information to a central computer having a database for storing user-browsing-information; and
(2) installation information for use by the browser controller program including computer-readable data identifying (a) a serial number or Batch Code identifying the distribution medium copy as an authorized copy, the information optionally being used to prevent unauthorized copying of the program, the information being used to identify the user of the software by Batch Code indicating the group of individuals targeted for the media distribution, (b) a Web Page address (URL) for the specified web page(s), (c) an Internet address for a copy-protection host computer programmed to control access to the browser controller program, (d) an Internet address of the computer having the database for storing user-browsing- information, and (e) a plurality of hot buttons that when pressed will take the user to specific web pages;
(B) distributing copies of the encoded computer-readable media to a targeted group of users;
(C) each user utilizing the copy of the encoded computer-readable media to install the browser controller program on a computer having a World Wide Web browser program installed thereon;
(D) the browser controller program controlling the browser program to retrieve the specified web page(s); and
(E) the browser controller program monitoring movements of the user, and reporting details of browsing behavior of the user to the computer having the database for storing user-browsing-information.
17. A system for directing a selected group of users to visit a web site comprising: (A) a plurality of a computer-readable media encoded with at least:
(1) a browser controller program for (a) controlling the World Wide Web browser to access specified web page(s), (b) controlling the Worid Wide Web browser to retrieve the specified web page(s) from the Internet or intranet and to display the retrieved web page(s), (c) following any display or execution instructions that are on the web pages, (f) collecting information on web browsing movements of the user, and (g) sending the collected information to a central computer having a database for storing user-browsing-information; and
(2) installation information for use by the browser controller program including computer-readable data identifying (a) a Web Page address (URL) for the specified web page(s), (b) an Internet address of the computer having the database for storing user-browsing-information, and (c) a plurality of hot buttons that when pressed will take the user to specific web pages.
18. A computer-readable medium for use in a system for directing a selected group of users to visit at least one specified web site over a computer network after a plurality of the mediums programs are distributed to the selected group of users comprising:
(1) a browser controller program for (a) controlling the World Wide Web browser to access specified web page(s), (b) controlling the World Wide Web browser to retrieve the specified web page(s) from the Internet or intranet and to display the retrieved web page(s), (c) following any display or execution instructions that are on the web pages, (0 collecting information on web browsing movements of the user, and (g) sending the collected information to a central computer having a database for storing user-browsing-information; and
(2) installation information for use by the browser controller program including computer-readable data identifying (a) a Web Page address (URL) for the specified web page(s), (b) an Internet address of the computer having the database for storing user-browsing-information, and (c) a plurality of hot buttons that when pressed will take the user to specific web pages.
19. A method of directing a selected group of users to visit a Web site comprising the steps of:
(A) encoding a plurality of a computer-readable media with at least:
(1) a browser controller program for (a) controlling the World Wide Web browser to access and retrieve specified Web page(s) from the internet or intranet and to display the retrieved Web page(s), (c) following any display or execution instructions that are on the Web pages, (f) collecting information on Web browsing movements of the user, and (g) sending the collected information to a central computer having a database for storing user-browsiπg-information;
(D) the browser controller program controlling the browser program to retrieve the specified Web page(s); and
(E) the browser controller program monitoring movements of the user, and reporting details of browsing behavior of the user to the computer having the database for storing user-browsing- information.
(F) Using information asked from the user, the BC will command the Browser to retrieve alternative web pages.
(G) Using information asked from the user, the BC will show different "hot buttons" or otherwise configure the user interface.
PCT/US1998/010035 1997-05-15 1998-05-15 Multimedia interface with user interaction tracking WO1998052189A2 (en)

Priority Applications (3)

Application Number Priority Date Filing Date Title
CA002289533A CA2289533A1 (en) 1997-05-15 1998-05-15 Multimedia supplement for pc accessible recorded media
EP98923457A EP1032934A2 (en) 1997-05-15 1998-05-15 Multimedia interface with user interaction tracking
AU75749/98A AU7574998A (en) 1997-05-15 1998-05-15 Multimedia interface with user interaction tracking

Applications Claiming Priority (6)

Application Number Priority Date Filing Date Title
US4651197P 1997-05-15 1997-05-15
US60/046,511 1997-05-15
US5180597P 1997-07-07 1997-07-07
US60/051,805 1997-07-07
US6931897P 1997-12-06 1997-12-06
US60/069,318 1997-12-06

Publications (2)

Publication Number Publication Date
WO1998052189A2 true WO1998052189A2 (en) 1998-11-19
WO1998052189A3 WO1998052189A3 (en) 1999-04-15

Family

ID=27366918

Family Applications (1)

Application Number Title Priority Date Filing Date
PCT/US1998/010035 WO1998052189A2 (en) 1997-05-15 1998-05-15 Multimedia interface with user interaction tracking

Country Status (4)

Country Link
EP (1) EP1032934A2 (en)
AU (1) AU7574998A (en)
CA (1) CA2289533A1 (en)
WO (1) WO1998052189A2 (en)

Cited By (5)

* Cited by examiner, † Cited by third party
Publication number Priority date Publication date Assignee Title
US8326037B1 (en) 2005-11-23 2012-12-04 Matrox Electronic Systems, Ltd. Methods and apparatus for locating an object in an image
US9208608B2 (en) 2012-05-23 2015-12-08 Glasses.Com, Inc. Systems and methods for feature tracking
US9236024B2 (en) 2011-12-06 2016-01-12 Glasses.Com Inc. Systems and methods for obtaining a pupillary distance measurement using a mobile computing device
US9286715B2 (en) 2012-05-23 2016-03-15 Glasses.Com Inc. Systems and methods for adjusting a virtual try-on
US9483853B2 (en) 2012-05-23 2016-11-01 Glasses.Com Inc. Systems and methods to display rendered images

Families Citing this family (1)

* Cited by examiner, † Cited by third party
Publication number Priority date Publication date Assignee Title
CN114020187B (en) * 2021-10-26 2024-02-23 济南浪潮数据技术有限公司 Font icon display method and device and electronic equipment

Citations (4)

* Cited by examiner, † Cited by third party
Publication number Priority date Publication date Assignee Title
US5406557A (en) * 1993-02-01 1995-04-11 National Semiconductor Corporation Interenterprise electronic mail hub
US5572643A (en) * 1995-10-19 1996-11-05 Judson; David H. Web browser with dynamic display of information objects during linking
US5721908A (en) * 1995-06-07 1998-02-24 International Business Machines Corporation Computer network for WWW server data access over internet
US5737395A (en) * 1991-10-28 1998-04-07 Centigram Communications Corporation System and method for integrating voice, facsimile and electronic mail data through a personal computer

Patent Citations (4)

* Cited by examiner, † Cited by third party
Publication number Priority date Publication date Assignee Title
US5737395A (en) * 1991-10-28 1998-04-07 Centigram Communications Corporation System and method for integrating voice, facsimile and electronic mail data through a personal computer
US5406557A (en) * 1993-02-01 1995-04-11 National Semiconductor Corporation Interenterprise electronic mail hub
US5721908A (en) * 1995-06-07 1998-02-24 International Business Machines Corporation Computer network for WWW server data access over internet
US5572643A (en) * 1995-10-19 1996-11-05 Judson; David H. Web browser with dynamic display of information objects during linking

Non-Patent Citations (3)

* Cited by examiner, † Cited by third party
Title
ANTONUCCI M., "Sending Appliances to do the PC's Job", San Jose Mercury News, p1a(2), 3 June 1996, XP002917328 *
NETWORK WORLD, 28 September 1998, page 68. XP002917329 *
SPANNG K.," Software: Locates Selected Database, Runs Search Engine-Meridian Enters Entranet Arena",Computer Reseller News, No. 701, 1996, page 177, XP002917327 *

Cited By (9)

* Cited by examiner, † Cited by third party
Publication number Priority date Publication date Assignee Title
US8326037B1 (en) 2005-11-23 2012-12-04 Matrox Electronic Systems, Ltd. Methods and apparatus for locating an object in an image
US9236024B2 (en) 2011-12-06 2016-01-12 Glasses.Com Inc. Systems and methods for obtaining a pupillary distance measurement using a mobile computing device
US9208608B2 (en) 2012-05-23 2015-12-08 Glasses.Com, Inc. Systems and methods for feature tracking
US9235929B2 (en) 2012-05-23 2016-01-12 Glasses.Com Inc. Systems and methods for efficiently processing virtual 3-D data
US9286715B2 (en) 2012-05-23 2016-03-15 Glasses.Com Inc. Systems and methods for adjusting a virtual try-on
US9311746B2 (en) 2012-05-23 2016-04-12 Glasses.Com Inc. Systems and methods for generating a 3-D model of a virtual try-on product
US9378584B2 (en) 2012-05-23 2016-06-28 Glasses.Com Inc. Systems and methods for rendering virtual try-on products
US9483853B2 (en) 2012-05-23 2016-11-01 Glasses.Com Inc. Systems and methods to display rendered images
US10147233B2 (en) 2012-05-23 2018-12-04 Glasses.Com Inc. Systems and methods for generating a 3-D model of a user for a virtual try-on product

Also Published As

Publication number Publication date
CA2289533A1 (en) 1998-11-19
WO1998052189A3 (en) 1999-04-15
EP1032934A2 (en) 2000-09-06
AU7574998A (en) 1998-12-08

Similar Documents

Publication Publication Date Title
EP1010098B1 (en) Network delivery of interactive entertainment complementing audio recording
JP3194083B2 (en) Recording device creation device that records songs in music CDs by communication
US20020194260A1 (en) Method and apparatus for creating multimedia playlists for audio-visual systems
EP0875846B1 (en) Multimedia information transfer via a wide area network
US7941761B2 (en) Third party service switching through command bar user interface
EP1624944B1 (en) Video game method and system with content-related options
US8782521B2 (en) Graphical user interface with improved media presentation
KR100707326B1 (en) Information processing system, information processing apparatus, and information processing method
US20030145338A1 (en) System and process for incorporating, retrieving and displaying an enhanced flash movie
US20020069418A1 (en) Network-enabled audio/video player
US20020107802A1 (en) Secure file downloading
US20080126936A1 (en) Electronic/software multimedia library control system and methods of use thereof
US20020078037A1 (en) Information processing apparatus and method, and program storing medium
WO2001065526A1 (en) Multimedia content delivery system and method
US20020069412A1 (en) Three-panel display for selecting files
US20030212613A1 (en) System and method for providing access to digital goods over communications networks
US20100211874A1 (en) Emulating a USB drive to provide media files to a media player
WO1998052189A2 (en) Multimedia interface with user interaction tracking
WO2004111882A1 (en) Method and apparatus for organizing and playing data
AU2005311756A1 (en) Method and apparatus for automating an interactive consignment sale of multimedia content over a network
KR100631788B1 (en) Audio device capable of interworking with the Internet and A / W data playback method using the same
JP2004023696A (en) Method and electronic equipment for controlling reproduction of video and audio files stored in cd
JPH10285578A (en) Information providing device and method and computer readable recording medium recording program for providing information
JPH10283278A (en) Device and method for device control and computer-readable record medium recording device control program
WO2002005155A2 (en) System and method for connecting a media purchaser to a manufacturer site to obtain media related information

Legal Events

Date Code Title Description
AK Designated states

Kind code of ref document: A2

Designated state(s): AU CA JP

AL Designated countries for regional patents

Kind code of ref document: A2

Designated state(s): AT BE CH CY DE DK ES FI FR GB GR IE IT LU MC NL PT SE

AK Designated states

Kind code of ref document: A3

Designated state(s): AU CA JP

AL Designated countries for regional patents

Kind code of ref document: A3

Designated state(s): AT BE CH CY DE DK ES FI FR GB GR IE IT LU MC NL PT SE

DFPE Request for preliminary examination filed prior to expiration of 19th month from priority date (pct application filed before 20040101)
121 Ep: the epo has been informed by wipo that ep was designated in this application
ENP Entry into the national phase in:

Ref country code: CA

Ref document number: 2289533

Kind code of ref document: A

Format of ref document f/p: F

Ref document number: 2289533

Country of ref document: CA

WWE Wipo information: entry into national phase

Ref document number: 75749/98

Country of ref document: AU

WWE Wipo information: entry into national phase

Ref document number: 1998923457

Country of ref document: EP

NENP Non-entry into the national phase in:

Ref country code: JP

Ref document number: 1998549609

Format of ref document f/p: F

WWP Wipo information: published in national office

Ref document number: 1998923457

Country of ref document: EP

WWW Wipo information: withdrawn in national office

Ref document number: 1998923457

Country of ref document: EP