MULTIMEDIA INTERFACE WITH USER INTERACTION TRACKING

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 := pCurrentTubeList A .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 Decoder 1 ; 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 begin 0051 auxSetVolume(wCDVolumelD, (NewVolume shl 16) or NewVolume) 0052 end; 0053 { } 0054 function GetVolume: longint; 0055 var 0056 dwVolume: longint; 0057 begin 0058 auxGetVolume(wCDVolumeld, ©dwVolume); 0059 result := (dwVolume and longint($FFFF)) 0060 end; 0061 {======= ==============================================================} 0062 { Background processing } 0063 {=========================================================================} 0064 procedure VolumeBackgroundProcess; 0065 begin 0066 if (frmRun.mmCommentary.Mode=mpPLAYING) or 0067 (frmVideo.mmVideo.Mode=mpPLAYING) then begin 0068 BarDissable(Volume); 0069 exit 0070 end 0071 else begin 0072 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 begin 0082 if not Volume. bEnabled then 0083 exit; 0084 if BarButtonHit(Volume) then begin 0085 iHintltem := 0; 0086 iHintDelayTimer := 0; 0087 if bHintVisible then begin 0088 frmRun.blobHint.HideMessage; 0089 bHintVisible := false 0090 end; 0091 BarMouseMoveStart(Volume); 0092 bVolumeBarMouseDown := true; 0093 end 0094 end; 0095 { } 0096 procedure VolumeBarMouseUp; 0097 begin 0098 if not Volume.bEnabled then 0099 exit; 0100 bVolumeBarMouseDown := false 0101 end; 0102 { } 0103 procedure VolumeBarMouseDrag( x, y: longint); 0104 begin 0105 if not Volume.bEnabled then 0106 exit; 0107 if bVolumeBarMouseDown then begin 0108 BarMouseMoveDraw(Volume,x,y); 0109 SetVolume(longint($FFFF)-Volume.iSlidePosition) 0110 end 0111 end; 0112 { } 0113 procedure VolumeBarMouseMove(X,Y: longint); 0114 var 0115 iltem: longint; 0116 x1 ,y1 : longint; 0117 label 0118 exitl ; 0119 begin 0120 if not Volume.bEnabled then 0121 goto exitl ; 0122 if not Volume.bEnabled then 0123 goto exitl ; 0124 if bVolumeBarMouseDown then 0125 goto exitl ; 0126 iHintX := frmRun.Left+X+5; 0127 iHintY := frmRun.Top+Y-0; 0128 iltem := 0; 0129 with Volume.spriteBack do begin 0130 x1 := X-Left; 0131 y1 := Y-Top; 0132 if (x1>=0) and (x1-Width-1 <=0) and (y1>=0) and (y1-Height-1<=0) then 0133 iltem := 1 0134 end; 0135 if iltem>0 then begin 0136 if iltemoiHintltem then begin 0137 iHintDelayTimer := HINT_DELAY; 0138 iHintltem := iltem 0139 end; 0140 exit 0141 end; 0142 exitl : 0143 iHintDelayTimer := 0; 0144 iHintltem := 0; 0145 if bHintVisible then begin 0146 frmRun.blobHint.HideMessage; 0147 bHintVisible := false 0148 end 0149 end; 0150 { } 0151 procedure VolumeBarTimerTick; 0152 begin 0153 if not Volume.bEnabled then 0154 exit; 0155 if iHintDelayTimer=0 then 0156 exit; 0157 Dec(iHintDelayTimer); 0158 if iHintDelayTimer=0 then begin 0159 if bHintVisible then 0160 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 := true 0167 end 0168 end; 0169 {====================================================================== 0170 { Initialize and exit } 0171 {============___==================================================== 0172 procedure VolumeBarlnitialize; 0173 var 0174 iLastAux, iAux: shortlnt; 0175 AuxCaps: TAuxCaps; 0176 begin 0177 bVolumeBarMouseDown := false; 0178 wCDVolumeld := NO_VOLUME; 0179 iLastAux := auxGetNumDevs-1 ; 0180 for iAux := 0 to iLastAux do begin 0181 if auxGetDevCaps(iAux, ©AuxCaps, SizeOf(TAuxCaps))=0 then 0182 if (auxcaps.wTechnology=AUXCAPS_CDAUDIO) and 0183 ((AuxCaps.dwSupport and AUXCAPS_VOLUME)<>0) then begin 0184 wCDVolumeld := iAux; 0185 break 0186 end 0187 end; 0188 if wCDVolumeld=NO_VOLUME then 0189 for iAux := 0 to iLastAux do begin 0190 if auxGetDevCaps(iAux, ©AuxCaps, SizeOf(TAuxCaps))=0 then 0191 if (AuxCaps.dwSupport and AUXCAPS_VOLUME)<>0 then begin 0192 wCDVolumeld := iAux; 0193 break 0194 end 0195 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 begin 0201 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 := false 0209 end; 0210 { } 0211 procedure VolumeBarExit; 0212 begin 0213 BarExit(Volume) 0214 end; 0215 end. 0001 unit Wall; 0002 ,========================================================================> 0003 interface 0004 {=========================================================================} 0005 {$IFDEF WINDOWS} 0006 uses 0007 WinTypes, WinProcs, SysUtils, Messages, Classes, Controls, 0008 Run, IniFig; 0009 {$ELSE} 0010 uses 0011 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 implementation 0023 {=========================================================================} 0024 uses 0025 Sysfig; 0026 {= ====== ============ =============================================} 0027 { Code } 0028 { =========== = = ============ ===== ========= = = ================================ } 0029 function WallpaperOurslnstalled: boolean; 0030 var 0031 fWallpaper: TextFile; 0032 begin 0033 try 0034 AssignFile(fWallpaper, sWindowsDirectory+iniWallpaper); 0035 Reset(fWallpaper); 0036 CloseFile(fWallpaper); 0037 result := true 0038 except 0039 result := false 0040 end 0041 end; 0042 { } 0043 function UsingThisWallpaper(const ThisWallpaper: string): boolean; 0044 var 0045 Reglni: TReglniFile; 0046 begin 0047 Reglni := TreglniFile.Create('Control Panel'); 0048 result := (Reglni. ReadString('desktop', 'Wallpaper', ")=ThisWallpaper); 0049 Reglni.Free 0050 end; 0051 { } 0052 function UsingWallpaper: boolean; 0053 begin 0054 result := not UsingThisWallpaperf); 0055 end; 0056 { } 0057 function UsingOurWallpaper: boolean; 0058 begin 0059 result := UsingThisWallpaper(sWindowsDirectory+iniWallpaper+'.bmp'); 0060 end; 0061 { } 0062 function SetWallpaper( const WallpaperName, WallpaperTile: string): boolean; 0063 var 0064 Reglni: TReglniFile; 0065 begin 0066 result := true; 0067 try 0068 Reglni := TreglniFile.Create('Control Panel') 0069 except 0070 exit 0071 end; 0072 try 0073 Reglni.WriteString('desktop', 'Wallpaper', WallpaperName); 0074 Reglni.WriteStringCdesktop', TileWallpaper', WallpaperTile); 0075 SystemParameterslnfo(SPI_SETDESKWALLPAPER, 0, nil, SPIF_SENDWININICHANGE) 0076 except 0077 Reglni.Free; 0078 exit 0079 end; 0080 Reglni.Free; 0081 result := false 0082 end; 0083 { } 0084 procedure GetWallpaper( var WallpaperName, WallpaperTile: string); 0085 var 0086 Reglni: TReglniFile; 0087 begin 0088 WallpaperName := "; 0089 WallpaperTile := O'; 0090 try 0091 Reglni := TreglniFile.CreateCControl Panel') 0092 except 0093 exit 0094 end; 0095 try 0096 WallpaperName := Reglni. ReadString('desktop', 'Wallpaper 1 , "); 0097 WallpaperTile := Reglni.ReadString('desktop', TileWallpaper', '0') 0098 except 0099 end; 0100 Reglni.Free 0101 end; 0102 end. 0103 0001 unit Words; 0002 =========================================================================} 0003 interface 0004 <=========================================================================} 0005 {$IFDEF WINDOWS} 0006 uses 0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 0008 Forms, Dialogs, LMDnonvS, 0009 Run, Main, Tube, CDPIayer, SysFig; 0010 {$ELSE} 0011 uses 0012 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 0013 ExtCtrls, StdCtris, LMDnonvS, 0014 Run, Main, Tube, CDPIayer, SysFig; 0015 {$ENDIF} 0016 { } 0017 var 0018 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 implementation 0028 { == == == ======= ==================================================} 0029 var 0030 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 begin 0040 if eTubeModeState=tmWORDS then begin 0041 TubeSetTopLine(TheWords[TrackNo], 1); 0042 TubeDisplay(TheWords[TrackNo]) 0043 end 0044 end; 0045 {====================================================================== 0046 { Mouse Handling } 0047 {====================================================================== 0048 procedure WordsMouseDown; 0049 var 0050 iWordsTime: longint; 0051 begin 0052 if eTubeModeStateotmWORDS then 0053 exit; 0054 iWordsTime := TubeltemHit(iMOuseDownX,iMOuseDownY); 0055 if (iWordsTime>0) and (iWordsTime<9999) then begin 0056 iHintDelayTimer := 0; 0057 if bHintVisible then begin 0058 frmRun.blobHint.HideMessage; 0059 bHintVisible := false 0060 end; 0061 frmRun.WordsClicked(iWordsTime) 0062 end 0063 end; 0064 { } 0065 procedure WordsMouseMove(X,Y: longint); 0066 label 0067 exitl ; 0068 begin 0069 if eTubeModeStateotmWORDS then 0070 goto exitl ; 0071 if TubeHit(X,Y)=0 then 0072 goto exitl ; 0073 iHintX := frmRun.Left+X+5; 0074 iHintY := frmRun.Top+Y-0; 0075 if bHintVisible then begin 0076 frmRun.blobHint.HideMessage; 0077 bHintVisible := false 0078 end; 0079 iHintDelayTimer := HINT_DELAY; 0080 exit; 0081 exitl : 0082 iHintDelayTimer := 0; 0083 if bHintVisible then begin 0084 frmRun.blobHint.HideMessage; 0085 bHintVisible := false 0086 end 0087 end; 0088 { } 0089 procedure WordsTimerTick; 0090 begin 0091 if iHintDelayTimer=0 then 0092 exit; 0093 Dec(iHintDelayTimer); 0094 if iHintDelayTimer=0 then begin 0095 if bHintVisible then 0096 frmRun.blobHint.HideMessage; 0097 iHintLastX := iHintX; 0098 iHintLastY := iHintY; 0099 sHintLastMsg := sHintMsg; 0100 if eCDPIayerState=psPLAYING then begin 0101 frmRun. blobHint.Position := hpAboveLeft; 0102 frmRun.blobHint.ShowMessage(sHintMsg, frmRun.Left+312, frmRun.Top+55) 0103 end 0104 else begin 0105 frmRun. blobHint.Position := hpAboveRight; 0106 frmRun.blobHint.ShowMessage(sHintMsg, iHintX, iHintY) 0107 end; 0108 bHintVisible := true 0109 end 0110 end; 0111 i =------------ ================== ================================ 0112 { Initalize / Exit } 0113 {= =============== == ============= = ====================================== 0114 procedure Wordslnitialize; 0115 var 0116 fWords: TextFile; 0117 iTrack: Integer; 0118 I: string[250]; 0119 begin 0120 for iTrack := 1 to iAudioTracks do begin 0121 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 begin 0127 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 := false 0138 end; 0139 { } 0140 procedure WordsExit; 0141 var 0142 iTrack: Integer; 0143 begin 0144 for iTrack := 1 to iAudioTracks do 0145 TubeExitList(The Words[iTrack]) 0146 end; 0147 end. 0001 unit Loglt; 0002 { =============== == == = ==== = ==== = = = == == = === = = = = ======== === ================== } 0003 interface 0004 =========================================================================} 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 implementation 0015 { =========================================================================} 0016 type 0017 EVoteSendFailure = class(Exception); 0018 { } 0019 var 0020 bHTTPDone, 0021 bHTTPAckOK: boolean; 0022 sResponse: string; 0023 sAckOK: string = 'Status: Complete'; 0024 {=========================================================================} 0025 { Main Code } 0026 { ============ ======= ========== == ============== = =========================== } 0027 procedure logSend(const CDhandle: string); 0028 var 0029 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 begin 0038 bVoteEnabled := false; 0039 TheRegistry.RootKey := HKEY_LOCAL_MACHINE; 0040 sKey := '\SOFTWARE\Palantir\IQcd\'+CDhandle+'\Flags'; 0041 sValue := 'VoteEnabled'; 0042 try 0043 if TheRegistry.OpenKey(sKey,true) then 0044 if TheRegistry.ValueExists(sValue) then 0045 bVoteEnabled := TheRegistry.ReadBool(sValue) 0046 except 0047 TheRegistry.CloseKey; 0048 exit 0049 end; 0050 TheRegistry.CloseKey; 0051 if not bVoteEnabled then 0052 exit; 0053 TheRegistry.RootKey := HKEY_LOCAL_MACHINE; 0054 sKey := '\SOFTWARE\Palantir\IQcdY+CDhandle+'\Vote'; 0055 sValue := 'URL'; 0056 try 0057 if TheRegistry.OpenKey(sKey,true) then 0058 if TheRegistry.ValueExists(sValue) then 0059 sURLVote := TheRegistry.ReadString(sValue) 0060 except 0061 TheRegistry.CloseKey; 0062 exit 0063 end; 0064 TheRegistry.CloseKey; 0065 TheRegistry.RootKey := HKEY_LOCAL_MACHINE; 0066 sKey := '\SOFTWARE\Palantir\IQcd\'+CDhandle+'\Vote'; 0067 sValue := 'Chunk'; 0068 iChunk := 10; 0069 try 0070 if TheRegistry.OpenKey(sKey.true) then 0071 if TheRegistry.ValueExists(sValue) then 0072 iChunk := TheRegistry.Readlnteger(sValue) 0073 except 0074 TheRegistry.CloseKey; 0075 exit 0076 end; 0077 TheRegistry.CloseKey; 0078 TheRegistry.RootKey := HKEY_LOCAL_MACHINE; 0079 sKey := '\SOFTWARE\Palantir\IQcd\'+CDhandle+'\Vote'; 0080 try 0081 if TheRegistry.OpenKey(sKey.true) then begin 0082 if not TheRegistry.ValueExists('ln') then begin 0083 TheRegistry.Writelnteger('ln',1); 0084 iln := 1 0085 end 0086 else begin 0087 iln := TheRegistry.Readlnteger('ln') 0088 end; 0089 if not TheRegistry.ValueExists('Out') then begin 0090 TheRegistry.Writelnteger('Out',1); 0091 iOut := 1 0092 end 0093 else begin 0094 iOut := TheRegistry.Readlnteger('Out') 0095 end 0096 end 0097 else begin 0098 exit 0099 end 0100 except 0101 TheRegistry.CloseKey; 0102 exit 0103 end; 0104 if iOut>=iln then begin 0105 TheRegistry.CloseKey; 0106 exit 0107 end; 0108 if regTrace then 0109 frmMain.lbTrace.ltems.AddC ... send log for '+CDhandle); 0110 if regTrace then 0111 frmMain.lbTrace.ltems.AddC '+lntToStr(iOut)+','+lntToStr(iln-1)); 0112 iOutOld := iOut; 0113 iOutNew := iOut; 0114 bNoEntrles := true; 0115 sVote := sURLVote; 0116 try 0117 for iEntry := iOut to iOut+(iChunk-1) do begin 0118 if iEntry>=iln then 0119 break; 0120 try 0121 sVote := sVote+ 0122 TheRegistry.ReadString(Format('x%.9d', [iEntry]))+ 0123 '%0A' 0124 except 0125 end; 0126 iOutNew := iEntry+1 ; 0127 bNoEntries := false 0128 end; 0129 if bNoEntries then begin 0130 TheRegistry.CloseKey; 0131 exit 0132 end; 0133 bAIIVotesEmpty := false; 0134 if frmMain. ipwHTTP.Actionohttpldle then 0135 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 begin 0145 iOut := iOutNew; 0146 TheRegistry.Writelnteger('Out', iOut); 0147 try 0148 for iEntry := iOutOld to iOutNew-1 do begin 0149 sValue := Format('x%.9d', [iEntry]); 0150 if TheRegistry.ValueExists(sValue) then 0151 TheRegistry.DeleteValue(sValue) 0152 end 0153 except 0154 end 0155 end 0156 else begin 0157 raise EVoteSendFailure.CreateCVote send failure.') 0158 end 0159 except 0160 TheRegistry.CloseKey; 0161 exit 0162 end 0163 end; 0164 { } 0165 procedure LogjpwHTTPStartTransfer; 0166 begin 0167 sResponse := " 0168 end; 0169 { } 0170 procedure Log_ipwHTTPTransfer(const Text: String); 0171 begin 0172 sResponse := sResponse+Text 0173 end; 0174 { } 0175 procedure Log_ipwHTTPEndTransfer; 0176 begin 0177 if Length(sResponse)>=Length(sAckOk) then 0178 if Copy (sResponse, 1 ,Length(sAckOk))=sAckOk then 0179 bHTTPAckOk := true; 0180 bHTTPDone := true; 0181 frmMain. IbTrace.ltems.AddCResponse - '+sResponse) 0182 end; 0183 { } 0184 procedure LogjpwHTTPError; 0185 begin 0186 bHTTPDone := true; 0187 bHTTPAckOK := false 0188 end; 0189 end. 0001 unit Main; 0002 {======================================================================: 0003 interface 0004 { ======================== = == == = === = ==== ======= = ================ = 0005 uses 0006 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 0007 StdCtris, Registry, ExtCtrls, devSBase, ipwNetDial, ipwCWinsck, 0008 ipwiPPort, ipwCIPPMsg, ipwHTTP, TCPinfo, Imdclass, ImdnonvS; 0009 type 0010 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 var 0031 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 implementation 0043 {$R *.DFM} 0044 {=========================================================================} 0045 uses 0046 Loglt; 0047 {- } 0048 var 0049 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 begin 0058 result := '?'; 0059 TheRegistry.RootKey := HKEY_LOCAL_MACHINE; 0060 sKey := '\SOFTWARE\Palantir\User'; 0061 try try 0062 if TheRegistry.OpenKey(sKey,false) then 0063 if TheRegistry.ValueExists(Value) then 0064 result := TheRegistry.ReadStringfValue) 0065 except 0066 end 0067 finally 0068 TheRegistry.CloseKey 0069 end 0070 end; 0071 { } 0072 procedure GetPallnfo; 0073 var 0074 i: integer; 0075 begin 0076 sPalHandle := "; 0077 TheRegistry.RootKey := HKEY_LOCAL_MACHINE; 0078 sKey := '\SOFTWARE\Palantir'; 0079 sValue := 'Handle'; 0080 try try 0081 if TheRegistry.OpenKey(sKey.true) then 0082 if TheRegistry.ValueExists(sValue) then begin 0083 sPalHandle := TheRegistry.ReadString(sValue) 0084 end 0085 else begin 0086 for i := 1 to 10 do 0087 sPalHandle := sPalHandle + Chr(Ord('A')+Random(26)); 0088 TheRegistry.WriteString(sValue, sPalHandle) 0089 end 0090 except 0091 end 0092 finally 0093 TheRegistry.CloseKey 0094 end; 0095 if sPalHandle=" then 0096 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 var 0106 iCD1 , iCD: integer; 0107 label 0108 WinsockUpdate; 0109 0110 begin 0111 if iTimerBusy>0 then 0112 exit; 0113 Inc(iTimerBusy); 0114 if not bWinsockAccessOk then 0115 goto WinsockUpdate; 0116 if regTrace then begin 0117 if bWinsockAccessOk and not bWinsockAccessOkO then begin 0118 lbTrace.ltems.Add('<Dialer activated>'); 0119 lbTrace.!tems.Add(") 0120 end; 0121 if bWinsockAccessOkO and not bWinsockAccessOk then begin 0122 lbTrace.ltems.AddC<Dialer shut down>'); 0123 lbTrace.ltems.AddO 0124 end 0125 end; 0126 bWinsockAccessOkO := bWinsockAccessOk; 0127 TheRegistry.RootKey := HKEY_LOCAL_MACHINE; 0128 sKey := '\SOFTWARE\Palantir\IQcd'; 0129 try 0130 if not TheRegistry.OpenKey(sKey,false) then begin 0131 if iTimerBusy>0 then 0132 Dec(iTimerBusy); 0133 exit 0134 end; 0135 TheRegistry.GetKeyNames(CD) 0136 except 0137 TheRegistry.CloseKey; 0138 if iTimerBusy>0 then 0139 Dec(iTimerBusy); 0140 exit 0141 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 do 0149 LogSend(CD.Strings[iCD]); 0150 frmMain. ipwHTTP.WinsockLoaded := false; 0151 if bAllVotesEmpty and not bAIIVotesEmptyO then begin 0152 if regTrace then begin 0153 IbTrace. Items. Addf); 0154 lbTrace.ltems.Add('<AII Votes Empty>'); 0155 IbTrace. Items. Addf) 0156 end; 0157 if regExitOnEmpty then begin 0158 tmTimer.Enabled := false; 0159 close; 0160 exit 0161 end; 0162 end; 0163 WinsockUpdate: 0164 if bDialerCheck then 0165 try 0166 if ipwNetDialer.Action=ntdldle then begin 0167 bWinsockAccessOk := false; 0168 ipwNetDialer. Action := ntdListConnections 0169 end 0170 except 0171 end; 0172 if iTimerBusy>0 then 0173 Dec(iTimerBusy); 0174 end; 0175 { } 0176 procedure TfrmMain. ipwNetDialerConnectedEntry(Sender: TObject; 0177 Handle: Integer; const Entry, DeviceName, DeviceType, 0178 StatusDescription: String); 0179 begin 0180 if (DeviceNameo") or (DeviceTypeo") or (StatusDescriptiono") then 0181 bWinsockAccessOk := true 0182 end; 0183 { } 0184 procedure TfrmMain. ipwHTTPStartTransfer(Sender: TObject); 0185 begin 0186 Log_ipwHTTPStartTransfer 0187 end; 0188 { } 0189 procedure TfrmMain. ipwHTTPTransfer(Sender: TObject; 0190 BytesTransferred: Integer; Text: String); 0191 begin 0192 Log_ipwHTTPTransfer(Text) 0193 end; 0194 {- } 0195 procedure TfrmMain. ipwHTTPEndTransfer(Sender: TObject); 0196 begin 0197 Log_ipwHTTPEndTransfer 0198 end; 0199 { } 0200 procedure TfrmMain. ipwHTTPError(Sender: TObject; ErrorCode: Integer; 0201 const Description: String); 0202 begin 0203 Log_ipwHTTPError 0204 end; 0205 {=========================================================================} 0206 { Initalize / EΞxit } 0207 { =========== === = = ====== == = = == == = ====== ===== = = = =============== = ============ } 0208 procedure TfrmMain. FormCreate(Sender: TObject); 0209 begin 0210 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 := 'Trace 1 ; 0226 try 0227 if TheRegistry.OpenKey(sKey.true) then 0228 if TheRegistry.ValueExists(sValue) then 0229 regTrace := TheRegistry.ReadBool(sValue) 0230 except 0231 end; 0232 Application. ShowMainForm := regTrace; 0233 TheRegistry.RootKey := HKEY_LOCAL_MACHINE; 0234 sKey := '\SOFTWARE\Palantir\IQcd 1 ; 0235 sValue := ΕxitOnEmpty 1 ; 0236 try 0237 if TheRegistry.OpenKey(sKey.true) then 0238 if TheRegistry. ValueExists(sValue) then 0239 regExitOnEmpty := TheRegistry.ReadBool(sValue) 0240 except 0241 end; 0242 { set send control flags } 0243 if TCPinfo.HasModem and TCPinfo.HasDialUP and TCPinfo.HasTCPIP and 0244 TCPinfo.HasBindToDialUP and TCPinfo.HasAutodialSetup then begin 0245 bDialerCheck := true 0246 end 0247 else begin 0248 if TCPinfo.HasTCPIP then 0249 bWinsockAccessOk := true 0250 end; 0251 if regTrace then begin 0252 lbTrace.ltems.Add('<Server Start>'); 0253 lbTrace.ltems.Add("); 0254 if TCPinfo.HasAutoDialSetup then 0255 IbTrace.ltems.AddC ... uses autodial'); 0256 if TCPinfo.HasTCPIP then 0257 lbTrace.ltems.Add(' ... networking has TCP/IP protocol'); 0258 if TCPinfo.HasDialup then 0259 IbTrace.ltems.AddC ... networking has dial-up adapter 1 ); 0260 if TCPinfo.HasBindToDialUP then 0261 IbTrace.ltems.AddC ... dial-up adapter bound to TCP/IP 1 ); 0262 if TCPinfo.HasModem then 0263 IbTrace.ltems.AddC - has modem'); 0264 if TCPinfo.HasTCPIP then 0265 if bWinsockAccessOk then 0266 lbTrace.ltems.Add(' -> Winsock access always allowed') 0267 else 0268 IbTrace. ltems.Add(' --> Winsock access only when modem active') 0269 else 0270 IbTrace.ltems.AddC -> No Winsock access allowed (no TCP/IP) 1 ); 0271 IbTrace.ltems.AddC 1 ) 0272 end; 0273 { lets go } 0274 tmTimer.Enabled := true 0275 end; 0276 { } 0277 procedure TfrmMain. FormClose(Sender: TObject; var Action: TCIoseAction); 0278 begin 0279 tmTimer.Enabled := true 0280 CD.Free; 0281 CD := nil; 0282 TheRegistry. Free; 0283 TheRegistry := nil 0284 end; 0285 end. program Vote; {$R *.RES} uses Forms, Windows, Registry, Main in 'Main.pas' {frmMain}, Loglt in 'Loglt.pas'; begin Application. Initialize; Application. Title := 'IQcd Vote'; Application. CreateForm(TfrmMain, frmMain); Application. Run end. 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 type print "Content-type: text/plain\n\n"; # Open and Write the data file for append if (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} begin Application. Initialize; Application. Run; end. 0001 unit TCPinfo; 0002 { ================================ ============ ============================= } 0003 interface 0004 {=========================================================================} 0005 uses 0006 Windows, Messages, SysUtils, Classes, Controls, Registry; 0007 { } 0008 type 0009 TpsTCPinfo = class(TComponent) 0010 private 0011 FHasModem: boolean; 0012 FHasDialUp: boolean; 0013 FHasAutoDialSetup: boolean; 0014 FHasTCPIP: boolean; 0015 FHasBindToDialUP: boolean; 0016 procedure Writelnvaiid(X: boolean); 0017 public 0018 constructor Create(AOwner: TComponent); override; 0019 destructor Destroy; override; 0020 procedure Update; 0021 published 0022 property HasModem: boolean read FHasModem 0023 write Writelnvalid; 0024 property HasAutoDialSetup: boolean read FHasAutoDialSetup 0025 write Writelnvalid; 0026 property HasDialUp: boolean read FHasDialUp 0027 write Writelnvalid; 0028 property HasTCPIP: boolean read FHasTCPIP 0029 write Writelnvalid; 0030 property HasBindToDialUP: boolean read FHasBindToDialUp 0031 write Writelnvalid; 0032 end; 0033 { } 0034 procedure Register; 0035 { „.. ==== — = „ } 0036 implementation 0037 { ============================== = === ===== ========= = ================ ==== } 0038 type 0039 EReadOnly = class(Exception); 0040 0041 { = = ====================== = = = === == ======== = === = ===== = ====================== } 0042 { Register Component } 0043 {=== == ====================================================} 0044 procedure Register; 0045 begin 0046 RegisterComponentsCPalantir", [TpsTCPinfo]); 0047 end; 0048 {=========================================================================} 0049 { Local routines } 0050 { ============================================= == ========================== } 0051 procedure TpsTCPinfo.Writelnvalid(X: boolean); 0052 begin 0053 end; 0054 {=========================================================================} 0055 { Methods } 0056 {= ============= ====== ============= === ===================================== } 0057 procedure TpsTCPinfo.Update; 0058 var 0059 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 begin 0066 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 0075 0076 { has modem installed ? } 0077 Reg.RootKey := HKEY_LOCAL_MACHINE; 0078 sKey := '\System\CurrentControlSet\Services\Class\Modem'; 0079 try 0080 if Reg.KeyExists(sKey) then 0081 FHasModem := true 0082 except 0083 end; 0084 { has AutoDial enabled ? } 0085 Reg.RootKey := HKEY_CURRENT_USER; 0086 sKey := '\Software\Microsoft\Windows\CurrentVersion\lnternet Settings'; 0087 sValue := ΕnableAutodial'; 0088 try 0089 if Reg.OpenKey(sKey .false) then 0090 if Reg.ValueExists(sValue) then 0091 if Reg.ReadBinaryData(sValue,N,4)=4 then 0092 if integer(N)<>0 then 0093 FHasAutodialSetup := true 0094 except 0095 end; 0096 { has TCPIP protocol installed ? } 0097 Reg.RootKey := HKEY_LOCAL_MACHINE; 0098 sKey := '\Enum\Network\MSTCP'; 0099 try 0100 if Reg.KeyExists(sKey) then 0101 FHasTCPIP := true 0102 except 0103 end; 0104 { has Dial-Up adapter installed & is it bound to TCPIP protocol ? } 0105 Reg.RootKey := HKEY_LOCAL_MACHINE; 0106 try 0107 if Reg.OpenKey(sKey .false) then begin 0108 Reg.GetKeyNames(Nets); 0109 iNetl := Nets.Count-1 ; 0110 for iNet := 0 to iNetl do begin 0111 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; 0132 0133 Create/Destroy 0134 0135 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 I A . t**********+*it*1ι*iA *****itit*i*i<***^ 2: * BC (Browser Controller) v1.10 3 4 Browser.pas 5 6 7 8: * This module contains functions to find and capture a browser. Currently 9: * Netscape and Internet Explorer are supported. 34: unit Browser; 35: 36: interface 37: 38: uses Messages, SysUtils, WinProcs, WinTypes, ShellAPI, Ver, Classes, HTTP; 39: 41 : * Command button constants 43: 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 = record 55: case Integer of 56: 0: (Left, Top, Right, Bottom: Integer); 57: 1 : (TopLeft, BottomRight: TPoint); 58: end; 59: 60: type xtBrowserData = record 61 : 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)) or 189: ((PosCBLANK.', UpperCase(strTitle)) <> 0)) then 190: begin 191 : iCount := iCount + 1 ; 192: 193: xBrowserData. hEditWnd := hWnd; 194: end 195: else 196: 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; 353 354 if xBrowserData.strlD = 'N' then 355 begin 356 if StrPos(szSubMenultemText, 'CLOSE') <> Nil then 357 begin 358 if xBrowserData.lyButtons[BTN_EXIT] = 0 then 359 begin 360 xBrowserData.lyButtons[BTN_EXIT] := 361 GetMenultemlD(hSubMenu, iSubMenultemPos); 362 xBrowserData.hyMenus[BTN_EXIT] := hSubMenu; 363 end; 364 end; 365 end 366 else 367 begin 368 if StrPos(szSubMenultemText, 'CLOSE') <> Nil then 369 begin 370 if xBrowserData.lyButtons[BTN_EXIT] = 0 then 371 begin 372 xBrowserData.lyButtons[BTN_EXIT] := 373 GetMenultemlD(hSubMenu, iSubMenultemPos); 374 xBrowserData.hyMenus[BTN_EXIT] := hSubMenu; 375 end; 376 end; 377 end; 378 379 if xBrowserData.strlD = 'N' then 380 begin 381 if StrPos(szSubMenultemText, 'STOP') <> Nil then 382 begin 383 if xBrowserData.lyButtons[BTN_STOP] = 0 then 384 begin 385 xBrowserData. lyButtons[BTN_STOP] := 386 GetMenultemlD(hSubMenu, iSubMenultemPos); 387 xBrowserData. hyMenus[BTN_STOP] := hSubMenu 388 end; 389 end; 390 end 391 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\\ProductVersion 1 , 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 PosCNETSCAPE 1 , UpperCase(strBrowserEXE)) <> 0 then 598 xBrowserData.strlD := 'N' 599 else 600 if PosCIEXPLORE 1 , 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 II 1 2 3 4: * Main.pas 5 6 7 8: * This module contains the main BC window. The form handles all the 9: * toolbar functionality and tracks the movements of the user to be reported to 10: * the server. 51: unit Main; 52: 53: interface 54: E C . t******************************************************************************* 56: * Units used by the main form c . ******************************************************************************** 58: uses 59: 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 controls 70: 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: TDdeClientConv 87: 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; 128 129 r*************************************************************************** 130 * Control procedures 131 * ** ** * * *** » ** » * *** *** * * ******** ** ***** ** *** * * * * * *********** * *** * » ** ******* * \ 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); 141 142 r ** * ****** * ****** ****** * **************************************************** 143 * User procedures 144 ************* ********»*»**********************************★****************> 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 clicked 248 249 * Returns: None. 250 ***** ***** ** * * * ** * ****** ** * ************ ***** ** ************* *** **** * *** *** ******* 251 * This procedure processes all of the command button clicks. 252 *** ***** * **** ****************** * ****************** **** *** ** * * ********* * ******** * 253 procedure TfrmMain. CommandClick(oSender: TObject); 254 begin 255 if oSender = TObject(sbBack) then 256 PressButton(BTN_BACK); 257 258 if oSender = TObject(sbForward) then 259 PressButton(BTN_FORWARD); 260 261 if oSender = TObject(sbReload) then 262 PressButton(BTN_RELOAD); 263 264 if oSender = TObject(sbStop) then 265 begin 266 if xBrowserData.strlD = 'I' then 267 begin 268 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 end 272 else 273 PressButton(BTN_STOP); 274 end; 275 276 if oSender = TObject(sbPrint) then 277 begin 278 BringWindowToTop(xBrowserData.hWnd); 279 PressButton(BTN_PRINT); 280 end; 281 282 if oSender = TObject(sbFind) then 283 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, 'SESSION 1 , 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; 615 616 picActHome.Height := 2*iHomeHeight+1 ; 617 picActHome. Picture. Bitmap.Height := picActHome.Height; 618 picActHome.Width := iHomeWidth; 619 picActHome. Picture.Bitmap.Width := picActHome.Width; 620 621 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); 627 628 picActHome. Picture. Bitmap.Canvas.Draw(0, iHomeHeight+1 , bmyHome[0]); 629 picActHome.Top := -(iHomeHeight+1); 630 631 sbActHome.Enabled := True; 632 sbActHome.Visible := True; 633 pnActHome.Visible := True; 634 picActHome.Visible := True; 635 636 r * *** * ****** ****** *********** * ******** ** * * * ****** * ****** ******** **** ******** 637 * Adjust the control buttons position to accomodate the Home/Site button 638 ************ ******** * A*****************************************************! * } 639 640 { iMove is set above (acting home button) 641 { to adjust control buttons positions } 642 643 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; 650 651 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+iniGetLongCSITE1 l , , 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; 695 696 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); 702 703 picyUser[iLoop2].Picture.Bitmap.Canvas.Draw(0, iUserHeight+1 , bmyUser[0,iLoop2]); 704 picyUser[iLoop2]Top := -(iUserHeight+1); 705 706 sbyUser[iLoop2].Hint := syUserHint[0,iLoop2]; 707 708 sbyUser[iLoop2]. Enabled := True; 709 sbyUser[iLoop2].Visible := True; 710 pnyUser[iLoop2].Visible := True; 711 picyUser[iLoop2]. Visible := True; 712 end; 713 end 714 else 715 begin 716 pnUser.Enabled := False; 717 pnUser. Visible := False; 718 end; 719 720 r ********** ********************************************************* ******** 721 * Setup logo animation 722 * ** ************************* * **************************************** **** ** * 723 if GetDeviceCaps(Canvas.Handle, NUMCOLORS) > 256 then 724 begin 725 picLogoBC := picLogoBC256; 726 picLogoBCI 6. Visible := False; 727 end 728 else 729 begin 730 picLogoBC := picLogoBC16; 731 picLogoBC256.Vislble := False; 732 end; 733 734 lAnimBC := iniGetLongCANIMATION 1 , ΕC EPEAT, 1); 735 lAnimBrowser := iniGetLongCANIMATION 1 , 'BROWSER.REPEAT 1 , 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-b 1 , ParamStr(1)) = 1 then 763 xBrowserData.strBrowserEXE := Copy(ParamStr(1), 3, 764 Length(ParamStr(1)) - 2); 765 766 IResult := brwlnitializeBrowser(pnBrowser.Handle, xBrowserData, 767 iniGetStringCSITEI 1 , 'URL0 1 , "), 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 - 'LI 1 ; 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', 'START 1 , "); 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 window 982 ************** ***** * ******* ****** * ***************************************** 983 iniSetLongCWINDOW, 'LEFT, Left); 984 iniSetLongCWINDOW, TOP', Top); 985 iniSetLongCWINDOW, 'WIDTH', Width); 986 iniSetLongCWINDOW, 'HEIGHT, Height); 987 988 iniSetLongCWINDOW, 'STATE', Longlnt(eOldWindowState)); 989 990 iniClose(False); 991 992 r ************* ************************************************************** 993 * Destroy all objects used by the program 994 ***** ****** ************************************★***************************! 995 oDomains.Destroy; 996 oHTTP. Destroy; 997 998 *** * ******** * ** * * ** * * ******* ********** *** * * ******* *** * ** ********* * ********* 999 * Exit the browser 1000 ********** * **** ** ********** ***** ********* * ***************************** ****\ 1001 PressButton(BTN_EXIT); 1002 end; 1003 1004 r******************************************************************************* 1005 * TfrmMain.sbUserCiick 1006 * * ******************************************************** * ********************* 1007 * Parameters: 1006 * oSender - The button which was pressed 1009 * 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 var 1016 iLoop2: Integer; 1017 begin 1018 for ILoop2 :■ O to (IUsers-1) do 1019 if Pointer(sbyUser[iLoop2]) = Pointer(oSender) then 1020 begin 1021 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; 1110 1111 1112 * TfrmMain.tmPollTimer 1113 **** * ****** * * ** ** * * * * * ********** *** ****** *** ******** * * * ** * ** ***** * * ********** * ** 1114 * Parameters: 1115 * oSender - The timer which has been fired 1116 * 1117 * Returns: None. 1118 *********************************************************************** * ******** 1119 * This procedure checks the state of the menu items and the URL box. If the 1120 * URL has changed it sends feedback to the server. 1121 ********* **** ***** ********** ** ********** ** **************** * ******************** * * 1122 procedure TfrmMain.tmPolITimer(oSender: TObject); 1123 var 1124 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 begin 1137 if WindowState = wsMinimized then 1138 Exit; 1139 1140 { ShowWindow(xBrowserData.hWnd, SW_SHOWNORMAL); 1141 FormResize(Self);} 1142 1143 1144 * 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 := iniGetStringCCONNECT 1 , 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 Navigator 1 1421 else 1422 dlgAbout.laBrowser.Caption := 'Running Microsoft Internet Explorer 1 ; 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: var 1434: iLoop2: Integer; 1435: begin 1436: tmPoll.Enabled := False; 1437: 1438: for iLoop2 := 0 to (iUsers-1) do 1439: begin 1440: if Pointer(sbyUser[iLoop2])=Pointer(Sender) then 1441 : begin 1442: 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: var 1452: oop2: Integer; 1453: begin 1454: for iLoop2 := 0 to (iUsers-1) do 1455: begin 1456: if Pointer(sbyUser[iLoop2])=Pointer(Sender) then 1457: begin 1458: 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: begin 1470: 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: begin 1480: 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: begin 1490: 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: begin 1500: 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: begin 1510: tmPoll.Enabled := False; 1511 : end; 1512: 1514: procedure TfrmMain.sbBackMouseUp(Sender: TObject; Button: TMouseButton; 1515: Shift: TShiftState; X, Y: Integer); 1516: begin 1517: tmPoll.Enabled := True; 1516: end; 1519: 1 *i_?Ω' i****************^********** ****************"^ 1521 : * Site button switch and animation initiator 1 ^ \ ' ****** * ********* * ********** * ** **** * * ************************ * *******************\ 1523: procedure TfrmMain.SwitchSiteButtonToNextSite; 1524: var 1525: iLastSiteButton: Integer; 1526: begin 1527: if tmSiteAnim.Enabled=True then exit; 1526: 1529: iLastSiteButton := iSiteButton; 1530: 1531 : repeat 1532: 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: var 1550: iLoop2: Integer; 1551 : sSound: String; 1552: begin 1553: 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 := st 1597: 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 site 16ΩQ ' ******************************************************************************** 1610: procedure TfrmMain.tmSiteTimer(Sender: TObject); 1611 : begin 1612: tmSite.Enabied := False; 1613: SwitchSiteButtonToNextSite; 1614: end; 1615: 1 R1 fi* ******************************************************************************* 1617: * Site button animation R1 ft* ********************************************************************************\ 1619: procedure TfrmMain.tmSiteAnimTimer(Sender: TObject); 1620: begin 1621 : iSiteAnim := iSiteAnim-iAnimationLines; 1622: 1623: if iSiteAnim>0 then 1624: begin 1625: 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 animation procedure 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 animation procedure 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: begin 1687: RequestDoc(syHomeURL[iSiteCurrent]); 1688: end; 1689: 1690: end. APPENDIX III HTTP.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: interface 24: 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: private 36: 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; implementation function 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: begin 117: RegisterComponents('Samples', [THTTP]); 118: end; 119: 120: function THTTP.GetDateTime: String; 121 : begin 122: GetDateTime := FormatDateTime('yyyymmdd"-"hhnnss', Now); 123: end; 124: 125: procedure THTTP.AddFeedback(strFeedback: String); 126: var 127: strBuffer: String; 128: begin 129: strBuffer := strCustlD + ',' + strSerialNo + ',' + strJoblD + ',' + 130: IntToStr(iSessionCount) + ',' + 131: IntToStr(iTransCount) + ',' + 132 GetDateTime + ',' + 133 strFeedback; 134 oFeedback.Add(strBuffer); 135 136 try 137 oFeedback.SaveToFile(strPath + 'palantir.fdk'); 138 except 139 end; 140 141 TransCount := TransCount + 1 ; 142 end; 143 144 constructor THTTP.Create(AOwner: TComponent); 145 var 146 xWSAData: TWSAData; 147 begin 148 inherited Create(AOwner); 149 oFeedback := TStringList.Create; 150 TransCount := 1 ; 151 bLookup := False; 152 153 WSAStartup($0101 , xWSAData); 154 155 szCRLF[0] := Chr(13); 156 szCRLF[1] := Chr(10); 157 szCRLF[2] := Chr(0); 158 159 try 160 oFeedback.LoadFromFile(strPath + 'palantir.fdk'); 161 except 162 end; 163 end; 164 165 procedure THTTP.AsyncSocket(var Message: TMessage); 166 var 167 iLineldx: Integer; 168 strBuffer: String; 169 begin 170 case LOWORD(Message.lParam) of 171 FD CONNECT: 172 begin 173 if HIWORD(Message.lParam) <> 0 then 174 begin 175 bConnected := False; 176 AddFeedback('E1.CONNECT,' + strHostName + ',' + 177 IntToStr(iHostPort)); 178 EΞxit; 179 end; 180 181 StrPCopy(szBuffer, 'GET ' + strRecord + '?file='); 182 183 StrPCopy(szBuffer2, 'palantir"); 184 StrCat(szBuffer, szBuffer2); 185 StrCat(szBuffer, '&data='); 186 187 iLineCount := oFeedback.Count; 188 189 if iLineCount > 10 then 190 iLineCount := 10; 191 192 for iLineldx := 0 to iLineCount - 1 do 193 begin 194 StrCat(szBuffer, '['); 195 StrPCopy(szBuffer2, oFeedBack.Strings[iϋneldx]); 196 StrCat(szBuffer, szBuffer2); 197 StrCat(szBuffer, ']'); 198 199 StrCat(szBuffer, '%0D%0A'); 200 end; 201 202 StrCat(szBuffer, ' HTTP/1.0'); 203 204 StrCat(szBuffer, szCRLF); 205 StrCat(szBuffer, szCRLF); 206 207 iState := STATE_RECEIVING; 208 ssend(hSocket, szBuffer, StrLen(szBuffer), 0); 209 end; 210 211 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.

Inventors: BLISS STEVEN, SNYDER J GARY, STEELE DAVID W, BLISS, STEVEN, SNYDER, J., GARY, STEELE, DAVID, W.
Applicants: PALANTIR SOFTWARE INC, PALANTIR SOFTWARE, INC.
Application year: 1998
Main classification: G11B
IPC codes: G06F17, G11B27, H04H1