CA2289533A1 - Multimedia supplement for pc accessible recorded media - Google Patents
Multimedia supplement for pc accessible recorded media Download PDFInfo
- Publication number
- CA2289533A1 CA2289533A1 CA002289533A CA2289533A CA2289533A1 CA 2289533 A1 CA2289533 A1 CA 2289533A1 CA 002289533 A CA002289533 A CA 002289533A CA 2289533 A CA2289533 A CA 2289533A CA 2289533 A1 CA2289533 A1 CA 2289533A1
- Authority
- CA
- Canada
- Prior art keywords
- begin
- procedure
- user
- browser
- longint
- Prior art date
- Legal status (The legal status is an assumption and is not a legal conclusion. Google has not performed a legal analysis and makes no representation as to the accuracy of the status listed.)
- Abandoned
Links
- 239000013589 supplement Substances 0.000 title claims abstract description 5
- 238000000034 method Methods 0.000 claims description 552
- 238000009434 installation Methods 0.000 claims description 19
- 230000003993 interaction Effects 0.000 claims description 11
- 238000009826 distribution Methods 0.000 claims description 7
- 230000004044 response Effects 0.000 claims description 3
- 230000000694 effects Effects 0.000 claims 2
- 238000012544 monitoring process Methods 0.000 claims 1
- 239000007787 solid Substances 0.000 claims 1
- 230000006870 function Effects 0.000 description 120
- 230000009471 action Effects 0.000 description 13
- 230000008569 process Effects 0.000 description 12
- 101150014794 IQCD gene Proteins 0.000 description 11
- 238000010586 diagram Methods 0.000 description 6
- 238000012545 processing Methods 0.000 description 5
- 230000008859 change Effects 0.000 description 3
- 238000005516 engineering process Methods 0.000 description 3
- 238000013515 script Methods 0.000 description 3
- 238000012546 transfer Methods 0.000 description 3
- 101100272797 Caenorhabditis elegans icd-1 gene Proteins 0.000 description 2
- 230000027455 binding Effects 0.000 description 2
- 238000009739 binding Methods 0.000 description 2
- 239000003999 initiator Substances 0.000 description 2
- 238000004519 manufacturing process Methods 0.000 description 2
- 230000004048 modification Effects 0.000 description 2
- 238000012986 modification Methods 0.000 description 2
- 230000006855 networking Effects 0.000 description 2
- 230000008520 organization Effects 0.000 description 2
- 230000002093 peripheral effect Effects 0.000 description 2
- 101150053844 APP1 gene Proteins 0.000 description 1
- 101100245253 Caenorhabditis elegans pas-5 gene Proteins 0.000 description 1
- 235000000722 Celosia argentea Nutrition 0.000 description 1
- 240000008365 Celosia argentea Species 0.000 description 1
- 235000008733 Citrus aurantifolia Nutrition 0.000 description 1
- 101100126165 Escherichia coli (strain K12) intA gene Proteins 0.000 description 1
- YCISZOVUHXIOFY-HKXOFBAYSA-N Halopredone acetate Chemical compound C1([C@H](F)C2)=CC(=O)C(Br)=C[C@]1(C)[C@]1(F)[C@@H]2[C@@H]2CC[C@](OC(C)=O)(C(=O)COC(=O)C)[C@@]2(C)C[C@@H]1O YCISZOVUHXIOFY-HKXOFBAYSA-N 0.000 description 1
- 101100189105 Homo sapiens PABPC4 gene Proteins 0.000 description 1
- 241000252067 Megalops atlanticus Species 0.000 description 1
- GVOIQSXBMLNCLC-UHFFFAOYSA-N OOOS Chemical compound OOOS GVOIQSXBMLNCLC-UHFFFAOYSA-N 0.000 description 1
- 102100039424 Polyadenylate-binding protein 4 Human genes 0.000 description 1
- 244000269722 Thea sinensis Species 0.000 description 1
- 241000534944 Thia Species 0.000 description 1
- 235000011941 Tilia x europaea Nutrition 0.000 description 1
- 238000004458 analytical method Methods 0.000 description 1
- 238000013475 authorization Methods 0.000 description 1
- 230000008901 benefit Effects 0.000 description 1
- 238000004422 calculation algorithm Methods 0.000 description 1
- 238000004590 computer program Methods 0.000 description 1
- 235000014510 cooky Nutrition 0.000 description 1
- 239000002360 explosive Substances 0.000 description 1
- 239000000945 filler Substances 0.000 description 1
- 238000011900 installation process Methods 0.000 description 1
- 239000004571 lime Substances 0.000 description 1
- 238000007639 printing Methods 0.000 description 1
- 230000001737 promoting effect Effects 0.000 description 1
- 230000008672 reprogramming Effects 0.000 description 1
- 230000001932 seasonal effect Effects 0.000 description 1
- 238000007619 statistical method Methods 0.000 description 1
- 238000003860 storage Methods 0.000 description 1
- 230000001360 synchronised effect Effects 0.000 description 1
- 235000012976 tarts Nutrition 0.000 description 1
- 238000010200 validation analysis Methods 0.000 description 1
- 238000004804 winding Methods 0.000 description 1
Classifications
-
- G—PHYSICS
- G11—INFORMATION STORAGE
- G11B—INFORMATION STORAGE BASED ON RELATIVE MOVEMENT BETWEEN RECORD CARRIER AND TRANSDUCER
- G11B27/00—Editing; Indexing; Addressing; Timing or synchronising; Monitoring; Measuring tape travel
- G11B27/10—Indexing; Addressing; Timing or synchronising; Measuring tape travel
- G11B27/34—Indicating arrangements
-
- G—PHYSICS
- G06—COMPUTING; CALCULATING OR COUNTING
- G06F—ELECTRIC DIGITAL DATA PROCESSING
- G06F16/00—Information retrieval; Database structures therefor; File system structures therefor
- G06F16/40—Information retrieval; Database structures therefor; File system structures therefor of multimedia data, e.g. slideshows comprising image and additional audio data
-
- G—PHYSICS
- G11—INFORMATION STORAGE
- G11B—INFORMATION STORAGE BASED ON RELATIVE MOVEMENT BETWEEN RECORD CARRIER AND TRANSDUCER
- G11B27/00—Editing; Indexing; Addressing; Timing or synchronising; Monitoring; Measuring tape travel
- G11B27/02—Editing, e.g. varying the order of information signals recorded on, or reproduced from, record carriers
- G11B27/031—Electronic editing of digitised analogue information signals, e.g. audio or video signals
- G11B27/034—Electronic editing of digitised analogue information signals, e.g. audio or video signals on discs
-
- G—PHYSICS
- G11—INFORMATION STORAGE
- G11B—INFORMATION STORAGE BASED ON RELATIVE MOVEMENT BETWEEN RECORD CARRIER AND TRANSDUCER
- G11B27/00—Editing; Indexing; Addressing; Timing or synchronising; Monitoring; Measuring tape travel
- G11B27/10—Indexing; Addressing; Timing or synchronising; Measuring tape travel
- G11B27/102—Programmed access in sequence to addressed parts of tracks of operating record carriers
- G11B27/105—Programmed access in sequence to addressed parts of tracks of operating record carriers of operating discs
-
- G—PHYSICS
- G11—INFORMATION STORAGE
- G11B—INFORMATION STORAGE BASED ON RELATIVE MOVEMENT BETWEEN RECORD CARRIER AND TRANSDUCER
- G11B27/00—Editing; Indexing; Addressing; Timing or synchronising; Monitoring; Measuring tape travel
- G11B27/10—Indexing; Addressing; Timing or synchronising; Measuring tape travel
- G11B27/11—Indexing; Addressing; Timing or synchronising; Measuring tape travel by using information not detectable on the record carrier
-
- G—PHYSICS
- G11—INFORMATION STORAGE
- G11B—INFORMATION STORAGE BASED ON RELATIVE MOVEMENT BETWEEN RECORD CARRIER AND TRANSDUCER
- G11B2220/00—Record carriers by type
- G11B2220/20—Disc-shaped record carriers
- G11B2220/21—Disc-shaped record carriers characterised in that the disc is of read-only, rewritable, or recordable type
- G11B2220/213—Read-only discs
-
- G—PHYSICS
- G11—INFORMATION STORAGE
- G11B—INFORMATION STORAGE BASED ON RELATIVE MOVEMENT BETWEEN RECORD CARRIER AND TRANSDUCER
- G11B2220/00—Record carriers by type
- G11B2220/20—Disc-shaped record carriers
- G11B2220/25—Disc-shaped record carriers characterised in that the disc is based on a specific recording technology
- G11B2220/2537—Optical discs
- G11B2220/2545—CDs
-
- G—PHYSICS
- G11—INFORMATION STORAGE
- G11B—INFORMATION STORAGE BASED ON RELATIVE MOVEMENT BETWEEN RECORD CARRIER AND TRANSDUCER
- G11B2220/00—Record carriers by type
- G11B2220/20—Disc-shaped record carriers
- G11B2220/25—Disc-shaped record carriers characterised in that the disc is based on a specific recording technology
- G11B2220/2537—Optical discs
- G11B2220/2562—DVDs [digital versatile discs]; Digital video discs; MMCDs; HDCDs
-
- G—PHYSICS
- G11—INFORMATION STORAGE
- G11B—INFORMATION STORAGE BASED ON RELATIVE MOVEMENT BETWEEN RECORD CARRIER AND TRANSDUCER
- G11B2220/00—Record carriers by type
- G11B2220/60—Solid state media
- G11B2220/61—Solid state media wherein solid state memory is used for storing A/V content
Landscapes
- Engineering & Computer Science (AREA)
- Multimedia (AREA)
- Theoretical Computer Science (AREA)
- Data Mining & Analysis (AREA)
- Databases & Information Systems (AREA)
- Physics & Mathematics (AREA)
- General Engineering & Computer Science (AREA)
- General Physics & Mathematics (AREA)
- Information Transfer Between Computers (AREA)
- Data Exchanges In Wide-Area Networks (AREA)
- Mobile Radio Communication Systems (AREA)
- Indexing, Searching, Synchronizing, And The Amount Of Synchronization Travel Of Record Carriers (AREA)
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.
(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
WO 98/52189 PCT/tTS98/10035 MULTIMEDIA INTERN=ACE 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 recoibed 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 artiist(s) recorded rendition, including:
(i) displaying the title of each recorded event (e.g. song titles, acts and scenes of a play, musical, dance, e~tc), (ii) a viewer optionally and selectively viewing and/or listening to any one or all of the recorded renditions, and (iii) displayintl 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 typicaNy 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 off playing only what song they would like io 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 seNected 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.
SUBSTTTtITE SHEET (RULE 26) 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 usePs 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 recorcied 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 wilt appear on the computer screen.
Thus it is a brief video talking about an introduction to get a personalized contact with the user (warm 8~ 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 io 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 chat 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 worcfs 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.
SUBSTITUTE SHEET (RULE 26) 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 ~~ ten song CD and individuals tend to play 5 of the songs on a regular basis, the system c~~n 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 TI~ACKING~ 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 ~~sked 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 lime on the user's PC wilt appear an icon for that artist. The icon is clicked on to launch its driver and thereafter to he connected to the artist's web site. In this case- and at the users instructions, the user wilt 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 i:~ 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.
SUBSTITUTE SHEET (RULE 26) 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 entire#y, 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 ii 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 ptayed 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 /ink 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.
SUBSTITUTE SHEET (RULE 26~
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 initializai.ion file used to initially configure the invention.
Fig. 7a is a CD PROFILE DAT~4 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 orillinal 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 serrver far 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 io 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 pertormance 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 inveniion 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 (IHTML) 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 intertace (GUI) based access to network servers. The network servers support docurnents forrnatted 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 provideas 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 speclflcatlon, the Fuser makes a Transmlsslon 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.
'SUBSTITUTE SHEET (RULE 26) 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 a1 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 copy-protection may be bypassed altogether.
SUBSTITUTE SHEET (RULE 26) 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 ;>erial 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 !he 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 (B,atch Code) to decide what Web Page information to show any particular user; to provide Fast-minule~ 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 monil:ors 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 b~ovNSing 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 ~ The browser controller is a program distributed to the user in the form of computer readable code on floppy disk, CDROM or other distributabie 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 lNeb browser software that is installed on the user's computer.
Once Installed on the user':. computer, the BC will access the particular sites that It was designed to retrieve, and pertorm a number of other browsing and access control functions including:
(a) Optionally detecl.ing unautlhorized copies of itself, and preventing any further execution if detected.
SUBST1TUT~ SHEET (RULE 26) g (b) Retrieving "invited" Web Pages from the Internet or inlranet.
(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 Listin4s in the followin4 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 intemet Explorer.
Main.pas. See Code Listinos in the followin4 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.oas. See Code Listincts 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 intemet 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 intemet 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 IBIS). 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 iUuslrate 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.
SUHST1TUTE SHEET tRULE 26) During installation on the user's computer, demographic information is assembled by asking the user personal and/or busines~~ 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 tire 8C occurs as needed through out the program. For example, see Main.pas in Appendix I, lines 178; 269-271; 276-358; 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 browsE~r 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. Atemativeiy 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 decompres:red and unpacked 11 from the installation disk and placed onto the target drive 13,14. The user is asked dlemographic questions 15, and the answers are scored in a Demographic file on the tayet 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 8rowser Controller, including demographics, copy-protection information, and primary web page and brow:~er 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 4:? 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. It 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 Werb Page 43.
SUBSTITUTE SHEET (RULE 26) WO 98/52189 PCT/US98/10035 .
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 io retrieve alternate web pages andlor 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 World 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 end 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 pages) on a Primary SUBSTITUTE SHEET (RULE 26) WO 98/52189 PCT/US98/10035 _ Web site 90. The retrieved Web pages or files optionally will need to be decrypted either by the Tracker Server program or the Browse~r-Controller program before the user can display the retrieved Web pages. Browsing infomnation 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 8.g for stati:>tical 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 tihat 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 1, II and ill 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 hnRL that you are currently addressing. Internet Explorer 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 i s made to detemnine which child window inside the browser is the largest. The largest child window should be the browser output window.
(See browser.pas: lines 610-73~.
The position of the lamest 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 lett 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 ate 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 SUBST1TLJTE SHEET (RULE 26) 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: fines 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 io 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 bvx must be idaintificd. These text controls also have handle 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, tntemet 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 & forvvard are critical operations. Reload is needed.
SUBSTITUTE SHEET (RULE 26) "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 Explorer, the BC does not search the menu as soon as Internet Explorer is found because Internet Explorer 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 an-ay through the operating system.
Therefore, (i) 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 ~lo 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, ii is intended io embrace all such alternatives, modification, and variations a;s fall within the spirit and broad scope of the appended claims.
SUBST1TLJT~ SHEET (RULE 26) 0001 unit BitBars;
{___________________________________________________________________________}
0003 interface ~___________________________________________________________________________}
0005 {$IFDEF WINDOWS}
0006 uses 0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 0008 Forms, Dialogs, ExtCtris, 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 {_____________~________________w_________}
0017 type 0018 TBar = record 0019 bVertical: Boolean;
0020 bEnabled: Boolean;
0021 bForceDraw: Boolean;
0022 iSIideRange, iSIidePosition: longint;
0023 iSweepWidth, iSweepHeight: longint;
0024 iSweepStart, iSweepTravel: longint;
0025 iSweepMoveStartPosition, iSweepPosition: longint;
0026 bmpBuffer: TBitmap;
0027 spriteBack, spriteRod, spriteButton, spriteEnd1, spriteEnd2: TSprite 0028 end;
0029 {-------_-___~_~~_ _________________}
0030 procedure Barlnitialize(var Bar: Tbar; imgBarBack, imgBarRod, imgBarButton, 0031 imgBarEnd1, imgBarEnd2: Tlmage);
0032 procedure BarExit(var Bar: TBar);
0033 procedure BarEnable(var Bar: TBar);
0034 procedure BarDlssable(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;
SUBSTITUTE SHEET (RULE 26) WO 98/52189 PCTlUS98/10035 0038 procedure BarMouseMoveStart(var Bar: Tbar);
0039 procedure BarMouseMoveDraw(var Bar: TBar; x,y: longint);
0040 function BarButtonHit(var Bar: TBar): Boolean;
~=______________________________________________________________________-__}
0042 implementation {_________________________________________________________________________}
0044 function ConvertSvveepToSlide(var Bar: TBar; SweepPosition: longint):
longint; forvvard;
0045 function ConvertSliideToSweep(var Bar: TBar; SIidePosition: longint):
longint; forvvard;
0046 procedure DrawAndUpdate(var Bar: TBar; NewSweepPosition: (ongint);
forward;
{__________________._______________________________________________________}
0048 { Local Routines }
0050 function ConvertSweepToSlide(var Bar: TBar; SweepPosition: longint):
longint;
0051 begin 0052 result :_ ((Bar.iSIideRange - (Bar.iSIideRange div Bar.iSweepTravel)) 0053 SweepPosition) div (Bar.iSweepTravei-1) 0054 end;
0055 {________________________________.______________}
0056 function ConvertSIideToSweep(var Bar: TBar; SIidePosition: longint):
longint;
0057 begin 0058 result :_ ((Bar.iS~~reepTravel-1) * SIidePosition) div 0059 (Bar.iSlide~Range - (Bar.iSIideRange div Bar.iSweepTravel)) 0060 end;
0061 {-----_------________,__________.__________~__}
0062 procedure DrawAncIUpdate(var Bar: TBar; NewSweepPosition: longint);
0063 var 0064 iRodLeft, iRodTap: longint;
0065 iOffset:longint;
0066 BarRect: TRect;
0067 begin 0068 if NewSweepPosition<0 ihen 0069 NewSweepPosition := 0;
0070 if NewSweepPosition>Bar.iSweepTravel-1 then 0071 NewSweepPosltion := Bar.iSweepTravel-1;
0072 if (not Bar.bForce~Draw) and (NewSweepPosition=Bar.iSweepPosition) then 0073 exit;
0074 Bar.iSweepPosition := NewSweepPosition;
SU~ST1TUTE SHEET (RULE 26) 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 BitmapOverlay(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.spriieRod.Image.Canvas.Handle, iRodLeft, iRodTop, srcCOP~;
0095 BitmapOverlay(Bar.bmpBuffer, Bar.spriteButton, Bar.spriteBack);
0096 BitmapOverlay(Bar.bmpBuffer, Bar.spriteEnd1, 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, Oi 01 Bar.bmpBuffer.Canvas.Handle , 1, 0, srcCOPI~;
0102 BarRect := Bounds(Bar.spriteBack.Left+1, Bar.spriteBack.Top, 0103 Bar.spriteBack.Width-1, Bar.spriteBack.Height);
0104 BitmapUpdateScreen(BarRect) 0105 end;
{_________________________________________________________________________}
0107 { Main code }
f==_______________________________________________________________________) 0109 procedure BarEnable(var Bar: TBar);
0110 begin 0111 if Bar.iSIideRange=0 then begin 0112 BarDissable(Bar);
0113 exit SUBST1TUT~ SHEET (RULE 26) 0114 end;
0115 if not Bar.bEnabl~:d then begin 0116 Bar.bEnabled := true; -0117 Bar.bForceDraw :_ #rue;
0118 DrawAndUpdal~e(Bar, ConvertSIideToSweep(Bar, Bar.iSIidePosition));
0119 end 0120 end;
0121 {________________________..___________________________}
0122 procedure BarDissalble(var Bar: Tbar);
0123 begin 0124 if Bar.bEnabled then begin 0125 Bar.bEnabled := false;
0126 8ar.bForceDraw := false;
0127 BitmapDraw(B~ar.spriteBack) 0128 end 0129 end;
0130 {___________________~________________..______________}
0131 procedure BarSetRange(var Bar: TBar; Range: longint);
0132 begin 0133 Bar.iSIideRange := Range;
0134 if Range>0 then 0135 Bar.iSIidePosition := ConvertSweepToSlide(Bar, Bar.iSweepPosition) 0136 else 0137 BarDissable(Bair) 0138 end;
0139 {____________________________________..______________}
0140 procedure BarSetPosition(var Bar: TBar; Position: longint);
0141 begin 0142 Bar.iSIidePosition := Position;
0143 if Bar.bEnabled then 0144 DrawAndUpdat~e(Bar, ConvertSIideToSweep(Bar,Position)) 0145 end;
0146 {-______________________..__________..______________}
0147 function BarGetPosition(var Bar: TBar): iongint;
0148 begin 0149 result := Bar.iSIidE~Position;
0150 end;
{___________________._______._______________________________________________}
0152 { Mouse !-candling }
{___________________._______________________________________________________}
SUBSTITUTE SHEET (RULE 26) 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 {_______-______~_~____________________M}
0160 procedure BarMouseMoveStart(var Bar: TBar);
0161 begin 0162 Bar.iSweepMoveStartPosition := Bar.iSweepPosition Oi63 end;
0164 { --__ _~M_____~~___~~}
0165 procedure BarMouseMoveDraw(var Bar: TBar; x,y: lorlgint);
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.iSIidePosition := ConvertSweepToSlide(Bar,Bar.iSweepPosition) 0175 end;
{_________________________________________________________________________}
0177 { Initalize / Exit }
{_________________________________________________________________________}
0179 procedure Barlnitialize(var Bar: Tbar; imgBarBack, imgBarRod, imgBarButton, 0180 imgBarEndl, imgBarEnd2: Tlmage);
0181 var 0182 l: string[50];
0183 p: integer;
0184 iSIideButtonSize:longint;
0185 begin 0186 BitmapCreate(Bar.spriteBack, imgBarBack, false);
0187 BitmapCreate(Bar.spriteRod, imgBarRod, true);
0188 BitmapCreate(Bar.spriteButton, imgBarButton, true);
0189 BitmapCreate(Bar.spriteEndl, imgBarEndl, true);
0190 BitmapCreate(Bar.spriteEnd2, imgBarEnd2, true);
0191 Bar.bmpBuffer := TBitmap.Create;
0192 Bar.bmpBuffer.Assign(imgBarBack.Picture.Bitmap);
SUBSTITUTE SHEET (RULE 26) 0193 I := imgBarRod.fiint:
0194 p := Pos(',',I);
0195 Bar.iSweepWidth := StrTolnt(Copy(1,1,p-1));
0196 I := Copy(I,p+1,99);
0197 p := Pos(',',I);
0198 Bar.iSweepHeight := StrTolnt(Copy(1,1,p-1));
0199 if Copy(I,p+1,1 )='V' then 0200 Bar.bVertical := true 0201 else 0202 Bar.bVertical := false;
0203 Bar.iSweepStart := StrTolnt(Copy(f,p+2,99));
0204 if Bar.bVertical then begin 0205 iSIideButtonSize := Bar.spriteButton.Height;
0206 Bar.iSweepTravel := Bar.iSweepHeight-iSIideButtonSize;
0207 Bar.spriteButton.Left := Bar.spriteBack.Left 0208 end 0209 else begin 0210 iSIideButtonSize := Bar.spriteButton.Width;
0211 Bar.iSweepTrFwel := Bar.iSweepWidth-iSIideButtonSize;
0212 Bar.spriteBuiton.Top := Bar.spriteBack.Top 0213 end;
0214 Bar.iSweepPosition :=-1;
0215 Bar.bEnabled := false;
0216 Bar.bForceDraw := false 0217 end;
0218 {_______________w___________________________}
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.
SUBSTITUTE SHEET (RULE 26) 0001 unit BitBtns;
0002 _ {________________________________________________________________________}
0003 interface ~______________________________________________________________________-_-_}
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 ExtCtrls, StdCtrls, 0014 Run, Main, Bitmaps;
0015 {$ENDIF}
0016 {_____~______________________________________}
0017 procedure Buttonslnitialize;
0018 procedure ButtonsF~cit;
0019 procedure ButtonsMouseDown_ExitCheck;
0020 procedure ButtonsMouseDown;
0021 procedure ButtonsMouseUp;
0022 procedure ButtonsForceNone;
0023 procedure ButtonsForcePlay;
0024 procedure ButtonsForcePause;
0025 procedure ButtonsForceStop;
{_________________________________________________________________________}
0027 implementation {_______________________________________________________________________-_-_}
0029 var 0030 spritePlay_Up, 0031 spriiePlay_Down, 0032 spritePause_Up, 0033 spritePause_Down, 0034 spriteResume Up, 0035 spriteResume_Down, 0036 spriteStop_Up, SUBST1TUTF SHEET (RULE Z6) 0037 spriteStop_Down, 0038 spriteEject Up, 0039 spriteEject Down, 0040 spriteRandom UipOn, 0041 spriteRandom C~ownOn, 0042 spriteRandom UipOff, 0043 spriteRandom_DownOff, 0044 spriteExit Up, 0045 spriteExit Down., 0046 spritelnfo_Up, 0047 spritelnfo_Down"
0048 spriteWords Up, 0049 spriteWords Down, 0050 spriteTracks_Up, 0051 spriteTracks_Do~rvn, 0052 spritePrint Up, 0053 spritePrint Down, 0054 spriteVideo_Up, 0055 spriteVideo_Dovsrn, 0056 spriteCommentary Up, 0057 spriteCommentary Down: TSpr9ie;
0058 bButtonsMouseDown: boolean;
{__________________.________________________________________________________}
0060 { Main code }
{__________________._______________________________________________________}
0062 procedure ButtonsDAouseDown_ExitCheck;
0063 begin 0064 if BitmapHit(spril:eExit Up) then begin 0065 bButtonsMou:~eDown := true;
0066 BitmapDraw(s;priteExit_Down);
0067 frmRun.ExitPressed 0068 end 0069 end;
0070 {__~__________~__..___~________________~___}
0071 procedure ButtonsMouseDown;
0072 begin 0073 case ePiayButtonState of 0074 bsPLAY: if BitmapHit(spritePlay Up) then begin 0075 bBut!ionsMouseDown := true;
SUBSTITUTE SHEET (RULE 26) 0076 BitmapDraw(spritePlay_Down);
0077 BitmapDraw(spriteSTOP Up);
0078 eStopButtonState := bsSTOP;
0079 frmRun.PIayPressed;
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 frmRun.ResumePressed;
0092 exit 0093 end 0094 end;
0095 case eStopButtonState of 0096 bsEJECT: if BitmapHit(sprtteEject 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(spritePlay_Up);
0106 ePiayButtonState := bsPLAY;
0107 frmRun.StopPressed;
0108 exit 0109 end;
0110 end;
0111 case eRandomButtonState of 0112 bsRANDOM ON: if BitmapHit(spriteRandom Upon) then begin 0113 bButtonsMouseDown := true;
0114 BitmapDraw(spriteRandom DownOff);
0115 eRandomSuttonState := t. >RANDOM_OFF;
0116 exit SUBSTITUTE SHEET (RULE 26~
WO 98/52189 PCT/fJS98/10035 0117 end;
0118 bsRANDOM_OFF: if BitmapHit(spriteRandom_Upon) then begin 0119 b8uttonsMouseDown := true; .
0120 BilmapDraw(spriteRandom_DownOn);
0121 eR;andomButtonState := bsRANDOM_ON;
0122 exit 0123 end 0124 end;
0125 if BitmapHit{spritelnfo_Up) then 0126 if eTubeModeState<>tmINFO then begin 0127 bButtonsMouseDown := true;
0128 BitmapDravr(spritelnfo_Down);
0129 BitmapDravr(spriteWords Up);
0130 BitmapDravr(spriteTracks_Up);
0131 eTubeMode~State := tmINFO;
0132 frmRun.Mo~ieSetlnfo;
0133 exit 0134 end;
0135 if BitmapHit(spriteWords_Up) then 0136 if eTubeModeState<>tmWORDS then begin 0137 bButtonsMouseDown := tme;
0138 BitmapDravr(spritelnfo_Up);
Oi 39 BitmapDravr(spriteWords_Down);
0140 BitmapDravr(spriteTracks Up);
0141 eTubeMode~State := ImWORDS;
0142 frmRun.ModeSetWords;
0143 exit 0144 end;
0145 if BitmapHit(spriteTracks Up) then 0146 if eTubeModeSiate<>tmTRACKS then begin 0147 bButlonsMouseDown := true;
0148 BitmapDravr(spriteinfo_Up);
0149 BitmapDravr(spriteWords_Up);
0150 BitmapDravr(spriteTracks_Down);
0151 eTubeMode~State := tmTRACKS;
0152 frmRun.ModeSetTracks;
0153 exit 0154 end;
0155 if BitmapHit(spritePrint_Up) then begin 0156 bButtonsMouseDown :_ true;
0157 BitmapDraw(spritePrint_ Down);
SUBSTiTLJTE SHEET (RULE 26) 0158 exit 0159 end;
0160 if BitmapHit(spriteVideo Up) then begin 0161 bButtonsMouseDown := true;
0162 BitmapDraw(spriteVideo_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 ePIayButtonState of 0178 bsPLAY: if BitmapHit(spritePlay_Up) then begin 0179 BitmapDraw(spritePause_Up);
0180 ePIayButtonState := bsPAUSE;
0181 exit 0182 end;
0183 bsPAUSE: if BitmapHit(spritePause_Up) then begin 0184 BitmapDraw(spriteResume_Up);
0185 ePIayButtonState := bsRESUME;
0186 exit 0187 end;
0188 bsRESUME: if BitmapHit(spriteResume Up) then begin 0189 BitmapDraw(spritePause_Up);
0190 ePIayButtonState := 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;
SUBSTITUTE SHEET (RULE 26) 0199 bsSTOP: if l3itmapHit(spriteStop_Up) then begin 0200 BitmapDraw(spriteEject Up);
0201 eStopButtonState := bsEJECT;
0202 exit 0203 end;
0204 end;
0205 case eRandomlButtonState of 0206 bsRANDOM_ ON: if BitmapHit(spriteRandom_Upon) then begin 0207 E~itmapDraw(spriteRandom UpOn);
0208 exit 0209 end;
0210 bsRANDOM_ OFF: if BitmapHit(spriteRandom Upon) then begin 0211 B~itmapDraw(spriteRandom UpOff);
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;
{__________________._______.________________________________________________}
0232 { Change button state }
{__________________._______________________________________________________}
0234 procedure ButtonsForceNone;
0235 begin 0236 if bButtonsMou;>eDown then 0237 exit;
SUBSTITUTE SHEET (RULE 2fi) 0238 BitmapDraw(spriteTracks_Up);
0239 BitmapDraw(spriteWords Up);
0240 BitmapDraw(spritelnfo_Up) 0241 end;
0242 {--___~~__w___~___~~_______________}
0243 procedure ButtonsForcePlay;
0244 begin 0245 if bButtonsMouseDown then 0246 exit;
0247 BitmapDraw(spritePause_Up);
0248 ePIayButtonState := bsPAUSE;
0249 BitmapDraw(spriteStop_Up};
0250 eStopButtonState := bsSTOP;
0251 end;
0252 {________________~_____________________________) 0253 procedure 8uttonsForcePause;
0254 begin 0255 if bButtonsMouseDown then 0256 exit;
0257 BitmapDraw(spriteResume_Up);
0258 ePiayButtonState := bsRESUME;
0259 BitmapDraw(spriteStop Up);
0260 eStopButtonState := bsSTOP;
0261 end;
0262 {_--________~____~_______________________}
0263 procedure ButtonsForceStop;
0264 begin 0265 if bButtonsMouseDown then 0266 exit;
0267 BitmapDraw(spritePlay_Up);
0268 ePIayButtonState := bsPLAY;
0269 BitmapDraw(spriteEje~ Up);
0270 eStopButtonState := bsEJECT;
0271 end;
{_______________________________________________________________________-__}
0273 { Initaiize / Exii }
{_______________________________________________________________________-__-}
0275 procedure Buttonsinitialize;
0276 begin SUBSTITUTE SHEET (RULE 26) 0277 BitmapCreate(:SpritePlay_Up, frmMain.imgPlay_Up, true);
0278 BitmapCreate(:SpritePlay_Down, frmMain.imgPlay_Down, true);
0279 BitmapCreate(spritePause_Up, frmMain.imgPause_Up, true);
0280 BitmapCreate(spriiePause Down, frmMain.imgPause_Down, true);
0281 BitmapCreate(:>priteResume_Up, frmMain.imgResume_Up, lrue);
0282 BitmapCreate(spriteResume_Down, frmMain.imgResume_Down, true);
0283 BitmapCreate(spriteStop_Up, frmMain.imgStop_Up, true);
0284 BitmapCreate(:~priteSto~~ Down, frmMain.imgStop_Down, true);
0285 BitmapCreate(spriteEject Up, frmMain.imgEject Up, true);
0286 BitmapCreate(:~priteEject Down, frmMain.imgEje~ Down, true);
0287 BitmapCreate(spriteRandom_Upon, frmMain.imgRandom Upon, true);
0288 BitmapCreate(:>priteRandom_DownOn, frmMain.imgRandom_DownOn, true);
0289 BitmapCreate(spriteRandom_UpOff, frmMain.imgRandom UpOff, true);
0290 BitmapCreate(spriteRandom DownOff, frmMain.imgRandom DownOff, true):
0291 BitmapCreate(;~priteExit_Up, frmMain.imgExit Up, true);
0292 BitmapCreate(;~priteExit_ Down, frmMain.imgExit_Down, true);
0293 BitmapCreate(apritelnfo_ Up, frmMain.imglnfo_Up, true);
0294 BitmapCreate(spritelnfo _Down, frmMain.imglnfo_Down, true);
0295 BitmapCreate(spriteWords Up, frmMain.imgWords Up, true);
0296 BitmapCreate(:~priteWords Down, frmMain.imgWords Down, true);
0297 BitmapCreate(spriteTracks Up, frmMain.imgTracks Up, true);
0298 BitmapCreate(spriteTracks_Down, frmMain.imgTracks Down, true);
0299 BitmapCreate(spritePrint_Up, frmMain.imgPrint Up, true);
0300 BitmapCreate(spritePrint_Down, frmMain.imgPrint Down, true);
0301 BiimapCreate(spriteVideo_Up, frmMain.imgVideo_Up, true);
0302 BitmapCreate(spriteVideo_Down, frmMain.imgVideo_Down, true);
0303 BitmapCreate(;~priteCommentary Up, frmMain.imgCommentary_Up, true);
0304 BitmapCreate(spriteCommentary Down, frmMain.imgCommentary_Down, true);
0305 BitmapDraw(sp~ritePlay_Up);
0306 BitmapDraw(syriteEject_Up);
0307 BitmapDraw(spriteRandom_UpOff);
0308 BitmapDraw(sF~riteExit Up);
0309 8itmapDraw(spritelnfo_Up);
0310 BitmapDraw(sF~riteWords Up);
0311 BitmapDraw(sF~riteTrackS Up);
0312 BitmapDraw(syritePrtnt Up);
0313 BitmapDraw(syriteVideo Up);
0314 BitmapDraw(sF~riteCommentary Up);
0315 ePIayButtonStFite := bsPLAY;
0316 eStopButtonSta~te := bsEJECT;
0317 eRandomi3uttonState := bsRANDOM_OFF;
SUBSTITUTE SHEET (RULE 26) 0318 eTubeModeState := tmINTRO;
0319 bButtonsMouseDown := false 0320 end;
0321 {___~________________w__~_________________}
0322 procedure ButtonsExit;
0323 begin 0324 BitmapDestroy(spritePlay_Up);
0325 BitmapDestroy(spritePlay_Down);
0326 BitmapDestroy(spritePause_Up);
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(spriteExii 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 8itmapDestroy(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.
SUBSTITUTE SHEET (RULE 26) 0001 unit Bitmaps;
0003 intertace {__________________________________________________________________________}
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 = reconi 0019 Left, Top: longing 0020 Width, Height: longint;
0021 bUseMask: Boolean;
0022 Image: TBitmap;
0023 Mask: TBitm;ap 0024 end;
0025 pTSprite = ~TSprite;
0026 {_-________~~_~_~_____________________}
0027 procedure BitmapCreate(var Sprite: TSprite; imglmage: Tlmage; UseMask:
Boolean);
0028 procedure BitmaplDestroy(var Sprite: TSprile);
0029 procedure Bitmap~Overlay(Biimap: TBitmap; var Sprite, SpriteOffset:
TSprite);
0030 procedure Bitmap~Draw(var Sprite: TSprite);
0031 procedure BilmapUpdateScreen(Rect: TRect);
0032 function BitmapHit(var Sprite: TSprite): Boolean;
{__________________________.______________________________________________.-_}
0034 implementation {__________________._____________________________________________________-__}
{__________________________.________________________________________________}
SUBSTITUTE SHEET (RULE 26) 0037 { Code }
~_________________________________________________________________________) 0039 procedure BitmapCreate(var Sprite: TSpriie; imglmage: Tlmage; UseMask:
Boolean);
0040 var 0041 I: string[50];
0042 p: integer;
0043 begin 0044 I := imglmage.Hint;
0045 p := Pos(',',I);
0046 Sprite.Left := StrTolnt(Copy(1,1,p-1));
0047 I := Copy(I,p+1,99);
0048 p := Pos(',',I);
0049 if p=0 then begin 0050 Sprite.Top := StrTolnt(I);
0051 imglmage.Hint :_ ";
0052 end 0053 else begin 0054 Sprite.Top := StrTolnt(Copy(1,1,p-1));
0055 imglmage.Hint := Copy(I,p+1,99) 0056 end;
0057 with Sprite do begin 0058 Width := imglmage.Width;
0059 Height := imglmage.Height;
0060 Image := TBitmap.Create;
0061 Image.Assign(imglmage.Picture.Biimap);
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(CIipRect, imglmage.Picture.Bitmap, CIipRect, TRANSPARENT COLOR) 0074 end;
0075 with Sprite.Image.Canvas do begin 0076 Brush.Color := clWhite;
SUBSTITUTE SHEET (RULE 26) 0077 Brush.Style := bsSolid;
0078 BrushCopy(CIipRect, imglmage.Picture.Biimap, CIipRect, TRANSPARENT
COLOR);
0079 end;
0080 with Sprite do 0081 BitBlt(Mask.Canvas.Handle, 0, 0, Width, Height, 0082 Image.(;anvas.Handle, 0, 0, MERGEPAINT) 0083 end 0084 end;
0085 {_-__________~~.____.~____________________}
0086 procedure BitmapDestroy(var Sprite: TSprite);
0087 begin 0088 with Sprite do beiiin 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 betiin 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-SpriieOffset.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.(~anvas.Handle, 1, 0, srcAND) 0113 end 0114 else begin 0115 BitBlt(Bitmap.Canvas.Handle, iLeft+1, iTop, Width-1, Height, 0116 Image.(:anvas.Handle, 1, 0, srcCOPlr7 0117 end SUBSTITUTE SHEET (RULE 26~
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, D140 Rect.Right-Reci.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): boofean;
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) SUBSTITUTE SHEET (RULE 26) 0159 else 0160 result := true 0161 end;
0162 end;
0163 end.
SUBSTITUTE SHEET (RULE 26) 0001 unit CDPlayer;
{-________________________________________________________________________}
0003 interface {________________________________________________________________________-}
0005 {$IFDEF WINDOWS}
0006 uses 0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 0008 Forms, Dialogs, ExtCtrls, MPlayer, 0009 Run, Main, Logging;
0010 {$ELSE}
0011 uses 0012 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 0013 ExtCtrls, StdCtrls, MPlayer, 0014 Run, Main, Logging;
0015 {$ENDIF}
0016 {___________~__w____w___________________}
0017 var 0018 iAudioTracks:longint;
0019 iAudioTrackStart, iAudioTrackLength: array [1..MAX TRACKS] of longint;
0020 iStatsCDStart, iStatsCDLength: longint;
0021 iStatsTrackStari, 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 iHoIdOffUpdate:longint;
0027 iPIayTimeout:longint;
0028 { ----_ ~ ________~M~}
0029 procedure Playerlnitialize;
0030 procedure PlayerTimerTick;
0031 procedure PlayerEject;
0032 procedure PlayerStop;
0033 procedure PlayerPlay(start: TLogStart; TrackTime: iongint);
0034 procedure PlayerPause;
0035 procedure PlayerResume;
0036 procedure PlayerGetTrackAndTime( var TrackNo, TrackTime: longint);
{_______________________________________________________________________-__}
0038 implementation SUBSTITUTE SHEET (RULE 26) 0040 procedure PlayerEject;
0041 begin 0042 frmRun.MouseDissable;
0043 eCDPIayerState := psNOCD;
0044 with frmRun.mml:,DPlayer do begin 0045 TimeFormat :_~ tfMilliseconds;
0046 LoggingLoglt(IePLAY, (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 {----__~_____~_w_~~_~_____~__~_w]
0069 procedure PlayerStop;
0070 begin 0071 frmRun.MouseDissable;
0072 eCDPIayerState := psSTOPPED;
0073 with frmRun.mmCDPlayer do begin 0074 TimeFormat :~= tfMilliseconds;
0075 LoggingLoglt(IIePLAY, (Position div 100) -iAudioTrackStart[iLastTrackNo]);
0076 try 0077 Wait := true;
0078 Notify := faise;
SUBSTiTUT~ SHEET (RULE 26) 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 eCDPlayerState := psSTOPPED;
0090 with frmRun.mmCDPiayer do begin 0091 TimeFormat := tfMilliseconds;
0092 LoggingLoglt(IePLAY, (Position div 100) -iAudioTrackStart[iLastTrackNoj);
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[iLastTrackNoj + 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 iPIayTimeout := 20;
0117 while (Mode<>mpPLAYING) do 0118 if (iPIayTimeout=0) then begin 0119 rrmRun.ErrorMessege('Thtre Is a problem trying to play the CD!');
SUBSTITUTE SHEET (RULE 26) 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(IePLAY, start, iLastTrackNo, TrackTime);
0131 iHoIdOffUpdate :== 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.mm(:DPlayer do begin 0141 TimeFormat :_ tfMilliseconds;
0142 LoggingLoglt(IeVIDEO, (Position div 100) -iAudioTrackStart[iLastTrackNo]);
0143 try 0144 TimeFormai: := tfMilliseconds;
0145 iPausedTime :_ (Position div 100) - iAudioTrackStart[iLastTrackNo];
0146 Wait := true;
0147 Notify := fal.~e;
0148 Stop 0149 except 0150 end 0151 end;
0152 frmRun.MouseEnable 0153 end;
0154 {__~___________________________________________}
0155 procedure PlayerResume;
0156 begin 0157 with frmRun.mm4.DPlayer do begin 0158 TimeFormat :=~ tfMilliseconds;
0159 Loggingloglt(I~ePLAY, (Position div 100) -iAudioTrackStart[iLastTrackNo]) 0160 end;
SUBST1TUTF SHEET (RULE 26) 0161 PfayerPlay(IsRESUME, iPausedTime) 0162 end;
0163 {-------__~_~~_____________________}
0164 procedure PlayerGetTrackAndTime( var TrackNo, TrackTime: longint);
0165 var 0166 iTrack:longint;
0167 begin 0168 with frmRun.mmCDPlayer 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;
{_________________________________________________________________________}
0181 { Initalize / Exit }
{_________________________________________________________________________}
0183 procedure PlayerTimerTick;
0184 begin 0185 if iHoIdOffUpdate>0 then 0186 Dec(iHoIdOffUpdate);
0187 if iPIayTimeout>0 then 0188 Dec(iPIayTimeout) 0189 end;
{_________________________________________________________________________}
0191 { Initaiize / Exii }
{_________________________________________________________________________}
0193 procedure Playerlnitialize;
0194 var 0195 iTrack:longint;
0196 begin 0197 frmRun.MouseDissable;
SUBSTITUTE SHEET (RULE 26) 0198 eCDPIayerSiate := psNOCD;
0199 with frmRun.mm(:DPlayer 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 := dICDAudio;
0209 Wait := true;
0210 Notify := false;
021 i 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 Mode<>mp~~TOPPED 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 iStatsCDLengih := Length;
0230 for iTrack := 1 to iAudioTracks do begin 0231 iStatsTrackStart[iTrack] := TrackPosition[iTrack];
0232 iStatsTrackl_engih[iTrack] := TrackLength[iTrack];
0233 iAudioTrach:Start[iTrack] := TrackPosition[iTrack] div 100 0234 end 0235 end;
0236 eCDPIayerState := psSTOPPED;
023 i iHoIdOffUpdate := 0;
0238 iPIayTimeout :_ ~D;
SUBSTITUTE SHEET (RULE 26) 0239 frmRun.MouseEnable 0240 end;
0241 end.
SUBSTITUTE SHEET (RULE 2fi) 0001 unit Comment;
{_-_________________.____________________________________________________-_}
0003 interface {___________________._____________________________________________________--_}
0005 {$IFDEF WINDOWS}
0006 uses 0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 0008 Fortns, Dialogs, E:xtCtrls, MPlayer, 0009 Run, Main, CDPl;ayer, SysFig, Logging;
0010 {$ELSE}
0011 uses 0012 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 0013 ExtCtrts, StdCtrls;, MPlayer, 0014 Run, Main, CDPfayer, 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;
{___________________.______________________________________________________}
0025 implementation {___________________.____________________________________________________.-_}
{-_________________________________________________________________________}
0028 { Main Code }
{~_________________._____________________________________________________-_-_}
0030 procedure CommentaryStop;
0031 begin 0032 with frmRun.mmCommentary do begin 0033 TimeFormat :_= tfMilliseconds;
0034. LoggingLoglt(IeCOMMENT, Position div 100);
0035 try SUBSTITUTE SHEET RULE 26) 0036 Wait := true;
0037 Notify := false;
0038 Stop 0039 except 0040 end 0041 end 0042 end;
0043 {_-_-----_-__~________~_________w_____}
0044 procedure CommentaryPlay(TrackNo: longint);
0045 begin 0046 with frmRun.mmCommentary do begin 0047 TimeFormat := tfMilliseconds;
0048 LoggingLoglt(IeCOMMENT, Position div 100);
0049 try 0050 FileName := sRunDirectory+'Stuff\Convent'+IntToStr(TrackNo)+'.wav';
0051 Wait := true;
0052 Notify := false;
0053 Open;
0054 Wait := false;
0055 Notify := true;
0056 Pfay 0057 except 0058 frmRun.ErrorMessage('There is a problem with Commentary playback!;
0059 exit 0060 end;
0061 LoggingEvent(IeCOMMENT, IsOTHER, TrackNo, 0) 0062 end;
0063 end;
0064 {___________~____~__w_~______________}
0065 procedure CommentaryNotify;
0066 begin 0067 with frmRun.mmCommentary do begin 0088 TimeFormat := tfMilliseconds;
0069 LoggingLogli(IeCOMMENT, Position div 100) 0070 end 0071 end;
{_________________________________________________________________________}
0073 { Initalize / Exit }
{_______________________________________________________________________ _}
SUBST1TUT~ SHEET (RULE 26) 0075 procedure Commentarylnitialize;
0078 var 0077 fCommentary: T~extFile;
0078 iTrack:lnteger;
0079 begin 0086 for iTrack := 1 to iAudioTracks do begin 0081 bCommentaryAvailable[iTrack] := true;
008 try 0083 AssignFile(fCommentary, sRunDirectory+'StufflConvent'+IniToStr(iTrack)+'.wav');
0084 Reset(fCommentary);
0085 CIoseFile(fl;,ommentary) 0088 except 0087 bCommentaryAvailable[iTrack] := false 0088 end 0089 end 0090 end;
0091 end.
SUBSTITUTE SHEET (RULE 26) 0001 unit Counter;
{___________________________________________________________________________ }
0003 intertace ________________________________________________________________________ _}
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 ExtCtrls, StdCtrts, 0014 Run, Main, Bitmaps, Tube;
0015 {$ENDIF}
0016 {--___-_ ~_________________________}
0017 procedure Counterlnitialize;
0018 procedure CounterExit;
0019 procedure CounterNewTrack;
0020 procedure CounterSetTime(TrackTime: longint};
0021 {__ ____~~w_______________________}
0022 type 0023 TTrackMS = record 0024 Minutes:longint;
0025 Seconds:longint 0026 end;
0027 { _~-__~___w__________~____}
0028 var 0029 OIdTrackMS: TTrackMS;
0030 spriteCounter: TSprite;
{___________________________________________________________________________ _}
0032 implementation ________________________________________________________________________ _}
SU6ST1TUTE SHEET (RULE Z6) 0034 const 0035 COUNTER_COLOR = $OOA00000;
0038 { Code }
_______________.________________________________________________________ _) 0040 procedure CounterNewTrack;
0041 begin 0042 OIdTrackMS.Minutes :_ -1 0043 end;
0044 {_-______________~___________________________) 0045 procedure Counter:~etTime(TrackTime: longint);
0046 var 0047 TrackMS: TTrach:MS;
0048 slime: string[6j;
0049 CounterRect: TRect;
0050 begin 0051 TrackMS.Minutes := TrackTime div 600;
0052 TrackMS.Seconds :_ (TrackTime - 600'TrackMS.Minutes) div 10;
0053 if (TrackMS.Minutes=OIdTrackMS.Minutes) and 0054 (TrackMS.Seconds=OIdTrackMS.Seconds) then 0055 exit;
0056 with bmpPlayer.Canvas do begin 0057 BitmapOverlay(bmpPlayer, spriteCounter, TSprite(nil~));
0058 slime := intTc~Str(TrackMS.Minutes);
0059 if TrackMS.Minutes<10 then 0060 slime :_ '0'~+sTime;
0061 slime := slime+':';
0062 if TrackMS.Seconds<10 then 0063 slime := sT'ime+'0'+IntToStr(TrackMS.Seconds) 0064 else 0065 slime := slime+IntToStrtTrackMS.Seconds);
0066 Brush.Style := bsClear;
0067 Font.Size := 11'extFontSize_2;
0088 Font.Color := i:,OUNTER_COLOR;
0069 Font.Style :_ [/;
0070 CounterRect :~= Bounds(spriteCounler.Left, spriteCounter.Top, SUBSTITUTE SHEET (RULE Z6) 0071 spriteCounler.Width, spriteCounter.Height);
0072 ExtTextOut(Handle, 0073 spriteCounter.Left+2, spr9teCounter.Top+4, 0074 0, cLDCounterRect, Pointer(~sTime[1j), 5, nil);
0075 BitmapUpdateScreen(CounterRect) 0076 end 0077 end;
{_-_________________________________________________________________________ _}
0079 { Initalize / Exit }
{___________________________________________________________________________ _}
0081 procedure Counterlnitiaiize;
0082 begin 0083 BitmapCreate(spriteCounter, frmMain.imgCounter, false);
0084 OIdTrackMS.Minutes :_ -1 0085 end;
0086 {_______________________________~__________________}
0087 procedure CounterExit;
0088 begin 0089 BitmapDestroy(spriteCounter) 0090 end;
0091 end.
SUBSTITUTE SHEET (RULE 26) WO 98/52189 PCT/iJS98/10035 0001 unit Info;
{___._______________._______________________________________________________}
0003 interface {___._______________.______________________________________________________--_}
0005 {$IFDEF WINDOWS}
0006 uses 0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 0008 Forms, Dialogs, 0009 Run, Main, CDPlayer, BitBtns, BitBars, Tube, SysFig;
0010 {$ELSE}
0011 uses 0012 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 0013 ExtCtrls, StdCtrls, 0014 Run, Main, CDPlayer, BitBtns, BitBars, Tube, SysFig;
0015 {$ENDIF}
0016 {________________________._____________________________}
0017 procedure Infolnitialize;
0018 procedure InfoExit;
0019 procedure InfoNewTrack(TrackNo: longint);
0020 {________________________..____________________________}
0021 var 0022 Thelnfo: array [1..MAX_TRACKS] of TTubeList;
{_________________________________________________________________________}
0024 implementation {__________________._____________________________________________________-_-_}
{_______________________________________________________________________.-_}
0027 { Code }
{_________________________________________________________________________}
0029 procedure infoNewTrack(TrackNo: longint);
0030 begin 0031 if eTubeModeState=tmINFO then 0032' TubeDisplay(Thelnfo[TrackNo]);
0033. TubeSetTopLine~(Thelnfo(TrackNo], 1) 0034 end;
{________________________________________________________________________-}
SUBSTITUTE SHEET (RULE 26) 0036 { Initalize / Exit }
{_______________________________________________________________________-__}
0038 procedure Infolnitialize;
0039 var 0040 flnfo: TextFile;
0041 iTrack:lnteger;
0042 I: String[250];
0043 begin 0044 for iTrack := 1 to iAudioTracks do begin 0045 AssignFile(flnfo, sRunDirectory+'Stuff\info'+IntToStr(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(I, nil) 0051 end;
0052 CIoseFile(flnfo);
0053 TubeInitList(spriteTubeText, Thelnfo[iTrack], -3, 0);
0054 end 0055 end;
0056 {_________________________w_____________________}
0057 procedure InfoExit;
0058 var 0059 iTrack:lnteger;
0060 begin 0061 for iTrack := 1 to iAudioTracks do 0062 if Theinfo[iTrack].TextList<>nil then 0063 TubeFacitList(Theinfo[iTrack]) 0064 end;
0065 end.
SUBSTITUTE SHEET (RULE 2fi) 0001 unit IniFig;
_______________.____________________________________________________.
0003 interface {--____________________________________________________________________ -_~
0005 {$IFDEF WINDOWS }
0006 uses 0007 WinTypes, WinProcs, SysUtiis, Messages, Classes, Controls, Inifiles, Registry, 0008 Run, SysFig;
0009 {$ELSE}
0010 uses 0011 Windows, SysUiils, 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: strinct[200];
0022 inilnfoFiie, 0023 iniVoteFile: string[50];
0024 iniAppName, 0025 iniAppTitie: string[100];
0026 iniAIbumHandle, 0027 iniAIbumLabel, 0028 iniAIbumArtist, 0029 iniAIbumName: 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 iniPIayByeBye: Boolean;
SUBSTITUTE SHEET (RULE 26) 0040 iniVoteLimit: integer;
{_________________________________________________________________________) 0042 implementation ____________________________________________________________________ 0044 function InifigLoad: Boolean;
0045 var 0046 flniFlle: 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+'IQPlayer.ini');
0059 Reset( flniFile);
0060 CIoseFile( flniFile);
0061 except 0062 exit 0063 end;
0064 try 0065 Ini := TIniFile.Create( sRunDirectory+'IQPlayer.ini');
0066 except 0067 exit 0068 end;
0069 try 0070 iniCryptPublic := Ini.Readlnteger('Intemet', 'CryptPublic', -1);
0071 iniCryptPrime := Ini.Readlnteger('Intemet', 'CryptPrime', -1);
0072 inilnfoFile := Ini.ReadString('Intemet', 'Filelnfo', ");
0073 inilnfoURL := Ini.ReadString('Internet', 'URLlnfo', ");
0074 iniVoteFile := Ini.ReadString('internet', 'FileVote', ");
0075 iniVoteURL := Ini.ReadString('Intemet', 'URLVote', ");
0076 iniAIbumHandle := Ini.ReadString('Aibum', 'Handle', ");
0077 iniAlbumLabel := Ini.ReadString('Album', 'Label', ");
0078 iniAIbumArtist := ini.ReadString('Album', 'Artist', ");
SUBSTITUTE SHEET (RULE 26) 0079 iniAIbumName := Ini.ReadString('Album', 'Name', ");
0080 iniAppName :_ Ini.ReadString('Application', 'Name', ");
0081 iniAppTitle := ini.ReadString('Application', 'Title', ");
0082 iniWallpaper :== Ini.ReadString('Application', 'Wallpaper', ");
0083 iniScreenSaver := iniWallpaper;
0084 sPlaylntro := Uppercase(Ini.ReadString('Application', 'Playlntro', "));
0085 sAskVote := Uppercase(ini.ReadString('Application', 'AskVote', "));
0086 sAskVideo := Uppercase(Ini.ReadString('Application', 'AskVideo', "));
0087 sSendVote := Uppercase(Ini.ReadString('Application', 'SendVote', "));
0088 sSendlnfo := Uppercase(Ini.ReadString('Application', 'Sendlnfo', "));
0089 iniPIayByeBye := Ini.ReadBool('Application', 'PIayBye', false);
0090 iniVoteLimit := Ini.Readlnteger('Application', 'Votel_imit', -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 inifnfoURL=" then exit;
0099 if iniVoteURL=" then exit;
0100 if iniVoteFile=" then exit;
0101 if iniAibumHandlE:=" then exit;
0102 if iniAlbumLabel=~" then exit;
0103 if iniAIbumArtist=" then exit;
0104 if iniAIbumName~=" then exit;
0105 if iniAppName=" then exit;
0106 if iniAppTitle=" then exit;
0107 if iniWallpaper=" then exit;
0108 if iniScreenSavei=" then exit;
0109 if sPiayintro='ONCE' then iniPlaylntro := qfONCE
0110 else if sPiaylntro~='ALWAYS' then iniPlaylntro := qfALWAYS
0111 else if sPlaylntro~='NEVER' then iniPlaylntro := qfNEVER
0112 else 0113 exit;
0114 if sAskVote='ON1;,E' 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
SUBSTITUTE SHEET (RULE 26~
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 iniVoteLimit=-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\'+iniAibumHandle+'\Info';
0143 try 0144 if Reg.OpenKey(sKey,true) then Reg.WriteString('URL',inilnfoURL+'lappend.cgi?file='+inilnfoFile+'&data='}
0146 except 0147 exit 0148 end;
0149 Reg.RootKey := HKEY LOCAL MACHINE;
0150 sKey :='\SOFTWAREIPalantir\IQcd\'+iniAlbumHandle+'\Vote';
0151 try 0152 if Reg.OpenKey(sKey,true) then Reg.WriteString('URL',iniVoteURL+'/append.cgi?file='+iniVoteFile+'&data=') 0154 except 0155 exit 0156 end;
0157 result := true 0158 end;
0159 end.
SUBSTITUTE SHEET' (RULE 26) 0001 unit IQAbout;
{________________________________________ . ______________________________-}
0003 interface {__________________._____________________________________________________-_-_}
0005 {$IFDEF WINDOWS}
OOOf> uses 0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 000& Forms, Dialogs, 000 Run, Main, Tube, Bitmaps, SysFig;
001 G {$ELSE}
0011 uses 001! Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 001 3 ExtCtrls, StdCtrf:>, 0014 Run, Main, Tube, Bitmaps, SysFig;
0015 {$ENDIF}
001ii {-------____________..__________________________}
001 i' procedure Aboutlnitialize;
0015 procedure AboufExit;
001 g {----_______________.__________________________}
0020 var 0021 spriteTubeCDABout, 002.? spriteTubeIQAbout: TSprite;
002a TheCDAbout: T1-ubeList;
0024 TheIQAbout: TTubeList;
{___._______________.______________________________________________________-}
002Ei implementation 002 i' 0029 { Code }
{__________________._____________________________________________________-_-_}
0031 procedure Aboutlnitialize;
0032 var 003:3 fAbout: TextFile;;
0034 I: string[100J;
0035 begin;
SUBSTITUTE SHEET (RULE 26) WO 98/52189 t'CT/US98/10035 0036 BiimapCreate(spriteTubeCDAbout, frmMain.imgTube_CDAbout, true);
0037 BitmapCreate(spriieTubeIQAbout, frmMain.imgTube_IQAbout, true);
0038 TheCDAbout.TextList := TStringList.Create;
0039 AssignFile(fAbout, sRunDirectory+'StufflCDlnfo.txt');
0040 Reset(fAbout);
0041 while not Eof(fAbout) do begin 0042 ReadLn(fAbout, I);
0043 TheCDAbout.TextList.AddObject(I, nil) 0044 end;
0045 CIoseFile(fAbout);
0046 TubeInitList(spriteTubeCDAbout, TheCDAbout, -3, 0);
0047 TheIQAbout.TextList := TStr9ngList.Create;
0048 AssignFile(fAbout, sRunDirectory+'Stuff\IQlnfo.txt');
0049 Reset(fAbout);
0050 while not Eof(fAbout) do begin 0051 ReadLn(fAbout, I);
0052 TheIQAbout.TextList.AddObject(I, nil) 0053 end;
0054 CIoseFile(fAbout);
0055 TubeInitList(spriteTubeIQAbout, TheIQAbout, -3, 0) 0056 end;
0057 {____________________________________________}
0058 procedure AboutExit;
0059 begin 0060 TubeExitLisf(TheIQAbout);
0061 TubeExitList(TheCDAbout);
0062 BitmapDestroy(spriteTubeCDAbout);
0063 BitmapDestroy(spriteTubeIQAbout) 0064 end;
0065 end.
SUBSTITUTE SHEET (RULE 26) 0001 unit IQMenu;
{___________________.______________________________________________________}
0003 interface {___________________.______________________________________________________}
0005 {$IFDEF WINDOW~~}
0006 uses 0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 0008 Forms, Dialogs, L:MDnonvS, 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, StdCtrls, LMDnonvS, IniFiles, Registry, 0014 Run, Main, Tube, Bitmaps, Wall, Saver, SysFig;
0015 {$ENDIF}
0016 {____________________________________________________}
0017 var 0018 TheMenu: TTubel_ist;
0019 {_____________~____~____________________________}
0020 procedure Menulniti~alize;
0021 procedure MenuExit;
0022 function MenuGetLine(Menuftem: longint): longint;
0023 procedure MenuEnableltem(Menultem: longint);
0024 procedure MenuDissableltem(Menultem: fongint);
0025 procedure MenuUpdate;
0026 procedure MenuHighlightltem(Menuitem: longint);
0027 procedure MenuMouseDown;
0028 procedure MenuMouseMove(X,Y: longint);
0029 procedure MenuTimerTick;
{____._______________.____________________________________________________-_-_}
0031 implementation {____._______________.____________________________________________________-_-_}
0033 var 0034 iHintltem:longint;
0035 iHintX, iHintY: longint;
0036 iHintDelayTimer:llongint;
0037 sHintMsg: string[250];
SUBSTITUTE SHEET (RULE 26) 0038 bHintVisible: Boolean;
0039 blnHintArea: Boolean;
{_________________________________________________________________________}
0041 { Main Code }
{_________________________________________________________________________}
0043 function MenuGetLine(Menultem: longint): longint;
0044 var 0045 iLine:longint;
0046 iLastLine:longint;
0047 {pTubeLine: pTTubet_ine;}
0048 begin 0049 iLastLine := TheMenu.TextList.Count-1;
0050 {for iLine := 0 to iLastLine do 0051 pTubeLine := pTTubeLine(TheMenu.TextList.Objects[iLine]);
0052 if pTubeLine~.iTimeStamp=Menultem then begin}
0053 for iLine := 0 to iLastLine do 0054 with pTTubeLine(TheMenu.TextList.Objects[iLinej)~ do 0055 if iTimeStamp=Menultem then begin 0056 result := iLine+1;
0057 exit 0058 end;
0059 frrnRun.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;
0087 {- __~ _~_____________~__}
0068 procedure MenuDissableltem(Menultem: longint);
0069 begin 0070 TubeSetDissable(TheMenu, MenuGetLine(Menultem)) 0071 end;
0072 { _~_ _w__________________~}
0073 procedure MenuHighlightttem(Menultem: longint);
0074 begin 0075 TubeSetAlINormal(TheMenu);
0076 TubeSetHighlight(TheMenu, MenuGetLine(Menultem)) SUBSTITUTE SHEET (RULE 26) 0077 end;
0078 {_____~___~__~____________________________) 0079 procedure MenuUpt~ate;
0080 var 0081 menu: TStringLis~t;
0082 iLine, iLastLine: integer;
0083 begin 0084 menu := TheMenu.TextList;
0085 iLastLine := menu.Count-1;
0086 for iLine := 0 to il_astLine do 0087 case pTfubeLine(menu.Objects[iLine]).iTimeStamp of 0088 4: if UsingOurWallpaper and not UsingThisWallpaper(startWaIIpaperName) then 0089 menu.Strings[iLine] :='{!s12 h15 c020}Previous Wallpaper' 0090 else 0091 menu.Strings[iLine] :='{!s12 h15 c020}Install Wallpaper';
0092 5: if UsingOurSaver and not UsingThisSaver(startScreenSaver) then 0093 menu.Strings[iLine] :='{lsl2 h15 c020}Previous Screen Saver' 0094 else 0095 menu. Strings[iLine] :='{!s12 h15 c020}install 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}Turn Wallpaper On';
0100 9: if bHintsE=nabled then 0101 menu.Strings[iLine] :='{!s12 h20 c020}Tum Hints Off 0102' else 0103 menu.~~trings[iLine] :='{!s12 h20 c020}Turn Hints On' 0104 end;
0105 TubeRefresh(TheMenu) 0106 end;
{_________________________________________________________________________}
0108 { Mouse Handling }
{_________________________________________________________________________}
0110 procedure MenuMouseDown;
0111 var 011.>. iMenultem:longint;
011:4 begin 0114 if eTubeModeState<>tmMENU then 0115 exit;
SUBSTITUTE SHEET (RULE 26) 0116 iMenultem := TubeItemHit(iMOuseDownX,iMOuseDownY);
0117 if iMenultem>0 then begin 0118 iHintDelayTimer := 0;
0119 if bHintVisible then begin 0120 frmRun.blobHint.HideMessage;
0121 bHintVisibie := 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 eTubeModeState<>tmMENU then 0134 goto exitl;
0135 iHintX := frmRun.Left+X+5;
0136 iHintY := frmRun.Top+Y_0;
0137 iltem := TubeItemHit(X,Y);
0138 if iltem>0 then begin 0139 if iltem<>iHiniltem then begin 0140 if bHintVisible then begin 0141 frmRun.bIobHint.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.bIobHint.HideMessage;
0155 bHintVisible := false 0156 end SUBSTITUTE SHEET (RULE 26) 0157 end;
0158 {__~___~____ __.._____~______~______}
0159 procedure MenuTimierTick; -0160 begin 0161 if iHintDelayTimer=0 then 0162 exit;
0163 Dec(iHintDelayTimer);
0164 if iHintDelayTimer=0 then begin 0165 if bHintVisible then 0166 frmRun.bIobHint.HideMessage;
0167 iHintLastX := il~intX;
0168 iHintLastY := iliintY;
0169 sHintLastMsg ::= sHintMsg;
0170 frmRun.bIobHint.Position := hpAboveRight;
0171 frmRun.bIobHint.ShowMessage(sHintMsg, iHintX, iHintY);
0172 bHintVisible := true 0173 end 0174 end;
{-______________________________________________________________________-_-_}
0176 { Initalize / Exit }
{-__________________.______________________________________________________}
0178 procedure Menulnitialize;
0179 begin;
0180 TheMenu.TextList := TStringList.Create;
0181 TheMenu.TextList.AddObject('{h20}', Pointer(0));
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}Install Wallpaper', Pointer(4));
0186 if not UsingOurSaver then 018i' TheMenu.TextList.AddObject('{!s12 h15 c020}Install Screen saver', Pointer(5));
0188 if UsingWallpaper then 0189 TheMenu.TextList.AddObject( '{!s12 h20 c020}Tum Wallpaper On', Pointer(7)) 0190 else 0191 TheMenu.TextLisl.AddObject( '{!s12 h20 c020}Turn Wallpaper Off, Pointer(7));
0192 if not bVideoEnable then begin 0193 TheMenu.TextList.AddObject('{!s12 h15 c020}Install Web Link', Pointer(6));
0194 TheMenu.TextList.AddObject('{!s12 h15 c020}Install Active Movie', Pointer(8)) 019!i end SUBST1TUT~ SHEET (RUL~ 26) 0196 else 0197 TheMenu.TextList.AddObject('{!s12 h15 c020}Install Web Link', Pointer(6));
0198 TheMenu.TextList.AddObject('{IS12 h20 c020}Turn Hints Off, Pointer(9));
0199 TubeInitList(spriteTubeMenu, TheMenu, -3, 8);
0200 sHintMsg :='Click selection to do it.';
0201 iHintltem := 0;
0202 iNintDelayTimer := 0;
0203 bHintVisible := false;
0204 blnHintArea := false;
0205 sCurrentWal! :_ ";
0206 sCurrentTile :='0';
0207 sCurrentSaver :_ "
0208 end;
0209 {_____________________________________________}
0210 procedure MenuExit;
0211 begin 0212 TubeExitList(TheMenu) 0213 end;
0214 end.
SUBSTITUTE SHEET (RULE 26) program IQPlayer;
uses Forms, Run in 'RUN.PAS' {frmRun}, Main in 'MAIN.PAS' {frmMain}, Video in'VIDEO.PAS' {frmVideo}, Regions in'REGIONS.P~AS', Bitmaps in'BITMAPS.PAS', BitBars in 'BITBARS.PA,~ , Bitgtns in 'BITBTNS.PA;'>'>', ScroIBar in 'SCROLBAR.PAS', TimeBar in 'TIMEBAR.P,AS', VolumBar in 'VOLUMBAR.PAS', PIayList 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', Cornment in'COMMENI'.PAS', CDPlayer in 'CDPLAYER.PAS', IQMenu in'IQMenu.pas'., IQA,bout in'IQAbout.pas", TrkIUledia 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}
begirt Application.lnitialize;
Application.CreateForm(TfrmRun, frmRun);
Application.Run;
end.
SUBSTITUTE SHEET (RULE 26) 0001 unit Logging;
{_________________________________________________________________________}
0003 interface {_________________________________________________________________________}
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 ExtCtris, StdCtrls, Registry, 0014 Run, IniFig, RegFig, SysFig, Wall, Saver;
0015 {$ENDIF}
0016 {________________________________________________}
0017 type 0018 TLogEvent = (IePLAY, IeVIDEO, IeCOMMENT, IeWALL, IeLINK, IeSAVER, 0019 IeNONE );
0020 TLogStart = (IsPLAY, IsRESUME, IsTIMEBAR, IsWORDS, IsTRACK, IsNEXT, IsOTHER);
0021 {_----_____~____________________________________}
0022 procedure LogginglnitialiZe;
0023 procedure LoggingEvent(event: TLogEvent; start: TLogStart; track, time0:
integer);
0024 procedure LoggingLoglt(event: TLogEvent; time1: integer);
{________________________________________________________________________-_}
0026 implementation ~_________________________________________________________________________}
0028 uses 0029 CDPlayer;
0030 {--------__~_~_~_~__w_____~_______}
0031 const 0032 sEvents: array [IePLAY..IeNONE) of string =
0033 ('PLAY', 'VIDEO', 'COMMENT', 'iWALL', 'iLINK', 'iSAVER', '?');
0034 sE2vents: array (IePLAY..)eNONE] of string =
0035 ('Pc', 'Pv', 'Pm', 'Iw', 'll', 'Is', '?');
0036 sStarts: array [IsPLAY..IsOTHER) of string =
0037 ('play', 'resume', 'timebar', 'words', 'track', 'next', 'other');
SUBSTITUTE SHEET (RULE 26~
003x {__---____~_____~..___~____________~_}
0039 var 0040 regFirstRun: string[30]; _ 0041 Logln, LogOut, LogSeq: integer;
0042' IogXevent: TLogEvent;
0043. IogXstart: TLogStart;
0044 IogXtrack: integer;
0045 IogXtimeO: integer;
0046.
{_________________________________________________________________________}
0047 { Code }
004a {_________________________________________________________________________}
0049 procedure LoggingEvent(event: TLogEveni; start: TLogStart; track, time0:
integer);
0050 begin 0051 IogXevent := event;
0052' iogXstart := start;
0053. iogXtrack := track;
0054 IogXtimeO := time0;
0055~ end;
0056. { __w_____~.._________________w____.}
005T procedure LoggingLoglt(event: TLogEvent; timel: integer);
0056 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 0066 exit;
0066 if (IogXevent=ieNONE) or (IogXevent<>event) then 0076 exit;
0071 if IogXtimeO<0 then 007! IogXtimeO := 0;
0073 if timel <IogXtimeO then 0074 timel := IogXtimeO;
007:1 if timel=IogXtimeO then 007Et exit;
SUBSTITUTE SHEET (RULE 26~
0077 Log :_ 'v1.00,'+iniAIbumHandle+','+regNandle+
0078 ','+regFirstRun+','+SysPad(LogSeq,6)+
0079 ','+regZip+','+regAge+','+regSex+',,.
0080 case eTubeModeState of 0081 tmTRACKS: s := Tt';
0082 ImWOROS: s :='Tw';
0083 tmINFO: s := Ti ;
0084 else 0085 s :_ 'To' 0086 end;
0087 Log := Log+s+',';
0088 For iTrack := 1 to iAudioTracks do 0089 if bTrackEnabled[iTrack] then 0090 Log := Log+'E' 0091 else 0092 Log := Log+'d';
0093 if WaIIpaperOurslnstalled then 0094 Log := Log+',Y' 0095 else 0096 Log := Log+',n';
0097 if UsingWallpaper then 0098 Log := Log+'Y' 0099 else 0100 Log := Log+'n ;
0101 if UsingOurWalfpaper 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+'Y' 0111 else 0112 Log := Log+'n';
0113 if UsinpOurSaver then 0114 Log := Log+'Y' 0115 else 0116 Log := Log+'n';
0117 if regHasTargetPage then SUBSTITUTE SHEET (RULE 2fi) fi5 0118 Log := Log+',1'',' 0119 else 0120 Log := Log+',n,';
0121 Log := Log+sE2vents[iogXevent]+SysPad(IogXtrack,2)+
0122 ','+FormatDateTime('yyyy/mmldd-hh:nnas', Now)+
0123 ','+sEvents[fogXevent]+','+sStarts[IogXstart]+','+SysPad(IogXtrack,2)+
0124 ','+IntToStr(IogXtimeO)+',~+IntToSir(time1)+','+IntToStr(timel-IogXtimeO);
0125 IogXevent := IeNONE;
0126 try 0127 Reg := TRegistry.Create 0128 except 0129 exit 0130 end;
0131 Reg.RootKey := HKEY LOCAL_MACHINE;
0132 sKey :='1SOFTWAREIPalantir\IQcd1'+iniAIbumHandle+'lVote';
0133 try 0134 if Reg.OpenKey(sKey,true) then 0135 Reg.WriteString('x'+SysPad(logln,9), log);
0136 Inc(logln) 0137 except 0138 end;
0139 try 0140 Reg.Writelnteger('In', Logln) 0141 {Reg.Writefnteger('Out', LogOut)}
0142 except 0143 end;
0144 Reg.CIoseKey;
0145 Reg.Free;
0146 end;
~_________________________________________________________________________}
0148 { Initalize / Exit }
{___.._______________,______________________________________________________}
0150 procedure Logginglnitialize;
0151 var 0152 Reg: TRegistry;
0153 sKey, sValue: string[200];
0154 iTrack: integer;
0155 st: string[3];
0156 begin SUBSTITUTE SHEET (RULE 26) 0157 try 0158 Reg := TRegistry.Create 0159 except 0160 exit 0161 end;
0162 Reg.RootKey := HKEY LOCAL MACHINE;
0163 sKey :='1SOFTWARE\Palantir\IQcdl'+iniAIbumHandle;
0164 try 0165 if Reg.OpenKey(sKey,true) then begin 0166 sValue :_ 'FirstRun ;
0167 if not Reg.ValueExists(sValue) then begin 0168 regFirstRun := FormatDateTime('yyyylmm/dd-hh:nnas', Now);
0169 Reg.WriteString(sValue, regFirstRun) 0170 end 0171 else 0172 regFirstRun := Reg.ReadString(sValue);
0173 Reg.WriteString('Label',iniAIbumLabel);
0174 Reg.WriteString('Artist',iniAIbumArtist);
0175 Reg.WriteString('Name',iniAIbumName);
0176 Reg.WriteString('Wallpaper',iniWallpaper) 0177 end 0178 except 0179 end;
0180 Reg.RootKey := HKEY LOCAL MACHINE;
0181 sKey :_ '1SOFTWARE\PalantirllQcd\'+iniAIbumHandle+'\Info';
0182 try 0183 if Reg.OpenKey(sKey,true) then begin 0184 for iTrack := 1 to iAudioTracks do begin 0185 if iTrack<10 then st :='0'+IntToStr(iTrack) 0186 else st := IntToStr(iTrack);
0187 Reg.Writelnteger(st+'-Begin', iStatsTrackStart[iTrack]);
0188 Reg.Writelnteger(st+'-Length', iStatsTrackLength[iTrack]) 0189 end;
0190 Reg.Writelnteger('TotaIBegin', iStatsCDStart);
0191 Reg.Writelnteger('TotaILength', iStatsCDLength) 0192 end 0193 except 0194 end;
0195 Reg.RootKey := HKEY LOCAL MACHINE;
0196 sKey :='1SOFTWARE\Palantir\IQcd\'+iniAlbumHandle+'\Vote';
0197 Logln := 1;
SUBSTITUTE SHEET (RULE 26) 0198 LogOut := 1;
0199 try 0200 if Reg.OpenKey{sKey,true) then begin 0201 if Reg.ValueExists('In~ then 0202 Logln := Reg.Readlnteger('In');
0203 if Reg.ValueExists('Out') then 0204 LogOut :== Reg.Readlnteger('Out');
0205 Reg.Writelnteger('In', logln);
0206 Reg.Writelnteger('Out', IogOut);
0207 if Reg.ValueExists('Sequence') then 0208 LogSeq : = Reg.Readlnteger('Sequence') 0209 else 0210 Logseq := 0;
0211 Inc(LogSeq);
0212 Reg.Writelnteger('Sequence', IogSeq) 0213 end 0214 except 0215 Logln := 1;
0216 LogOut := 1;
0217 LogSeq := 1 0218 end;
0219 Reg.CloseKey;
0220 Reg.Free;
0221 iogXevent := IeN~ONE
0222 end;
0223 end.
SUBSTITUTE SHEET (RULE 26) WO 98!52189 PCT/US98/10035 0001 unit Logo;
{_________________________________________________________________________}
0003 interface {_________________________________________________________________________}
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, StdCtrls, 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_Up, sprifeLogo_Down: TSprite;
{_________________________________________________________________________}
0026 implementation {_________________________________________________________________________}
{_________________________________________________________________________}
0029 { Local Routines }
{_________________________________________________________________________}
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;
SUBSTITUTE SHEET (RULE 26) ~___.________________.______________________________________________________}
0037 { Main Code }
{_________________________________________________________________________}
0039 procedure LogoMouseMove(X,Y: longint);
0040 var 0041 LogoRect: Trect;
0042 begin 0043 with spriteLogo_Up do 0044 LogoRect := B~ounds(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 BitmapOvertay(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.LogoC.licked 0063 end;
{___.________________.______________________________________________________}
0065 { Initalize I Exit }
{_________________________________________________________________________}
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;
SUBSTITUTE SHEET (RULE 26) 0073 { _--__~__~____~w________~_~_}
0074 procedure LogoF~cit;
OD75 begin 0076 BitmapDestroy(spriteLogo_Down);
0077 BitmapDestroy(spriteLogo_Up) 0078 end;
0079 end.
SUBSTITUTE SHEET (RULE 26) 0001 unit Main;
0003 interface {__._______________________________________________________________________}
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, StdCtrls;
0013 {$ENDIF}
0014 {_________~__~_______________________________}
0015 type 0016 TfrmMain = class(TForm) 0017 imgExit Up: Tlmage;
0018 imgExit Down: Tlmage;
0019 imglnfo_Up: Tlmage;
0020 imginfo_Down: Tlmage;
002'1 imgWords Up: Tlmage;
0022 imgWords_Down: Tfmage;
0023 imgTracks_Up: Tlmage;
0024 imgTracks_Down: Tlmage;
0025 imgPrint Up: Tfmage;
0026 imgPrint Down: Tlmage;
0027 imgVideo_Up: 'flmage;
0028 imgVideo_Down: Tlmage;
0029 imgCommentaiy_Up: Tlmage;
0030 imgCommentaiy_Down: Tlmage;
0031 imgPlay_Up: TNmage;
0032 imgPlay_Down: Tlmage;
0033 imgStop Up: Tlmage;
0034 imgEject Down: Tlmage;
0035 imgStop_Down: Tlmage;
0036 imgEject Up: T'Image;
0037 imgRandom UpOff: Tlmage;
0038 imgRandom Upon: Tlmage;
0039 imgRandom_DownOn: Tlmage;
SUBSTITUTE SHEET (RULE 26) 0040imgRandom_DownOff:
Tlmage;
0041imgTime_Endl: Tlmage;
0042imgVolume_Endl: Tlmage;
0043imgScrolt Rod: Tlmage;
0044imgVolume_Rod: Tlmage;
0045imgTime_Rod: Tlmage;
0046imgCounter: Timage;
0047imgPause_Up: Tlmage;
0048imgResume_Up: Tlmage;
0049imgPause_Down: Tlmage;
0050imgResume_Down: Tlmage;
0051imgTracks Back: Tlmage;
0052imgVolume_Back: Tlmage;
0053imgScroll Back: Tlmage;
0054imgTime_Back: Tlmage;
0055imgScroll Endl: Tlmage;
0056imgScroll End2: Tlmage;
0057imgScroll Button:
Tlmage;
0058imgTime_End2: Tlmage;
0059imgTime_Button: Tlmage;
0060imgVolume_End2: Tlmage;
0061imgVoiume_Button:
Tlmage;
0062imgTracks LedOn: Tlmage;
0063imgTracks_LedOff:
Tlmage;
0064imgPlayer: Tlmage;
0065imgLogo_Up: Tlmage;
0066imgLogo_Down: Tlmage;
0067imgTube_Intro: Tlmage;
0068imgTube_Tent: Tlmage;
0069imgTube_CDAbout: Tlmage;
0070imgTube_IGtAbout:
Tlmage;
0071imgMenu_Bullet: Tlmage;
0072imgPalette: Tlmage;
0073imgTracks Video: Timage;
0074imgTracks Comment:
Timage;
0075imgTracks Cyes: Tlmage;
0076imgTracks_Cno: Tlmage;
0077imgTracks_Vyes: Tlmage;
0078imgTracks_Vno: Tlmage;
0079imgTracks_Block: Tlmage;
0080imgTube_Menu: Tlmage;
SUBSTITUTE SHEET (RULE 26) 0081 imgTbQyes Up: Tlmage;
0082'. imgTbQyes Down: Tlmage;
0083'. imgTbQno_Up: Tlmage;
0084. imgTbQno Down: Tlmage;
0085 end;
008E~ {__-___~____~___..~_~________________ 0087 var 0088 frmMain: TfrmMain;
{___._______________._____________ 009(1 implementation 0091 {$R *.DFM}
009i!
009;1 0091 end.
SUBSTITUTE SHEET (RULE 26~
0001 unit PIayList;
{_______________________________________~-____-______---_-____-___=_-_--__}
0003 intertace {________________________________________________________________________-}
0005 {$IFDEF WINDOWS}
0006 uses 0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 0008 Forms, Dialogs, LMDnonvS, 0009 Run, Main, CDPlayer, Tube, BitBtns, SysFig;
0010 {$ELSE}
0011 uses 0012 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 0013 ExtCtrls, StdCtrls, LMDnonvS, 0014 Run, Main, CDPlayer, Tube, BitBtns, SysFig;
0015 {$ENDIF}
0016 {_______~______________________________________}
0017 procedure PIayListlnitialize;
0018 procedure PIayListExit;
0019 procedure PIayListNewTrack(TrackNo: longint);
0020 procedure PIayListTrackEnable(TrackNo: longint);
0021 procedure PIayListTrackDissable(TrackNo: longint);
0022 procedure PIayListMouseDown;
0023 procedure PIayListMouseMove(X,Y: longint);
0024 procedure PIayListTimerTick;
0025 {---_--_______w_____~______________________}
0026 var 0027 ThePfayList: TTubeList;
{________________________________________________________________________-}
0029 implementation {--_____________________________________________________________________-_-_}
0031 var 0032 iHintltem:longint;
0033 iHintX, iHintY: longint;
0034 iHintDelayTimer:longint;
0035 sHintMsg: string[250};
0036 bHintVisible: Boolean;
0037 blnHintArea: Boolean;
SUBSTITUTE SHEET (RULE 26) {___.______________________________________________________________________}
003~J { Main Code - }
004(1 {___.______________________________________________________________________}
0041 procedure PIayListNewTrack(TrackNo: longint);
0042 begin 00421 TubeSetAlINormal(ThePIayList);
0044 TubeSetHighlight(ThePIayList, TrackNo);
004~i if eTubeModeState=tmTRACKS then 0046 TubeDisplay(fhePIayLisi) 004 i' end;
0046 {-____~_______________________________________}
004u procedure PIayListTrackEnable(TrackNo: longint);
005(1 begin 0051 TubeSetEnable(ThePIayList, TrackNo);
0052 end;
005:1 {________________________~____________________}
0054 procedure PIayListTrackDissable(TrackNo: longint);
005:1 begin 005Ei TubeSetDissable(ThePIayList, TrackNo);
005i' frmRun.TrackDissable(TrackNo) 0056 end;
{___.______________________________________________________________________}
006(1 { Mouse Handling }
{___.___________________________________________________________________ __}
0062 procedure PIayListMouseDown;
0063 var 0064 iTrack:longint;
0065 begin OC16f3 if eTubeModeState<>tmTRACKS then 006 ~~ exit;
0066 iTrack := TubeitemHit(iMOuseDownX,iMOuseDownl~;
OC166 if iTrack>0 then begin 007() iHintDelayTimer := 0;
007'1 if bHintVisible then begin 007.? frmRun.bIobHint.HideMessage;
007;3 bHintVisible := false 0074 end;
SUBSTITUTE SHEET (RULE 26) 0075 if bTrackEnabled[iTrack] then 0076 frmRun.TrackClicked(iTrack) 0077 end 0078 end;
0079 {_----___ _____~__~_________~___}
0080 procedure PIayListMouseMove(X,Y: longint);
0081 var 0082 iltem:longint;
0083 label 0084 exitl ;
0085 begin 0086 if eTubeModeState<>tmTRACKS then 0087 goto exitl ;
0088 iHintX := frmRun.Left+X+5;
0089 iHintY := frmRun.Top+Y-0;
0090 iltem := TubeItemHit(X,Y);
0091 if iltem>0 then begin 0092 if iltem<>iHintitem then begin 0093 it bHintVisible then begin 0094 frrnRun.bIobHint.HideMessage;
0095 bHintVisible := false 0096 end;
0097 iHintDeiayTimer := HINT DELAY;
0098 iHintltem := iltem 0099 end;
0100 exit 0101 end;
0102 exit1:
0103 iHintDelayTimer := 0;
0104 iHintltem := 0;
0105 if bHintVisible then begin 0106 frmRun.bIobHint.HideMessage;
0107 bHintVisible := false 0108 end 0109 end;
0110 {__-- ~___~~__~_____________}
0111 procedure PIayLisfTimerTick;
0112 begin 0113 if iHintDelayTimer=0 then 0114 exit;
0115 Dec(iHintDelayTimer);
SUBSTITUTE SHEET (RULE 26) 0116 if iHintDelayTimer=0 then begin 0117 if bHintVisibie then 0118 frmRun.bIobHint.HideMessage;
0119 iHintLastX := iHintX;
0120 iHintLastY := iHintY;
0121 sHintLastMsg := sHintMsg;
0122 frmRun.bIobH int.Position := hpAboveRight;
0123 frmRun.blobHint.ShowMessage(sHintMsg, iHintX, iHintY);
0124 bHintVisible := true 0125 end 0126 end;
{_________________________________________________________________________) 0128 { Initalize / Exit ) {_________________________________________________________________________) 0130 procedure PIayListlnitialize;
0131 var 0132 fTracks: TextFile;
0133 I: string[250];
0134 begin;
013.5 ThePIayList.TextList := TStringList.Create;
0136 AssignFile(fTracks, sRunDirectary+'Stuff\Tracks.txt');
013.7 Reset(fTracks);
0138 iAudioTracks :_ 0;
0139 while not Eof(fTracks) and (iAudioTracks<MAX_TRACKS) do begin 0140 Inc(iAudioTracks);
0141 ReadLn(fTracks, I);
0142 ThePIayList.'TextList.AddObject(I, Pointer(iAudioTracks));
0143 end;
0144 CIoseFiie(fTracks);
0145 TubeInitList(spriteTubeText, ThePIayList, 0146 iTextBIockHeight div iAudioTracks, 0);
0147 sHintMsg :='Click title to select track.';
0148 iHintltem := 0;
0149 iHintDelayTimer := 0;
01:10 bHintVisible := false;
01:11 blnHintArea := false 0152 end;
0153 {_ __________..____~____________________) 0154 procedure PIayListF~cit;
SUBSTITUTE SHEET (RULE 26) 0155 begin 0156 TubeExitList(ThePIayList) 0157 end;
0158 end.
SUBSTITUTE SHEET (RULE 26) 0001 unit ~YesNo;
{__._______________________________________________________________________) 0003 intertace {__.______________________________________________________________________--_}
0005 {$IFDEF WINDOWS}
0008 uses 000'l SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 0003 Forms, Dialogs, 0009 Run, Main, Bitmaps, Tube, SysFig;
00117 {$ELSE}
0011 uses 0012 Windows, Messages, SysUiils, Classes, Graphics, Controls, Forms, Dialogs, 001:3 ExtCtrls, StdCtrls, 0014 Run, Main, Bitmaps, Tube, SysFig;
0015 {$ENDIF}
00113 (_________.___~________~______________________}
001'7 type 001 f3 TProc = Procedure;
001 !3 (-_~_~__~______._________~___________}
0020 var 002'1 Thet3video: TTubeList;
0022 Thef3vote: TTubelist;
002;3 {------_---------___~~___________________}
0024 procedure Qynlnitialize;
0025 procedure QynF~cit;
0026 procedure QynAsk(var TubeQ: TTubeList; xYes, xNo: TProc);
0027 procedure QynMouseMove(X,Y: longint);
0028 procedure QynMouseDown;
{___._____________________________________________________________________-}
0030 implementation 003'1 (___._____________________________________________________________________-}
0032 var 003;3 bYesDown, 003~t bNoDown: Boolean;
003;1 spriteQyes Up, 003fi spriteQyes Down, 0037 spriteQno_Up, SUBSTITUTE SHEET (RULE 26) WO 98/52189 PCT/(1S98/10035 0038 spriteQno_Down: TSprite;
0039 qaYes, qaNO: TProc;
0040 _ {_______________________________________________________________________-__}
0041 { Local Routines }
{_________________________________________________________________________}
0043 function QHit(var Sprite: TSpr9te; 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;
{_________________________________________________________________________}
0049 { Main code }
{_________________________________________________________________________}
0051 procedure QynAsk(var TubeQ: TTubeList; xYes, xNo: TProc);
0052 begin 0053 TubeDisplay(TubeQ);
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;
{_________________________________________________________________________}
0063 { Mouse support }
{_________________________________________________________________________}
0065 procedure QynMouseMove(X,Y: longint);
0066 begin 0067 if eTubeModeState<>tmQYN 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 SUBSTITUTE SHEET (RULE 26) 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 eTubeModeState<>tmQYN then 0098 exit;
0099 if BitmapHit(spriteQyes Up) then 0100 qaYes;
0101 if BitmapHit(spriteQno_Up) then 0102 qaNo;
0103 end;
{___________________.____________________________________________________-_-_}
0105 { Initalize / Exit }
{_______________________________________________________________________-__}
0107 procedure Glynlnitialize;
0108 var 0109 fQ: TextFile;
0110 I: string[250];
0111 begin SUBSTITUTE SHEET (RULE 26) 0112 BitmapCreate(spriteQyes Up, frmMain.imgTbQyes_Up, false);
0113 BitmapCreate(spriteQyes Down, frmMain.imgTb~yes 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+'Stuff\Qmovie.txt');
0118 Reset(fQ);
0119 while not Eof(fQ) do begin 0120 ReadLn(fQ, I);
0121 TheOvideo.TextList.AddObject(I, Pointer(0));
0122 end;
0123 CIoseFile(fQ);
0124 TubeInitList(spriteTubeText, TheQvideo, -3, 0);
0125 TheQvote.TextList := TStringt_ist.Create;
0126 AssignFile(fQ, sRunDirectory+'Stuff\Qvote.txt');
0127 Reset(fQ);
0128 while not Eof(fQ) do begin 0129 ReadLn(fQ, I);
0130 TheQvote.TextList.AddObject(I, Pointer(0));
0131 end;
0132 CIoseFile(fQ);
0133 TubeInitList(spriteTubeText, TheQvote, -3, 0);
0134 bYesDown := false;
0135 bNoDown := false 0136 end;
0137 {__~_____~_~____~_______________________}
0138 procedure QynExit;
0139 begin 0140 BitmapDestroy(spriteQyes Up);
0141 BitmapDestroy(spriteQyes Down);
0142 BitmapDestroy(spriteQno_Up);
0143 BitmapDestroy(spriteQno_Down);
0144 TubeExitList(TheQvote);
0145 TubeExitList(TheGlvideo) 0146 end;
0147 end.
SUBSTITUTE SHEET (RULE 26) 0001 unit RegFig;
0003 interface {_-_____________________________________________________________________-_-_}
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 regVoteEnabied, 0021 reglnfoEnabled, 0022 regVideoAsked, 0023 regVoteAsked, 0024 reglntroPlayed, 0025 reglnfoSent: Boolean;
0026 regHandle: string[20];
002:7 regZip, 0028 regAge, 0029 regSex: string[20];
{_______________________________________________________________________-_-_}
003.1 implementation {~______________________________________________________________________-_-_}
0033 function RegFigLoad: Boolean;
0034 var 003.5 Reg: TRegistry;
0036 sKey, sValue: string[200];
0037 n: integer;
SUBSTITUTE SHEET (RULE 26) 0038 begin 0039 result := false;
0040 try 0041 Reg := TRegistry.Create 0042 except 0043 exit 0044 end;
0045 regHandle :_ ";
0046 Reg.RooiKey := HKEY LOCAL MACHINE;
0047 sKey :_ '\SOFTUVAREIPalantir';
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 := regHandie + Chr(Random(26)+Ord('A'));
0056 Reg.WriteString(sValue, regHandle) 0057 end 0058 end 0058 except 0060 end;
0061 regZip :='00000';
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.ValueF~cists(sValue) then 0070 regZip := Reg.ReadString(sValue);
0071 sValue :='Age';
0072 if Reg.ValueExists(sValue) then 0073 regAge := Reg.ReadString(sVaiue);
0074 sValue :_ 'Sex';
0075 if Reg.ValueExists(sValue) then 0076 regSex := Reg.ReadString(sValue) 0077 end 0078 except SUBSTITUTE SHEET (RULE 26) 0079 end;
0081 Reg.RootKey := HKEY LOCAL MACHINE; -0082 sKey :_ '\SOFTV11ARE\PaiantirllQcd\'+iniAlbumHandle+'\Flags';
0083 try 0084 if Reg.OpenKey(sKey,true) then begin 0085 sValue :='IntroPlayed';
0086 if Reg.ValueF~cists(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 :_ '1/oteAsked';
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'. reginfoSent := Reg.ReadBool(sVaiue) 0103 else Oi04 reglnfoSent := false;
0105. sValue :_ 'VoteEnabled';
0106. if Reg.ValueExists(sValue) then 0107 regVoteEnabled := Reg.ReadBool(sValue) 0108 else 0109 regVoteEnabled := false;
01101 sValue :='InfoEnabled';
0111 if Reg.ValueExists(sValue) then 0112' reginfoEnabled := Reg.ReadBool(sValue) 0113 else 0114 reglnfoEnabled := false;
0115 sValue :_ ''fargetPage';
011E~ if Reg.ValueExists(sValue) then 0117 regHasTargetPage := Reg.ReadBool(sValue) 0118 else 0119 regHasTargetPage := false;
SUBSTITUTE SH~~T (RUL~ 25) 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[200j;
0131 begin 0132 try 0133 Reg := TRegistry.Create 0134 except 0135 exit 0136 end;
0137 Reg.RootKey := HKEY_LOCAL MACHINE;
0138 sKey :='1SOFTWAREIPalantir\IQcdl'+iniAIbumHandle+'\Flags';
0139 try 0140 if Reg.OpenKey(sKey,true) then begin 0141 Reg.WrileBool('VoteEnabied', regVoleEnabled);
0142 Reg.WriteBool('InfoEnabied', reglnfoEnabled);
0143 Reg.WriteBool('IntroPlayed', reglntroPlayed);
0144 Reg.WrtteBool('VideoAsked', regVideoAsked);
0145 Reg.WriteBool('VoteAsked', regVoteAsked);
0146 if iniSendlnfo=qfALWAYS then 0147 Reg.WriteBool('InfoSent', reglnfoSent) 0148 end 0149 except 0150 end;
0151 Reg.Free 0152 end;
0153 end.
SUBSTiTUT~ SHEET (RULE 26) 0001 unit Regions;
{__________________._______________________________________________________}
0003 interface {__________________._______________________________________________________}
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 ExtCfrls, StdCtris, 0014 Run, Main;
0015 {$ENDIF}
0016 {_____________________________________________}
0017 procedure OutIineJmage(ImageCanvas: TCanvas;
0018 iCanvasHeight, iCanvasWidth: longint;
0019 var PolygonRegion: hRGN);
{_________________________________________________________________________}
0021 implementation {_________________________________________________________________________}
0023 type 0024 POINT = recorcl 00'x!5 x:longint;
0026 y:longint;
0027 end;
0028 {__M____~~_________________________}
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 {__w_____~~_~._______~____________.__}
0033 var 00 34 tOutiine: array [0..1000] of POINT;
00;35 WorkingCanvas: TCanvas;
0036 iCanvasMaxX, iCanvasMaxY: longint;
00;17 iFirstPixeIX, iFirstPixelY: longint;
SUBST1TUT~ SHEET (RULE 26) 0038 iLastPixeIX, iLastPixelY: longint;
0039 iLastDirection:longint;
0040 iPixeIX, iPixelY: longint; _ 0041 iDirection:longint;
0042 {__~__~_____~_________~______________}
0043 procedure FindFirstPixel; forward;
0044 procedure FindNextPixel; forward;
0045 procedure FindPixel(iAtX, iAtY: longint); forward;
{_______________________________________________________________________==J
0047 { Code }
{_________________________________________________________________________}
0049 procedure Outlineimage(ImageCanvas: TCanvas;
0050 iCanvasHeight, iCanvasWidth: longing 0051 var PolygonRegion: hRGN);
0052 var 0053 iPoints:longint;
0054 begin 0055 WorkingCanvas :_ lmageCanvas;
0056 iCanvasMaxX := iCanvasWidth-1;
0057 iCanvasMaxY := iCanvasHeight-1;
0058 FindFirstPixei;
0059 tOutline[0].X := iFirstPixelX;
0060 tOutline[O].Y := iFirstPixelY;
0061 iPoints := 1;
0062 FindPixel( iFirstPixelX, iFirstPixelY);
0063 repeat 0064 FindNextPixel;
0065 if iDirection<>iLastDirection then begin 0066 tOutline[iPoints].X := iLastPixefX;
0067 tOutline[iPoints].Y := iLastPixelY;
0068 iPoints := iPoints+1;
0069 end 0070 until (iPixeIX=iFirstPixeIX) and (iPixelY=iFirstPixelY);
0071 PolygonRegion := CreatePolygonRgn( tOutline, iPoints, WINDING);
0072 end;
0073 {--_-___________~~__~_______________~_____) 0074 procedure FindFirstPixel;
0075 var 0076 x:longint;
SUHSTiTUTE SHEET (RULE 26~
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 iFirstPixeIX := iPixelX;
0086 iFirstPixelY := iPixelY;
0087 end;
0088 {___--_____~__~____..__~___________________}
0089 procedure FindNextPixel;
0090 begin 0091 FindPixel( iPixeIX, 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 := iPixeIX+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 := iPixeIX+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( iPixeiX, iPixelY);
0109 exit;
0110 Got Pixel:
0111 iPixeiX := x1;
0112 iPixelY := y1;}
0113 end;
0114 { ____~_~____~__________________}
0115 procedure FindPixel(iAtX, iAtY: longint);
0116 var 0117 d:lnteger;
SUBSTITUTE SHEFi' (RUL~ 26) 0118 bPixell , bPixel2: Boolean;
0119 CanvasDC: HDC;
0120 begin -0121 iLastPixeIX := iPixeIX;
0122 iLastPixeiY := iPixelY;
0123 iLastDirection := iDirection;
0124 bPixel1 := false; (kiN compiler warning}
0125 CanvasDC := WorkingCanvas.handle;
0126 for d := 1 to 9 do begin 0127 iPixeIX := iAtX+iScanX[d);
0128 iPixelY := iAtY+iScanY[d);
0129 if (iPixeIX>=0) and (iPixeIX<=iCanvasMaxX) and 0130 (iPixelY>=0) and (iPixelY<=iCanvasMaxY) then 0131 bPixel2 :_ (GeiPixel(CanvasDC,iPixeIX,iPixelY)<>TRANSPARENT_COLOR) 0132 else 0133 bPixel2 := False;
0134 if d>1 then 0135 if bPixel2 and (Not bPixell) then 0136 break;
0137 bPixel1 := bPixel2 0138 end;
0139 iDirection := d;
0140 if iDirection>9 then 0141 frmRun.SevereError('FindPixel - not found!') 0142 end;
0143 end.
SUBSTITUTE SHEET (RULE 26~
0001 unit Run;
OOOi! {$DEFINE KILLERASE}
{_________________________________________________________________________}
0004 intertace {___.______________________________________________________________________}
0006 {$IFDEF WINDOWS}
000 i' uses 0006 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 0009 Forms, Dialogs, StdCtrls, ExtCtrls, MPlayer, ComCtrls, SheIIAPI, 0010 xPrgExec, xFCopy, LMDnonvS, LMDclass, LMDctrl, LMDmmS, LMDwave;
00111 {$ELSE}
001'. uses 001:1 SysUtils, Windows, Messages, Classes, Graphics, Controls, 001~I Forms, Dialogs, StdCtrfs, ExtCtrls, MPlayer, ComCtris, SheIIAPI, 001 fi xPrgExec, xFCopy, LMDnonvS, LMDcIass, LMDctrl, LMDmmS, LMDwave;
0016 {$ENDIF}
0017 {_--______~_~__..__________________~___}
001 t3 const 0019 UM REALSTAR.T = WM_USER+1;
002() TEXT NORMAL. = clBlack;
002'1 TEXT HIGHLIGHT = clWhite;
0022 TEXT DISSABL.ED = $006F6470;
002;3 {___________~___._________________..____~}
0024 type 002a TfrmRun = class(TForm) 0026 tmTimer: TTimer;
0027 mmCDPlayer: TMediaPlayer;
00213 PrintDialog: TPrintDialog;
00213 mmCommentana: TMediaPlayer;
0030 Run: TxProgExec;
0031 FileCopier: TxFileCopy;
0032 ProgressBar: TProgressBar;
0033 blobMessage: TLMDMessageHint;
0034 waveSony: TLMDWaveComp;
0036 Onelnstance: TL_MDOnelnstance;
0036 blobHint: TLMDMessageHlni;
003'7 waveByeBye: TLMDWaveComp;
0036 wavelnstallingWallpaper: TLMDWaveComp;
0039 wavelnstallingSaver: TLMDWaveComp;
SUBSTITUTE SH~ET (RULE 26) 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 PIayNextTrack(TrackFrom: Integer);
0057 procedure GoCopyFile(FileFrom, FileTo: string);
0058 {_______________________________________________.~
0059 procedure PIayPressed;
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(lNordTime: longint);
0075 procedure SetTrack(TrackNo: fongint);
0076 procedure TrackDissable(TrackNo: longint);
0077 procedure TimeMoveStart;
0078 procedure TimeMoveEnd;
0079 procedure MouseEnable;
0080 procedure MouseDissable;
SUBSTITUTE SHEET (RULE 26) 0081 function NoVideo: boolean;
0082 procedure ErrorMessage(const msg: string);
0083 procedure SevereError(const msg: string);
0084 private 0085 procedure idleProcess(Sender: TObject; var Done: Boolean);
0086 procedure DefauItException(Sender: TObject; E: Exception);
0087 procedure ReaIStart(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 DELAY INTROVIDEO = 5;
0101 SCROLL DELA'f = 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: booiean;
0112'. iMouseDownX, iMouseDownY: longint;
0113 bqAskVideo, 0114 bqAskVote: Boolean;
0115 bqPlaylntro: Boolean;
0116 iDelayintroVideo:longint;
011 i' iMenuNormaiizeTimer, 0118 iErrorMessageTimer: iongint;
0119 iLastTrackNo:longint;
012CI ePIayButtonState: (bsPLAY, bsPAUSE, bsRESUME);
0121 eStopButtonState: (bsEJECT, bsSTOP);
SUBSTITUTE SHEET (RULE 26) 0122 eRandomButtonState: (bsRANDOM ON, bsRANDOM_OFF);
0123 eTubeModeState: (tmINTRO, tmMENU, tmABOUT, tmIQABOUT, tmTRACKS, tmWORDS, tmINFO, tmQYN);
0124 bStopPaint: Boolean;
0125 iHintLastX, iHintLastY: longint;
0126 sHintLastMsg: string[250];
0127 bHintsEnabled: Boolean;
0128 sCurrentWall: string[100];
0129 sCurrentTile: string(100];
0130 sCurrentSaver: string[100];
0131 { ------_ _~___~______~_~__}
0132 procedure qaVideoYes; forward;
0133 procedure qaVideoNo; forward;
0134 procedure qaVoteYes; forwarct;
0135 procedure qaVoteNo; forward;
0136 procedure qaNextl ; forward;
0137 procedure qaNext2; forward;
0138 procedure qaNext3; forward;
{______________________________________________________________________ __}
0140 implementation 0141 {$R '.DFM}
{________________________________________________________________________~}
0143 uses 0144 Main, PIayList, Tracks, Words, Info, 0145 QYesNo, TrkMedia, ScroIBar, TimeBar, VolumBar, 0146 Regions, Bitmaps, BitBtns, BitBars, Sysfig, 0147 Tube, Video, Comment, Counter, Logo, Inifig, 0148 IoMenu, IQAbout, CDPlayer, 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;
{_________________________________________________________________________}
0158 { Utility Routines }
SUBST]TUTE SHEET (RULE 26) {___________________.____________________________________________________-__}
olso {__~-____~___________________~___________) 0161 function TfrmRun.NextTrack(TrackFrom: longint): longint;
0162 var 0163 iTrack, iTracksEnabled: longint;
0164 iTrack1, 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 iTrack1 := TrackFrom to iAudioTracks do 0172 if bTrackEnabled[iTrack1 ] then begin 0173 iTrack2 := iTrackl ;
0174 break 0175 end;
0176 if iTrack2=0 then 0177 for iTrack1 :_ 1 to TrackFrom-1 do 0178 if bTrackEnabied[iTrackl] then begin 0179 iTrack2 :== iTrackl ;
0180 break 0181 end;
0182 if iTrack2=0 then begin 0183 SevereError('PIayNextTrack: all tracks dissabled!');
0184 Result := 1;
0185 exit 0186 end;
0187 if (eRandomButtanState=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.PIayNextTrack(TrackFrom: Integer);
0195 begin 0196 SetTrack(NextTrack(TrackFrom));
0197 PlayerPlay(IsNEXT, iLasiTrackNo) 0198 end;
SUBSTITUTE SHEET (RULE 26~
0199 {-______~______~_______w__________________}
0200 procedure TfrmRun.GoCopyFile(FileFrom, Filei'o: string);
0201 begin 0202 MouseDissable;
0203 with FileCopier do begin 0204 ProgressBar.Show;
0205 SourceFile := FileFrom;
0206 TargetFile := FileTo;
0207 Execute 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;
{_______________________________________________________________________-__}
0225 { Process button press }
{_________________________________________________________________________}
0227 procedure TfrmRun.PIayPressed;
0228 begin 0229 VideoStop;
0230 CommentaryStop;
0231 PlayerPlay(IsPLAY, TimeBarGetPosition) 0232 end;
0233 {-_----_________________~___________________}
0234 procedure TfrmRun.PausePressed;
0235 begin 0236 VideoStop;
0237 CommentaryStop;
SUBSTITUTE SHEET (RULE 26) WO 98,152189 PCT/US98/10035 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;
0256 {_---___________~____..___________~__________}
0257 procedure TfrmRun.EjectPressed;
0258 begin 0259 PlayerStop;
0260 VideoStop;
0261 CommentaryStop;
0262 PlayerEject;
0263 ExitPressed 0264 end;
0265 {-----------_-_-------_.._~________~_______}
0266 procedure TfrmRun.PrintPressed;
0267 begin 0268 TubePrint 0269 end;
0270 { _ ~_..__~~~~_____~_}
0271 procedure TfrmRun.'dideoPressed;
0272 begin 0273 if NoVideo then 0274 exit;
0275 if not bVideoAvailable[iLaslTrackNo] then begin 0276 En-orMessage(''This track does not have a video clip, sorry.');
0277 exit 0278 end;
SUBSTTTUTE SHEET (RULE 26) 0279 if eCDPIayerState=psPLAYtNG then begin 0280 ButtonsForcePause;
0281 PlayerPause 0282 end;
0283 VideoStop;
0284 CommentaryStop;
0285 VideoPlay(iLastTrackNo, nil) 0286 end;
0287 {_-----_______~w_________________________}
0288 procedure TfrmRun.CommentaryPressed;
0289 begin 0290 if not bCommentaryAvailabie[iLastTrackNoj 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 PtayerPause 0297 end;
0298 VideoStop;
0299 CommentaryStop;
0300 CommentaryPlay(iLastTrackNo) 0301 end;
0302 {_________________________________________________}
0303 procedure TfrmRun.ExitPressed;
0304 begin 0305 VideoStop;
0306 CommentaryStop;
0307 TubeDisplay(Thetntro);
0308 eTubeModeState := tmintro;
0309 PiayerStop;
0310 if iniPIayByeBye then 0311 frmRun.waveByeBye.PIaySound(sdSync);
0312 Close 0313 end;
~_________________________________________________________________________}
0315 { Process mode changes }
{_______________________________________________________________________-_-_}
0317 procedure TfrmRun.ModeSetlnfo;
SUBST1TUT~ SHEET (RULE 26) 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(ThePlayt_ist);
0339 MediaDraw(iLastTrackNo) 0340 end;
{-_________________._______________________________________________________}
0342 { Process Logo / Menu mouse click }
{_______________________________________________________________________-_.}
0344 procedure TfrmRun.LogoClicked;
0345 begin 0346 VideoStop;
0347 CommentaryStop;
0348 ButtonsForceNone;
0349 if eTubeModeState=tmMenu then begin 0350 TubeDisplay(Thelntro);
0351 eTubeModeState := tmlntro 0352 end 0353. else begin 0354 iMenuNom3alizeTimer := 0;
0355 TubeSetAlINormal(TheMenu);
0356 TubeDisplay(~'heMenu);
SUBSTITUTE SHEET (RULE 26~
0357 eTubeModeState := tmMenu 0358 end 0359 end;
0360 {_______~________________________________________) 0361 procedure TfrmRun.MenuClicked(Menuitem: 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 := tmIQABOUT;
0374 TubeDisplay(TheIQAbout) 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(startWaIIpaperName) then begin 0389 sCurrentWall := startWaIIpaperName;
0390 sCurrentTile := startWaIIpaperTile 0391 end 0392 else begin 0393 wavelnstallingWaIIpaper.Play;
0394 GoCopyFile(sRunDirectory+'Stuff\Wall.bmp', 0395 sWindowsDirectory+iniWallpaper+'.bmp');
0396 sCurrentWall := sWindowsDirectory+iniWallpaper+'.bmp';
0397 sCurrentTile :_ '0' SUBSTITUTE SHEET (RULE 26~
0398 end;
0399 SetWallpaper(sCurrentWall, sCurrentTile);
0401) MenuUpclate 0401 end;
0402 5: begin 040:3 if UsingOurSaver and not UsingThisSaver(startScreenSaver) then 0404 sCurrentSaver := startScreenSaver 040!i else begin 04011 wavelnstallingSaver.Play;
040't GoCopyFile(sRunDirectory+'StufflSaver.exe', 0408 sSystemDirectory+iniScreenSaver+'.scr');
0409 sCurrentSaver := sSystemDirectory+iniScreenSaver+'.scr' 0410 end;
041'1 SetSaver~(sCurrentSaver);
0412 MenuUpdate 041:3 end;
0414 6: begin 0415 VideoStop;
04111 CommentaryStop;
0417 ButtonsForceStop;
0418 StopPressed;
041!3 Run.CmdLine := sRunDirectory+'Stuff\WebLink.exe';
0420 if Run.Execute then 042'1 {$IFOEF WINDOWS}
0422 WindowState := TWindowState(wsMinimized) 042:3 {$ELSE}
0424 Applic~ation.Minimize 042:1 {$END!F}
0426 else 042'7 ErrorMlessage('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 043.5 SetWallpaper(sCurrentWall, sCurrentTile);
0436 MenuUpdate 043'1 end;
0438 8: begin SUBSTtTLJTE~SHEET (RULE 26) 0439 VideoStop;
0440 CommentaryStop;
0441 ButtonsForceStop;
0442 StopPressed;
0443 Run.CmdLine := sRunDireciory+'StufflActMovie.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: SheIlExecute(frmRun.Handle, 0458 'Open', 'http://www.baconbros.com/', 0459 nil, nil, SW SHOWNORMAL) 0460 else 0461 SevereError('MenuClicked - invalid item!') 0462 end 0463 end;
{_________________________________________________________________________}
0465 { Process Tracks/Words mouse click }
{_________________________________________________________________________}
0467 procedure TfrmRun.TrackClicked(Track: longint);
0468 begin 0489 if eCDPIayerState=psPAUSED then begin 0470 ButtonsForceStop;
0471 StopPressed 0472 end;
0473 {if eCDPlayerState=psPLAYING then}
0474 SetTrack(Track);
0475 if eCDPIayerState=psPLAYING then begin 0476 ButtonsForcePlay;
0477 PlayerPlay(IsTRACK, 0) SUBSTITUTE 5 H E ET (RU LE 26) 0478 end 0479 end;
0480 {_____w_~__________________________________}
0481 procedure TfrmRun.WordsClicked(WordTime: longint);
0482 begin 0483 if eCDPIayerState=psPLAYING then 0484 ScroIIBarStartDelay;
0485 TimeBarPosition(WordTime);
0485 if eCDPiayerState=psPLAYING then begin 0487 ButtonsForcePlay;
0488 PlayerPlay(IsWORDS, WordTime) 0489 end 0490 end;
0491 {_-________________..____________________________}
0492 procedure TfrmRun.SetTrack(TrackNo: longint);
0493 begin 0494 if TrackNo<>iLastTrackNo then begin 0495 TimeBarNev~iTrack(TrackNo);
0496 PIayListNewTrack(TrackNo);
0497 TracksNewTrackiTrackNo);
0498 WordsNewTrack(TrackNo);
0499 InfoNewTrack(TrackNo);
0500 MediaNewTracktTrackNo);
0501 iLastTrackNo := TrackNo 0502 end 0503 end;
0504 {________~~~_..___~________________~___}
0505 procedure TfrmRun.TrackDissabletTrackNo: longint);
0508 begin 0507 if iLastTrackNo=TrackNo then 0508 if eCDPlayerState=psPLAYING then 0509 PIayNextTrack(TrackNo+1 ) 0510 else 0511 SetTrack(NextTracktTrackNo+1)) 0512 end;
t==.________________._______________________________________________________}
0514 { Process mouse moved bars }
{__._______________________________________________________________________}
0516 procedure TfrmRun.TimeMoveStart;
SUBSTITUTE SHEET (RULE 26) ~i'~ ~8f s~183 ~~'1'fUS~~fl~t~35 0517 begin 0518 if eCDPIayerState=psPLAYING then begin 0519 ButtonsForcePause;
0520 PiayerPause 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(IsTIMEBAR, TimeBarGetPosition) 0533 end 0534 end;
{_________________________________________________________________________}
0536 { Backround processing }
{_________________________________________________________________________}
0538 procedure TfrmRun.IdleProcess(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 Ciose;
0550 goto exit1 0551 end;
0552 if eCDPIayerState=psPlAYING then begin 0553 PlayerGetTrackAndTime(iTrack,iTime);
0554 if (mmCDPIayer.Mode=mpStopped) and (iTrack=iAudioTracks) then begin 0555 PIayNextTrack(1 );
SUBSTITUTE SHEET (RULE 26) 0556 goto exit1 0557 end;
0558 if (iTrack<>iL.astTrackNo) and (iHoIdOffUpdate=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 PIayNextTrack(iTrack);
0565 iTrack := 0 0566 end 0567 else begin 0568 PIayNextTrack(iTrack+1 );
0569 iTrack := 0 0570 end 0571 end;
0572 If iTrack=il_astTrackNo 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 {_-----____~ _____________w__________}
0585 procedure TfrmRun.tmTimerTick(Sender: TObject);
0586 begin 0587 if iErrorMessageTimer>0 then begin 0588 Dec(iErrorMessageTimer);
0589 if iErrorMessageTimer=0 then 0590 frmRun.bIobMessage.HideMessage 0591 end;
0592 PlayerTimerTick;
0593 MenuTimerTick;
0594 TracksTimerTick;
0595 PIayListTimerTick;
0596 WordsTimerTic,k;
SUBSTITUTE SHEET (RULE 26) 0597 ScroIIBarTimerTick;
0598 TimeBarTimerTick;
0599 VolumeBarTimerTick; _ 0600 if not bStopPaint then begin 0601 ScroIIBarTimerTick;
0602 if iMenuNormalizeTimenO then begin 0603 Dec(iMenuNormalizeTimer);
0604 if iMenuNormalizeTimerO then 0605 TubeSetAiINormal(TheMenu) 0606 end 0607 end;
0608 if iDelaylntroVideo>0 then begin 0609 Dec(iDelaylnlroVideo};
0610 if iDelaylntroVideo=0 then 0611 VideoPlay(INTROVIDEO, IntroDone) 0612 end;
0613 end;
{_________________________________________________________________________}
0815 { Process mouse click/move }
{_________________________________________________________________________}
0617 procedure TfrmRun.MouseEnabfe;
0618 begin 0619 Cursor := crArrow;
0620 bMouseEnabled := true;
0621 end;
0622 {--____________~w__________________~w) 0623 procedure TfrmRun.MouseDissable;
0624 begin 0625 bMouseEnabled := false;
0626 Cursor := crHourGlass;
0627 end;
0628 {-----_________~___________________________}
0629 procedure TfmzRun.RunMouseDown(Sender: TObject;
0630 Button: TMouseButton; Shift: TShiftState;
0831 X, Y: Integer);
0632 begin 0633 if iErrorMessageTimer<>0 then 0634 frmRun.bIobMessage.HideMessage;
0635 if not bMouseEnabled then SUBSTITUTE SHEET (RULE 26) 0636 exit;
0637 if Button=mbLeft then begin 0638 iMouseDownX := X;
0639 iMouseDownY := Y;
0640 bMouseDown := true;
0641 ButtonsMouseDown ExiiCheck;
0642 QynMouseDown;
0643 if eTubeModeState<>tmQYN then begin 0644 ButtonsMouseDown;
0645 ScroIIBarMouseDown;
0646 TimeBarMouseDown;
0647 VolumeBarllAouseDown;
0648 MenuMouseDown;
0649 PIayListMouseDown;
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 ScroIIBarMouseUp;
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 067E~ X :_ -1;
0676 Y :_ -1 SUBSTITUTE SHEET (RULE 26) 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 ScroIIBarMouseMove(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 ScroIIBarMouseDrag(X,Y);
0695 TimeBarMouseDrag(X,Y);
0696 VolumeBarMouseDrag(X,Y) 0697 end;
0698 end;
{______________________________________________________________________ __}
0700 { Initalize / Exit }
{_________________________________________________________________________}
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 biniOk := tniFigLoad;
0714 if blniOk then begin 0715 Application.Icon.LoadFromFile(sRunDirectory+'Stuff\Icon.ico');
SUBSTITUTE SHEET (RULE 26) 0716 Application.Title := iniAppName;
0717 frmRun.Caption := iniAppTitle 07113 end; -071!a SysFigCheckVideo;
0720 Videolnitialize0;
0721 frmMain := TfrmMain.Create(nil);
072:? bmpPalette := TBitmap.Create;
072:3 bmpPalette.Assign(frmMain.imgPaiette.Picture.Bitmap);
0724 bmpPlayer := TBi#map.Create;
0725 bmpPlayer.Assign(frmMain.imgPlayer.Picture.Bitmap);
072E3 frmRun.CIientWidth := fmnMain.imgPlayer.Width;
072'7 frmRun.CIientHeight := frmMain.imgPlayer.Height;
07213 with bmpPlayer.Canvas do begin 072!a Brush.Cotor := WINDOWCOLOR_16BIT;
0730 Brush.Style :== bsSOLID;
0731 BrushCopy(CIipRect, frmMain.imgPlayer.Picture.Bitmap, 073;2 CIipRect, TRANSPARENT COLOR) 0733 end;
0734 {$IFNDEF WINDOWS}
073.5 with frmMain.imgPlayer do 0736 Outlinelmage( Canvas, Height, Width, WindowRegion);
073'7 SetWindowRgnl; Handle, WindowRegion, false);
0738 {$ENDIF}
0739 Buttonslnitialize;
0740 ScroIIBarlnitialize;
0741 TimeBarinitialize;
074;2 Tubelnitialize;
0743 PIayListlnitialize;
0744 Trackslnitiaiize;
0745 Wordslnilialize;
0746 Menuinitialize;
0747 Aboutlnitialize;
0748 Infolnitialize;
0749 Counterlnitialize;
0750 Logoinitialize;
0751 Commentaryinitialize;
0752 Videolnitialize;
0753 Medialnitialize;
0754 Qynlnitialize;
0755 VolumeBarlnitialize;
0756 frmMain.Free;
SUBSTITUTE SH~~T (RULE 26) 0757 Thelntro.TextList := TStringList.Create;
0758 TubeInitList(spriteTubelntro, Thelntro, 0, 0);
0759 iLastTrackNo := 0; -0760 SetTrack(1);
0761 ModeSetTracks;
0762 TubeDisplay(Thelntro);
0763 eTubeModeState := tmINTRO;
0764 ProgressBar.Hide;
0765 ProgressBar.Position := 0;
0766 ProgressBar.Top := iTextBIockTop+iTextBIockHeight+2;
0767 ProgressBar.Left := iTextBIockLeft+((iTextBIockWidth-ProgressBar.Width) div 2);
0768 bStopPaint := false;
0769 Playerlnitialize;
0770 if bIniOK 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=qfALWAYS);
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: reginfoEnabled := false 0796 end 0797 end;
SUBSTITUTE SHEET (RULE 26) WO 9:8/52189 PCT/US98/10035 0798 if bStopPaint then 0799 exit;
0800 iHintLastX := 100; -0801 iHintLastY := 10CI;
0802'. sHintLastMsg :_ 'No Hini!';
0803 bHintsEnabled := tme;
0804 bGwideo := false;
0805 bQvote := false:
0806. tmTimer.Enabled := true;
0807 Application.OnException := DefauItException;
080E~ Application.Onldle := IdIeProcess;
0809 if not blniOk then 0810 SevereError('Unable to Start!');
0811 PostMessage(Handle, UM REALSTART, 0, 0) 0812 end;
081 °~ {_-_________________..______________________}
08141 procedure TfrmRun.FormClose(Sender: TObject; var Action: TCIoseAction);
081 ~i begin 081Ei tmTimer.Enabled := false;
081 i' bStopPaint := tn~e;
081 ft RegFigUpdate;
0819 TubeExitList(Thelntro);
082(1 VolumeBarExif;
0821 QynExit;
0822. MediaExit;
082;1 VideoExit;
0824 LogoExit;
082:1 CounterExit;
082Ei InfoExit;
0827 AboutFacit;
0828 MenuExit;
0829 WordsExit;
0830 TracksExit;
083'1 PIayListExit;
083:? TubeExit;
083;3 TimeBarExit;
0831 ScroIIBarF~cit;
083!1 ButtonsExit;
08311 bmpPlayer.Free 083'7 end;
0838 {____________ _~__~__________________}
SUBSTITUTE SHEET (RULE 26) 0839 procedure TfrmRun.ReaIStart(var Msg: TMessage);
0840 begin 0841 if bqAskVideo and (not bVideoEnable) then 0842 QynAsk(TheQvideo, qaVideoYes, qaVideoNO) 0843 else 0844 qaNext1;
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 qaNext1 0858 end 0859 end;
0860 {_____________w_____________________________}
0861 procedure qaVideoNO;
0862 begin 0863 regVideoAsked := true;
0864 qaNext1 0865 end;
0866 {--_-______ _________________w______}
0867 procedure qaVideoYes;
0868 begin 0869 regVideoAsked := true;
0870 bQvideo := true;
0871 frmRun.Run.CmdLine := sRunDirectory+'Stuff~ActMovie.exe';
0872 if frmRun.Run.Execute then 0873 {$IFDEF WINDOWS}
0874 WindowState := TWindowState(wsMinimized) 0875 {$ELSE}
0878 AppIIcation.Mlnlmlze 0877 {$ENDIF}
0878 else begin 0879 frmRun.ErrorMessage('Unable to Install Active Movie!');
SUBSTITUTE SHEET (RULE 26) 088() bQvideo := false;
088,1 qaNext1 088:? end 0883 end;
088~E {_--___________________~____________________}
088!i procedure qaNextl;
088Ei begin 0887 TubeDisplay(Thelntro);
08813 eTubeModeState := tmINTRO;
088!3 if bVideoEnable and bqPlaylntro then begin 0890 bqPlaylntro := false;
0891 if bqAskVote then 0892 eTubeModeState := tmQYN;
089:3 iDelaylntroVideo := DELAY INTROVIDEO
0894 end 089!i else 08913 qaNext2 089'7 end;
0898 {________________~_.._________________________}
0899 procedure qaNext2;
0900 begin 090'1 if bqAskVote then 0902 QynAsk(TheQvote, qaVoteYes, qaVoteNo) 0903 else 0904 qaNext3 090.5 end;
0906 {-_--__w_____~..____________________~___}
090'7 procedure qaVoteNO;
0908 begin 0909 regVoteAsked : = true;
091 ~0 regVoteEnabled := false;
0911 qaNext3 091.2 end;
0913 {-___-_---_~__~__._~__________________}
0914 procedure qaVoteYes;
0915 begin 0916 regVoteAsked : = true;
0917 regVoteEnabled := true;
0918 qaNext3 0919 end;
0920 {_-----___~_~___,____~_________w___~___}
SUBSTITUTE SHEET (RULE 26) 0921 procedure qaNext3;
0922 begin 0923 TubeDisplay(Thelntro);
0924 eTubeModeState := tmINTRO
0925 end;
{_________________________________________________________________________}
0927 { Errors }
~_________________________________________________________________________}
0929 function TfrmRun.NoVideo: Boolean;
0930 begin 0931 if bVideoEnable then begin 0932 Result := false;
0933 exit 0934 end;
0935 waveSony.Play;
0936 with frmRun.bIobMessage do Begin 0937 MaxWidth := 152;
0938 ShowMessage('Your 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 pertorm 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.En'orMessage(const msg: string);
0951 begin 0952 waveSorry.Play;
0953 with frmRun.bIobMessage do begin 0954 MaxWidth := 152;
0955 ShowMessage(Msg, frmRun.Left+310, frmRun.Top+64) 0956 end;
0957 iErrorMessageTimer := 50 0958 end;
0959 t ----_____~_~_______________________}
SUBSTITUTE SHEET (RULE 26) 0960 procedure TfrmRun.SevereError(const msg: string);
0961 begin 096x' tmTimer.Enabled := false;
0963 bStopPaint := true;
0964. MessageDlg('('+msg+' )'+char(10)+char(10)+char(13)+
0965 'An unexpected problem occured, and IQcd must exil now:'+
0966 char(10)+char(13)+
0967 'All wilt be fine, but you should reboot your computer.', 0968 mtError, [], 0);
0969 Close;
0970 Application.Tem7inate 0971 end;
097! {-______~_____~_~_.___________________________}
097;1 procedure TfrmRun.DefauItException(Sender: TObject; E: Exception);
09741 begin 097si if true {Application.Terminated} then begin 0976 MessageDlg(E.Message, miError, [mbOK], 0);
097 i' exit 097f9 end;
0979 waveSorry.Play;
098() with frmRun.blobMessage do begin 09811 MaxWidth := 230;
098:' 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 "+
098Ei 'then exit IQcd or reboot your system.', 098fi frmRun.Left+310, frmRun.Top+64) 098 ~' end;
0988 iErrorMessageTimer :_ -1 0989 end;
{___.___________________________________________________________________ __}
099'1 { form repaint }
099:?
{___.______________________________________________________________________}
0993 {$1FDEF KILLERASE}
0994 procedure TfrmRun.FormErase(var Msg: TWMEraseBkgnd);
099:1 begin 0996 {if bVideo256 then begin 099'7 SeleciPalette(Handle, imgPalette.Picture.Bitmap.Palette, false);
0998 RealizePalette(Handle) SUBSTITUTE SHEET' (RULE 26) 0999 end;}
1000 Msg.Result := LRESULT(False) 1001 end; _ 1002 {$ENDIF}
1003 { ____~_____~_~________________________}
1004 procedure TfrmRun.FormPaini(Sender: TObject);
1005 var 1006 FuIIRect: TRect;
1007 begin 1008 if bStopPaint then 1009 exit;
1010 if bVideo256 then begin 1011 FuIIRect := Bounds(0, 0, ClientWidth, Clientlieight);
1012 BitmapUpdateScreen(FuiIRect) 1013 end 1014 else 1015 BitmapUpdateScreen(Canvas.CIipRect) 1016 end;
1017 end.
SUBSTITUTE SHEET (RULE 26) 0001 unit Saver;
000'.
{___._______________,_____________________ _ _____________________________-_}
OOO;f interface 000~I
{___._______________._____________________________________________________-_}
OOOfi {$IFDEF WINDOWS}
OOOfi uses 0007 WinTypes, Winprocs, SysUtils, Messages, Classes, Controls, Inifiles, OOOE3 Run, IniFig;
0009 {$ELSE}
0010 uses 001'1 Windows, SysUtils, Messages, Classes, Controls, Inifiles, 001:? Run, IniFig;
001;3 {$ENDIF}
0014 {_____________________________________________}
001!i function SaverOurslnstalled: Boolean;
001E3 function UsingThisSaver(const ThisSaver: string): Boolean;
0017 function UsingSaver: Boolean;
00113 function UsingOurSaver: Boolean;
001!) function SetSaver(const SaverName: string): Boolean;
0020 procedure GetSaver( var SaverName: siring);
002'1 {__________________________________________________________________________}
0022 implementation {________________________________________________________________________-}
0024 uses 002.5 Sysfig;
002r3 {__.________________.____________________________________________________ __}
002'7 { Code }
{__.________________._____________________________________________________-_-_}
0029 function SaverOurslnstalled: Boolean;
0030 var 0031 (Saver: TextFile;
0032 begin 0033 try 0034 AssignFile(fSaver, sSystemDirectory+iniScreenSaver+'.scr');
0035 Reset(fSaver);
SUBSTITUTE SH~ET (RULE 26) 0036 CIoseFile(fSaver);
0037 result := true 0038 except 0039 result := false 0040 end 0041 end;
0042 {____________________________________________~__) 0043 function UsingThisSaver(const ThisSaver: string): Boolean;
0044 var 0045 Ini: TIniFile;
0046 begin 0047 result := false;
0048 try 0049 Ini := TIniFile.Create(sWindowsDirectory+'System.ini') 0050 except 0051 exit 0052 end;
0053 try 0054 result :_ (Ini.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: TIniFile;
0073 begin 0074 result := true;
0075 try 0076 Ini := TIniFlle.Create(sWindowsDirectory+'System.ini') SUBSTITUTE SHEET (RULE 26) 0077 except 0078 exit 0079 end;
0080 try 0081 Ini.WriieString('boot', '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: TIniFile;
0091 begin 0092 SaverName :_ ";
0093 try 0094 ini := TIniFile.Create(sWindowsDirectory+'System.ini') 0095 except 0096 exit 0097 end;
0098 try 0099 SaverName := Ini.ReadString('boot', 'SCRNSAVE.EXE', ") 01 CIO except 01 CI1 end;
01CI2 ini.Free 01 CI3 end;
01 CI4 end.
SUBSTITUTE SHEET (RULE 26) 0001 unit ScroIBar;
{_______________________________________ _ _______________________________-~
0003 interface {________________________________________________________________________-}
0005 {$IFDEF WINDOWS}
0006 uses 0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 0008 Forms, Dialogs, LMDnonvS, 0009 Run, Main, CDPlayer, BitBtns, BitBars;
0010 {$ELSE}
0011 uses 0012 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 0013 ExtCtrls, StdCtrls, LMDnonvS, 0014 Run, Main, CDPlayer, BitBtns, BitBars;
0015 {$ENDIF}
0016 {_---_____~__~_______________~___________}
0017 procedure ScroIIBarlnitialize;
0018 procedure ScroIIBarExit;
0019 procedure ScroIIBarStartDelay;
0020 procedure ScroIIBarMouseDown;
0021 procedure ScroIlBarMouseUp;
0022 procedure ScroIIBarMouseDrag( x, y: longint);
0023 procedure ScroIIBarMouseMove(X,Y: longint);
0024 procedure ScroIIBarTimerTick;
0025 procedure ScrotIBarAbort;
0026 procedure ScroIIBarPosition(Position: longint);
0027 {---___~__ ~__~_w___________~~_}
0028 var 0029 Scroll: TBar;
{_______________________________________________________________________..}
0031 implementation {________________________________________________________________________-}
0033 uses 0034 Tube, Words;
0035 {_-----__w~_______~______~_________}
0036 var 0037 bScroIIBarMouseDown: Boolean;
SUBSTITUTE SHEET (RULE 2fi) 0038 iTimerPosition:longint;
0039 iTimerDelay:longint;
0040 iHintltem:longint; _ 0041 iHintX, iHintY: longint;
0042 iHiniDelayTimer:longint;
0043 sHintMsg: string[250];
0044 bHintVisible: Boolean;
0045 blnHintArea: Boolean;
{_______________________________________________________________________-__}
0047 ~; Main Code }
{____._____________________________________________________________________}
0049 procedure ScroIIBarPosition(Position: longint);
0050 begin 0051 if bScroliBarMouseDown or (iTimerDelay>=0) then 0052 iTimerPosiiion :~= Position 0053 else 0054 BarSetPosition(Scroll, Position);
0055 TubeScroll(ScroILiSIidePosition) 0056 end;
0057 ~;_----_-_________~________________________}
0058 procedure ScroIIBarStartDelay;
0059 begin 0060 iTimerDelay := SCROLL DELAY
0061 1?nd;
{____._____________________________________________________________________}
0063 ~; Mouse Handling }
~____._____________________________________________________________________}
0065 procedure ScrotIBarMouseDown;
0066 begin 0067 if ScroILbEnabled and BarButtonHit(Scroll) then begin 0068 iHintltem := 0;
0069 iHintDelayTimer := 0;
0070 if bHintVisibte then begin 0071 frmRun.blobHInt.HIdeMessage;
0072 bHintVisible := false 0073 end;
0074 BarMouseMoveStart(Scroll);
SUBSTITUTE SHEET (RULE 26) WO 98!52189 PCT/US98/10035 0075 bScroIIBarMouseDown := true;
0076 if (eTubeModeState=tmWORDS) and (eCDPIayerState=psPLAYING) then begin 0077 iTimerPosition := ScroILiSIidePosition;
0078 iTimerDelay := SCROLL DELAY
0079 end 0080 end 0081 end;
0082 {-_-__~___ ___________________}
0083 procedure ScroIlBarMouseUp;
0084 begin 0085 bScroIIBarMouseDown := false;
0086 end;
0087 {-----_-_____~~____ ______ 0088 procedure ScroIIBarMouseDrag( x, y: longint);
0089 begin 0090 if bScroIIBarMouseDown then begin 0091 BarMouseMoveDraw(Scroll,x,y);
0092 TubeScroll(ScroILiSIidePosition) 0093 end 0094 end;
0095 {-______~~_____~___~______________}
0096 procedure ScroIIBarMouseMove(X,Y: longint);
0097 var 0098 iltem:longint;
0099 x1,yl: fongint;
0100 label 0101 exit1;
0102 begin 0103 if not ScroILbEnabted then 0104 goto exit! ;
0105 if bScroIIBarMouseDown then 0106 goto exit1;
0107 iHintX := frmRun.Left+X-5;
0108 iHintY := frmRun.Top+Y-0;
0109 iltem := 0;
0110 with ScroILspriteBack 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;
SUBSTITUTE SHEET (RULE 26) 0116 if iltem>0 then begin 0117 if iliem<>iHintltem then begin 0118 iHintDelayTimer := HINT DELAY; _ 0119 iHintltem := iltem 0120 end;
0121 exit 0122 end;
0123 exitl:
0124 iHintDelayTimer := 0;
0125 iHintltem := 0;
0127 if bHintVisible then begin 0128 frmRun.bIobHint.HideMessage;
0129 bHintVisibie := false 0130 end 0131 end;
0132 {_-___________________..__________________________}
0133 procedure ScroIIBarTimerTick;
0134 begin 0135 if iHintDeiayTimer>0 then begin 0136 Dec(iHintDelayTimer);
0137 if iHintDelayTirner-0 then begin 0138 if bHintVisible then 0139 frmRun.bIobHint.HideMessage;
0140 iHintLastX :== iHintX;
0141 iHintLastY : = iHintY;
0142 sHintLasiMsg := sHintMsg;
0143 frmRun.bIobHint.Position := hpAboveLeft;
0144 frmRun.bIobHint.ShowMessage(sHintMsg, iHintX, iHintY);
0145 bHintVisible := true 0146 end 0147 end;
0148 if bScroIIBarMouseDown or (iTimerDeiay<0) then 0149 exit;
0150 Dec(iTimerDelay);
0151 it iTimerDelay<0 then begin 0152 SarSetPosition(Scroll, iTimerPosition);
0153 TubeScroll(iTimerPosition) 0154 end 0155 end;
_______________._____________________________________________________ SUBSTITUTE SHEET (RULE 26) 0157 { Mouse Handling }
{________________________________________ _ _______________________________}
0159 procedure ScroIIBarAbort;
0160 begin 0161 bScroliBarMouseDown := false;
0162 if iTimerDelay>-1 then begin 0163 iTimerDelay :_ -1;
0164 TubeScroll(iTimerPosition) 0165 end 0166 end;
{_________________________________________________________________________}
0168 { Initaiize / Exit }
{_________________________________________________________________________}
0170 procedure ScroIIBarlnitialize;
0171 begin 0172 Barlnitialize(Scroll, frmMain.imgScroll Back, 0173 frmMain.imgScroll Rod, frmMain.imgScroll Button, 0174 frmMain.imgScroll Endl, frmMain.imgScroll End2);
0175 iTimerDelay :_ -1;
0176 sHintMsg :='Drag button to scroll display.';
0177 iHintltem := 0;
0178 iHintDelayTimer := 0;
0179 bHintVisible := false;
0180 blnHiniArea := false;
0181 bScroIIBarMouseDown := false 0182 end;
0183 {----______~_______~~~______________}
0184 procedure ScroIIBarF~cit;
0185 begin 0186 BarF~cit(Scroll) 0187 end;
0188 end.
SUBSTITUTE SHEET (RULE 26) 0001 unit SysFig;
{___________________.____________________ _ _____________________________-_-_}
0003 interface {___.______________________________________________________________________}
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 bVideoEnable: Boolean;
0022 sRunDirectory: string[200];
0023 sWindowsDirectory: string[200];
0024 sSystemDirector!r: string[200];
0025 startWaIIpaperName, 0026 startWaIIpaperTile: string[200];
0027 startScreenSaver: string[100];
_____________________________________________________________________ 0029 implementation {_______________________________________________________________________-_-_}
0031 uses 0032: Wall, Saver;
0033'~
_____________________________________________________________________ 0034. { Code }
{__________________._____________________________________________________..}
SUBSTITUTE SHEET (RULE 26) 0036 procedure SysFigCheckVideo;
0037 var 0038 Ini: TIniFile; _ 0039 s: string[100];
0040 begin 0041 bVideoEnable := false;
0042 Ini := TIniFile.Create(sWindowsDirectory+'System.ini');
0043 try 0044 s := Ini.ReadString('MCI', 'MPEGVIDEO', ");
0045 except 0046 end;
0047 if s<>" then 0048 bVideoEnable := 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 SysFigLoad;
0064 var 0065 n: word;
0066 DC: HDC;
0087 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(t~sWindowsDirectory[1]), 200-1);
0075 if sWindowsDirectory[n]<>'1' then begin 0076 sWindowsDirectory[n+1] :_'\';
SUBSTITUTE SHEET (RULE 26) 0077 Inc(n) 0078 end;
0079 sWindowsDirectory[0] := Char(n);
0080 n := GetSystemDirectory(Pointer(~sSystemDirectory[1 )), 200-1 );
0081 if sSystemDirectory[n]<>'\' then begin 0082 sSystemDirectory[n+1 ) :_ '\';
0083 Inc(n) 0084 end;
0085 sSystemDirectory[0] := Char(n);
0086 GetWallpaper(startWaIIpaperName, startWaIIpaperTile);
0087 GetSaver(startScreenSaver) 0088 end;
0089 end.
SUBSTITUTE SHEET (RULE 26) 0001 unit TimeBar;
{________________________________________ _ ______________________________-}
0003 interface {________________________________________________________________________-}
0005 {$IFDEF WINDOWS}
0006 uses 0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 0008 Forms, Dialogs, LMDnonvS, 0009 Run, Main, BitBars, Tube, Words, ScroIBar, Counter;
0010 {$ELSE}
0011 uses 0012 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 0013 ExtCtrls, StdCtrls, LMDnonvS, 0014 Run, Main, BitBars, Tube, Words, ScroiBar, Counter;
0015 {$ENDIF}
0016 {-_-___________________________________________}
0017 procedure TimeBarinitialize;
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: longlnt);
0025 procedure TimeBarMouseMove(X,Y: longint);
0026 procedure TimeBarTimerTick;
0027 {_-___~~___w____~______________________}
0028 var 0029 Time: TBar;
{-______________________________________________________________________-_-_}
0031 implementation 0033 uses 0034 CDPlayer;
0035 {__~____~___________________________________}
0036 var 0037 bTimeBarMouseDown: Boolean;
SUBSTITUTE SHEET (RULE 26) 0038 iHintltem:longint;
0039 iHintX,iHintY:longint;
0040 iHintDelayTimer:longint;
0041 sHintMsg: string[250];
0042 bHintVisible: boolean;
0043 blnHintArea: Boolean;
{____.___________________________________________________________________-__}
0045 { Main Code ) {___.______________________________________________________________________}
0047 procedure TimeBarrJewTrack(TrackNo: longint);
0048 begin 0049 BarSetRange(Time, iAudioTrackLength[TrackNoJ);
0050 BarSetPosition(Time, 0);
0051 BarEnable(Time);;
0052 CounterNewTrack;
0053 CounterSetTime(0);
0054 TubeSetTime(TheWords[TrackNoJ, 0) 0055 end;
0056 {__~_______________..____________~__.~____J
0057 procedure TimeBarPosition(TrackTime: longint);
0058 begin 0059 if not bTimeBarMouseDown then begin 0060 BarSetPosition(Time, TrackTime);
0061 CounterSeiTime(TrackTime);
0062 TubeSetTime(fheWords[iLastTrackNoJ, TrackTime) 0063 end 0064 end;
0065 { --__-_----_--_..~____~______________) 0066 function TimeBarGetPosition: longint;
0067 begin 0068 result := BarGetPosition(Time) 0069 end;
{___.________________.____________________________________________________-_}
0071 { Mouse Handling }
{___________________.____________________________________________________-_-_) 0073 procedure TimeBarIUlouseDown;
0074 begin SUBST1'TLJTE SHEET (RULE 26~
0075 if BarButtonHit(Time) then begin 0076 iHintltem := 0;
0077 iHintDelayTimer := 0; _ 0078 if bHintVisible then begin 0079 frmRun.bIobHint.HideMessage;
0080 bHintVisible := false 0081 end;
0082 BarMouseMoveStart(Time);
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 ScroIIBarAbort;
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 xl,y1:longint;
0110 label 0111 exitl ;
0112 begin 0113 if bTimeBarMouseDown then 0114 goto exit1;
0115 iHintX := frmRun.!_eft+X+5;
SUBSTITUTE SHEET (RULE 26) 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;
Oi27 if iltem>0 then begin 0128 if iltem<>iHintltem 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.bIobHinl.HideMessage;
0139 bHintVisible :_~ false 0140 end 0141 end;
0142 {_______________~__.._____________~____________}
0143 procedure TimeBarTimerTick;
0144 begin 0145 if iHintDelayTimer-0 then 0146 exit;
0147 Dec(iHintDefayTimer);
0148 if iHintDeiayTimer=0 then begin 0149 if bHintVisible then 0150 frmRun.bIobHint.HideMessage;
0151 iHintLastX := iHintX;
0152 iHintLastY := iHintY;
0153 sNintLastMsg := sHintMsg;
0154 frmRun.bIobHint.Position := hpAboveRight;
0155 frmRun.bIobHint.ShowMessage(sHintMsg, iHintX, iHintY);
0156 bHintVisible :== true SUBSTITUTE SHEET (RULE 26) 0157 end 0158 end;
0159 _ {_________________________________________________________________________}
0160 { Initalize / Exit }
{_________________________________________________________________________}
0162 procedure TimeBarlnitiatize;
0163 begin 0164 Barlnitialize(Time, frmMain.imgTime_Back, 0165 frmMain.imgTime_Rod, frmMain.imgTime_Button, 0166 frmMain.imgTime Endl, frmMain.imgTime_End2);
0187 sHintMsg :_ 'Drag button to move track time.';
0168 iHintltem := 0;
0169 iHintDelayTimer := 0;
0170 bHintVisibfe := false;
0171 blnHintArea := false;
0172 bTimeBarMouseDown := false 0173 end;
0174 {_________~_______________________________}
0175 procedure TimeBarExit;
0176 begin 0177 BarExit(Time) 0178 end;
0179 end.
SUBSTITUTE SHEET (RULE 26) 0001 unit Tracks;
0003 interface {__________________________________________________________________________}
0005 {$IFDEF WINDOWS}
0006 uses 0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 0008 Forms, Dialogs, LMDnonvS, 0009 Run, Main, CDPlayer, Bitmaps, Tube;
0010 {$ELSE}
0011 uses 0012 Windows, Messages, SysUtils, Classes, Graphics, Conlrols, Forms, Dialogs, 0013 ExiCtrls, StdCtrls, LMDnonvS, 0014 Run, Main, CDPlayer, Bitmaps, Tube;
0015 {$ENDIF}
0016 {_--________________.._~_______________________}
0017 procedure Tracksfnitialize;
0018 procedure TracksExit;
0019 procedure TracksNewTrack(TrackNo: longint);
0020 procedure TracksMouseDown;
0021 procedure TracksMouseMove(X,Y: longint);
0022: procedure TracksTiimerTick;
{_______________________________________________________________________-__}
0024. implementation {________________________________________________________________________--_}
002fi~ uses 0027 PIayList;
0028 {_________~___-___~__~________________}
0029 const 0030 LEDTEXT ADJUST = 3;
0031 TRACKCLICK ADJUST = 1;
0032 {---_________________________________________~}
003a var 0034 spriteTracks Back, 003fi spriteTracks_LedOn, 003Ei spriteTracks LedOff: TSprite;
0037 bTracksMouseDown: booiean;
SUBST1TUT~ SH~~T (RULE 26) 0038 iTracksTop, iTracksSpacing: longint;
0039 iTracksTextLeft, iTracksTextWidth: longint;
0040 iTracksLEDLeft, iTracksLEDWidth: fongint;
0041 iHintltem:longint;
0042 iHintX,iHintY:longint;
0043 iHintDeiayTimer: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; EnabiedState: Boolean); forward;
0050 function TrackMouseHit(X,Y: longint): longint; forward;
0051 function LedMouseHit(X,Y: longint): longint; forward;
0053 { Local Routines }
{_________________________________________________________________________}
0055 procedure DrawTrack(TrackNo: longint; SelectedState: Boolean);
0056 var 0057 TextAlignFlags: word;
0058 iBitmapLine:longint;
0059 TrackRect: TRect;
0060 sTrack: string[4J;
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 bTrackEnabled[TrackNoJ then 0068 if SelectedState then 0089 Font.Color := TEXT HIGHLIGHT
0070 else 0071 Font.Color := TEXT NORMAL
0072 else 0073 Font.Color := TEXT_DISSABLED;
0074 sTrack := IntToStr(TrackNo);
0075 iBitmapLine := iTracksTop + (TrackNo-1)*iTracksSpacing - LEDTEXT_ADJUST;
0076 TrackRect := bounds(iTracksTextLeft, iBitmapLine, SUBSTITUTE SiiEET (RULE 26) 0077 iTracksTextWidth, iTracksSpacing);
0078 ExtTextOut(Handle, 0079 iTracksTextLeft+iTracksTextWidth-1, iBitmapLine, 0080 ETO CLIPPED, ~TrackRect, Pointer(~sTrack~1]), Length(sTrack), nil);
0081 SetTextAlign(Handle, TextAlignFlags);
0082 BitmapUpdateScreen(Trackrect) 0083 end;
0084 end;
0085 {-____-_----___-__--_._______________________) 0086 procedure DrawLED(TrackNo: longint; EnabIedStaie: Boolean);
0087 var 0088 iBitmapLine:longint;
0089 begin 0090 iBitmapLine := iTracksTop + (TrackNo-1)*iTracksSpacing;
0091 if EnabIedState then begin 0092 spriteTracks_LedOn.Top := iBiimapLine;
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 := i TracksTop + (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;
SUBSTITUTE SHEET (RULE 2fi~
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>iTracksLEDLefi+iTracksLEDWidth-1) then 0126 exit;
0127 for iTrack := 1 to iAudioTracks do begin 0128 iTrackLine := iTracksTop + (iTrack-1)*iTracksSpacing;
0129 if tY>=iTrackLine) and (Y<=iTrackLine+iTracksSpacing-1) then begin 0130 result := iTrack;
0131 exit 0132 end 0133 end 0134 end;
{_______________________________________________________________________-_-_}
0136 { Main code }
{_________________________________________________________________________}
0138 procedure TracksNewTrack(TrackNo: longint);
0139 begin Oi40 if TrackNo<>iLastTrackNo then begin 0141 if iLastTrackNo>0 then 0142 DrawTrack(iLastTrackNo, false);
0143 Drawi'rack(TrackNo, true) 0144 end 0145 end;
{_________________________________________________________________________~
0147 { Mouse Handling }
{_________________________________________________________________________}
0149 procedure TracksMouseDown;
0150 var 0151 iTrack, iTrackE: longint;
0152 iTracksEnabled:longint;
0153 begin 0154 iTrack := TrackMouseHit(iMouseDownX, iMouseDownY);
SUBSTITUTE SHEET (RULE 2fi) 0155 if iTrack>0 then begin 0156 iHintDelayTimer := 0;
015'7 -0158 if bHintVisible~ then begin 0159 frmRun.bIobHint.HideMessage;
0160 bHintVisible := false 0161 end;
0162 if bTrackEnabled[itrack] then 0163 frmRun.TrackClicked(iTrack);
0164 exit 0165 end;
0166 iTrack := LedMauseHit(iMouseDownX, iMouseDownY);
0167 if iTrack>0 then begin 0188 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.EnrorMessage( 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(i1'rack, (iLastTrackNO=iTrack));
0184 DrawLED(iTrack, bTrackEnabled[iTrack]);
0185 if bTrackEnabled[iTrack] then 0186 PIayListTrackEnable(iTrack) 0187 else 0188 PIayListTrackDissable(iTrack);
0189 exit 0190 end 0191 end;
0192 { ____w_ _________~____________) 0193 procedure TracksMouseMove(X,Y: longint);
0164 var 0195 iltem:longint;
SUBSTITUTE SHEET (RULE 26) 0196 begin 0197 iHintX := frmRun.Left+X_5;
0198 iHintY := frmRun.Top+Y-0;
0199 iltem :_ -TrackMouseHit(X,Y);
0200 if iltem<0 then begin 0201 if iltem<>iHintltem then begin 0202 if bHintVisible then begin 0203 frmRun.bIobHint.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 iltem<>iHintltem then begin 0214 if bHintVisible then begin 0215 frmRun.bIobHint.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.bIobHint.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 SUB ST1TUTE 5 H EET (RULE 26) WO !98/52189 PCT/US98/10035 023i' if bHintVisible then 023f: frmRun.bIobHint.HideMessage;
0239 sHintMsg :_ 'No hint, song.';
024() if iHintltem>0 then 02411 if bTrackEnabled[iHintltem] then 024a sHintMsg :_ 'Click indicator to disable the track' 024a else 0244 sHintMsd :='Click indicator to enable the track.';
024Ei if iHintltem<0 then 024fi sHintMsg :_ 'Click number to select the track.';
0247 iHintLastX := iHintX;
024!3 iHintLastY := iiHintY;
0249 sHintl.astMsg := sHintMsg;
0250 frmRun.bIobHint.Position := hpAboveLeft;
0251 frmRun.bIobHIint.ShowMessage(sHintMsg, iHintX, iHintY);
0252 bHintVisible :~= true 025;3 end 0254 end;
{__..______________________________________________________________________}
0256 { Initalize / Exit }
025'7 {__________________________________________________________________________}
0258 procedure Trackslnitialize;
0259 var 0260 TrackNo:longini;
0261 sTrack: string[4];
0262 begin 0263 BitmapCreate(spriteTracks_Back, frmMain.imgTracks Back, false);
0264 BitmapCreate(spriteTracks_LedOn, frmMain.imgTracks LedOn, true);
0265 BitmapCreaie(spriteTracks LedOff, frmMain.imgTracks LedOff, tme);
0266 iTracksTop := iTextBIockTop;
0267 iTracksSpacing := iTextBIockHeight div iAudioTracks;
0268 iTracksLEDLeft := spriteTracks_LedOn.Left;
0269 iTracksLEDWidih := spriteTracks LedOn.Width;
0270 iTracksTextLeft := spriteTracks Back.Left +
0271 ((spriteTracks_Back.Left+spriteTracks_Back.Width-1) 0272 (ITracksLEDLeft+ITracksLEDWtdth-1 ) );
0273 with frmRun.Canvas do begin 0274 Font.Size := iiTextFontSize;
0275 Font.Style :_ [fsBold];
SUBSTITUTE SHEET (RULE 26) 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 iHintitem := 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.
SUBSTITUTE SHEET (RULE 26) 0001 unit TrkMedia;
000 3 intertace {_______________________________________________________________________--}
OOOti {$IFDEF WINDOWS}
OOOEi uses OOOi' SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, OOOF3 Forms, Dialogs, OOOS) Run, Main, Bitmaps, Tube, Video, Comment;
001 t) {$ELSE}
0011 uses 001:? Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 001',3 ExtCids, StdCtrls, 0014 Run, Main, Bitmaps, Tube, Video, Comment;
0015 {$ENDIF}
001 Ei {-_____________w__..___w____________________}
001; procedure Medialnitialize;
00113 procedure MediaF~cit;
0019 procedure MediaDraw(TrackNo: longint);
002i) procedure MediaNewTrack(TrackNo: longini);
002'1 {_______________________________________________________________________-__-}
0022 implementation 0024 var 0025 spriteMedia_Video, 002t~ spriteMedia_Comment, 002'7 spriteMedia_Vyes, 0028 spriteMedia_Vno, 0021) spriteMedia_Cyes, 0030 spriteMedia_cno, 0031 spriteMedia_Block: TSprite;
003.2 bmpBlockO: TBitmap;
{__________________._____________________________________________________-_-_}
0034 { Main code }
{__________________._____________________________________________________-__-}
SUBSTITUTE SHEET (RULE 26) 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 BitmapOverlay(Image, spriteMedia_Video, TSprite(nil~));
0043 BitmapOveriay(Image, spriteMedia_Comment, TSprite(nil~));
0044 if not bVideoAvailable[TrackNo] then 0045 BitmapOveriay(Image, spriteMedia_Vno, TSprite(nil"));
0046 if not bCommentaryAvailable[TrackNo] then 0047 BitmapOverlay(Image, 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=tmINFO)) then 0057 if TrackNo<>iLastTrackNo then 0058 MediaDraw(TrackNo) 0059 end;
{_________________________________________________________________________}
0061 { Initatize / Exit }
{_________________________________________________________________________}
0063 procedure Mediainitialize;
0064 var 0065 I: string[50j;
0066 p: integer;
0067 x,y:longint;
0068 Rect1, Rect2: Trect;
0069 begin 0070 BitmapCreate(spriteMedia_Video, frmMain.imgTracks Video, true);
0071 8itmapCreate(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);
SUBSTITUTE SHEET (RULE 26) 0075 BitmapCreate(spriteMedia_Cno, frmMain.imgTracks Cno, true);
0071; with frmMain.irrigTracks_Block do begin 0077 I := Hint;
0078 p := Pos(',',I);
007'9 x := SirTolnt(Copy(1,1,p-1));
0080 y := StrTolnt(Copy(I,p+1,99));
0081 Rect1 := 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 := T'Bitmap.Create;
0087 bmpBlockO.Assign(spriteMedia_Block.lmage) 0088 end;
008'9 {_________~~_____________________________) 0090 procedure MediaExit;
0091 begin 0092 BitmapDestroy(spriteMedia_Video);
0093 BitmapDestroy(spriteMedia_Comment);
0094 BitmapDestroy(spriteMedia_Vyes);
0095 BitmapDestroy(spriteMedia_Vno);
0096 BitmapDestroy(speiteMedia_Cyes);
0097 BitmapDestroy(spr9teMedia_Cno);
0098 BitmapDestroy(spr9teMedia_Block);
0099 bmpBlockO.Free 0100 end;
0101 end.
SUBSTITUTE SHEET (RULE 26) 0001 unit Tube;
0002 {$DEFINE NOSCROLL_LEADER}
0003 {$DEFINE NOSCROLL_TRAILER}
{_________________________________________________________________________}
0005 interface {_________________________________________________________________________}
0007 {$IFDEF WINDOWS}
0008 uses 0009 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, OOiO Forms, Dialogs, Printers, 0011 Run, Main, CDPlayer, Bitmaps, ScrolBar, BitBars;
0012 {$ELSE}
0013 uses 0014 Windows, Messages, SysUtifs, Classes, Graphics, Controls, Forms, Dialogs, 0015 ExtCtrls, StdCtrls, Printers, 0016 Run, Main, CDPlayer, Bitmaps, ScroIBar, 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 = recorci 0029 bEnabled: Boolean;
0030 bHighlight: Boolean;
0031 iMaxFontSize:longint;
0032 iBitmapHeight:longint;
0033 iBitmapLeft, iBitmapTop: longint;
0034 iTimeStamp:longint 0035 end;
0036 pTTubeLine = ~TTubeLine;
0037 {--_-_~~______~___~________~___}
0038 var 0039 iTextFontSize:longint;
SUBSTITUTE SHEET (RULE 26) 0040 iTextBiockLeft, i f-extBIockTop, 0041' iTexlBIockWidth, iTexiBIockHeight: longint;
0042 spriteTubelntro, 0043 spriteTubeText, 0044 spriteTubeMenu: TSprite;
0045 spriteMenuBullet: TSprite;
0046 pCurrentTubeList: ~TTubeList;
0047 pCurrentTube: p'fSprite;
0048 iLastTubeScroll:longint;
0049 {_ ___~____~_________) 0050 procedure Tubelnitialize;
0051 procedure TubeExit;
0052 procedure Tubelnitl_ist(var spriteTube; var TubeList: TTubei_ist;
005~~ t_ineSpacing, LeftOffset: longint);
0054 procedure TubeExitList(var TubeList: TTubeList);
0055 procedure TubeRefresh(var TubeList: TTubeList);
005fi~ procedure TubeDisplay(var TubeList: TTubeList);
0057 procedure TubeSet'TopLine(var TubeList: TTubeList; TopTextLine: longint);
0058 procedure TubeSetAtINormal(var TubeList: TTubeList);
0059 procedure TubeSetHighlight(var TubeList: TTubeList; TextLine: longint);
00601 procedure TubeSetNormal(var Tubel_ist: TTubeList; TextLine: longint);
0061 procedure TubeSetBnable(var Tubet_ist: TTubeList; TextLine: longint);
0062. procedure TubeSetDissable(var TubeList: TTubeList; TextLine: longint);
0063 procedure TubeSet'Time(var TubeList: TTubeList; LineTime: longint);
0064 procedure TubePrint;
0065 function TubeHit(X,Y: longint): longint;
0066 function TubeItemHit(X,Y: longint): longint;
0067 procedure TubeScroll(fopBitmapLine: longint);
oosa {_________________________________________________________________________~
0069 implementation {___________________.___________________________________________________ __) 0071 uses 0072 Words;
0073 {--____~__~_~_____________________________}
0074 const 0075 FORCE DRAW - _9999;
0076 { ___ __~_~_________..____}
0077 function SteppedBitmapLine(var Tubel_ist: TTUbeList; BitmapLine:
longint):
0078 longint; forward;
SUBSTITUTE SHEET (RULE 26) 0079 procedure GetVisibIeLinesRange(var iStartLine, iLastLine: iongint);
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, i!_eftOffset: longint;
0086 ScreenUpdate: Boolean): longint; forward;
0087 procedure DrawLine(TextLine: longint; ScreenUpdate: Boolean); forward;
0088 procedure DrawList(var TubeList: TTubeList); forwarcl;
0089 procedure SetTopLine(var TubeList: TTubeList; TopBitmapLine: longint);
forward;
0090 procedure UpdateScroIIBar(var TubeList: TTubeList; BitmapLine: longint);
forward;
{_________________________________________________________________________}
0092 { Local Routines }
{_________________________________________________________________________}
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 := pTTubeLine(TubeList.TextList.Objects[iLinej);
0104 if pTubeLine~.iBitmapTop = 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.TextList.Objects[iStartLine])~.iBitmapTop 0114 {$ELSE}
0115 begin 0116 result := BitmapLine 0117 {$ENDIF}
SUBSTITUTE SHEET (RULE 26) 011!3 end;
0119 {_---_-_--___~_____~__________________}
012() procedure GetVisibIeLinesRange(var iStartLine: longint; var iLastLine:
longint);
0121 var 012:? iBitmapTop, iBitmapBottom: longint;
0123 iMaxLine, iLine: longint;
0124 pTubeLine: pTT~ubeLine;
012 5 begin 012(i iBitmapTop := pCurrentTubeList~.iCurrentSteppedTop;
0127 iBitmapBottom := iBitmapTop + (iTextBIockHeight-1);
0128 iMaxLine := pCun-entTubeList".TextList.Count-1;
012!3 iStartLine := iLastLine+1;
0130 for iLine := 0 to iMaxLine do begin 0131 pTubeLine := pTTubeLine(pCurrentTubeList".TextList.Objects[iLine]);
0132 if pTubeLine~.iBitmapTop = iBitmapTop then begin 0133 iStartLine := iLine;
0134 break 0135 end;
0136 if pTubeLine~.iSitmapTop > iBitmapTop then begin 013'T iStartLine := iLine-1;
0138 break 013! end 0140 end;
0141 if iStartLine<0 then 014;2 iStartLine := 0;
0143 iLastLine := iMaxLine;
0144 for iLine := iStartLine+1 to iMaxLine do begin 014.5 pTubeLine := pTTubeLine(pCurrentTubeList".TextList.Objects[iLine]);
0146 if pTubeLine~.i8itmapTop > iBitmapBottom then begin 014'7 iLastLine :~= iLine-1;
014$ break 0149 end 0150 end 0151 end;
0152 {----_---___________________________________}
0153 procedure GetLineSizes(const sText: string; var iSpace: longint; var iSize: longint);
0154 var 0155 p0, p1, p2, p9: longint;
0156 c0, c9, n: longint;
0157 s: string[250];
0158 begin SUBSTITUTE SHEET (RULE 26) 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,pl+1,249));
0166 if p2=((p1 +1 )-1 ) then 0167 break;
0168 s := Copy(sText,pl+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[c0) of 0174 's': begin 0175 if [s[c0+1}) <_ ['0'..'9'] then begin 0176 n := StrTolnt(Copy(s,c0+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,c0+1,2));
0188 inc(c0,3) 0189 end 0190 else 0191 tnc(c0) 0192 end 0193 end 0194 end 0105 end;
0196 {_-_--__________________~___________________}
0197 procedure Formatlt(const sText: string; iStart, iEnd: longint);
0198 var 0199 p0:longint;
SUBSTiTUT~ SHEET (RULE 26) 020() red, green, blue: byte;
02011 Stylel: TFontStyles;
0202 begin 020;3 with bmpPlayer.~:,anvas do begin 0204 p0 := iStart;
020Ei while p0<=iEnd do begin 020f3 Stylel :_ [];
020 ~~ case sText(pOj of 0208 '!': begin 0209 Stylel :_ [fsBoid];
0210 Inc(p0) 02111 end;
021:? 'i': begin 0213 Style1 :_ [fsltalic];
0214 Inc;(p0) 021 Ei end;
021f _': begin 021 ~~ Stylel :_ (fsUnderline];
0218 Inc(p0) 0219 end;
022() 'c': begin 0221 red := byte(sText[p0+1 ])-byte('0');
022:? green := byte(sText[p0+2])-byte('0');
0223 blue := byte(sText[p0+3])-byte('0');
0224 Font.Color := RGB(28*red, 28*green, 28*blue);
022!i I nc:(p0,4) 022(3 end;
022 ~~ 's': begin 0228 if [sText[p0+1 ]j <_ ('0'..'9'] then begin 0229 Font.Size := StrTolnt(Copy(sText,p0+1,2));
023() I nc(p0, 3) 0231 end 023:? else begin 023;3 Font.Size := iTextFontSize;
0234 inc(p0,1 ) 0230 end 023!3 end;
023'.7 'q': begin 0238 if [sText[p0+1]] <_ (~p'"~g'j then begin 023!3 red := byte(sText[p0+1 ])-byte('0');
0240 green := byte(sText[p0+2j)-byte('0');
SUBSTITUTE SHEET (RULE 26) 0241 blue := byte(sText[p0+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 Inc(p0) 0249 end 0250 end 0251 else 0252 Inc(p0) 0253 end;
0254 if Stylel <= Font.Style then 0255 Font.Style := Font.Style-Style1 0256 else 0257 Font.Style := Font.Style+Stylel 0258 end 0259 end 0260 end;
0261 {_-__________~__~____________________________}
0262 function Drawit(pTubeLine: pTTUbeLine;
0263 coast 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 TextBIockRect: TRect;
0274 label 0275 Exit Text;
0276 begin 0277 with bmpPlayer.Canvas do begin 0278 TextAlignFlags := SefTextAlign(Handle, TA
LEFT+TA_BASELINE+TA_NOUPDATECP);
0279 SetTextJustification(Handle, 0, 0);
0280 result := iLeftOffset;
0281 if pTubeLine".bHighlight then SUBSTITUTE SHEET (RULE 26) 0282 Font.Color := TEXT HIGHLIGHT;
0283 if not pTubel_ine~.bEnabled then 0284 Font.Cotor := TEXT DISSABLED;
0285 iTextLeft := pTubeLine".iBitmapLeft+iLeftOffset;
0286 iTextTop :_ 'iBitmapLine;
0287 if iEnd>Lenglth(sText) then 0288 iEnd := Le;ngth(sText);
0289 iLength := iE:nd-iStart+1;
020 {$IFDEF WINDOWS}
02!X1 GetTextExle~ntPoint(Handle, ~sText[iStart], iLength, TextEx);
022 {$ELSE}
0293 GetTextExtentPoint32(Handle, ~sText[iStart], iLength, TextEx);
024 {$ENDIF) 025 iTextWidth := TextEx.cx;
026 iTexlHeight := pTubeLine~.iBitmapHeight;
02!7 if (iTextLeft+iTextWidth)>(iTextBIockWidth-1) then begin 028 iTextWidth :_ (iTexiBIockWidth-1)-iTextLeft;
0299 font.Color := clFuchsia 0300 end;
0301 if iTextWidih<=0 then 0302 goto Exit_ Text;
03173 if (iTextTop+iTextHeight-1 )>(iTextBIockHeight-1 ) then 03174 iTextHeight := iTextBIockHeight-iTextTop;
0305 if iTextHeight<=0 then 0306 goto Exit. Text;
03177 TexiLineRec;t := Bounds(iTextBIockLeft+iTextLeft, 0308 iTextBIockTop+iTextTop, 0309 iTextWidth, iTextHeight);
0310 if ScreenUpdate then 0311 BitBlt(bmpPlayer.Canvas.Handle, 03t2 Textl.-ineRect.Left, TextLineRect.Top, 0313 iTextWidth, iTextHeight, 0314 pCunrentTube".Image.Canvas.Handle, 03'15 (iTextBtockLeft-pCurrentTube".Left)+iTextLeft, 0316 (iTextBIockTop-pCurrentTube".Top)+iTextTop, 03'17 srcCOPI~;
0318 ExtTextOut(Handle, 0319 iTextBIockLeft+iTextLeft, 0320 iTextBIockTop+iTextTop+pTubeLine~.iMaxFontSize, 0321 ETO_ CLIPPED, ~Textt_ineRect, ~sTexi[iStart], iLength, nil);
0322 result := iLeftOffset+iTextWidth;
SUBSTITUTE SHEF1' (RULE 26) 0323 TextBIockRect := Bounds(iTextBIockLeft, iTextBIockTop, 0324 iTextBIockWidth, iTextBIockHeight);
0325 if ScreenUpdate then 0326 BitmapUpdateScreen(TextLineRect);
0327 Exit Text:
0328 SetTextAlign(Handle, TextAlignFlags) 0329 end 0330 end;
0331 {_____---______________~_______________~__}
0332 procedure DrawLine(TextLine: longint; ScreenUpdate: Boolean);
0333 var 0334 pTubeLine: pTTubeLine;
0335 iBitmapLine:longint;
0336 iBitmapHeight:longint;
0337 p0,p1,p2,o:longint;
0338 sText: string[255];
0339 illem:longint;
0340 begin 0341 pTubeLine := pTTubeLine(pCurrentTubeList~.TextList.Objects[TextLine-1]);
0342 iBitmapLine := pTubeLine~.iBitmapTop-pCurrentTubeList~.iCurrentSteppedTop;
0343 iBitmapHeight := pTubeLine~.iBitmapHeight;
0344 if (iBitmapLine+igitmapHeight<0) or (iBitmapLine>iTextBIockHeight-1) then 0345 exit;
0346 {$IFDEF NOSCROLL_LEADER}
0347 if iBitmapLine<0 then 0348 exit;
0349 {$ENDIF}
0350 {$IFDEF NOSCROLL TRAILER}
0351 if iBitmapLine+iBitmapHeight>(iTextBIockHeight-1) then 0352 exit;
0353 {$ENDIF}
0354 sText := pCurrentTubeList~.TextList.Strings[TextLine-1];
0355 iltem := pTubeLine~.iTimeStamp;
0356 with bmpPlayer.Canvas do begin 0357 Brush.Styte := bsClear;
0358 Font.Size := iTextFontSize;
0359 Font.Color := TEXT NORMAL;
0360 Font.Style := p;
0361 p0 := 1;
0362 0:= pTubeLine~.iBitmapLeft;
0363 if (0>0) and (iltem>0) then begin SUBSTITUTE SHEET (RULE 26) 0364 with spriteAAenuBullet do begin 036li Left := i'1i extBIockLeft+2"o;
0366 Top := ilfextBIockTop+iBitmapLine+2;-036.T o := o+Width+7 0368 end;
0369 BitmapDraw(spriteMenuBullet) 0371) end;
0371 while p0<=Length(sText) do begin 0372 p1 :_ (p0-1) + Pos('{', Copy(sText,p0,249));
037:3 p2 :_ ((p1+1)-1) + Pos('}',Copy(sText,p1+1,249));
0374 if p2>p1 then begin 037!i o := Drawlt(pTubeLine,sText,p0,p1-l,iBitmapLine,o,ScreenUpdate);
03713 Formatll:(sText,pl+1,p2-1);
0377 p0 := p2+1 03713 end 037!3 else begin 0380 0 := Drawlt(pTubeLine,sText,p0,249,iBitmapLine,o,ScreenUpdate);
038'1 p0 := 249 038:? end 0383 end 0384 end 0385 end;
0386 {__-___________________..___________________________}
038'7 procedure DrawList(var Tubet.ist: TTubeList);
0388 var 0389 iStartLine, iLastLine, iLine: iongint;
0390 TextBIockRect: TRect;
0391 begin 0392 if ~TubeList<>pCurrentTubeList then 039:3 exit;
0394 with pCurrentTube~ do begin 039.5 BitBlt(bmpPlayer.Canvas.Handle, 0396 iTextBIockLeft, iTextBIockTop, iTextBIockWidth, iTextBIockHeight, 039'7 Image.Canvas.Handle, (iTextBIockLeft-Left)+0, (iTextBIockTop-Top)+0, 0398 srcCOPI~;
0399 GetVisibIeLinesRange(iStartLine, iLastLine);
0400 for iLine := iStartLine to iLastLine do 0401 DrawLine(iLine+1, false);
0402 TextBIockRect := Bounds(iTextBIockLeft, iTextBIockTop, 0403 iTextBIockWidth, iTextBIockHeight);
0404 BitmapUpdateScreen(TextBIockRect) SUBSTITUTE SHEET (RULE 26) 0405 end 0406 end;
0407 {___~_____M___~___________________________]
0408 procedure SetTopLine(var TubeList: TTubeList; TopBitmapLine: longint);
0409 begin 0410 TubeList.iCurrentBitmapTop := TopBitmapLine;
0411 TopBitmapLine := SteppedBitmapLine(TubeList, TopBitmapLine);
0412 if TopBitmapLine = TubeList.iCurrentSteppedTop then 0413 exit;
0414 TubeList.iCurrentSteppedTop := TopBitmapLine 0415 end;
0416 {_______________~_________________________) 0417 procedure UpdateScroIlBar(var TubeList: TTubeList; BitmapLine: Iongint);
0418 begin 0419 if ~TubeList=pCurrentTubeList then 0420 ScroIIBarPosition(BitmapLine) 0421 end;
{_________________________________________________________________________) 0423 { Main code }
{_________________________________________________________________________}
0425 procedure TubeInitList(var spriteTube; var TubeList: TTubeList;
0426 LineSpacing, LeftOffsei: longint);
0427 var 0428 iLastLine, iLine: longint;
0429 iTime:longint;
0430 iTop: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 iTime := longint(TubeList.TextList.Objects[iLine]);
0440 TubeLlst.TextLlst.Ob]ects(ILlne] := TOb]ect(pTubeLlne);
0441 pTubeLine~.iTimeStamp := iTime;
0442 iSpace :_ -1;
0443 iSize := iTextFontSize;
SUBSTITUTE SHEET (RULE 26) 0444 GetLineSizes(TubeList.Textt_ist.Strings[iLine], iSpace, iSize);
0445 if iSpace=-1 then 0446 if LineSpaci~ng<0 then 0447 iSpace :=~ (iSize - LineSpacing) 0448 else 0449 iSpace :== LineSpacing;
0450 pTubeLine~.bE:nabled := true;
0451 pTubeLine".bH ightight := false;
0452 pTubeLine~.iMaxFontSize := iSize;
0453 pTubeLine".iBitmapLeft := LeftOffset;
0454 pTubeLine~.i8itmapTop := iTop;
0455 pTubeLine~.iBitmapHeight := iSpace;
0456 Inc(iTop,iSpac:e) 0457 end;
0458 TubeList.iCurrentBitmapTop := 0;
0459 TubeList.iCurrentSteppedTop := 0;
0460 TubeList.iBitmap~MaxTop :_ (iTop-1)-iTexlBIockHeight;
0461 if TubeList.iBitm:apMaxTop<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 := TubE:List.TextList.Count-1;
0472 for iLine := 0 to il_astLine do begin 0473 pTubeLine := jaTTubeLine(TubeList.TextList.Objects[iLine]);
0474 Dispose(pTub~eLine);
0475 TubeList.Textl_ist.Objects[iLine] := nil;
0476 end;
0477 TubeList.TextList.Free;
0478 TubeList.TextList := nil 0479 end;
0480 {_----___~.~_____,____~____________~_}
0481 procedure TubeRefresh(var TubeList: TTubeList);
0482 begin 0483 ScroIIBarAborlt;
0484 iLastTubeScra~ll :_ -1;
SUBSTITUTE SHEET (RULE 2fi~
0485 BitmapDraw(pCurreniTube~);
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 ~TubeList<>pCurrentTubeList then begin 0495 ScroIlBarAbort;
0496 pCurrentTubeList :_ ~TubeList;
0497 iLastTubeScroll :_ -1;
0498 if pCurrentTube<>TubeList.pTube then begin 0499 pCurrentTube := Tubet_ist.pTube;
0500 BitmapDraw(pCurrentTube~) 0501 end;
0502 TubeList.iCurrentSteppedTop := FORCE DRAW;
0503 BarSetRange(Scroll, TubeList.iBitmapMaxTop);
0504 UpdateScroIIBar(TubeList, TubeList.iCurrentBitmapTop);
0505 BarEnable(Scroll) 0506 end 0507 end;
0508 {______________________________________________) 0509 procedure TubeSetTopLine(var TubeLisf: TTubeList; TopTextLine: longint);
0510 begin 0511 UpdateScroIIBar(TubeList, 0512 pTTubeLine(TubeList.TextList.Objects[TopTextLine-1])~.iBitmapTop) 0513 end;
0514 {-_----_____M_~___ _____________M}
0515 procedure TubeSetAlINormal(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);
SUBSTITUTE SHfET (RULE 2fi) 0526 begin 0527 with pTTubeLine(TubeList.TextList.Objects[TextL.ine-1])~ do 0528 if not bHighlight then begin 0529 bHighlight := true;
0530 if ~Tubel_ist=pCurrentTubeList then 0531 DrawLine(TextLine,lrue) 0532 end 0533 end;
0534 {___________w___..__________________________}
0535 procedure TubeSetNormal(var TubeList: TTubeList; TextLine: longint);
0536 begin 0537 with pTTubeLine(TubeList.Textlist.Objects[TeotLine-1])~ do 0538 if bHighlight then begin 0539 bNighlight := false;
0540 if ~Tubel.ist=pCurrentTubeList then 0541 DrawLine(TextLine,true) 0542 end 0543 end;
0544 {_---________________.___________________________) 0545 procedure TubeSE~iEnable(var TubeList: TTubeList; TextLine: longint);
0546 begin 0547 with pTTubeLine(TubeList.TextList.Objects[TextLine-1 ])~ do 0548 if not bEnabled then begin 0549 bEnabled := true;
0550 if ~TubeL.ist=pCurrentTubeList then 0551 DrawLine(TextLine,true) 0552 end 0553 end;
0554 {__________~_______________________________) 0555 procedure TubeSEaDissable(var TubeList: TTubeList; Textl_ine: iongint);
0556 begin 0557 with pTTubeLine(TubeList.TextList.Objects[TextLine-1])~ do 0558 if bEnabied then begin 0559 bEnabled := false;
0560 if ~TubeL.ist=pCurrentTubeList then 0561 DrawLine(TextLine,true) 0562 end 0563 end;
0564 {--_--_-___ _____~____________~__) 0565 procedure TubeSEaTime(var TubeList: TTubeList; LineTime: longint);
0566 var SU B ST1TUTE S H E~T {RULE 26) 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 iLine2 :_ -1;
0579 iTime3 := 0; {kill compiler warning}
0580 iTimePrev := 0; {kill compiler warning}
0581 for iLine := 0 to iLasit-ine 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 := pTTubeLine(TubeList.TextList.Objects[iLine+1]).iTimeStamp;
0586 iTime3 :_ (iTimePrev+iTime2) div 2 0587 end 0588 else begin 0589 iTime2 := pTubeLine~.iTimeStamp;
0590 iTime3 := iTime2 0591 end;
0592 iTimePrev := pTubeLine~.iTimeStamp;
0593 if iTime2>LineTime then begin 0594 iLine2 := pTubeLine".iBitmapTop;
0595 iTextLine := iLine-1;
0596 break 0597 end 0598 end;
0599 if iLine2=-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 := pTubeLine~.iTimeStamp;
0606 iLinel := pTubeLine~.iBitmapTop 0607 end SUBSTITUTE SHEET (RULE 26) 0606 else begin 0609 iTimel := 0;
0610 iLinel := 0 0611 end;
0612 iTimeSpan := iTime3-iTimel;
0613 iLineSpan := iLine2-iLinel ;
0614 if iTimeSpan=0 then 0615 iScroll := iLine2 0616 else 0617 iScroll := iLine1 + (iLineSpan*(LineTime-iTime1)) div iTimeSpan 0616 end;
0619 iScroll := iScroll - ({iTextBIockHeight-iTextFontSize) div 2);
0620 if iScroll<0 then 0621 iScroil := 0;
062! if iScroll>TubeLiat.iBitmapMaxTop then 0623 iScroll := TubE:List.iBitmapMaxTop;
0624 if ~TubeList=pC,urrentTubeList then 0625 UpdateScroIIBar(TubeList, iScroll) 0626 else 0627 SetTopLine(TubeList, iScroll);
0626 for iLine := 0 to iLastLine do 0629 if iLine<>iTexllLine then 0630 TubeSetNormal(TubeList, iLine+1);
0631 if iTextLine>=0 tlhen 0632 TubeSetHighli~ght(TubeList, iTextLine+1}
0633 end;
_______________._____________________________________________________ 0635 { Printer support }
_______________._____________________________________________________ 0637 procedure TubePrint;
0636 var 0639 Printer: TextFile;
0640 iLine, iLastLine: Ilongint;
0641 p0, p1, p2, p9: Ic~ngint;
0642 sText, sprint: strung[250];
0643 begin 0644 frmRun.PrintDiafog.Options :_ [poWarningJ;
0645 if frmRun.PrintDiialog.Execute=False then 0646 exit;
SUBSTITUTE SHEET (RULE 2fi) 0647 try 0648 AssignPm(Printer) 0649 except _ 0850 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.Error1111essage('There is a problem with the printer!');
0658 try 0659 CIoseFile(Printer);
0660 except 0661 end;
0662 exit 0663 end;
0664 for iLine := 0 to iLastLine do begin 0665 sText := pCurreniTubet.ist".TextList.Strings[iLine];
0666 sprint :_ ' ;
0667 p0 := 1;
0868 p9 := Length(sText);
0669 while p0<=p9 do begin 0670 p1 :_ (p0-1)+Pos('{',Copy(sText,p0,249));
0671 if p1=(p0-1) then begin 0672 sprint := sprint + Copy(sText,p0,249);
0673 break 0674 end;
0875 sprint := sprint + Copy(sText,p0,(p1-p0));
0676 p2 :_ ((p1+1)-1)+Pos('}',Copy(sText,pl+1,249));
0877 if p2=((p1+1)-1) then 0678 break;
0679 p0 := p2+1;
0680 end;
0681 try 0682 WriteLn(Printer, sprint) 0683 except 0884 frmRun.ErrorMessage('There is a problem printing to the printerl');
0685 try 0686 CIoseFile(Printer);
0687 except SUBSTITUTE SHEET (RULE 26) 0688 end;
0689 exit 0690 end 0691 end;
0692 try 0693 CIoseFile(Printer);
0694 except 0695 end 0696 end;
{__________________._______________________________________________________}
0698 { Mouse support }
{_________________________________________________________________________}
0700 function TubeHit(X,Y: longint): fongint;
0701 var 0702 iMouseX, iMous~sY: longint;
0703 i8itmapLine:longint;
0704 begin 0705 result := 0;
0706 iMouseX := X-iTextBIockLeft;
0707 iMouseY := Y-iTextBIockTop;
0708 if (iMouseX<0) or (iMouseX>iTextBIockWidth-1) then 0709 exit;
0710 if (iMouseY<0) or (iMouseY>iTextBIockHeight-1) then 07i 1 exit;
0712 iBitmapLine := illAouseY + pCurrentTubeList~.iCurrentSteppedTop;
0713 if (iBitmapLine<0) or (iBitmapLine>pCurrentTubeList~.iBottomBitmapLine) then 0714 exit;
0715 result := 1 0716 end;
0717 {--____~~__..___~___________________}
0718 function TubeItemIHit(X,Y: longint): longint;
0719 var 0720 iMouseX, iMouseY: longint;
0721 iBitmapLine:longint;
0722 iLastLine, iLine: longint;
0723 iFoundLine: iongint;
0724 pTubeLine: pTT'ubeLine;
0725 begin 0726 result := 0;
SUBSTITUTE SHEET (RULE 26) 0727 iMouseX := X-iTextBIockLeft;
0728 iMouseY := Y-iTextBlockTop;
0729 if (iMouseX<0) or (iMouseX>iTextBIockWidih-1) then 0730 exit;
0731 if (iMouseY<0) or (iMouseY>iTextBIockHeight-1) then 0732 exit;
0733 iBitmapLine := iMouseY + pCurrentTubeList~.iCurrentSteppedTop;
0734 if (iBitmapLine<0) or (iBitmapLine>pCurrentTubeList".iBottomBitmapLine) then 0735 exit;
0736 iLastLine := pCurrentTubeList~.TextList.Count-1;
0737 iFoundLine :_ -2;
0738 for iLine := 0 to iLastLine do begin 0739 pTubeLine := pTTubeLine(pCurrentTubeList~.TextList.Objects(iLine]);
0740 if pTubeLine~.iBitmapTop = iBitmapLine then begin 0741 iFoundLine := iLine;
0742 break 0743 end;
0744 if pTubeLine~.iBitmapTop > iBitmapLine then begin 0745 iFoundLine := it_ine-1;
0746 break 0747 end 0748 end;
0749 if iFoundLine=-2 then 0750 iFoundLine := iLasiLine;
0751 if iFoundLine<0 ihen begin 0752 frmRun.SevereError('TubeItemHit - Mouse hit line -ve found!;
0753 exit 0754 end;
0755 with pTTubeLine(pCurrentTubeList~.TextList.Objects[iFoundLinej)~ do 0756 if bEnabled then 0757 result := iTimeStamp 0758 end;
{_________________________________________________________________________}
0760 { ScrollBar support ) {_________________________________________________________________________) 0782 procedure TubeScroIItTopBItmapLine: longint);
0763 begin 0764 SetTopLine(pCurrentTubeList~, TopBitmapLine);
0765 DrawList(pCurrentTubeList~);
SUBSTITUTE SHEET (RULE 26) 0766 if eCDPIayerState<>psPLAYING then 0767 wiih frmRun.tdobHint do 0768 if TopBitmapLine<>iLastTubeScroll then begin 0769 if IsDisplaying then 0770 ShowllAessage(sHintLastMsg, iHintLastX, iHintl_astY);
0771 iLastTub~eScroll := TopBitmapLine 0772 end 0773 end;
{_________________________________________________________________________}
0775 { Initalize I F~cit }
{_________________________________________________________________________}
0777 procedure Tubetnitiaiize;
0778 var 0779 I: string[50];
0780 p: integer;
0781 begin 0782 BitmapCreate(spriieTubelntro, frmMain.imgTube_Intro, true);
0783 BitmapCreate(spriteTubeText, frmMain.imgTube_Text, true);
0784 BitmapCreate(spriteTubeMenu, frmMain.imgTube_Menu, true);
0785 BitmapCreate(spriteMenuBullet, frmMain.imgMenu Bullei, tnue);
078 with bmpPlayer.Canvas do begin 078'1 Font.Assign(fnnRun.Font);
0788 iTextFontSize~ := Font.Size 0789 end;
0790 I := frmMain.imgiPlayer.Hint;
0791 p := Pos(',',I);
0792 iTextBIockLeft :== StrTolnt(Copy(1,1,p-1));
0793 I := Copy(I,p+1,19);
0794 p := Pos(',',I);
0795 iTextBIockTop :~= StrTolnt(Copy(i,1,p-1));
0796 I := Copy(I,p+1,99);
0797 p := Pos(',',I);
0798 iTextBIockWidth := StrTolnt(Copy(1,1,p-1));
0799 iTextBIockHeight := StrTolnt(Copy(I,p+1,99));
0800 pCurrentTube :_~ nit;
0801 pCurrentTubeList := nll;
0802 iLastTubeScroll :_ -1;
0803 end;
0804 {_-_--_____~___~__.~~~__________._~___}
SUBSTITUTE SHEET (RULE 26) WO 98/52189 PCT/tTS98/10035 0805 procedure TubeExit;
0806 begin 0807 BitmapDestroy(spriteMenuBullet);
0808 BitmapDestroy(spriteTubeText);
0809 BitmapDestroy(spriteTubelntro) 0810 end;
0811 end.
SUBSTITUTE SHEET (RULE 26) 0001 unit Video;
0002 l-$DEFINE KILLEIRASE}
0004 interface {__________________._____________________________________________________-__-}
0008 {$IFDEF WINDOUVS}
0007 uses 0008 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 0009 Forms, Dialogs, ExtCtrls, Registry, MPlayer, 0010 Run, Main, CDF'layer, Tube, Regions, Bitmaps, SysFig, Logging;
0011 {$ELSE}
0012 uses 0013 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 0014 ExtCtrls, StdCtrls, Registry, MPlayer, 0015 Run, Main, CDF'layer, Tube, Regions, Bitmaps, SysFig, Logging;
0016 {$ENDIF}
0017 {--_-_____w_~_,_______________________}
0018 type 0019 TfrmVideo = clas~s(TForm) 0020 pnVideo: TPane~l;
0021 mmVideo: TMediaPlayer;
0022 imgVideo: Tlma~ge;
0023 {_-__~______~~_.._______________________}
0024 procedure FormiCreate(Sender: TObject);
0025 procedure mmVideoNotify(Sender: TObject);
0026 {_-________~_~_.______~__________~}
0027 protected 0028 {$IFDEF KILLERA.SE}
0029 procedure FormiErase(var Msg: TWMEraseBkgnd);
0030 message WM_EraseBkgnd;
0031 {$ENDIF}
0032 end;
0033 type ~o~ {__ _~__~___~______________~___}
0035 TProc = Procedure;
0036 {-------_ ~_._____________________}
0037 const 0038 INTROVIDEO =~ 90;
0039 {-----____-------__-----_- -_________}
SUBSTITUTE SHEET (RULE 26) 0040 var 0041 bVideoAvailable: array [1..MAX_TRACKS] of Boolean;
0042 {_------- -------________~__________}
0043 procedure VideoStop;
0044 procedure VideoPlay(TrackNo: longint; xFinished: Tproc);
0045 procedure Videolnitiaiize0;
0046 procedure Videolnitialize;
0047 procedure VideoExit;
0048 { __~___~_~ _w_______~~_}
0049 var 0050 fmzVideo: TfrmVideo;
{_-_______________________________________________________________________}
0052 implementation 0053 {$R *.DFM}
{_______________________________________________________________________-__}
0055 var 0056 VideoRegion: hRGN;
0057 endVideo: TProc;
0058 iVideoOffsetLeft, iVideoOffsetTop: longint;
0059 iVideoWidth, iVideoHeight: longint;
{_______________________________________________________________________-__-}
0061 { Main Code }
{_________________________________________________________________________}
0063 procedure VideoStop;
0064 var 0065 TubeRect: TRect;
0066 begin 0067 with frmVideo.mmVideo do begin 0068 TimeFormat := tfMilliseconds;
0069 LoggingLoglt(IeVIDEO, Position div 100);
0070 try 0071 Wait := true;
0072 Notify := false;
0073 Stop;
0074 except 0075 end 0076 end;
SUBSTITUTE SHEET (RULE 2fi) 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(IeVIDEO, Position div 100);
0089 try 0090 Wait := truce;
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.p~nVideo 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 := frtnRun.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\Intro.mpg' 0117 else SUBSTITUTE SHEET (RULE 26) 0118 FifeName := sRunDirectory+'StufflVideo'+IntToStr(TrackNo)+'.mpg';
0119 Wait := true;
0120 Notify := false;
0121 Open 0122 except 0123 if TrackNo<>INTROVIDEO then 0124 frmRun.ErrorMessage('There 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;
0138 frmRun.ErrorMessage('There is a problem with video playback!');
0137 xFinished 0138 end;
0139 LoggingEvent(IeVIDEO, IsOTHER, TrackNo, 0) 0140 end 0141 end;
{_________________________________________________________________________}
0143 { Video Play end processing }
{_______________________________________________________________________-__}
0145 procedure TFrmVideo.mmVideoNotify(Sender: TObject);
0148 var 0147 ev: TProc;
0148 begin 0149 frmVideo.Hide;
0150 with frmVideo.mmVideo do begin 0151 TimeFormat := tfMilliseconds;
0152 Loggingl_oglt(IeVIDEO, Position div 100) 0153 end;
0154 ev := endVideo;
0155 endVideo := nil;
0156 if Assigned(ev) then SUBSTITUTE SHEET (RULE 26) 0157 ev 0158 end;
0159 {_ _~__~_____~__________~______} _ 0160 {$IFDEF KILLERASE}
0181 procedure TfrmVideo.FormErase(var Msg: TWMEraseBkgnd);
016 begin 0163 Msg.Result := LI~ESULT(False) 0164 end;
0165 {$ENDIF}
{_________________________________________________________________________}
0167 { Initialize and exit }
{_________________________________________________________________________}
0169 procedure TfrmVideo.FormCreate(Sender: TObject);
0170 var 0171 p:longint;
0172 I: string[50];
0173 begin 0174 I := imgVideo.Hint;
0175 p := Pos(',',I);
0176 iVideoOffsetLeft := StrTolnt(Copy(1,1,p_1));
0177 iVideoOffsetTop~ := StrTolnt(Copy(I,p+1,99));
0178 iVideoWidth := imgVideo.Width;
0179 iVideoHeight := imgVideo.Height;
0180 {$IFNDEF WINDOWS}
0181 Outlinelmage( irngVideo.Canvas, 018 imgVideo.Height, imgVideo.Width, 0183 VideoF;egion);
0184 SetWindowRgnl; Handle, VideoRegion, False);
0185 {$ENDIF}
0186 end;
0187 {_---__~__~~__ _________~___~~}
0188 procedure Videolnitialize0;
0189 var 0190 Reg: TRegistry;
019'1 sKey, sValue: string;
019 begin 0193 Reg := TRegistry.Create;
0194 Reg.RootKey := HKEY CURRENT USER;
0195 sKey :='\Softwa~reWlicrosoftWIuItimedia~ActiveMovie FiltersUIIPEG
Decoder;
SUB STTTUTE S H EET (RULE 26) 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,l) 0211 end 0212 except 0213 end;
0214 Reg.Free;
0215 frmVideo := TfrmVideo.Create(nil);
0216 with frmVideo.mmVideo do 0217 try 0218 FileName := sRunDirectory+'Stuff\Intro.mpg';
0219 Wait := true;
0220 Notify := false;
0221 Open 0222 except 0223 end .
0224 end;
0225 {-_-____ _~______~____w_}
0226 procedure Videolnitialize;
0227 var 0228 (Video: TextFile;
0229 iTrack:lnteger;
0230 begin 0231 for iTrack := 1 to iAudioTracks do begin 0232 bVideoAvailable[iTrack] := true;
0233 try 0234 AssignFile(fVideo, sRunDirectory+'Stuff\Video'+IntToStr(iTrack)+'.mpg');
0235 Reset(fVideo);
0236 CIoseFile(fVideo) SUBSTITUTE SHEET (RULE 26) 0237 except 0238 bVideoAvailable[iTrack] := false 0239 end 0240 end;
0241 endVideo := nil;
0242 end;
0243 { _ ___..~____________w~___}
0244 procedure VideoF~ctt;
0245 begin 0246 frmVideo.Free 0247 end;
0248 end.
SUBSTITUTE SHEET (RULE 26) 0001 unit Volumbar;
{--_____________________________________ ______________________________-}
0003 interface {_________________________________________________________________________}
0005 {$IFDEF WINDOWS}
0006 uses 0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 0008 Forms, Dialogs, MMSystem, MPlayer, LMDnonvS, 0009 Run, Main, BitBars, Video;
0010 {$ELSE}
0011 uses 0012 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 0013 ExtCtrls, StdCtrls, MMSystem, MPlayer, LMDnonvS, 0014 Run, Main, BitBars, Video;
0015 {$ENDIF}
0016 {______________~________________________}
0017 procedure VolumeBarlnitialize;
0018 procedure VolumeBarExit;
0019 procedure VoiumeBackgroundProcess;
0020 procedure VolumeBarMouseDown;
0021 procedure VolumeBarMouseUp;
0022 procedure VolumeBarMouseDrag( x, y: longlnt);
0023 procedure VolumeBarMouseMove(X,Y: longint);
0024 procedure VolumeBarTimerTick;
0025 {__w__~_ ~_ ______~________}
0028 var 0027 Volume: TBar;
{-________________________________________________________________________}
0029 implementation {_________________________________________________________________________}
0031 const 0032 NO VOLUME = $FFFF;
0033 {_____~_______~__________________~__w__}
0034 var 0035 wCDVolumeld: word;
0036 bVolumeBarMouseDown: Boolean;
0037 iHintltem:longint;
SUBSTITUTE SHEET (RULE 26) 0038 iHintX, iHintY: la~ngint;
0039 iHintDelayTimer:longint;
0040 sHintMsg: string[250j;
0041 bHintVisible: Boolean;
0042 blnHintArea: Boolean;
0043 {_-_--_--___ _____________________________}
0044 procedure SetVolu~me(NewVolume: longint); forward;
0045 function GetVolume: longing forvvard;
0047 { Local Routines }
{________________________________________________________________________=}
0049 procedure SetVotu~me(NewVolume: longint);
0050 begin 0051 auxSetVolume(vvCDVolumelD, (NewVolume shl 16) or NewVolume) 0052 end;
0053 {___________ _______________________________}
0054 function GetVolume: longint;
0055 var 0056 dwVolume: longing 0057 begin 0058 auxGetVolume(vvCDVoiumeld, '(,aDdwVolume);
0058 result :_ (dwVolume and longint($FFFF)) 0060 end;
{_______________________________________________________________________-__}
0062 { Background processing }
{______________________________________________________________________ __}
0064 procedure Voiumel3ackgroundProcess;
0065 begin 0066 if (frmRun.mmCommentary.Mode=mpPLAYING) or 0067 (frmVideo.mmVideo.Mode=mpPLAYING) then begin 0068 BarDissabletl/olume);
0069 exit 0070 end 007'1 else begin 0072 BarEnable(Vcdume) 0073 end;
0074 if not bVolumeBarMouseDown then SUBSTITUTE SHEET (RULE 26~
WO 98!52189 PCT/US98/10035 0075 BarSetPosition(Volume, longint($FFFF)-GetVolume) 0076 end;
{_________________________________________________________________________}
0078 { Mouse Handling }
{_________________________________________________________________________~
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.bIobHini.HideMessage;
0089 bHintVisible := false 0090 end;
0091 BarMouseMoveStart(Volume);
0092 bVolumeBarMouseDown := true;
0093 end 0094 end;
0095 {_________________________w___________________}
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.iSIidePosition) 0110 end 0111 end;
0112 {______~_~~__~__________________w}
0113 procedure VolumeBarMouseMove(X,Y: longint);
SUBSTITUTE SHEET (RULE 26) 0114 var 0115 iltem:longint;
0115 xl,yl:longint; _ 0117 label 0118 exitl ;
011 U begin 0120 if not Volume.bE:nabled then 0121 goto exitl ;
0122 if not Volume.bE:nabled then 0123 goto exitl ;
0124 if bVolumeBarMouseDown then 0125 goto exitl ;
0126 iHintX := frmRun.Left+X+5;
0127 iHintY := frmRurt.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 0138 if iltem<>iHintltem then begin 0137 iHintDelayTimer := HINT DELAY;
0138 iHintltem :_= iltem 0138 end;
0140 exit 0141 end;
0142 exitl:
0143 iHintDelayTimer := 0;
0144 iHintltem := 0;
0145 if bHintVisible then begin 0146 frmRun.blob~lint.HideMessage;
0147 bHintVisible :~= false 0148 end 0148 end;
0150 {__~___~________.____________________________}
015 t procedure VolumeIBarTimerTick;
0152 begin 0153 if not Volume.bE:nabled then 0154 exit;
SUBSTITUTE SHEET (RULE 26) WO 98/52189 PCT/fJS98/10035 0155 if iHintDelayTimer=0 then 0156 exit;
0157 Dec(iHintDelayTimer); _ 0158 if iHintDelayTimer=0 then begin 0159 if bHintVisible then 0160 frmRun.bIobHint.HideMessage;
0161 iHintLastX := iHintX;
0162 iHintLastY := iHintY;
0163 sHintLastMsg := sHintMsg;
0164 frmRun.biobHint.Position := hpAboveRight;
0165 frmRun.bIobHint.ShowMessage(sHintMsg, iHintX, iHintY);
0166 bHintVisibie := true 0167 end 0168 end;
{_________________________________________________________________________}
0170 { Initialize and exit }
{_________________________________________________________________________}
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 iLas#Aux do begin 0181 if auxGetDevCaps(iAux, ~AuxCaps, SizeOf(TAuxCaps))=0 then 0182 if (auxcaps.wTechnoiogy=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 SUBSTITUTE SHEET (RULE Z6) 0194 end 0195 end;
0196 Barlnitialize(Volume, frmMain.imgVolume_Back, 0197 frmMain.imgVolume_Rod, frmMain.imgVolume_Button, 0198 fm~Main.imgVolume Endl, frmMain.imgVolume_End2);
0199 BarSetRange(Volume, longint($FFFF));
0200 if wCDVotumeld<:>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 VolumeE~arExit;
0212 begin 0213 BarF~cit(Volume) 0214 end;
0215 end.
SUBSTiTUTF SHEET (RULE 26~
0001 unit Wall;
~_-_____________________________________________________________________-_}
0003 intertace ~_______________________________________________________________________-_-_}
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 {_____________M_______________________________}
0015 function WaIIpaperOurslnstalled: Boolean;
0016 function UsingThisWalfpaper(const ThisWalipaper: string): Boolean;
0017 function UsingWallpaper: Boolean;
0018 function UsingOurWallpaper: Boolean;
0019 function SeiWallpaper(const WaIIpaperName, WaIIpaperTile: string):
Boolean;
0020 procedure GetWalipaper( var WaIIpaperName, WaIIpaperTile: string);
{_________________________________________________________________________}
0022 implementation {_______________________________________________________________________-__-}
0024 uses 0025 Sysfig;
{_______________________________________________________________________-_-_}
0027 { Code }
{________________________________________________________________________--_}
0029 function WallpaperOurslnstalled: Boolean;
0030 var 0031 fWallpaper: TextFile;
0032 begin 0033 try 0034 AssignFile(fWallpaper, sWindowsDirectory+iniWallpaper);
0035 Reset(fWalipaper);
SUBSTITUTE SHEET (RULE 26) 0036 CIoseFile(fWallpaper);
0037 result := true 0038 except -0039 result := false 0040 end 0041 end;
0042 {_____________________._________________________~_}
0043 function UsingThisWallpaper(const ThisWaBpaper: string): Boolean;
0044 var 0045 Reglni: TReginiFile;
0046 begin 0047 Regini := TregIniFile.Create('Control Panel');
0048 result :_ (RegIni.ReadString('desktop', 'Wallpaper', ")=ThisWallpaper);
0049 RegIni.Free 0050 end;
0051 {_-___________________._____________________________) 0052 function UsingWallpaper: Boolean;
0053 begin 0054 result := not UsingThisWallpaper(");
0055 end;
0056 {-_______________________________________________) 0057 function UsingOurWallpaper: Boolean;
0058 begin 0059 result := UsingT'hisWallpaper(sWindowsDirectory+iniWallpaper+'.bmp');
0060 end;
0061 {___________~____________~_______~______________) 0062 function SetWallpaper( const WaIIpaperName, WaIIpaperTile: string):
booiean;
0063 var 0064 Reglni: TRegIniFile;
0065 begin 0066 result := true;
0067 try 0068 Reglni := TregIniFiie.Create('Control Panel') 0069 except 0070 exit 0071 end;
0072 try 0073 RegIni.Write~String('desktop', 'Wallpaper', WalipaperName);
0074 RegIni.WriteString('desktop', 'TileWallpaper', WaIIpaperTile);
0075 SystemPararneterslnfo(SPI SETDESKWALLPAPER, 0, nil, SPIF_SENDWININICHANGE) 0076 except SUBSTITUTE SHEET (RULE 26) 0077 RegIni.Free;
0078 exit 0079 end;
0080 RegIni.Free;
0081 result := false 0082 end;
0083 {___________~________________________________}
0084 procedure GetWallpaper( var WallpaperName, WallpaperTile: string);
0085 var 0086 Reglni: TRegIniFile;
0087 begin 0088 WaIIpaperName :_ ";
0089 WaIIpaperTile :_ '0';
0090 try 0091 Reglni := TregIniFile.Create('Control Panel') 0092 except 0093 exit 0094 end;
0095 try 0096 WaIIpaperName := RegIni.ReadString('desktop', 'Wallpaper', ");
0097 WaIIpaperTile := RegIni.ReadString('desktop', 'TileWallpaper', '0') 0098 except 0099 end;
0100 RegIni.Free 0101 end;
0102 end.
SUBSTITUTE SHEET (RULE 26) 0001 unit Words;
0003 interface {_-______________________________________________________________________-_-}
0005 {$1FDEF WINDOWS}
OOOS uses OOOJ SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 0008 Forms, Dialogs, LMDnonvS, OOOg Run, Main, Tube, CDPlayer, SysFig;
0010 {$ELSE}
0011 uses 0012 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 0013 ExtCtrls, StdCtrls, LMDnonvS, 0014 Run, Main, Tube, CDPlayer, SysFig;
0015 {$ENDIF}
0016 {_-____.______________.,____________________________}
001 var 0018 TheWords: array [1..MAX_TRACKS] of TTubeList;
0010 {_________________.____..____________________________}
0020 procedure Wordslnitialize;
002'1 procedure WordsE:xit;
0022 procedure WordsNewTrack(TrackNo: longint);
0023 procedure WordsMouseDown;
0024 procedure WordsMouseMove(X,Y: longint);
0025 procedure WordsTimerTick;
_______________._____________________________________________________ 002'T implementation {__________________._______________________________________________________}
0028 var 0030 iHintX, iHintY: longint;
0031 iHintDelayTimei°:longint;
0032 sHintMsg: string[250];
0033 bHintVisible: Boolean;
0034 blnHintArea: Boolean;
~_-________________._____________________________________________________-_-_}
0036 { Code }
SUBSTITUTE SHEET (RULE 26) {_________________________________________________________________________) 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;
{_________________________________________________________________________) 0046 { Mouse Handling }
{_________________________________________________________________________) 0048 procedure WordsMouseDown;
0049 var 0050 iWordsTime:longint;
0051 begin 0052 if eTubeModeState<>tmWORDS then 0053 exit;
0054 iWordsTime := TubeltemHit(iMOuseDownX,iMOuseDownY);
0055 if (iWords'fime>0) and (iWordsTime<9999) then begin 0056 iHintDelayTimer := 0;
0057 if bHintVisible then begin 0058 frmRun.bIobHint.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 eTubeModeState<>tmWORDS 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;
SUBSTITUTE SH E~T (RULE 26) 0075 if bHintVisible then begin 0078 frmRun.bIobHint.HideMessage;
0077 bHintVisible :== false 0078 end;
0079 iHintDelayTimer := HINT DELAY;
0080 exit;
0081 exit1:
0082 iHintDelayTimer := 0;
0083 if bHiniVisibie then begin 0084 frmRun.bIobHint.HideMessage;
0085 bHintVisible :=~ false 0086 end 0087 end;
0088 {_____________w___..__________________________}
0089 procedure WordsTimerTick;
0090 begin 0091 if iHintDelayTimer=0 then 0092 exit;
0093 Dec(iHintDelayTiimer);
0094 if iHintDelayTime;r=0 then begin 0095 if bHintVisible then 0096 frmRun.blobHint.HideMessage;
0097 iHintLastX := iHiniX;
0098 iHintLastY := iHintY;
0099 sHintLastMsg := sHintMsg;
0100 if eCDPIayerState=psPLAYING then begin 0101 frmRun.bIobHint.Position := hpAbovei.eft;
0102 frmRun.bIobHint.ShowMessage(sHintMsg, frmRun.Left+312, frmRun.Top+55) 0103 end 0104 else begin 0105 frmRun.bIobHint.Position := hpAboveRight;
0106 frmRun.bIobHint.ShowMessage(sHintMsg, iHintX, iHintY) 0107 end;
0108 bHintVisible :_ true 0109 end 0110 end;
{___________________.______________________________________________________}
0112 { Initalize / Exit }
{___________________.______________________________________________________}
SUBST1TUT~ SHEET (RULE 26) 0114 procedure Wordslnitialize;
0115 var 0116 fWords: TextFile;
0117 iTrack:lnteger;
0118 I: string[250];
0119 begin 0120 for iTrack := 1 to iAudioTracks do begin 0121 AssignFile(fWords, sRunDirectory+'Stuff\Words'+IntToSir(iTrack)+'.txt');
0122 Reset(fWords);
0123 ReadLn(fWords, I);
0124 iAudioTrackLength[iTrack] := 10"StrTolnt(I);
0125 TheWords[iTrack].TextList := TStringList.Create;
0126 while not Eof(fWords) do begin 0127 ReadLn(fWords, I);
0128 TheWords[iTrackJ.TextList.AddObject(Copy(1,7,255), 0129 Pointer(StrTolnt(Copy(1,1,5))));
0130 end;
0131 CIoseFile(fWords);
0132 TubeInitList(spriteTubeText, TheWords[iTrack], -3, 0);
0133 end;
0134 sHintMsg :_ 'Click the words to jump there.';
0135 iHintDelayTimer := 0;
0136 bHintVisible := false;
Oi37 blnHintArea := false 0138 end;
Oi 39 (___________________~_______________________________) 0140 procedure WordsExit;
0141 var 0142 iTrack:lnteger;
0143 begin 0144 for iTrack := 1 to iAudioTracks do 0145 TubeF~ciiList(TheWords[iTrack]) 0146 end;
0147 end.
SUBSTITUTE SHEET (RULE 26) 0001 unit Loglt;
~__________________._____________________________________________________-_-_}
000;3 intertace {==r_______________._______________________________________________________}
0005 uses Forms, Windows, SysUtils, Registry, ipwHTTP, 0006 Main;
0007 {_--___~___~_.._________________~}
0008 procedure LogSend(const CDhandle: string);
0009 procedure Log ipwHTTPStartTransfer;
001 U procedure Log ipwHTTPTransfer(const Text: String);
0011 procedure Log ipwHTTPEndTransfer;
0012 procedure Log ipwHTTPError;
{__________________._______________________________________________________}
0014 implementation {__________________._______________________________________________________}
0016 type 0017 EVoteSendFailure = class(Exception);
0018 {__~_____~______..________________________}
0019 var 0020 bHTTPDone, 0021 bHTTPAckOK: Boolean;
0022 sResponse: string;
0023 sAckOK: string =~ 'Status: Complete';
{__________________.______________________________________________________-_}
0025 { Main Code }
{-_________________._______________________________________________________}
0027 procedure IogSend(const CDhandle: string);
0028 var 0029 iln, i0ut: longint;
0030 iOutNew, iOutOld: longint;
0031 iEntry:longint;
0032 sURLVote: string;
0033 sVote: string;
0034 iChunk: integer;
0035 bNoEntries: boollean;
SUBSTITUTE SHEET (RUL~ 26) 0036 bVoteEnabled: Boolean;
0037 begin 0038 bVoteEnabled := false; _ 0039 TheRegistry.RootKey := HKEY LOCAL MACHINE;
0040 sKey :_ '1SOFTWARE\PalantirllQcd\'+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.CIoseKey;
0048 exit 0049 end;
0050 TheRegistry.CIoseKey;
0051 if not bVoteEnabled then 0052 exit;
0053 TheRegistry.RootKey := HKEY LOCAL MACHINE;
0054 sKey :_ '1SOFTV11ARE\Palantir\IQcd\'+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.CIoseKey;
0062 exit 0063 end;
0064 TheRegistry.CIoseKey;
0065 TheRegistry.RootKey := HKEY LOCAL MACHINE;
0066 sKey :='1SOFTWAREIPalantirllQcd\'+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.CIoseKey;
0075 exit 0076 end;
SUBSTITUTE SHEET (RULE 26) 0077 TheRegistry.CIoseKey;
0078 TheRegistry.RootKey := HKEY LOCAL MACHINE;
0079 sKey :_ '\SOFT~JVARE\F'alantir\IQcd\'+CDhandle+'\Vote';
ooso try 0081 if TheRegistry.OpenKey(sKey,true) then begin 0082 if not TheRegistry.ValueExists('In') then begin 0083 TheRegistry.Writelnteger('In',1);
0084 iln := 1 0085 end 0086 else begin 0087 iin := TheRegistry.Readlnteger('In') 0088 end;
0089 if not TheRegistry.ValueExists('Ouf) then begin 0090 TheRegistry.Writelnteger('Out',1);
0091 i0ut :_ '1 0092 end 0093 else begin 0094 i0ut :='fheRegistry.Readlnteger('Out') 0095 end 0096 end 0097 else begin 0098 exit 0099 end 0100 except 0101 TheRegistry.~~loseKey;
0102 exit 0103 end;
0104 if i0ut>=iln then begin 0105 TheRegistry.CIoseKey;
0106 exit 0107 end;
0108 if regTnace then 0109 frmMain.IbTrace.Items.Add(' ... send log for'+CDhandle);
0110 if regTrace then 0111 frmMain.IbTrace.Items.Add("+IntToStr(i0ut)+','+IntToStr(iln-1));
0112 iOutOld := i0ut;
0113 iOutNew := i0ut;
0114 bNoEntries := five;
0115 sVote := sURLVote;
0116 try 0117 for iEntry := i0u1 to i0ui+(iChunk-1) do begin SUBSTITUTE SHEET (RULE 26) 0118 if iEntry>=iln then 0119 break;
0120 try _ 0121 sVote := sVote+
0122 TheRegistry.ReadString(Format('x%.9d', [iEntryJ))+
0123 '%OA' 0124 except 0125 end;
0126 iOutNew := iEntry+1;
0127 bNoEntries := false 0128 end;
0129 if bNoEntries then begin 0130 TheRegistry.CIoseKey;
0131 exit 0132 end;
0133 bAlIVotesEmpty := false;
0134 if frmMain.ipwHTTP.Action<>httpldle then 0135 raise EVoteSendFailure.Create('HTTP not idle at start.');
0136 sResponse :_ 'None';
0137 bHTTPDone := false;
0138 bHTTPAckOK := false;
0139 frmMain.ipwHTTP.Action := htlpResetHeaders;
0140 while frmMain.ipwHTTP.Action<>httpldle do;
0141 frmMain.ipwHTTP.URL := sVote;
0142 frmMain.ipwHTTP.Action := httpGet;
0143 while not bHTTPDone do;
0144 if bHTTPAckOk then begin 0145 i0ut := iOutNew;
0146 TheRegistry.Writelnteger('Out', i0ut);
0147 try 0148 for iEntry := iOutOld to iOutNew-1 do begin 0149 sValue := Format('x%.9d', [iEntryJ);
0150 if TheRegistry.ValueExists(sValue) then 0151 TheRegistry.DeleteValue(sValue) 0152 end 0153 except 0154 end 0155 end 0156 else begin 0157 raise EVoteSendFailure.Create('Vote send failure.') 0158 end SUBSTITUTE SHEET (RULE 26) 0159 except 0160 TheRegistry.C:loseKey;
0161 exit 0162 end 0163 end;
0164 {_-____________~__.________________________}
0165 procedure Log ipwHTTPStartTransfer;
0166 begin 0167 sResponse :_ "
0168 end;
0169 {-_---__~____..____.__._______________}
0170 procedure Log ipwHTTPTransfer(const Text: String);
0171 begin 0172 sResponse := sF;esponse+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 := firue;
0181 frmMain.IbTrace.Items.Add('Response -'+sResponse) 0182 end;
0183 {_--_--_____~_______._~_____________________}
0184 procedure Log ipwIHTTPError;
0185 begin 0186 bHTTPDone := true;
0187 bHTTPAckOK := false 0188 end;
0189 end.
SUBSTITUTE SHEET (RULE 26) 0001 unit Main;
{_________________________________________________________________________) 0003 intertace {_________________________________________________________________________}
0005 uses 0006 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 0007 StdCtrls, 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: TLMDOnefnstance;
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; BytesTransferred: Inleger;
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 repExitOnEmpty: Boolean;
0037 bWinsockAccessOk: Boolean = false;
0038 sPaIHandle: string;
0039 sPaIZip, sPalAge, sPaISex: string;
SUBSTITUTE SHEET (RULE 26) 0040 bAltVotesEmptyO~, bAIlVotesEmpty: Boolean;
{___________________.______________________________________________________}
0042 implementation 0043 {$R *.DFM}
{___________________.______________________________________________________}
0045 uses 0046 Loglt;
0047 {______________~_M__________________________}
0048 var 0049 bDialerCheck: Boolean = false;
0050 bWinsockAccessOkO: Boolean = false;
0051 CD: TStrings;
0052 iTimerBusy: intecter = 0;
{___.________________.______________________________________________________}
0054 { Local Routines }
{__________________________________________________________________________}
0056 function GetPalUser(const Value: siring): string;
0057 begin 0058 result :_ '?';
0059 TheRegistry.RootKey := HKEY LOCAL MACHINE;
0060 sKey :='\SOFTV~JARE\PatantirlUser';
0061 try try 0062 if TheRegistry.OpenKey(sKey,false) then 0063 if TheRegistry.ValueExists(Value) then 0064 result :_ 'TheRegistry.ReadString(Value) 0065 except 0066 end 0067 finally 0068 TheRegistry.CIoseKey 0069 end 0070 end;
0071 {__-________ ~__.__________________________}
0072 procedure GetPallnfo;
0073 var 0074 i: integer;
0075 begin 0076 sPaiHandle :_ ";
SUBSTITUTE SHEET (RULE 26) 0077 TheRegis#ry.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 sPaIHandle := TheRegistry.ReadString(sValue) 0084 end 0085 else begin 0086 for i := 1 to 10 do 0087 sPaIHandle := sPaIHandle + Chr(Ord('A')+Random(26));
0088 TheRegistry.WriteString(sValue,sPaIHandle) 0089 end 0090 except 0091 end 0092 finally 0093 TheRegistry.CIoseKey 0094 end;
0095 if sPalHandle=" then 0096 sPaIHandle :_ 'XXXXX~UUUC';
0097 sPaIZip := GetPalUser('Zip');
0098 sPalAge := GetPalUser('Age');
0099 sPaISex := GetPalUser('Sex');
0100 end;
0102 { Main Code }
{_________________________________________________________________________}
0104 procedure TfrmMain.tmTimerTimer(Sender: TObject);
0105 var 0106 iCD1, iCD: integer;
0107 label 0108 WinsockUpdate;
0110 begin 0111 if iTimerBusy>0 then 0112 exit;
0113 Inc(iTimerBusy);
0114 if not bWinsockAccessOk then 0115 goto WinsockUpdate;
SUBSTITUTE SHEET (RULE 26) 0116 if regTrace then begin 0117 if bWinsockAccessOk and not bWinsockAccessOkO then begin 0118 IbTrace.Items.Add('<Dialer activated>');
0119 IbTrace.Items.Add(") 0120 end;
012'1 if bWinsockAccessOkO and not bWinsockAccessOk then begin 0122 IbTrace.Items.Add('<Dialer shut down>');
0123 IbTrace.Items.Add(") 0124 end 0125 end;
0126 bWinsockAcces;sOkO := bWinsockAccessOk;
012'7 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 013'7 TheRegistry.CIoseKey;
0138 if iTimerBusy>0 then 0139 Dec(iTimerBusy);
0140 exit 0141 end;
0142 TheRegistry.CIoseKey;
0143 GetPallnfo;
0144 bAlIVotesEmptyO := bAlIVotesEmpty;
0145 bAlIVotesEmpty := true;
0146 iCD1 := CD.Count-1;
0147 frmMain.ipwHTlfP.WinsockLoaded := true;
0148 for iCD := 0 to i(~D1 do 0149 LogSend(CD.Strings[iCD]);
0150 frmMain.ipwHl'"~P.WinsockLoaded := false;
0151 if bAlIVotesEmp~ty and not bAlIVotesEmpiyO then begin 0152 if regTrace then begin 0153 IbTrace.Items.Add(");
0154 IbTrace.Items.Add('<All Votes Empty>');
0155 IbTrace.Items.Add(") 0156 end;
SUBSTITUTE SHEET (RULE 26) 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 := ntdLisiConnections 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; coast Entry, DeviceName, DeviceType, 0178 StatusDescription: String);
0179 begin 0180 if (DeviceName<>") or (DeviceType<>") or (StatusDescription<>") then 0181 bWinsockAccessOk := true 0182 end;
0183 {-______~___________________________________) 0184 procedure TfrtnMain.ipwHTTPStartTransfer(Sender: TObject);
0185 begin 0186 Log ipwHTTPStartTransfer 0187 end;
0188 { ___~ ~________________________) 0189 procedure TfrmMain.ipwHTTPTransfer(Sender: TObject;
0190 BytesTransfen-ed: Integer; Text: String);
0191 begin 0192 Log ipwHTTPTransfer{Text) 0193 end;
01 A4 {_-_--__~_ ______~____________~______~
0195 procedure TfrmMain.ipwHTTPEndTransfer(Sender: TObject);
0196 begin 0197 Log ipwHTTPEndTransfer SUBSTITUTE SHEET (RULE Z6) 0198 end;
0199 {_----_________ ~_.._______________________}
0200 procedure TfrmMain.ipwHTTPError(Sender: TObject; ErrorCode: Integer;
0201 const Description: String);
0202 begin 0203 Log ipwHTTPError 0204 end;
{______________________________________________________________________ __}
0206 { Initalize I Exit }
{_________________________________________________________________________}
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 bAlIVotesEmpty := false;
0217 bAlIVotesEmptyO := false;
0218 TheRegistry := TRegistry.Create;
0219 CD := TStringLisl.Create;
0220 {----- set send control flags }
0221 regTrace := false;
0222 regExilOnEmpty := true;
0223 TheRegistry.RootKey := HKEY LOCAL_MACHINE;
0224 sKey :='\SOFTW'ARE\PalantirllQcd ;
0225 sValue :_ 'Trace';
0226 try 0227 if TheRegistry.OpenKey(sKey,true) then 0228 if TheRegistny.ValueExists(sValue) then 0229 regTrace := TheRegistry.ReadBool(sValue) 0230 except 0231 end;
0232 Application.ShowMainForm := regTrace;
0233 TheRegistry.RootKey := HKEY LOCAL MACHINE;
0234 sKey :='\SOFTW'ARE\PalantirllQcd';
0235 sValue :_ 'ExitOnEmpty ;
0236 try SUBSTITUTE SHEET (F~ULE 26) 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.HasBindToDiaIUP 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 IbTrace.Items.Add('<Server Start>');
0253 IbTrace.Items.Add(");
0254 if TCPinfo.HasAutoDiaISetup then 0255 IbTrace.items.Add(' ... uses autodial');
0256 if TCPinfo.HasTCPIP then 0257 IbTrace.Items.Add(' ... networking has TCP/IP protocol');
0258 if TCPinfo.HasDialup then 0259 IbTrace.Items.Add(' ... networking has dial-up adapter');
0260 if TCPinfo.HasBindToDialUp then 0261 IbTrace.Items.Add(' ... dial-up adapter bound to TCP/IP');
0262 if TCPinfo.HasModem then 0263 IbTrace.ltems.Add(' ... has modem');
0264 if TCPinfo.HasTCPIP then 0265 if bWinsockAccessOk then 0266 IbT~ace.Items.Add(' --> Winsock access always allowed') 0267 else 0268 IbTrace.Items.Add(' --> Winsock access only when modem active') 0269 else 0270 IbTrace.Items.Add(' --> No Winsock access allowed (no TCP/IP)');
0271 IbTrace.Items.Add('~
0272 end;
0273 {--------- lets go }
0274 tmTimer.Enabled := true 0275 end;
0276 {__________~_ __~_~_____________~_}
0277 procedure TfrmMain.FormClose(Sender: TObject; var Action: TCIoseAction);
SUBSTITUTE SHEET (RULE 26) 0278begin 0279tmTimer.Enabled := true;
0280CD.Free;
0281CD := nil;
0282TheRegistry.Free;
0283TheRegistry :=
nil 0284end;
0285end.
SUBSTITUTE SHEET (RULE 26) program Vote;
{$R '. RES}
uses Forms, Windows, Registry, Main in 'Main.pas' {frmMain}, Loglt in 'Loglt.pas ;
begin Application.lnilialize;
Application.Title :_ 'IQcd Vote';
Application.CreateForm(TfrmMain, frmMain);
Application.Run end.
SUBSTITUTE SHEET (RULE 26) 0001 #!/usr/bin/pert #**~r*wmrww*r***w*r**r****w***w**w**r*w**rwwr***r*r**ww*rrwrwrr**w*ww**xr***,t*
r*w # Record Movement Script #**rw**xrrrrr**wwr*r***rr*r**********rrwrwr**rrwwrwrww*wrwwrrw*wwr**t******r*w*
r # Author: Steve Bliss #**rw*wrrww*wrw*w*******rr*rr***rrr*r***************************w****www*rr*r**
*
# Revision History:
#
# 1997/01/09 - 1.00.000/DWS - Created file.
#*********************************rw*****r*rrr*r******r**r****r**r******rrr*r**
*
require("cgi-lib.pl");
#*************************r**r******r*******w********w*******************w*****
*
# Parse the input parameters #*******rr*rw*r*********wr******,t****r*w**r*wr*wwt*r**r******w*rr***********wr **
&ReadParse(rinput);
#r*wr*r*wrrwxr***wr****wrrr***r*r**w**r*w***r****w*****r***wa*r*rr***********wr *
# Inform the server of our content type #*******r*******rw*******rw***~****************r*r**********w*****w*****r******
r*
print "'Content-type: textlplain\n\n";
#****w*wrr**rw*****w*r*w*rr*w*~*w*wt**w**w*r*rr*w*r*r*r***w****w*******ww***r*r r*
# Open and Write the data file for append #******rrrrrr***r****w****w***~**r***rr*r************r********rw**rr****r***t**
**
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";}
SUBSTITUTE SHEET (RULE 26) program pTCPinfo;
uses Forms, TCPinfo;
{$R *.RES}
begin Application.initialize;
Application.Run;
end.
SUHST(TtJTE SHEET (RULE 26) 0001 unit TCPinfo;
0002.
0003 interface {__________________._______________________________________________________}
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 FHasAutoDiaISetup: booiean;
0014 FHasTCPIP: Boolean;
0015 FHasBindT~oDialUP: Boolean;
0016 procedure Writelnvalid(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 Ha~sAutoDiaISetup: Boolean read FHasAutoDiaISetup 0025 write Writelnvalid;
0026 property HasDialUp: Boolean read FHasDialUp 0027 write Writelnvalid;
0028 property HasTCPIP: Boolean read FHasTCPIP
0029 write Writelnvalid;
0030 property HasBindToDiaIUP: Boolean read FHasBindToDialUp 0031 write Writelnvalid;
0032 end;
0033 {-_ -----_ __.._ 0034 procedure Register;
~~e___o.=ass==vsmaa:e.=c=ax==o=caeo~ccc=~c~~cn==oars===c~co~~c==e~=ae=~~=~cl 0038 implementation {__________________._______________________________________________________) SUBSTITUTE SHEET (RULE 26) 0038 type 0039 EReadOnly = class(Exception);
{_________________________________________________________________________}
0042 { Register Component }
{_________________________________________________________________________}
0044 procedure Register;
0045 begin 0046 RegisterComponents('Palantir', [TpsTCPinfo]);
0047 end;
{_________________________________________________________________________}
0049 { Local routines }
{_________________________________________________________________________}
0051 procedure TpsTCPinfo.Writelnvalid(X: Boolean);
0052 begin 0053 end;
{_________________________________________________________________________}
0055 { Methods }
{_________________________________________________________________________}
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, iProt1: integer;
0065 begin 0066 FHasModem := false;
0067 FHasDialUp := false;
0068 FHasAutoDiaISetup := false;
0069 FHasTCPIP := false;
0070 FHasBindToDiaIUP '= false;
0071 Reg := TRegistry.Create;
0072 Nets := TStringList.Create;
SUBSTITUTE SHEET (RULE 26) 0073 Prots := TStringl_ist.Create;
0074 try 0076 {---------- has modem installed ? }
0077 Reg.RootKey := HKEY~LOCAL MACHINE;
0078 sKey :='\Syst~emlCurrentControlSetlServices\Class\Modem';
0079 try 0080 if Reg.KeyE_xists(sKey) then 0081 FHasMo~dem := true 0082 except 0083 end;
0084 {------ has AutoDial enabled ? ) 0085 Reg.RootKey := HKEY_CURRENT USER;
0088 sKey :='lSoftwarelMicrosoft\WindowslCurrentVersion\Internet Settings';
0087 sValue :='En<~bleAutodial' 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 in~teger(N)<>0 then 0093 FHasAutodialSetup := true 0094 except 0095 end;
0098 {--~--~-- has'fCPIP protocol installed ? }
009'.7 Reg.RootKey := HKEY_LOCAL MACHINE;
0098 sKey :='lEnum\Network\MSTCP';
0099 try 0100 if Reg.Keyl=xists(sKey) then 0101 FHasTCPIP := true 0102 except 0103 end;
0104 {~------- has Dial-Up adapter installed 8 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 iNet1 := Nets.Count-1;
0110 for iNet ::= 0 to iNet1 do begin 0111 skey :='\EnumlRootWet\'+Nets.Strings[iNetJ;
0112 if not Reg.OpenKey(sKey,false) then continue;
0113 if not Reg.ValueExists('DeviceDesc') then continue;
SUBSTITUTE SHEET (RULE 26) 0114 if Reg.ReadString('DeviceDesc')<>'Dial-Up Adapter then continue;
0115 FHasDialUp := true;
0116 if not Reg.OpenKey(sKey+'\Bindings',faise) then continue;
0117 Reg.GetValueNames(Prots);
0118 iProtl := Prots.Count-1;
0119 for iProt := 0 to iProt1 do 0120 if Copy(Prots.Strings[iProt],1,6)='MSTCP\' 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;
{_______________________________________________________________________-__}
0133 { Create/Destroy }
{-________________________________________________________________________}
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.
SUBSTITUTE SHEET (RULE 26) APPENDIX I
xx**xwx*xxw**w*x*wwwwxxxtrw*w**e**x*x*wx*x********wwx*xx****x*x*x***xw*w*rxrxw*
*
1.
2: * BC (Browser Controller) v1.10 3:*
4: * Browser.pas .
ie*ww**x*x*x**w**x**x*r*ewier***xxw*xxx*****x***xwx****xw*****x***xw*w**rxxwr**
w,tw 5.
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 recoibed 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 artiist(s) recorded rendition, including:
(i) displaying the title of each recorded event (e.g. song titles, acts and scenes of a play, musical, dance, e~tc), (ii) a viewer optionally and selectively viewing and/or listening to any one or all of the recorded renditions, and (iii) displayintl 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 typicaNy 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 off playing only what song they would like io 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 seNected 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.
SUBSTTTtITE SHEET (RULE 26) 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 usePs 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 recorcied 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 wilt appear on the computer screen.
Thus it is a brief video talking about an introduction to get a personalized contact with the user (warm 8~ 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 io 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 chat 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 worcfs 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.
SUBSTITUTE SHEET (RULE 26) 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 ~~ ten song CD and individuals tend to play 5 of the songs on a regular basis, the system c~~n 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 TI~ACKING~ 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 ~~sked 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 lime on the user's PC wilt appear an icon for that artist. The icon is clicked on to launch its driver and thereafter to he connected to the artist's web site. In this case- and at the users instructions, the user wilt 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 i:~ 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.
SUBSTITUTE SHEET (RULE 26) 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 entire#y, 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 ii 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 ptayed 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 /ink 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.
SUBSTITUTE SHEET (RULE 26~
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 initializai.ion file used to initially configure the invention.
Fig. 7a is a CD PROFILE DAT~4 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 orillinal 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 serrver far 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 io 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 pertormance 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 inveniion 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 (IHTML) 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 intertace (GUI) based access to network servers. The network servers support docurnents forrnatted 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 provideas 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 speclflcatlon, the Fuser makes a Transmlsslon 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.
'SUBSTITUTE SHEET (RULE 26) 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 a1 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 copy-protection may be bypassed altogether.
SUBSTITUTE SHEET (RULE 26) 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 ;>erial 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 !he 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 (B,atch Code) to decide what Web Page information to show any particular user; to provide Fast-minule~ 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 monil:ors 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 b~ovNSing 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 ~ The browser controller is a program distributed to the user in the form of computer readable code on floppy disk, CDROM or other distributabie 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 lNeb browser software that is installed on the user's computer.
Once Installed on the user':. computer, the BC will access the particular sites that It was designed to retrieve, and pertorm a number of other browsing and access control functions including:
(a) Optionally detecl.ing unautlhorized copies of itself, and preventing any further execution if detected.
SUBST1TUT~ SHEET (RULE 26) g (b) Retrieving "invited" Web Pages from the Internet or inlranet.
(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 Listin4s in the followin4 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 intemet Explorer.
Main.pas. See Code Listinos in the followin4 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.oas. See Code Listincts 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 intemet 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 intemet 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 IBIS). 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 iUuslrate 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.
SUHST1TUTE SHEET tRULE 26) During installation on the user's computer, demographic information is assembled by asking the user personal and/or busines~~ 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 tire 8C occurs as needed through out the program. For example, see Main.pas in Appendix I, lines 178; 269-271; 276-358; 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 browsE~r 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. Atemativeiy 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 decompres:red and unpacked 11 from the installation disk and placed onto the target drive 13,14. The user is asked dlemographic questions 15, and the answers are scored in a Demographic file on the tayet 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 8rowser Controller, including demographics, copy-protection information, and primary web page and brow:~er 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 4:? 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. It 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 Werb Page 43.
SUBSTITUTE SHEET (RULE 26) WO 98/52189 PCT/US98/10035 .
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 io retrieve alternate web pages andlor 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 World 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 end 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 pages) on a Primary SUBSTITUTE SHEET (RULE 26) WO 98/52189 PCT/US98/10035 _ Web site 90. The retrieved Web pages or files optionally will need to be decrypted either by the Tracker Server program or the Browse~r-Controller program before the user can display the retrieved Web pages. Browsing infomnation 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 8.g for stati:>tical 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 tihat 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 1, II and ill 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 hnRL that you are currently addressing. Internet Explorer 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 i s made to detemnine which child window inside the browser is the largest. The largest child window should be the browser output window.
(See browser.pas: lines 610-73~.
The position of the lamest 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 lett 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 ate 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 SUBST1TLJTE SHEET (RULE 26) 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: fines 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 io 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 bvx must be idaintificd. These text controls also have handle 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, tntemet 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 & forvvard are critical operations. Reload is needed.
SUBSTITUTE SHEET (RULE 26) "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 Explorer, the BC does not search the menu as soon as Internet Explorer is found because Internet Explorer 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 an-ay through the operating system.
Therefore, (i) 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 ~lo 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, ii is intended io embrace all such alternatives, modification, and variations a;s fall within the spirit and broad scope of the appended claims.
SUBST1TLJT~ SHEET (RULE 26) 0001 unit BitBars;
{___________________________________________________________________________}
0003 interface ~___________________________________________________________________________}
0005 {$IFDEF WINDOWS}
0006 uses 0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 0008 Forms, Dialogs, ExtCtris, 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 {_____________~________________w_________}
0017 type 0018 TBar = record 0019 bVertical: Boolean;
0020 bEnabled: Boolean;
0021 bForceDraw: Boolean;
0022 iSIideRange, iSIidePosition: longint;
0023 iSweepWidth, iSweepHeight: longint;
0024 iSweepStart, iSweepTravel: longint;
0025 iSweepMoveStartPosition, iSweepPosition: longint;
0026 bmpBuffer: TBitmap;
0027 spriteBack, spriteRod, spriteButton, spriteEnd1, spriteEnd2: TSprite 0028 end;
0029 {-------_-___~_~~_ _________________}
0030 procedure Barlnitialize(var Bar: Tbar; imgBarBack, imgBarRod, imgBarButton, 0031 imgBarEnd1, imgBarEnd2: Tlmage);
0032 procedure BarExit(var Bar: TBar);
0033 procedure BarEnable(var Bar: TBar);
0034 procedure BarDlssable(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;
SUBSTITUTE SHEET (RULE 26) WO 98/52189 PCTlUS98/10035 0038 procedure BarMouseMoveStart(var Bar: Tbar);
0039 procedure BarMouseMoveDraw(var Bar: TBar; x,y: longint);
0040 function BarButtonHit(var Bar: TBar): Boolean;
~=______________________________________________________________________-__}
0042 implementation {_________________________________________________________________________}
0044 function ConvertSvveepToSlide(var Bar: TBar; SweepPosition: longint):
longint; forvvard;
0045 function ConvertSliideToSweep(var Bar: TBar; SIidePosition: longint):
longint; forvvard;
0046 procedure DrawAndUpdate(var Bar: TBar; NewSweepPosition: (ongint);
forward;
{__________________._______________________________________________________}
0048 { Local Routines }
0050 function ConvertSweepToSlide(var Bar: TBar; SweepPosition: longint):
longint;
0051 begin 0052 result :_ ((Bar.iSIideRange - (Bar.iSIideRange div Bar.iSweepTravel)) 0053 SweepPosition) div (Bar.iSweepTravei-1) 0054 end;
0055 {________________________________.______________}
0056 function ConvertSIideToSweep(var Bar: TBar; SIidePosition: longint):
longint;
0057 begin 0058 result :_ ((Bar.iS~~reepTravel-1) * SIidePosition) div 0059 (Bar.iSlide~Range - (Bar.iSIideRange div Bar.iSweepTravel)) 0060 end;
0061 {-----_------________,__________.__________~__}
0062 procedure DrawAncIUpdate(var Bar: TBar; NewSweepPosition: longint);
0063 var 0064 iRodLeft, iRodTap: longint;
0065 iOffset:longint;
0066 BarRect: TRect;
0067 begin 0068 if NewSweepPosition<0 ihen 0069 NewSweepPosition := 0;
0070 if NewSweepPosition>Bar.iSweepTravel-1 then 0071 NewSweepPosltion := Bar.iSweepTravel-1;
0072 if (not Bar.bForce~Draw) and (NewSweepPosition=Bar.iSweepPosition) then 0073 exit;
0074 Bar.iSweepPosition := NewSweepPosition;
SU~ST1TUTE SHEET (RULE 26) 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 BitmapOverlay(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.spriieRod.Image.Canvas.Handle, iRodLeft, iRodTop, srcCOP~;
0095 BitmapOverlay(Bar.bmpBuffer, Bar.spriteButton, Bar.spriteBack);
0096 BitmapOverlay(Bar.bmpBuffer, Bar.spriteEnd1, 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, Oi 01 Bar.bmpBuffer.Canvas.Handle , 1, 0, srcCOPI~;
0102 BarRect := Bounds(Bar.spriteBack.Left+1, Bar.spriteBack.Top, 0103 Bar.spriteBack.Width-1, Bar.spriteBack.Height);
0104 BitmapUpdateScreen(BarRect) 0105 end;
{_________________________________________________________________________}
0107 { Main code }
f==_______________________________________________________________________) 0109 procedure BarEnable(var Bar: TBar);
0110 begin 0111 if Bar.iSIideRange=0 then begin 0112 BarDissable(Bar);
0113 exit SUBST1TUT~ SHEET (RULE 26) 0114 end;
0115 if not Bar.bEnabl~:d then begin 0116 Bar.bEnabled := true; -0117 Bar.bForceDraw :_ #rue;
0118 DrawAndUpdal~e(Bar, ConvertSIideToSweep(Bar, Bar.iSIidePosition));
0119 end 0120 end;
0121 {________________________..___________________________}
0122 procedure BarDissalble(var Bar: Tbar);
0123 begin 0124 if Bar.bEnabled then begin 0125 Bar.bEnabled := false;
0126 8ar.bForceDraw := false;
0127 BitmapDraw(B~ar.spriteBack) 0128 end 0129 end;
0130 {___________________~________________..______________}
0131 procedure BarSetRange(var Bar: TBar; Range: longint);
0132 begin 0133 Bar.iSIideRange := Range;
0134 if Range>0 then 0135 Bar.iSIidePosition := ConvertSweepToSlide(Bar, Bar.iSweepPosition) 0136 else 0137 BarDissable(Bair) 0138 end;
0139 {____________________________________..______________}
0140 procedure BarSetPosition(var Bar: TBar; Position: longint);
0141 begin 0142 Bar.iSIidePosition := Position;
0143 if Bar.bEnabled then 0144 DrawAndUpdat~e(Bar, ConvertSIideToSweep(Bar,Position)) 0145 end;
0146 {-______________________..__________..______________}
0147 function BarGetPosition(var Bar: TBar): iongint;
0148 begin 0149 result := Bar.iSIidE~Position;
0150 end;
{___________________._______._______________________________________________}
0152 { Mouse !-candling }
{___________________._______________________________________________________}
SUBSTITUTE SHEET (RULE 26) 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 {_______-______~_~____________________M}
0160 procedure BarMouseMoveStart(var Bar: TBar);
0161 begin 0162 Bar.iSweepMoveStartPosition := Bar.iSweepPosition Oi63 end;
0164 { --__ _~M_____~~___~~}
0165 procedure BarMouseMoveDraw(var Bar: TBar; x,y: lorlgint);
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.iSIidePosition := ConvertSweepToSlide(Bar,Bar.iSweepPosition) 0175 end;
{_________________________________________________________________________}
0177 { Initalize / Exit }
{_________________________________________________________________________}
0179 procedure Barlnitialize(var Bar: Tbar; imgBarBack, imgBarRod, imgBarButton, 0180 imgBarEndl, imgBarEnd2: Tlmage);
0181 var 0182 l: string[50];
0183 p: integer;
0184 iSIideButtonSize:longint;
0185 begin 0186 BitmapCreate(Bar.spriteBack, imgBarBack, false);
0187 BitmapCreate(Bar.spriteRod, imgBarRod, true);
0188 BitmapCreate(Bar.spriteButton, imgBarButton, true);
0189 BitmapCreate(Bar.spriteEndl, imgBarEndl, true);
0190 BitmapCreate(Bar.spriteEnd2, imgBarEnd2, true);
0191 Bar.bmpBuffer := TBitmap.Create;
0192 Bar.bmpBuffer.Assign(imgBarBack.Picture.Bitmap);
SUBSTITUTE SHEET (RULE 26) 0193 I := imgBarRod.fiint:
0194 p := Pos(',',I);
0195 Bar.iSweepWidth := StrTolnt(Copy(1,1,p-1));
0196 I := Copy(I,p+1,99);
0197 p := Pos(',',I);
0198 Bar.iSweepHeight := StrTolnt(Copy(1,1,p-1));
0199 if Copy(I,p+1,1 )='V' then 0200 Bar.bVertical := true 0201 else 0202 Bar.bVertical := false;
0203 Bar.iSweepStart := StrTolnt(Copy(f,p+2,99));
0204 if Bar.bVertical then begin 0205 iSIideButtonSize := Bar.spriteButton.Height;
0206 Bar.iSweepTravel := Bar.iSweepHeight-iSIideButtonSize;
0207 Bar.spriteButton.Left := Bar.spriteBack.Left 0208 end 0209 else begin 0210 iSIideButtonSize := Bar.spriteButton.Width;
0211 Bar.iSweepTrFwel := Bar.iSweepWidth-iSIideButtonSize;
0212 Bar.spriteBuiton.Top := Bar.spriteBack.Top 0213 end;
0214 Bar.iSweepPosition :=-1;
0215 Bar.bEnabled := false;
0216 Bar.bForceDraw := false 0217 end;
0218 {_______________w___________________________}
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.
SUBSTITUTE SHEET (RULE 26) 0001 unit BitBtns;
0002 _ {________________________________________________________________________}
0003 interface ~______________________________________________________________________-_-_}
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 ExtCtrls, StdCtrls, 0014 Run, Main, Bitmaps;
0015 {$ENDIF}
0016 {_____~______________________________________}
0017 procedure Buttonslnitialize;
0018 procedure ButtonsF~cit;
0019 procedure ButtonsMouseDown_ExitCheck;
0020 procedure ButtonsMouseDown;
0021 procedure ButtonsMouseUp;
0022 procedure ButtonsForceNone;
0023 procedure ButtonsForcePlay;
0024 procedure ButtonsForcePause;
0025 procedure ButtonsForceStop;
{_________________________________________________________________________}
0027 implementation {_______________________________________________________________________-_-_}
0029 var 0030 spritePlay_Up, 0031 spriiePlay_Down, 0032 spritePause_Up, 0033 spritePause_Down, 0034 spriteResume Up, 0035 spriteResume_Down, 0036 spriteStop_Up, SUBST1TUTF SHEET (RULE Z6) 0037 spriteStop_Down, 0038 spriteEject Up, 0039 spriteEject Down, 0040 spriteRandom UipOn, 0041 spriteRandom C~ownOn, 0042 spriteRandom UipOff, 0043 spriteRandom_DownOff, 0044 spriteExit Up, 0045 spriteExit Down., 0046 spritelnfo_Up, 0047 spritelnfo_Down"
0048 spriteWords Up, 0049 spriteWords Down, 0050 spriteTracks_Up, 0051 spriteTracks_Do~rvn, 0052 spritePrint Up, 0053 spritePrint Down, 0054 spriteVideo_Up, 0055 spriteVideo_Dovsrn, 0056 spriteCommentary Up, 0057 spriteCommentary Down: TSpr9ie;
0058 bButtonsMouseDown: boolean;
{__________________.________________________________________________________}
0060 { Main code }
{__________________._______________________________________________________}
0062 procedure ButtonsDAouseDown_ExitCheck;
0063 begin 0064 if BitmapHit(spril:eExit Up) then begin 0065 bButtonsMou:~eDown := true;
0066 BitmapDraw(s;priteExit_Down);
0067 frmRun.ExitPressed 0068 end 0069 end;
0070 {__~__________~__..___~________________~___}
0071 procedure ButtonsMouseDown;
0072 begin 0073 case ePiayButtonState of 0074 bsPLAY: if BitmapHit(spritePlay Up) then begin 0075 bBut!ionsMouseDown := true;
SUBSTITUTE SHEET (RULE 26) 0076 BitmapDraw(spritePlay_Down);
0077 BitmapDraw(spriteSTOP Up);
0078 eStopButtonState := bsSTOP;
0079 frmRun.PIayPressed;
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 frmRun.ResumePressed;
0092 exit 0093 end 0094 end;
0095 case eStopButtonState of 0096 bsEJECT: if BitmapHit(sprtteEject 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(spritePlay_Up);
0106 ePiayButtonState := bsPLAY;
0107 frmRun.StopPressed;
0108 exit 0109 end;
0110 end;
0111 case eRandomButtonState of 0112 bsRANDOM ON: if BitmapHit(spriteRandom Upon) then begin 0113 bButtonsMouseDown := true;
0114 BitmapDraw(spriteRandom DownOff);
0115 eRandomSuttonState := t. >RANDOM_OFF;
0116 exit SUBSTITUTE SHEET (RULE 26~
WO 98/52189 PCT/fJS98/10035 0117 end;
0118 bsRANDOM_OFF: if BitmapHit(spriteRandom_Upon) then begin 0119 b8uttonsMouseDown := true; .
0120 BilmapDraw(spriteRandom_DownOn);
0121 eR;andomButtonState := bsRANDOM_ON;
0122 exit 0123 end 0124 end;
0125 if BitmapHit{spritelnfo_Up) then 0126 if eTubeModeState<>tmINFO then begin 0127 bButtonsMouseDown := true;
0128 BitmapDravr(spritelnfo_Down);
0129 BitmapDravr(spriteWords Up);
0130 BitmapDravr(spriteTracks_Up);
0131 eTubeMode~State := tmINFO;
0132 frmRun.Mo~ieSetlnfo;
0133 exit 0134 end;
0135 if BitmapHit(spriteWords_Up) then 0136 if eTubeModeState<>tmWORDS then begin 0137 bButtonsMouseDown := tme;
0138 BitmapDravr(spritelnfo_Up);
Oi 39 BitmapDravr(spriteWords_Down);
0140 BitmapDravr(spriteTracks Up);
0141 eTubeMode~State := ImWORDS;
0142 frmRun.ModeSetWords;
0143 exit 0144 end;
0145 if BitmapHit(spriteTracks Up) then 0146 if eTubeModeSiate<>tmTRACKS then begin 0147 bButlonsMouseDown := true;
0148 BitmapDravr(spriteinfo_Up);
0149 BitmapDravr(spriteWords_Up);
0150 BitmapDravr(spriteTracks_Down);
0151 eTubeMode~State := tmTRACKS;
0152 frmRun.ModeSetTracks;
0153 exit 0154 end;
0155 if BitmapHit(spritePrint_Up) then begin 0156 bButtonsMouseDown :_ true;
0157 BitmapDraw(spritePrint_ Down);
SUBSTiTLJTE SHEET (RULE 26) 0158 exit 0159 end;
0160 if BitmapHit(spriteVideo Up) then begin 0161 bButtonsMouseDown := true;
0162 BitmapDraw(spriteVideo_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 ePIayButtonState of 0178 bsPLAY: if BitmapHit(spritePlay_Up) then begin 0179 BitmapDraw(spritePause_Up);
0180 ePIayButtonState := bsPAUSE;
0181 exit 0182 end;
0183 bsPAUSE: if BitmapHit(spritePause_Up) then begin 0184 BitmapDraw(spriteResume_Up);
0185 ePIayButtonState := bsRESUME;
0186 exit 0187 end;
0188 bsRESUME: if BitmapHit(spriteResume Up) then begin 0189 BitmapDraw(spritePause_Up);
0190 ePIayButtonState := 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;
SUBSTITUTE SHEET (RULE 26) 0199 bsSTOP: if l3itmapHit(spriteStop_Up) then begin 0200 BitmapDraw(spriteEject Up);
0201 eStopButtonState := bsEJECT;
0202 exit 0203 end;
0204 end;
0205 case eRandomlButtonState of 0206 bsRANDOM_ ON: if BitmapHit(spriteRandom_Upon) then begin 0207 E~itmapDraw(spriteRandom UpOn);
0208 exit 0209 end;
0210 bsRANDOM_ OFF: if BitmapHit(spriteRandom Upon) then begin 0211 B~itmapDraw(spriteRandom UpOff);
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;
{__________________._______.________________________________________________}
0232 { Change button state }
{__________________._______________________________________________________}
0234 procedure ButtonsForceNone;
0235 begin 0236 if bButtonsMou;>eDown then 0237 exit;
SUBSTITUTE SHEET (RULE 2fi) 0238 BitmapDraw(spriteTracks_Up);
0239 BitmapDraw(spriteWords Up);
0240 BitmapDraw(spritelnfo_Up) 0241 end;
0242 {--___~~__w___~___~~_______________}
0243 procedure ButtonsForcePlay;
0244 begin 0245 if bButtonsMouseDown then 0246 exit;
0247 BitmapDraw(spritePause_Up);
0248 ePIayButtonState := bsPAUSE;
0249 BitmapDraw(spriteStop_Up};
0250 eStopButtonState := bsSTOP;
0251 end;
0252 {________________~_____________________________) 0253 procedure 8uttonsForcePause;
0254 begin 0255 if bButtonsMouseDown then 0256 exit;
0257 BitmapDraw(spriteResume_Up);
0258 ePiayButtonState := bsRESUME;
0259 BitmapDraw(spriteStop Up);
0260 eStopButtonState := bsSTOP;
0261 end;
0262 {_--________~____~_______________________}
0263 procedure ButtonsForceStop;
0264 begin 0265 if bButtonsMouseDown then 0266 exit;
0267 BitmapDraw(spritePlay_Up);
0268 ePIayButtonState := bsPLAY;
0269 BitmapDraw(spriteEje~ Up);
0270 eStopButtonState := bsEJECT;
0271 end;
{_______________________________________________________________________-__}
0273 { Initaiize / Exii }
{_______________________________________________________________________-__-}
0275 procedure Buttonsinitialize;
0276 begin SUBSTITUTE SHEET (RULE 26) 0277 BitmapCreate(:SpritePlay_Up, frmMain.imgPlay_Up, true);
0278 BitmapCreate(:SpritePlay_Down, frmMain.imgPlay_Down, true);
0279 BitmapCreate(spritePause_Up, frmMain.imgPause_Up, true);
0280 BitmapCreate(spriiePause Down, frmMain.imgPause_Down, true);
0281 BitmapCreate(:>priteResume_Up, frmMain.imgResume_Up, lrue);
0282 BitmapCreate(spriteResume_Down, frmMain.imgResume_Down, true);
0283 BitmapCreate(spriteStop_Up, frmMain.imgStop_Up, true);
0284 BitmapCreate(:~priteSto~~ Down, frmMain.imgStop_Down, true);
0285 BitmapCreate(spriteEject Up, frmMain.imgEject Up, true);
0286 BitmapCreate(:~priteEject Down, frmMain.imgEje~ Down, true);
0287 BitmapCreate(spriteRandom_Upon, frmMain.imgRandom Upon, true);
0288 BitmapCreate(:>priteRandom_DownOn, frmMain.imgRandom_DownOn, true);
0289 BitmapCreate(spriteRandom_UpOff, frmMain.imgRandom UpOff, true);
0290 BitmapCreate(spriteRandom DownOff, frmMain.imgRandom DownOff, true):
0291 BitmapCreate(;~priteExit_Up, frmMain.imgExit Up, true);
0292 BitmapCreate(;~priteExit_ Down, frmMain.imgExit_Down, true);
0293 BitmapCreate(apritelnfo_ Up, frmMain.imglnfo_Up, true);
0294 BitmapCreate(spritelnfo _Down, frmMain.imglnfo_Down, true);
0295 BitmapCreate(spriteWords Up, frmMain.imgWords Up, true);
0296 BitmapCreate(:~priteWords Down, frmMain.imgWords Down, true);
0297 BitmapCreate(spriteTracks Up, frmMain.imgTracks Up, true);
0298 BitmapCreate(spriteTracks_Down, frmMain.imgTracks Down, true);
0299 BitmapCreate(spritePrint_Up, frmMain.imgPrint Up, true);
0300 BitmapCreate(spritePrint_Down, frmMain.imgPrint Down, true);
0301 BiimapCreate(spriteVideo_Up, frmMain.imgVideo_Up, true);
0302 BitmapCreate(spriteVideo_Down, frmMain.imgVideo_Down, true);
0303 BitmapCreate(;~priteCommentary Up, frmMain.imgCommentary_Up, true);
0304 BitmapCreate(spriteCommentary Down, frmMain.imgCommentary_Down, true);
0305 BitmapDraw(sp~ritePlay_Up);
0306 BitmapDraw(syriteEject_Up);
0307 BitmapDraw(spriteRandom_UpOff);
0308 BitmapDraw(sF~riteExit Up);
0309 8itmapDraw(spritelnfo_Up);
0310 BitmapDraw(sF~riteWords Up);
0311 BitmapDraw(sF~riteTrackS Up);
0312 BitmapDraw(syritePrtnt Up);
0313 BitmapDraw(syriteVideo Up);
0314 BitmapDraw(sF~riteCommentary Up);
0315 ePIayButtonStFite := bsPLAY;
0316 eStopButtonSta~te := bsEJECT;
0317 eRandomi3uttonState := bsRANDOM_OFF;
SUBSTITUTE SHEET (RULE 26) 0318 eTubeModeState := tmINTRO;
0319 bButtonsMouseDown := false 0320 end;
0321 {___~________________w__~_________________}
0322 procedure ButtonsExit;
0323 begin 0324 BitmapDestroy(spritePlay_Up);
0325 BitmapDestroy(spritePlay_Down);
0326 BitmapDestroy(spritePause_Up);
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(spriteExii 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 8itmapDestroy(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.
SUBSTITUTE SHEET (RULE 26) 0001 unit Bitmaps;
0003 intertace {__________________________________________________________________________}
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 = reconi 0019 Left, Top: longing 0020 Width, Height: longint;
0021 bUseMask: Boolean;
0022 Image: TBitmap;
0023 Mask: TBitm;ap 0024 end;
0025 pTSprite = ~TSprite;
0026 {_-________~~_~_~_____________________}
0027 procedure BitmapCreate(var Sprite: TSprite; imglmage: Tlmage; UseMask:
Boolean);
0028 procedure BitmaplDestroy(var Sprite: TSprile);
0029 procedure Bitmap~Overlay(Biimap: TBitmap; var Sprite, SpriteOffset:
TSprite);
0030 procedure Bitmap~Draw(var Sprite: TSprite);
0031 procedure BilmapUpdateScreen(Rect: TRect);
0032 function BitmapHit(var Sprite: TSprite): Boolean;
{__________________________.______________________________________________.-_}
0034 implementation {__________________._____________________________________________________-__}
{__________________________.________________________________________________}
SUBSTITUTE SHEET (RULE 26) 0037 { Code }
~_________________________________________________________________________) 0039 procedure BitmapCreate(var Sprite: TSpriie; imglmage: Tlmage; UseMask:
Boolean);
0040 var 0041 I: string[50];
0042 p: integer;
0043 begin 0044 I := imglmage.Hint;
0045 p := Pos(',',I);
0046 Sprite.Left := StrTolnt(Copy(1,1,p-1));
0047 I := Copy(I,p+1,99);
0048 p := Pos(',',I);
0049 if p=0 then begin 0050 Sprite.Top := StrTolnt(I);
0051 imglmage.Hint :_ ";
0052 end 0053 else begin 0054 Sprite.Top := StrTolnt(Copy(1,1,p-1));
0055 imglmage.Hint := Copy(I,p+1,99) 0056 end;
0057 with Sprite do begin 0058 Width := imglmage.Width;
0059 Height := imglmage.Height;
0060 Image := TBitmap.Create;
0061 Image.Assign(imglmage.Picture.Biimap);
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(CIipRect, imglmage.Picture.Bitmap, CIipRect, TRANSPARENT COLOR) 0074 end;
0075 with Sprite.Image.Canvas do begin 0076 Brush.Color := clWhite;
SUBSTITUTE SHEET (RULE 26) 0077 Brush.Style := bsSolid;
0078 BrushCopy(CIipRect, imglmage.Picture.Biimap, CIipRect, TRANSPARENT
COLOR);
0079 end;
0080 with Sprite do 0081 BitBlt(Mask.Canvas.Handle, 0, 0, Width, Height, 0082 Image.(;anvas.Handle, 0, 0, MERGEPAINT) 0083 end 0084 end;
0085 {_-__________~~.____.~____________________}
0086 procedure BitmapDestroy(var Sprite: TSprite);
0087 begin 0088 with Sprite do beiiin 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 betiin 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-SpriieOffset.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.(~anvas.Handle, 1, 0, srcAND) 0113 end 0114 else begin 0115 BitBlt(Bitmap.Canvas.Handle, iLeft+1, iTop, Width-1, Height, 0116 Image.(:anvas.Handle, 1, 0, srcCOPlr7 0117 end SUBSTITUTE SHEET (RULE 26~
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, D140 Rect.Right-Reci.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): boofean;
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) SUBSTITUTE SHEET (RULE 26) 0159 else 0160 result := true 0161 end;
0162 end;
0163 end.
SUBSTITUTE SHEET (RULE 26) 0001 unit CDPlayer;
{-________________________________________________________________________}
0003 interface {________________________________________________________________________-}
0005 {$IFDEF WINDOWS}
0006 uses 0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 0008 Forms, Dialogs, ExtCtrls, MPlayer, 0009 Run, Main, Logging;
0010 {$ELSE}
0011 uses 0012 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 0013 ExtCtrls, StdCtrls, MPlayer, 0014 Run, Main, Logging;
0015 {$ENDIF}
0016 {___________~__w____w___________________}
0017 var 0018 iAudioTracks:longint;
0019 iAudioTrackStart, iAudioTrackLength: array [1..MAX TRACKS] of longint;
0020 iStatsCDStart, iStatsCDLength: longint;
0021 iStatsTrackStari, 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 iHoIdOffUpdate:longint;
0027 iPIayTimeout:longint;
0028 { ----_ ~ ________~M~}
0029 procedure Playerlnitialize;
0030 procedure PlayerTimerTick;
0031 procedure PlayerEject;
0032 procedure PlayerStop;
0033 procedure PlayerPlay(start: TLogStart; TrackTime: iongint);
0034 procedure PlayerPause;
0035 procedure PlayerResume;
0036 procedure PlayerGetTrackAndTime( var TrackNo, TrackTime: longint);
{_______________________________________________________________________-__}
0038 implementation SUBSTITUTE SHEET (RULE 26) 0040 procedure PlayerEject;
0041 begin 0042 frmRun.MouseDissable;
0043 eCDPIayerState := psNOCD;
0044 with frmRun.mml:,DPlayer do begin 0045 TimeFormat :_~ tfMilliseconds;
0046 LoggingLoglt(IePLAY, (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 {----__~_____~_w_~~_~_____~__~_w]
0069 procedure PlayerStop;
0070 begin 0071 frmRun.MouseDissable;
0072 eCDPIayerState := psSTOPPED;
0073 with frmRun.mmCDPlayer do begin 0074 TimeFormat :~= tfMilliseconds;
0075 LoggingLoglt(IIePLAY, (Position div 100) -iAudioTrackStart[iLastTrackNo]);
0076 try 0077 Wait := true;
0078 Notify := faise;
SUBSTiTUT~ SHEET (RULE 26) 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 eCDPlayerState := psSTOPPED;
0090 with frmRun.mmCDPiayer do begin 0091 TimeFormat := tfMilliseconds;
0092 LoggingLoglt(IePLAY, (Position div 100) -iAudioTrackStart[iLastTrackNoj);
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[iLastTrackNoj + 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 iPIayTimeout := 20;
0117 while (Mode<>mpPLAYING) do 0118 if (iPIayTimeout=0) then begin 0119 rrmRun.ErrorMessege('Thtre Is a problem trying to play the CD!');
SUBSTITUTE SHEET (RULE 26) 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(IePLAY, start, iLastTrackNo, TrackTime);
0131 iHoIdOffUpdate :== 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.mm(:DPlayer do begin 0141 TimeFormat :_ tfMilliseconds;
0142 LoggingLoglt(IeVIDEO, (Position div 100) -iAudioTrackStart[iLastTrackNo]);
0143 try 0144 TimeFormai: := tfMilliseconds;
0145 iPausedTime :_ (Position div 100) - iAudioTrackStart[iLastTrackNo];
0146 Wait := true;
0147 Notify := fal.~e;
0148 Stop 0149 except 0150 end 0151 end;
0152 frmRun.MouseEnable 0153 end;
0154 {__~___________________________________________}
0155 procedure PlayerResume;
0156 begin 0157 with frmRun.mm4.DPlayer do begin 0158 TimeFormat :=~ tfMilliseconds;
0159 Loggingloglt(I~ePLAY, (Position div 100) -iAudioTrackStart[iLastTrackNo]) 0160 end;
SUBST1TUTF SHEET (RULE 26) 0161 PfayerPlay(IsRESUME, iPausedTime) 0162 end;
0163 {-------__~_~~_____________________}
0164 procedure PlayerGetTrackAndTime( var TrackNo, TrackTime: longint);
0165 var 0166 iTrack:longint;
0167 begin 0168 with frmRun.mmCDPlayer 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;
{_________________________________________________________________________}
0181 { Initalize / Exit }
{_________________________________________________________________________}
0183 procedure PlayerTimerTick;
0184 begin 0185 if iHoIdOffUpdate>0 then 0186 Dec(iHoIdOffUpdate);
0187 if iPIayTimeout>0 then 0188 Dec(iPIayTimeout) 0189 end;
{_________________________________________________________________________}
0191 { Initaiize / Exii }
{_________________________________________________________________________}
0193 procedure Playerlnitialize;
0194 var 0195 iTrack:longint;
0196 begin 0197 frmRun.MouseDissable;
SUBSTITUTE SHEET (RULE 26) 0198 eCDPIayerSiate := psNOCD;
0199 with frmRun.mm(:DPlayer 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 := dICDAudio;
0209 Wait := true;
0210 Notify := false;
021 i 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 Mode<>mp~~TOPPED 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 iStatsCDLengih := Length;
0230 for iTrack := 1 to iAudioTracks do begin 0231 iStatsTrackStart[iTrack] := TrackPosition[iTrack];
0232 iStatsTrackl_engih[iTrack] := TrackLength[iTrack];
0233 iAudioTrach:Start[iTrack] := TrackPosition[iTrack] div 100 0234 end 0235 end;
0236 eCDPIayerState := psSTOPPED;
023 i iHoIdOffUpdate := 0;
0238 iPIayTimeout :_ ~D;
SUBSTITUTE SHEET (RULE 26) 0239 frmRun.MouseEnable 0240 end;
0241 end.
SUBSTITUTE SHEET (RULE 2fi) 0001 unit Comment;
{_-_________________.____________________________________________________-_}
0003 interface {___________________._____________________________________________________--_}
0005 {$IFDEF WINDOWS}
0006 uses 0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 0008 Fortns, Dialogs, E:xtCtrls, MPlayer, 0009 Run, Main, CDPl;ayer, SysFig, Logging;
0010 {$ELSE}
0011 uses 0012 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 0013 ExtCtrts, StdCtrls;, MPlayer, 0014 Run, Main, CDPfayer, 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;
{___________________.______________________________________________________}
0025 implementation {___________________.____________________________________________________.-_}
{-_________________________________________________________________________}
0028 { Main Code }
{~_________________._____________________________________________________-_-_}
0030 procedure CommentaryStop;
0031 begin 0032 with frmRun.mmCommentary do begin 0033 TimeFormat :_= tfMilliseconds;
0034. LoggingLoglt(IeCOMMENT, Position div 100);
0035 try SUBSTITUTE SHEET RULE 26) 0036 Wait := true;
0037 Notify := false;
0038 Stop 0039 except 0040 end 0041 end 0042 end;
0043 {_-_-----_-__~________~_________w_____}
0044 procedure CommentaryPlay(TrackNo: longint);
0045 begin 0046 with frmRun.mmCommentary do begin 0047 TimeFormat := tfMilliseconds;
0048 LoggingLoglt(IeCOMMENT, Position div 100);
0049 try 0050 FileName := sRunDirectory+'Stuff\Convent'+IntToStr(TrackNo)+'.wav';
0051 Wait := true;
0052 Notify := false;
0053 Open;
0054 Wait := false;
0055 Notify := true;
0056 Pfay 0057 except 0058 frmRun.ErrorMessage('There is a problem with Commentary playback!;
0059 exit 0060 end;
0061 LoggingEvent(IeCOMMENT, IsOTHER, TrackNo, 0) 0062 end;
0063 end;
0064 {___________~____~__w_~______________}
0065 procedure CommentaryNotify;
0066 begin 0067 with frmRun.mmCommentary do begin 0088 TimeFormat := tfMilliseconds;
0069 LoggingLogli(IeCOMMENT, Position div 100) 0070 end 0071 end;
{_________________________________________________________________________}
0073 { Initalize / Exit }
{_______________________________________________________________________ _}
SUBST1TUT~ SHEET (RULE 26) 0075 procedure Commentarylnitialize;
0078 var 0077 fCommentary: T~extFile;
0078 iTrack:lnteger;
0079 begin 0086 for iTrack := 1 to iAudioTracks do begin 0081 bCommentaryAvailable[iTrack] := true;
008 try 0083 AssignFile(fCommentary, sRunDirectory+'StufflConvent'+IniToStr(iTrack)+'.wav');
0084 Reset(fCommentary);
0085 CIoseFile(fl;,ommentary) 0088 except 0087 bCommentaryAvailable[iTrack] := false 0088 end 0089 end 0090 end;
0091 end.
SUBSTITUTE SHEET (RULE 26) 0001 unit Counter;
{___________________________________________________________________________ }
0003 intertace ________________________________________________________________________ _}
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 ExtCtrls, StdCtrts, 0014 Run, Main, Bitmaps, Tube;
0015 {$ENDIF}
0016 {--___-_ ~_________________________}
0017 procedure Counterlnitialize;
0018 procedure CounterExit;
0019 procedure CounterNewTrack;
0020 procedure CounterSetTime(TrackTime: longint};
0021 {__ ____~~w_______________________}
0022 type 0023 TTrackMS = record 0024 Minutes:longint;
0025 Seconds:longint 0026 end;
0027 { _~-__~___w__________~____}
0028 var 0029 OIdTrackMS: TTrackMS;
0030 spriteCounter: TSprite;
{___________________________________________________________________________ _}
0032 implementation ________________________________________________________________________ _}
SU6ST1TUTE SHEET (RULE Z6) 0034 const 0035 COUNTER_COLOR = $OOA00000;
0038 { Code }
_______________.________________________________________________________ _) 0040 procedure CounterNewTrack;
0041 begin 0042 OIdTrackMS.Minutes :_ -1 0043 end;
0044 {_-______________~___________________________) 0045 procedure Counter:~etTime(TrackTime: longint);
0046 var 0047 TrackMS: TTrach:MS;
0048 slime: string[6j;
0049 CounterRect: TRect;
0050 begin 0051 TrackMS.Minutes := TrackTime div 600;
0052 TrackMS.Seconds :_ (TrackTime - 600'TrackMS.Minutes) div 10;
0053 if (TrackMS.Minutes=OIdTrackMS.Minutes) and 0054 (TrackMS.Seconds=OIdTrackMS.Seconds) then 0055 exit;
0056 with bmpPlayer.Canvas do begin 0057 BitmapOverlay(bmpPlayer, spriteCounter, TSprite(nil~));
0058 slime := intTc~Str(TrackMS.Minutes);
0059 if TrackMS.Minutes<10 then 0060 slime :_ '0'~+sTime;
0061 slime := slime+':';
0062 if TrackMS.Seconds<10 then 0063 slime := sT'ime+'0'+IntToStr(TrackMS.Seconds) 0064 else 0065 slime := slime+IntToStrtTrackMS.Seconds);
0066 Brush.Style := bsClear;
0067 Font.Size := 11'extFontSize_2;
0088 Font.Color := i:,OUNTER_COLOR;
0069 Font.Style :_ [/;
0070 CounterRect :~= Bounds(spriteCounler.Left, spriteCounter.Top, SUBSTITUTE SHEET (RULE Z6) 0071 spriteCounler.Width, spriteCounter.Height);
0072 ExtTextOut(Handle, 0073 spriteCounter.Left+2, spr9teCounter.Top+4, 0074 0, cLDCounterRect, Pointer(~sTime[1j), 5, nil);
0075 BitmapUpdateScreen(CounterRect) 0076 end 0077 end;
{_-_________________________________________________________________________ _}
0079 { Initalize / Exit }
{___________________________________________________________________________ _}
0081 procedure Counterlnitiaiize;
0082 begin 0083 BitmapCreate(spriteCounter, frmMain.imgCounter, false);
0084 OIdTrackMS.Minutes :_ -1 0085 end;
0086 {_______________________________~__________________}
0087 procedure CounterExit;
0088 begin 0089 BitmapDestroy(spriteCounter) 0090 end;
0091 end.
SUBSTITUTE SHEET (RULE 26) WO 98/52189 PCT/iJS98/10035 0001 unit Info;
{___._______________._______________________________________________________}
0003 interface {___._______________.______________________________________________________--_}
0005 {$IFDEF WINDOWS}
0006 uses 0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 0008 Forms, Dialogs, 0009 Run, Main, CDPlayer, BitBtns, BitBars, Tube, SysFig;
0010 {$ELSE}
0011 uses 0012 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 0013 ExtCtrls, StdCtrls, 0014 Run, Main, CDPlayer, BitBtns, BitBars, Tube, SysFig;
0015 {$ENDIF}
0016 {________________________._____________________________}
0017 procedure Infolnitialize;
0018 procedure InfoExit;
0019 procedure InfoNewTrack(TrackNo: longint);
0020 {________________________..____________________________}
0021 var 0022 Thelnfo: array [1..MAX_TRACKS] of TTubeList;
{_________________________________________________________________________}
0024 implementation {__________________._____________________________________________________-_-_}
{_______________________________________________________________________.-_}
0027 { Code }
{_________________________________________________________________________}
0029 procedure infoNewTrack(TrackNo: longint);
0030 begin 0031 if eTubeModeState=tmINFO then 0032' TubeDisplay(Thelnfo[TrackNo]);
0033. TubeSetTopLine~(Thelnfo(TrackNo], 1) 0034 end;
{________________________________________________________________________-}
SUBSTITUTE SHEET (RULE 26) 0036 { Initalize / Exit }
{_______________________________________________________________________-__}
0038 procedure Infolnitialize;
0039 var 0040 flnfo: TextFile;
0041 iTrack:lnteger;
0042 I: String[250];
0043 begin 0044 for iTrack := 1 to iAudioTracks do begin 0045 AssignFile(flnfo, sRunDirectory+'Stuff\info'+IntToStr(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(I, nil) 0051 end;
0052 CIoseFile(flnfo);
0053 TubeInitList(spriteTubeText, Thelnfo[iTrack], -3, 0);
0054 end 0055 end;
0056 {_________________________w_____________________}
0057 procedure InfoExit;
0058 var 0059 iTrack:lnteger;
0060 begin 0061 for iTrack := 1 to iAudioTracks do 0062 if Theinfo[iTrack].TextList<>nil then 0063 TubeFacitList(Theinfo[iTrack]) 0064 end;
0065 end.
SUBSTITUTE SHEET (RULE 2fi) 0001 unit IniFig;
_______________.____________________________________________________.
0003 interface {--____________________________________________________________________ -_~
0005 {$IFDEF WINDOWS }
0006 uses 0007 WinTypes, WinProcs, SysUtiis, Messages, Classes, Controls, Inifiles, Registry, 0008 Run, SysFig;
0009 {$ELSE}
0010 uses 0011 Windows, SysUiils, 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: strinct[200];
0022 inilnfoFiie, 0023 iniVoteFile: string[50];
0024 iniAppName, 0025 iniAppTitie: string[100];
0026 iniAIbumHandle, 0027 iniAIbumLabel, 0028 iniAIbumArtist, 0029 iniAIbumName: 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 iniPIayByeBye: Boolean;
SUBSTITUTE SHEET (RULE 26) 0040 iniVoteLimit: integer;
{_________________________________________________________________________) 0042 implementation ____________________________________________________________________ 0044 function InifigLoad: Boolean;
0045 var 0046 flniFlle: 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+'IQPlayer.ini');
0059 Reset( flniFile);
0060 CIoseFile( flniFile);
0061 except 0062 exit 0063 end;
0064 try 0065 Ini := TIniFile.Create( sRunDirectory+'IQPlayer.ini');
0066 except 0067 exit 0068 end;
0069 try 0070 iniCryptPublic := Ini.Readlnteger('Intemet', 'CryptPublic', -1);
0071 iniCryptPrime := Ini.Readlnteger('Intemet', 'CryptPrime', -1);
0072 inilnfoFile := Ini.ReadString('Intemet', 'Filelnfo', ");
0073 inilnfoURL := Ini.ReadString('Internet', 'URLlnfo', ");
0074 iniVoteFile := Ini.ReadString('internet', 'FileVote', ");
0075 iniVoteURL := Ini.ReadString('Intemet', 'URLVote', ");
0076 iniAIbumHandle := Ini.ReadString('Aibum', 'Handle', ");
0077 iniAlbumLabel := Ini.ReadString('Album', 'Label', ");
0078 iniAIbumArtist := ini.ReadString('Album', 'Artist', ");
SUBSTITUTE SHEET (RULE 26) 0079 iniAIbumName := Ini.ReadString('Album', 'Name', ");
0080 iniAppName :_ Ini.ReadString('Application', 'Name', ");
0081 iniAppTitle := ini.ReadString('Application', 'Title', ");
0082 iniWallpaper :== Ini.ReadString('Application', 'Wallpaper', ");
0083 iniScreenSaver := iniWallpaper;
0084 sPlaylntro := Uppercase(Ini.ReadString('Application', 'Playlntro', "));
0085 sAskVote := Uppercase(ini.ReadString('Application', 'AskVote', "));
0086 sAskVideo := Uppercase(Ini.ReadString('Application', 'AskVideo', "));
0087 sSendVote := Uppercase(Ini.ReadString('Application', 'SendVote', "));
0088 sSendlnfo := Uppercase(Ini.ReadString('Application', 'Sendlnfo', "));
0089 iniPIayByeBye := Ini.ReadBool('Application', 'PIayBye', false);
0090 iniVoteLimit := Ini.Readlnteger('Application', 'Votel_imit', -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 inifnfoURL=" then exit;
0099 if iniVoteURL=" then exit;
0100 if iniVoteFile=" then exit;
0101 if iniAibumHandlE:=" then exit;
0102 if iniAlbumLabel=~" then exit;
0103 if iniAIbumArtist=" then exit;
0104 if iniAIbumName~=" then exit;
0105 if iniAppName=" then exit;
0106 if iniAppTitle=" then exit;
0107 if iniWallpaper=" then exit;
0108 if iniScreenSavei=" then exit;
0109 if sPiayintro='ONCE' then iniPlaylntro := qfONCE
0110 else if sPiaylntro~='ALWAYS' then iniPlaylntro := qfALWAYS
0111 else if sPlaylntro~='NEVER' then iniPlaylntro := qfNEVER
0112 else 0113 exit;
0114 if sAskVote='ON1;,E' 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
SUBSTITUTE SHEET (RULE 26~
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 iniVoteLimit=-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\'+iniAibumHandle+'\Info';
0143 try 0144 if Reg.OpenKey(sKey,true) then Reg.WriteString('URL',inilnfoURL+'lappend.cgi?file='+inilnfoFile+'&data='}
0146 except 0147 exit 0148 end;
0149 Reg.RootKey := HKEY LOCAL MACHINE;
0150 sKey :='\SOFTWAREIPalantir\IQcd\'+iniAlbumHandle+'\Vote';
0151 try 0152 if Reg.OpenKey(sKey,true) then Reg.WriteString('URL',iniVoteURL+'/append.cgi?file='+iniVoteFile+'&data=') 0154 except 0155 exit 0156 end;
0157 result := true 0158 end;
0159 end.
SUBSTITUTE SHEET' (RULE 26) 0001 unit IQAbout;
{________________________________________ . ______________________________-}
0003 interface {__________________._____________________________________________________-_-_}
0005 {$IFDEF WINDOWS}
OOOf> uses 0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 000& Forms, Dialogs, 000 Run, Main, Tube, Bitmaps, SysFig;
001 G {$ELSE}
0011 uses 001! Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 001 3 ExtCtrls, StdCtrf:>, 0014 Run, Main, Tube, Bitmaps, SysFig;
0015 {$ENDIF}
001ii {-------____________..__________________________}
001 i' procedure Aboutlnitialize;
0015 procedure AboufExit;
001 g {----_______________.__________________________}
0020 var 0021 spriteTubeCDABout, 002.? spriteTubeIQAbout: TSprite;
002a TheCDAbout: T1-ubeList;
0024 TheIQAbout: TTubeList;
{___._______________.______________________________________________________-}
002Ei implementation 002 i' 0029 { Code }
{__________________._____________________________________________________-_-_}
0031 procedure Aboutlnitialize;
0032 var 003:3 fAbout: TextFile;;
0034 I: string[100J;
0035 begin;
SUBSTITUTE SHEET (RULE 26) WO 98/52189 t'CT/US98/10035 0036 BiimapCreate(spriteTubeCDAbout, frmMain.imgTube_CDAbout, true);
0037 BitmapCreate(spriieTubeIQAbout, frmMain.imgTube_IQAbout, true);
0038 TheCDAbout.TextList := TStringList.Create;
0039 AssignFile(fAbout, sRunDirectory+'StufflCDlnfo.txt');
0040 Reset(fAbout);
0041 while not Eof(fAbout) do begin 0042 ReadLn(fAbout, I);
0043 TheCDAbout.TextList.AddObject(I, nil) 0044 end;
0045 CIoseFile(fAbout);
0046 TubeInitList(spriteTubeCDAbout, TheCDAbout, -3, 0);
0047 TheIQAbout.TextList := TStr9ngList.Create;
0048 AssignFile(fAbout, sRunDirectory+'Stuff\IQlnfo.txt');
0049 Reset(fAbout);
0050 while not Eof(fAbout) do begin 0051 ReadLn(fAbout, I);
0052 TheIQAbout.TextList.AddObject(I, nil) 0053 end;
0054 CIoseFile(fAbout);
0055 TubeInitList(spriteTubeIQAbout, TheIQAbout, -3, 0) 0056 end;
0057 {____________________________________________}
0058 procedure AboutExit;
0059 begin 0060 TubeExitLisf(TheIQAbout);
0061 TubeExitList(TheCDAbout);
0062 BitmapDestroy(spriteTubeCDAbout);
0063 BitmapDestroy(spriteTubeIQAbout) 0064 end;
0065 end.
SUBSTITUTE SHEET (RULE 26) 0001 unit IQMenu;
{___________________.______________________________________________________}
0003 interface {___________________.______________________________________________________}
0005 {$IFDEF WINDOW~~}
0006 uses 0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 0008 Forms, Dialogs, L:MDnonvS, 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, StdCtrls, LMDnonvS, IniFiles, Registry, 0014 Run, Main, Tube, Bitmaps, Wall, Saver, SysFig;
0015 {$ENDIF}
0016 {____________________________________________________}
0017 var 0018 TheMenu: TTubel_ist;
0019 {_____________~____~____________________________}
0020 procedure Menulniti~alize;
0021 procedure MenuExit;
0022 function MenuGetLine(Menuftem: longint): longint;
0023 procedure MenuEnableltem(Menultem: longint);
0024 procedure MenuDissableltem(Menultem: fongint);
0025 procedure MenuUpdate;
0026 procedure MenuHighlightltem(Menuitem: longint);
0027 procedure MenuMouseDown;
0028 procedure MenuMouseMove(X,Y: longint);
0029 procedure MenuTimerTick;
{____._______________.____________________________________________________-_-_}
0031 implementation {____._______________.____________________________________________________-_-_}
0033 var 0034 iHintltem:longint;
0035 iHintX, iHintY: longint;
0036 iHintDelayTimer:llongint;
0037 sHintMsg: string[250];
SUBSTITUTE SHEET (RULE 26) 0038 bHintVisible: Boolean;
0039 blnHintArea: Boolean;
{_________________________________________________________________________}
0041 { Main Code }
{_________________________________________________________________________}
0043 function MenuGetLine(Menultem: longint): longint;
0044 var 0045 iLine:longint;
0046 iLastLine:longint;
0047 {pTubeLine: pTTubet_ine;}
0048 begin 0049 iLastLine := TheMenu.TextList.Count-1;
0050 {for iLine := 0 to iLastLine do 0051 pTubeLine := pTTubeLine(TheMenu.TextList.Objects[iLine]);
0052 if pTubeLine~.iTimeStamp=Menultem then begin}
0053 for iLine := 0 to iLastLine do 0054 with pTTubeLine(TheMenu.TextList.Objects[iLinej)~ do 0055 if iTimeStamp=Menultem then begin 0056 result := iLine+1;
0057 exit 0058 end;
0059 frrnRun.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;
0087 {- __~ _~_____________~__}
0068 procedure MenuDissableltem(Menultem: longint);
0069 begin 0070 TubeSetDissable(TheMenu, MenuGetLine(Menultem)) 0071 end;
0072 { _~_ _w__________________~}
0073 procedure MenuHighlightttem(Menultem: longint);
0074 begin 0075 TubeSetAlINormal(TheMenu);
0076 TubeSetHighlight(TheMenu, MenuGetLine(Menultem)) SUBSTITUTE SHEET (RULE 26) 0077 end;
0078 {_____~___~__~____________________________) 0079 procedure MenuUpt~ate;
0080 var 0081 menu: TStringLis~t;
0082 iLine, iLastLine: integer;
0083 begin 0084 menu := TheMenu.TextList;
0085 iLastLine := menu.Count-1;
0086 for iLine := 0 to il_astLine do 0087 case pTfubeLine(menu.Objects[iLine]).iTimeStamp of 0088 4: if UsingOurWallpaper and not UsingThisWallpaper(startWaIIpaperName) then 0089 menu.Strings[iLine] :='{!s12 h15 c020}Previous Wallpaper' 0090 else 0091 menu.Strings[iLine] :='{!s12 h15 c020}Install Wallpaper';
0092 5: if UsingOurSaver and not UsingThisSaver(startScreenSaver) then 0093 menu.Strings[iLine] :='{lsl2 h15 c020}Previous Screen Saver' 0094 else 0095 menu. Strings[iLine] :='{!s12 h15 c020}install 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}Turn Wallpaper On';
0100 9: if bHintsE=nabled then 0101 menu.Strings[iLine] :='{!s12 h20 c020}Tum Hints Off 0102' else 0103 menu.~~trings[iLine] :='{!s12 h20 c020}Turn Hints On' 0104 end;
0105 TubeRefresh(TheMenu) 0106 end;
{_________________________________________________________________________}
0108 { Mouse Handling }
{_________________________________________________________________________}
0110 procedure MenuMouseDown;
0111 var 011.>. iMenultem:longint;
011:4 begin 0114 if eTubeModeState<>tmMENU then 0115 exit;
SUBSTITUTE SHEET (RULE 26) 0116 iMenultem := TubeItemHit(iMOuseDownX,iMOuseDownY);
0117 if iMenultem>0 then begin 0118 iHintDelayTimer := 0;
0119 if bHintVisible then begin 0120 frmRun.blobHint.HideMessage;
0121 bHintVisibie := 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 eTubeModeState<>tmMENU then 0134 goto exitl;
0135 iHintX := frmRun.Left+X+5;
0136 iHintY := frmRun.Top+Y_0;
0137 iltem := TubeItemHit(X,Y);
0138 if iltem>0 then begin 0139 if iltem<>iHiniltem then begin 0140 if bHintVisible then begin 0141 frmRun.bIobHint.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.bIobHint.HideMessage;
0155 bHintVisible := false 0156 end SUBSTITUTE SHEET (RULE 26) 0157 end;
0158 {__~___~____ __.._____~______~______}
0159 procedure MenuTimierTick; -0160 begin 0161 if iHintDelayTimer=0 then 0162 exit;
0163 Dec(iHintDelayTimer);
0164 if iHintDelayTimer=0 then begin 0165 if bHintVisible then 0166 frmRun.bIobHint.HideMessage;
0167 iHintLastX := il~intX;
0168 iHintLastY := iliintY;
0169 sHintLastMsg ::= sHintMsg;
0170 frmRun.bIobHint.Position := hpAboveRight;
0171 frmRun.bIobHint.ShowMessage(sHintMsg, iHintX, iHintY);
0172 bHintVisible := true 0173 end 0174 end;
{-______________________________________________________________________-_-_}
0176 { Initalize / Exit }
{-__________________.______________________________________________________}
0178 procedure Menulnitialize;
0179 begin;
0180 TheMenu.TextList := TStringList.Create;
0181 TheMenu.TextList.AddObject('{h20}', Pointer(0));
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}Install Wallpaper', Pointer(4));
0186 if not UsingOurSaver then 018i' TheMenu.TextList.AddObject('{!s12 h15 c020}Install Screen saver', Pointer(5));
0188 if UsingWallpaper then 0189 TheMenu.TextList.AddObject( '{!s12 h20 c020}Tum Wallpaper On', Pointer(7)) 0190 else 0191 TheMenu.TextLisl.AddObject( '{!s12 h20 c020}Turn Wallpaper Off, Pointer(7));
0192 if not bVideoEnable then begin 0193 TheMenu.TextList.AddObject('{!s12 h15 c020}Install Web Link', Pointer(6));
0194 TheMenu.TextList.AddObject('{!s12 h15 c020}Install Active Movie', Pointer(8)) 019!i end SUBST1TUT~ SHEET (RUL~ 26) 0196 else 0197 TheMenu.TextList.AddObject('{!s12 h15 c020}Install Web Link', Pointer(6));
0198 TheMenu.TextList.AddObject('{IS12 h20 c020}Turn Hints Off, Pointer(9));
0199 TubeInitList(spriteTubeMenu, TheMenu, -3, 8);
0200 sHintMsg :='Click selection to do it.';
0201 iHintltem := 0;
0202 iNintDelayTimer := 0;
0203 bHintVisible := false;
0204 blnHintArea := false;
0205 sCurrentWal! :_ ";
0206 sCurrentTile :='0';
0207 sCurrentSaver :_ "
0208 end;
0209 {_____________________________________________}
0210 procedure MenuExit;
0211 begin 0212 TubeExitList(TheMenu) 0213 end;
0214 end.
SUBSTITUTE SHEET (RULE 26) program IQPlayer;
uses Forms, Run in 'RUN.PAS' {frmRun}, Main in 'MAIN.PAS' {frmMain}, Video in'VIDEO.PAS' {frmVideo}, Regions in'REGIONS.P~AS', Bitmaps in'BITMAPS.PAS', BitBars in 'BITBARS.PA,~ , Bitgtns in 'BITBTNS.PA;'>'>', ScroIBar in 'SCROLBAR.PAS', TimeBar in 'TIMEBAR.P,AS', VolumBar in 'VOLUMBAR.PAS', PIayList 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', Cornment in'COMMENI'.PAS', CDPlayer in 'CDPLAYER.PAS', IQMenu in'IQMenu.pas'., IQA,bout in'IQAbout.pas", TrkIUledia 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}
begirt Application.lnitialize;
Application.CreateForm(TfrmRun, frmRun);
Application.Run;
end.
SUBSTITUTE SHEET (RULE 26) 0001 unit Logging;
{_________________________________________________________________________}
0003 interface {_________________________________________________________________________}
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 ExtCtris, StdCtrls, Registry, 0014 Run, IniFig, RegFig, SysFig, Wall, Saver;
0015 {$ENDIF}
0016 {________________________________________________}
0017 type 0018 TLogEvent = (IePLAY, IeVIDEO, IeCOMMENT, IeWALL, IeLINK, IeSAVER, 0019 IeNONE );
0020 TLogStart = (IsPLAY, IsRESUME, IsTIMEBAR, IsWORDS, IsTRACK, IsNEXT, IsOTHER);
0021 {_----_____~____________________________________}
0022 procedure LogginglnitialiZe;
0023 procedure LoggingEvent(event: TLogEvent; start: TLogStart; track, time0:
integer);
0024 procedure LoggingLoglt(event: TLogEvent; time1: integer);
{________________________________________________________________________-_}
0026 implementation ~_________________________________________________________________________}
0028 uses 0029 CDPlayer;
0030 {--------__~_~_~_~__w_____~_______}
0031 const 0032 sEvents: array [IePLAY..IeNONE) of string =
0033 ('PLAY', 'VIDEO', 'COMMENT', 'iWALL', 'iLINK', 'iSAVER', '?');
0034 sE2vents: array (IePLAY..)eNONE] of string =
0035 ('Pc', 'Pv', 'Pm', 'Iw', 'll', 'Is', '?');
0036 sStarts: array [IsPLAY..IsOTHER) of string =
0037 ('play', 'resume', 'timebar', 'words', 'track', 'next', 'other');
SUBSTITUTE SHEET (RULE 26~
003x {__---____~_____~..___~____________~_}
0039 var 0040 regFirstRun: string[30]; _ 0041 Logln, LogOut, LogSeq: integer;
0042' IogXevent: TLogEvent;
0043. IogXstart: TLogStart;
0044 IogXtrack: integer;
0045 IogXtimeO: integer;
0046.
{_________________________________________________________________________}
0047 { Code }
004a {_________________________________________________________________________}
0049 procedure LoggingEvent(event: TLogEveni; start: TLogStart; track, time0:
integer);
0050 begin 0051 IogXevent := event;
0052' iogXstart := start;
0053. iogXtrack := track;
0054 IogXtimeO := time0;
0055~ end;
0056. { __w_____~.._________________w____.}
005T procedure LoggingLoglt(event: TLogEvent; timel: integer);
0056 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 0066 exit;
0066 if (IogXevent=ieNONE) or (IogXevent<>event) then 0076 exit;
0071 if IogXtimeO<0 then 007! IogXtimeO := 0;
0073 if timel <IogXtimeO then 0074 timel := IogXtimeO;
007:1 if timel=IogXtimeO then 007Et exit;
SUBSTITUTE SHEET (RULE 26~
0077 Log :_ 'v1.00,'+iniAIbumHandle+','+regNandle+
0078 ','+regFirstRun+','+SysPad(LogSeq,6)+
0079 ','+regZip+','+regAge+','+regSex+',,.
0080 case eTubeModeState of 0081 tmTRACKS: s := Tt';
0082 ImWOROS: s :='Tw';
0083 tmINFO: s := Ti ;
0084 else 0085 s :_ 'To' 0086 end;
0087 Log := Log+s+',';
0088 For iTrack := 1 to iAudioTracks do 0089 if bTrackEnabled[iTrack] then 0090 Log := Log+'E' 0091 else 0092 Log := Log+'d';
0093 if WaIIpaperOurslnstalled then 0094 Log := Log+',Y' 0095 else 0096 Log := Log+',n';
0097 if UsingWallpaper then 0098 Log := Log+'Y' 0099 else 0100 Log := Log+'n ;
0101 if UsingOurWalfpaper 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+'Y' 0111 else 0112 Log := Log+'n';
0113 if UsinpOurSaver then 0114 Log := Log+'Y' 0115 else 0116 Log := Log+'n';
0117 if regHasTargetPage then SUBSTITUTE SHEET (RULE 2fi) fi5 0118 Log := Log+',1'',' 0119 else 0120 Log := Log+',n,';
0121 Log := Log+sE2vents[iogXevent]+SysPad(IogXtrack,2)+
0122 ','+FormatDateTime('yyyy/mmldd-hh:nnas', Now)+
0123 ','+sEvents[fogXevent]+','+sStarts[IogXstart]+','+SysPad(IogXtrack,2)+
0124 ','+IntToStr(IogXtimeO)+',~+IntToSir(time1)+','+IntToStr(timel-IogXtimeO);
0125 IogXevent := IeNONE;
0126 try 0127 Reg := TRegistry.Create 0128 except 0129 exit 0130 end;
0131 Reg.RootKey := HKEY LOCAL_MACHINE;
0132 sKey :='1SOFTWAREIPalantir\IQcd1'+iniAIbumHandle+'lVote';
0133 try 0134 if Reg.OpenKey(sKey,true) then 0135 Reg.WriteString('x'+SysPad(logln,9), log);
0136 Inc(logln) 0137 except 0138 end;
0139 try 0140 Reg.Writelnteger('In', Logln) 0141 {Reg.Writefnteger('Out', LogOut)}
0142 except 0143 end;
0144 Reg.CIoseKey;
0145 Reg.Free;
0146 end;
~_________________________________________________________________________}
0148 { Initalize / Exit }
{___.._______________,______________________________________________________}
0150 procedure Logginglnitialize;
0151 var 0152 Reg: TRegistry;
0153 sKey, sValue: string[200];
0154 iTrack: integer;
0155 st: string[3];
0156 begin SUBSTITUTE SHEET (RULE 26) 0157 try 0158 Reg := TRegistry.Create 0159 except 0160 exit 0161 end;
0162 Reg.RootKey := HKEY LOCAL MACHINE;
0163 sKey :='1SOFTWARE\Palantir\IQcdl'+iniAIbumHandle;
0164 try 0165 if Reg.OpenKey(sKey,true) then begin 0166 sValue :_ 'FirstRun ;
0167 if not Reg.ValueExists(sValue) then begin 0168 regFirstRun := FormatDateTime('yyyylmm/dd-hh:nnas', Now);
0169 Reg.WriteString(sValue, regFirstRun) 0170 end 0171 else 0172 regFirstRun := Reg.ReadString(sValue);
0173 Reg.WriteString('Label',iniAIbumLabel);
0174 Reg.WriteString('Artist',iniAIbumArtist);
0175 Reg.WriteString('Name',iniAIbumName);
0176 Reg.WriteString('Wallpaper',iniWallpaper) 0177 end 0178 except 0179 end;
0180 Reg.RootKey := HKEY LOCAL MACHINE;
0181 sKey :_ '1SOFTWARE\PalantirllQcd\'+iniAIbumHandle+'\Info';
0182 try 0183 if Reg.OpenKey(sKey,true) then begin 0184 for iTrack := 1 to iAudioTracks do begin 0185 if iTrack<10 then st :='0'+IntToStr(iTrack) 0186 else st := IntToStr(iTrack);
0187 Reg.Writelnteger(st+'-Begin', iStatsTrackStart[iTrack]);
0188 Reg.Writelnteger(st+'-Length', iStatsTrackLength[iTrack]) 0189 end;
0190 Reg.Writelnteger('TotaIBegin', iStatsCDStart);
0191 Reg.Writelnteger('TotaILength', iStatsCDLength) 0192 end 0193 except 0194 end;
0195 Reg.RootKey := HKEY LOCAL MACHINE;
0196 sKey :='1SOFTWARE\Palantir\IQcd\'+iniAlbumHandle+'\Vote';
0197 Logln := 1;
SUBSTITUTE SHEET (RULE 26) 0198 LogOut := 1;
0199 try 0200 if Reg.OpenKey{sKey,true) then begin 0201 if Reg.ValueExists('In~ then 0202 Logln := Reg.Readlnteger('In');
0203 if Reg.ValueExists('Out') then 0204 LogOut :== Reg.Readlnteger('Out');
0205 Reg.Writelnteger('In', logln);
0206 Reg.Writelnteger('Out', IogOut);
0207 if Reg.ValueExists('Sequence') then 0208 LogSeq : = Reg.Readlnteger('Sequence') 0209 else 0210 Logseq := 0;
0211 Inc(LogSeq);
0212 Reg.Writelnteger('Sequence', IogSeq) 0213 end 0214 except 0215 Logln := 1;
0216 LogOut := 1;
0217 LogSeq := 1 0218 end;
0219 Reg.CloseKey;
0220 Reg.Free;
0221 iogXevent := IeN~ONE
0222 end;
0223 end.
SUBSTITUTE SHEET (RULE 26) WO 98!52189 PCT/US98/10035 0001 unit Logo;
{_________________________________________________________________________}
0003 interface {_________________________________________________________________________}
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, StdCtrls, 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_Up, sprifeLogo_Down: TSprite;
{_________________________________________________________________________}
0026 implementation {_________________________________________________________________________}
{_________________________________________________________________________}
0029 { Local Routines }
{_________________________________________________________________________}
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;
SUBSTITUTE SHEET (RULE 26) ~___.________________.______________________________________________________}
0037 { Main Code }
{_________________________________________________________________________}
0039 procedure LogoMouseMove(X,Y: longint);
0040 var 0041 LogoRect: Trect;
0042 begin 0043 with spriteLogo_Up do 0044 LogoRect := B~ounds(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 BitmapOvertay(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.LogoC.licked 0063 end;
{___.________________.______________________________________________________}
0065 { Initalize I Exit }
{_________________________________________________________________________}
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;
SUBSTITUTE SHEET (RULE 26) 0073 { _--__~__~____~w________~_~_}
0074 procedure LogoF~cit;
OD75 begin 0076 BitmapDestroy(spriteLogo_Down);
0077 BitmapDestroy(spriteLogo_Up) 0078 end;
0079 end.
SUBSTITUTE SHEET (RULE 26) 0001 unit Main;
0003 interface {__._______________________________________________________________________}
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, StdCtrls;
0013 {$ENDIF}
0014 {_________~__~_______________________________}
0015 type 0016 TfrmMain = class(TForm) 0017 imgExit Up: Tlmage;
0018 imgExit Down: Tlmage;
0019 imglnfo_Up: Tlmage;
0020 imginfo_Down: Tlmage;
002'1 imgWords Up: Tlmage;
0022 imgWords_Down: Tfmage;
0023 imgTracks_Up: Tlmage;
0024 imgTracks_Down: Tlmage;
0025 imgPrint Up: Tfmage;
0026 imgPrint Down: Tlmage;
0027 imgVideo_Up: 'flmage;
0028 imgVideo_Down: Tlmage;
0029 imgCommentaiy_Up: Tlmage;
0030 imgCommentaiy_Down: Tlmage;
0031 imgPlay_Up: TNmage;
0032 imgPlay_Down: Tlmage;
0033 imgStop Up: Tlmage;
0034 imgEject Down: Tlmage;
0035 imgStop_Down: Tlmage;
0036 imgEject Up: T'Image;
0037 imgRandom UpOff: Tlmage;
0038 imgRandom Upon: Tlmage;
0039 imgRandom_DownOn: Tlmage;
SUBSTITUTE SHEET (RULE 26) 0040imgRandom_DownOff:
Tlmage;
0041imgTime_Endl: Tlmage;
0042imgVolume_Endl: Tlmage;
0043imgScrolt Rod: Tlmage;
0044imgVolume_Rod: Tlmage;
0045imgTime_Rod: Tlmage;
0046imgCounter: Timage;
0047imgPause_Up: Tlmage;
0048imgResume_Up: Tlmage;
0049imgPause_Down: Tlmage;
0050imgResume_Down: Tlmage;
0051imgTracks Back: Tlmage;
0052imgVolume_Back: Tlmage;
0053imgScroll Back: Tlmage;
0054imgTime_Back: Tlmage;
0055imgScroll Endl: Tlmage;
0056imgScroll End2: Tlmage;
0057imgScroll Button:
Tlmage;
0058imgTime_End2: Tlmage;
0059imgTime_Button: Tlmage;
0060imgVolume_End2: Tlmage;
0061imgVoiume_Button:
Tlmage;
0062imgTracks LedOn: Tlmage;
0063imgTracks_LedOff:
Tlmage;
0064imgPlayer: Tlmage;
0065imgLogo_Up: Tlmage;
0066imgLogo_Down: Tlmage;
0067imgTube_Intro: Tlmage;
0068imgTube_Tent: Tlmage;
0069imgTube_CDAbout: Tlmage;
0070imgTube_IGtAbout:
Tlmage;
0071imgMenu_Bullet: Tlmage;
0072imgPalette: Tlmage;
0073imgTracks Video: Timage;
0074imgTracks Comment:
Timage;
0075imgTracks Cyes: Tlmage;
0076imgTracks_Cno: Tlmage;
0077imgTracks_Vyes: Tlmage;
0078imgTracks_Vno: Tlmage;
0079imgTracks_Block: Tlmage;
0080imgTube_Menu: Tlmage;
SUBSTITUTE SHEET (RULE 26) 0081 imgTbQyes Up: Tlmage;
0082'. imgTbQyes Down: Tlmage;
0083'. imgTbQno_Up: Tlmage;
0084. imgTbQno Down: Tlmage;
0085 end;
008E~ {__-___~____~___..~_~________________ 0087 var 0088 frmMain: TfrmMain;
{___._______________._____________ 009(1 implementation 0091 {$R *.DFM}
009i!
009;1 0091 end.
SUBSTITUTE SHEET (RULE 26~
0001 unit PIayList;
{_______________________________________~-____-______---_-____-___=_-_--__}
0003 intertace {________________________________________________________________________-}
0005 {$IFDEF WINDOWS}
0006 uses 0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 0008 Forms, Dialogs, LMDnonvS, 0009 Run, Main, CDPlayer, Tube, BitBtns, SysFig;
0010 {$ELSE}
0011 uses 0012 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 0013 ExtCtrls, StdCtrls, LMDnonvS, 0014 Run, Main, CDPlayer, Tube, BitBtns, SysFig;
0015 {$ENDIF}
0016 {_______~______________________________________}
0017 procedure PIayListlnitialize;
0018 procedure PIayListExit;
0019 procedure PIayListNewTrack(TrackNo: longint);
0020 procedure PIayListTrackEnable(TrackNo: longint);
0021 procedure PIayListTrackDissable(TrackNo: longint);
0022 procedure PIayListMouseDown;
0023 procedure PIayListMouseMove(X,Y: longint);
0024 procedure PIayListTimerTick;
0025 {---_--_______w_____~______________________}
0026 var 0027 ThePfayList: TTubeList;
{________________________________________________________________________-}
0029 implementation {--_____________________________________________________________________-_-_}
0031 var 0032 iHintltem:longint;
0033 iHintX, iHintY: longint;
0034 iHintDelayTimer:longint;
0035 sHintMsg: string[250};
0036 bHintVisible: Boolean;
0037 blnHintArea: Boolean;
SUBSTITUTE SHEET (RULE 26) {___.______________________________________________________________________}
003~J { Main Code - }
004(1 {___.______________________________________________________________________}
0041 procedure PIayListNewTrack(TrackNo: longint);
0042 begin 00421 TubeSetAlINormal(ThePIayList);
0044 TubeSetHighlight(ThePIayList, TrackNo);
004~i if eTubeModeState=tmTRACKS then 0046 TubeDisplay(fhePIayLisi) 004 i' end;
0046 {-____~_______________________________________}
004u procedure PIayListTrackEnable(TrackNo: longint);
005(1 begin 0051 TubeSetEnable(ThePIayList, TrackNo);
0052 end;
005:1 {________________________~____________________}
0054 procedure PIayListTrackDissable(TrackNo: longint);
005:1 begin 005Ei TubeSetDissable(ThePIayList, TrackNo);
005i' frmRun.TrackDissable(TrackNo) 0056 end;
{___.______________________________________________________________________}
006(1 { Mouse Handling }
{___.___________________________________________________________________ __}
0062 procedure PIayListMouseDown;
0063 var 0064 iTrack:longint;
0065 begin OC16f3 if eTubeModeState<>tmTRACKS then 006 ~~ exit;
0066 iTrack := TubeitemHit(iMOuseDownX,iMOuseDownl~;
OC166 if iTrack>0 then begin 007() iHintDelayTimer := 0;
007'1 if bHintVisible then begin 007.? frmRun.bIobHint.HideMessage;
007;3 bHintVisible := false 0074 end;
SUBSTITUTE SHEET (RULE 26) 0075 if bTrackEnabled[iTrack] then 0076 frmRun.TrackClicked(iTrack) 0077 end 0078 end;
0079 {_----___ _____~__~_________~___}
0080 procedure PIayListMouseMove(X,Y: longint);
0081 var 0082 iltem:longint;
0083 label 0084 exitl ;
0085 begin 0086 if eTubeModeState<>tmTRACKS then 0087 goto exitl ;
0088 iHintX := frmRun.Left+X+5;
0089 iHintY := frmRun.Top+Y-0;
0090 iltem := TubeItemHit(X,Y);
0091 if iltem>0 then begin 0092 if iltem<>iHintitem then begin 0093 it bHintVisible then begin 0094 frrnRun.bIobHint.HideMessage;
0095 bHintVisible := false 0096 end;
0097 iHintDeiayTimer := HINT DELAY;
0098 iHintltem := iltem 0099 end;
0100 exit 0101 end;
0102 exit1:
0103 iHintDelayTimer := 0;
0104 iHintltem := 0;
0105 if bHintVisible then begin 0106 frmRun.bIobHint.HideMessage;
0107 bHintVisible := false 0108 end 0109 end;
0110 {__-- ~___~~__~_____________}
0111 procedure PIayLisfTimerTick;
0112 begin 0113 if iHintDelayTimer=0 then 0114 exit;
0115 Dec(iHintDelayTimer);
SUBSTITUTE SHEET (RULE 26) 0116 if iHintDelayTimer=0 then begin 0117 if bHintVisibie then 0118 frmRun.bIobHint.HideMessage;
0119 iHintLastX := iHintX;
0120 iHintLastY := iHintY;
0121 sHintLastMsg := sHintMsg;
0122 frmRun.bIobH int.Position := hpAboveRight;
0123 frmRun.blobHint.ShowMessage(sHintMsg, iHintX, iHintY);
0124 bHintVisible := true 0125 end 0126 end;
{_________________________________________________________________________) 0128 { Initalize / Exit ) {_________________________________________________________________________) 0130 procedure PIayListlnitialize;
0131 var 0132 fTracks: TextFile;
0133 I: string[250];
0134 begin;
013.5 ThePIayList.TextList := TStringList.Create;
0136 AssignFile(fTracks, sRunDirectary+'Stuff\Tracks.txt');
013.7 Reset(fTracks);
0138 iAudioTracks :_ 0;
0139 while not Eof(fTracks) and (iAudioTracks<MAX_TRACKS) do begin 0140 Inc(iAudioTracks);
0141 ReadLn(fTracks, I);
0142 ThePIayList.'TextList.AddObject(I, Pointer(iAudioTracks));
0143 end;
0144 CIoseFiie(fTracks);
0145 TubeInitList(spriteTubeText, ThePIayList, 0146 iTextBIockHeight div iAudioTracks, 0);
0147 sHintMsg :='Click title to select track.';
0148 iHintltem := 0;
0149 iHintDelayTimer := 0;
01:10 bHintVisible := false;
01:11 blnHintArea := false 0152 end;
0153 {_ __________..____~____________________) 0154 procedure PIayListF~cit;
SUBSTITUTE SHEET (RULE 26) 0155 begin 0156 TubeExitList(ThePIayList) 0157 end;
0158 end.
SUBSTITUTE SHEET (RULE 26) 0001 unit ~YesNo;
{__._______________________________________________________________________) 0003 intertace {__.______________________________________________________________________--_}
0005 {$IFDEF WINDOWS}
0008 uses 000'l SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 0003 Forms, Dialogs, 0009 Run, Main, Bitmaps, Tube, SysFig;
00117 {$ELSE}
0011 uses 0012 Windows, Messages, SysUiils, Classes, Graphics, Controls, Forms, Dialogs, 001:3 ExtCtrls, StdCtrls, 0014 Run, Main, Bitmaps, Tube, SysFig;
0015 {$ENDIF}
00113 (_________.___~________~______________________}
001'7 type 001 f3 TProc = Procedure;
001 !3 (-_~_~__~______._________~___________}
0020 var 002'1 Thet3video: TTubeList;
0022 Thef3vote: TTubelist;
002;3 {------_---------___~~___________________}
0024 procedure Qynlnitialize;
0025 procedure QynF~cit;
0026 procedure QynAsk(var TubeQ: TTubeList; xYes, xNo: TProc);
0027 procedure QynMouseMove(X,Y: longint);
0028 procedure QynMouseDown;
{___._____________________________________________________________________-}
0030 implementation 003'1 (___._____________________________________________________________________-}
0032 var 003;3 bYesDown, 003~t bNoDown: Boolean;
003;1 spriteQyes Up, 003fi spriteQyes Down, 0037 spriteQno_Up, SUBSTITUTE SHEET (RULE 26) WO 98/52189 PCT/(1S98/10035 0038 spriteQno_Down: TSprite;
0039 qaYes, qaNO: TProc;
0040 _ {_______________________________________________________________________-__}
0041 { Local Routines }
{_________________________________________________________________________}
0043 function QHit(var Sprite: TSpr9te; 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;
{_________________________________________________________________________}
0049 { Main code }
{_________________________________________________________________________}
0051 procedure QynAsk(var TubeQ: TTubeList; xYes, xNo: TProc);
0052 begin 0053 TubeDisplay(TubeQ);
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;
{_________________________________________________________________________}
0063 { Mouse support }
{_________________________________________________________________________}
0065 procedure QynMouseMove(X,Y: longint);
0066 begin 0067 if eTubeModeState<>tmQYN 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 SUBSTITUTE SHEET (RULE 26) 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 eTubeModeState<>tmQYN then 0098 exit;
0099 if BitmapHit(spriteQyes Up) then 0100 qaYes;
0101 if BitmapHit(spriteQno_Up) then 0102 qaNo;
0103 end;
{___________________.____________________________________________________-_-_}
0105 { Initalize / Exit }
{_______________________________________________________________________-__}
0107 procedure Glynlnitialize;
0108 var 0109 fQ: TextFile;
0110 I: string[250];
0111 begin SUBSTITUTE SHEET (RULE 26) 0112 BitmapCreate(spriteQyes Up, frmMain.imgTbQyes_Up, false);
0113 BitmapCreate(spriteQyes Down, frmMain.imgTb~yes 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+'Stuff\Qmovie.txt');
0118 Reset(fQ);
0119 while not Eof(fQ) do begin 0120 ReadLn(fQ, I);
0121 TheOvideo.TextList.AddObject(I, Pointer(0));
0122 end;
0123 CIoseFile(fQ);
0124 TubeInitList(spriteTubeText, TheQvideo, -3, 0);
0125 TheQvote.TextList := TStringt_ist.Create;
0126 AssignFile(fQ, sRunDirectory+'Stuff\Qvote.txt');
0127 Reset(fQ);
0128 while not Eof(fQ) do begin 0129 ReadLn(fQ, I);
0130 TheQvote.TextList.AddObject(I, Pointer(0));
0131 end;
0132 CIoseFile(fQ);
0133 TubeInitList(spriteTubeText, TheQvote, -3, 0);
0134 bYesDown := false;
0135 bNoDown := false 0136 end;
0137 {__~_____~_~____~_______________________}
0138 procedure QynExit;
0139 begin 0140 BitmapDestroy(spriteQyes Up);
0141 BitmapDestroy(spriteQyes Down);
0142 BitmapDestroy(spriteQno_Up);
0143 BitmapDestroy(spriteQno_Down);
0144 TubeExitList(TheQvote);
0145 TubeExitList(TheGlvideo) 0146 end;
0147 end.
SUBSTITUTE SHEET (RULE 26) 0001 unit RegFig;
0003 interface {_-_____________________________________________________________________-_-_}
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 regVoteEnabied, 0021 reglnfoEnabled, 0022 regVideoAsked, 0023 regVoteAsked, 0024 reglntroPlayed, 0025 reglnfoSent: Boolean;
0026 regHandle: string[20];
002:7 regZip, 0028 regAge, 0029 regSex: string[20];
{_______________________________________________________________________-_-_}
003.1 implementation {~______________________________________________________________________-_-_}
0033 function RegFigLoad: Boolean;
0034 var 003.5 Reg: TRegistry;
0036 sKey, sValue: string[200];
0037 n: integer;
SUBSTITUTE SHEET (RULE 26) 0038 begin 0039 result := false;
0040 try 0041 Reg := TRegistry.Create 0042 except 0043 exit 0044 end;
0045 regHandle :_ ";
0046 Reg.RooiKey := HKEY LOCAL MACHINE;
0047 sKey :_ '\SOFTUVAREIPalantir';
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 := regHandie + Chr(Random(26)+Ord('A'));
0056 Reg.WriteString(sValue, regHandle) 0057 end 0058 end 0058 except 0060 end;
0061 regZip :='00000';
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.ValueF~cists(sValue) then 0070 regZip := Reg.ReadString(sValue);
0071 sValue :='Age';
0072 if Reg.ValueExists(sValue) then 0073 regAge := Reg.ReadString(sVaiue);
0074 sValue :_ 'Sex';
0075 if Reg.ValueExists(sValue) then 0076 regSex := Reg.ReadString(sValue) 0077 end 0078 except SUBSTITUTE SHEET (RULE 26) 0079 end;
0081 Reg.RootKey := HKEY LOCAL MACHINE; -0082 sKey :_ '\SOFTV11ARE\PaiantirllQcd\'+iniAlbumHandle+'\Flags';
0083 try 0084 if Reg.OpenKey(sKey,true) then begin 0085 sValue :='IntroPlayed';
0086 if Reg.ValueF~cists(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 :_ '1/oteAsked';
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'. reginfoSent := Reg.ReadBool(sVaiue) 0103 else Oi04 reglnfoSent := false;
0105. sValue :_ 'VoteEnabled';
0106. if Reg.ValueExists(sValue) then 0107 regVoteEnabled := Reg.ReadBool(sValue) 0108 else 0109 regVoteEnabled := false;
01101 sValue :='InfoEnabled';
0111 if Reg.ValueExists(sValue) then 0112' reginfoEnabled := Reg.ReadBool(sValue) 0113 else 0114 reglnfoEnabled := false;
0115 sValue :_ ''fargetPage';
011E~ if Reg.ValueExists(sValue) then 0117 regHasTargetPage := Reg.ReadBool(sValue) 0118 else 0119 regHasTargetPage := false;
SUBSTITUTE SH~~T (RUL~ 25) 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[200j;
0131 begin 0132 try 0133 Reg := TRegistry.Create 0134 except 0135 exit 0136 end;
0137 Reg.RootKey := HKEY_LOCAL MACHINE;
0138 sKey :='1SOFTWAREIPalantir\IQcdl'+iniAIbumHandle+'\Flags';
0139 try 0140 if Reg.OpenKey(sKey,true) then begin 0141 Reg.WrileBool('VoteEnabied', regVoleEnabled);
0142 Reg.WriteBool('InfoEnabied', reglnfoEnabled);
0143 Reg.WriteBool('IntroPlayed', reglntroPlayed);
0144 Reg.WrtteBool('VideoAsked', regVideoAsked);
0145 Reg.WriteBool('VoteAsked', regVoteAsked);
0146 if iniSendlnfo=qfALWAYS then 0147 Reg.WriteBool('InfoSent', reglnfoSent) 0148 end 0149 except 0150 end;
0151 Reg.Free 0152 end;
0153 end.
SUBSTiTUT~ SHEET (RULE 26) 0001 unit Regions;
{__________________._______________________________________________________}
0003 interface {__________________._______________________________________________________}
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 ExtCfrls, StdCtris, 0014 Run, Main;
0015 {$ENDIF}
0016 {_____________________________________________}
0017 procedure OutIineJmage(ImageCanvas: TCanvas;
0018 iCanvasHeight, iCanvasWidth: longint;
0019 var PolygonRegion: hRGN);
{_________________________________________________________________________}
0021 implementation {_________________________________________________________________________}
0023 type 0024 POINT = recorcl 00'x!5 x:longint;
0026 y:longint;
0027 end;
0028 {__M____~~_________________________}
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 {__w_____~~_~._______~____________.__}
0033 var 00 34 tOutiine: array [0..1000] of POINT;
00;35 WorkingCanvas: TCanvas;
0036 iCanvasMaxX, iCanvasMaxY: longint;
00;17 iFirstPixeIX, iFirstPixelY: longint;
SUBST1TUT~ SHEET (RULE 26) 0038 iLastPixeIX, iLastPixelY: longint;
0039 iLastDirection:longint;
0040 iPixeIX, iPixelY: longint; _ 0041 iDirection:longint;
0042 {__~__~_____~_________~______________}
0043 procedure FindFirstPixel; forward;
0044 procedure FindNextPixel; forward;
0045 procedure FindPixel(iAtX, iAtY: longint); forward;
{_______________________________________________________________________==J
0047 { Code }
{_________________________________________________________________________}
0049 procedure Outlineimage(ImageCanvas: TCanvas;
0050 iCanvasHeight, iCanvasWidth: longing 0051 var PolygonRegion: hRGN);
0052 var 0053 iPoints:longint;
0054 begin 0055 WorkingCanvas :_ lmageCanvas;
0056 iCanvasMaxX := iCanvasWidth-1;
0057 iCanvasMaxY := iCanvasHeight-1;
0058 FindFirstPixei;
0059 tOutline[0].X := iFirstPixelX;
0060 tOutline[O].Y := iFirstPixelY;
0061 iPoints := 1;
0062 FindPixel( iFirstPixelX, iFirstPixelY);
0063 repeat 0064 FindNextPixel;
0065 if iDirection<>iLastDirection then begin 0066 tOutline[iPoints].X := iLastPixefX;
0067 tOutline[iPoints].Y := iLastPixelY;
0068 iPoints := iPoints+1;
0069 end 0070 until (iPixeIX=iFirstPixeIX) and (iPixelY=iFirstPixelY);
0071 PolygonRegion := CreatePolygonRgn( tOutline, iPoints, WINDING);
0072 end;
0073 {--_-___________~~__~_______________~_____) 0074 procedure FindFirstPixel;
0075 var 0076 x:longint;
SUHSTiTUTE SHEET (RULE 26~
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 iFirstPixeIX := iPixelX;
0086 iFirstPixelY := iPixelY;
0087 end;
0088 {___--_____~__~____..__~___________________}
0089 procedure FindNextPixel;
0090 begin 0091 FindPixel( iPixeIX, 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 := iPixeIX+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 := iPixeIX+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( iPixeiX, iPixelY);
0109 exit;
0110 Got Pixel:
0111 iPixeiX := x1;
0112 iPixelY := y1;}
0113 end;
0114 { ____~_~____~__________________}
0115 procedure FindPixel(iAtX, iAtY: longint);
0116 var 0117 d:lnteger;
SUBSTITUTE SHEFi' (RUL~ 26) 0118 bPixell , bPixel2: Boolean;
0119 CanvasDC: HDC;
0120 begin -0121 iLastPixeIX := iPixeIX;
0122 iLastPixeiY := iPixelY;
0123 iLastDirection := iDirection;
0124 bPixel1 := false; (kiN compiler warning}
0125 CanvasDC := WorkingCanvas.handle;
0126 for d := 1 to 9 do begin 0127 iPixeIX := iAtX+iScanX[d);
0128 iPixelY := iAtY+iScanY[d);
0129 if (iPixeIX>=0) and (iPixeIX<=iCanvasMaxX) and 0130 (iPixelY>=0) and (iPixelY<=iCanvasMaxY) then 0131 bPixel2 :_ (GeiPixel(CanvasDC,iPixeIX,iPixelY)<>TRANSPARENT_COLOR) 0132 else 0133 bPixel2 := False;
0134 if d>1 then 0135 if bPixel2 and (Not bPixell) then 0136 break;
0137 bPixel1 := bPixel2 0138 end;
0139 iDirection := d;
0140 if iDirection>9 then 0141 frmRun.SevereError('FindPixel - not found!') 0142 end;
0143 end.
SUBSTITUTE SHEET (RULE 26~
0001 unit Run;
OOOi! {$DEFINE KILLERASE}
{_________________________________________________________________________}
0004 intertace {___.______________________________________________________________________}
0006 {$IFDEF WINDOWS}
000 i' uses 0006 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 0009 Forms, Dialogs, StdCtrls, ExtCtrls, MPlayer, ComCtrls, SheIIAPI, 0010 xPrgExec, xFCopy, LMDnonvS, LMDclass, LMDctrl, LMDmmS, LMDwave;
00111 {$ELSE}
001'. uses 001:1 SysUtils, Windows, Messages, Classes, Graphics, Controls, 001~I Forms, Dialogs, StdCtrfs, ExtCtrls, MPlayer, ComCtris, SheIIAPI, 001 fi xPrgExec, xFCopy, LMDnonvS, LMDcIass, LMDctrl, LMDmmS, LMDwave;
0016 {$ENDIF}
0017 {_--______~_~__..__________________~___}
001 t3 const 0019 UM REALSTAR.T = WM_USER+1;
002() TEXT NORMAL. = clBlack;
002'1 TEXT HIGHLIGHT = clWhite;
0022 TEXT DISSABL.ED = $006F6470;
002;3 {___________~___._________________..____~}
0024 type 002a TfrmRun = class(TForm) 0026 tmTimer: TTimer;
0027 mmCDPlayer: TMediaPlayer;
00213 PrintDialog: TPrintDialog;
00213 mmCommentana: TMediaPlayer;
0030 Run: TxProgExec;
0031 FileCopier: TxFileCopy;
0032 ProgressBar: TProgressBar;
0033 blobMessage: TLMDMessageHint;
0034 waveSony: TLMDWaveComp;
0036 Onelnstance: TL_MDOnelnstance;
0036 blobHint: TLMDMessageHlni;
003'7 waveByeBye: TLMDWaveComp;
0036 wavelnstallingWallpaper: TLMDWaveComp;
0039 wavelnstallingSaver: TLMDWaveComp;
SUBSTITUTE SH~ET (RULE 26) 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 PIayNextTrack(TrackFrom: Integer);
0057 procedure GoCopyFile(FileFrom, FileTo: string);
0058 {_______________________________________________.~
0059 procedure PIayPressed;
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(lNordTime: longint);
0075 procedure SetTrack(TrackNo: fongint);
0076 procedure TrackDissable(TrackNo: longint);
0077 procedure TimeMoveStart;
0078 procedure TimeMoveEnd;
0079 procedure MouseEnable;
0080 procedure MouseDissable;
SUBSTITUTE SHEET (RULE 26) 0081 function NoVideo: boolean;
0082 procedure ErrorMessage(const msg: string);
0083 procedure SevereError(const msg: string);
0084 private 0085 procedure idleProcess(Sender: TObject; var Done: Boolean);
0086 procedure DefauItException(Sender: TObject; E: Exception);
0087 procedure ReaIStart(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 DELAY INTROVIDEO = 5;
0101 SCROLL DELA'f = 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: booiean;
0112'. iMouseDownX, iMouseDownY: longint;
0113 bqAskVideo, 0114 bqAskVote: Boolean;
0115 bqPlaylntro: Boolean;
0116 iDelayintroVideo:longint;
011 i' iMenuNormaiizeTimer, 0118 iErrorMessageTimer: iongint;
0119 iLastTrackNo:longint;
012CI ePIayButtonState: (bsPLAY, bsPAUSE, bsRESUME);
0121 eStopButtonState: (bsEJECT, bsSTOP);
SUBSTITUTE SHEET (RULE 26) 0122 eRandomButtonState: (bsRANDOM ON, bsRANDOM_OFF);
0123 eTubeModeState: (tmINTRO, tmMENU, tmABOUT, tmIQABOUT, tmTRACKS, tmWORDS, tmINFO, tmQYN);
0124 bStopPaint: Boolean;
0125 iHintLastX, iHintLastY: longint;
0126 sHintLastMsg: string[250];
0127 bHintsEnabled: Boolean;
0128 sCurrentWall: string[100];
0129 sCurrentTile: string(100];
0130 sCurrentSaver: string[100];
0131 { ------_ _~___~______~_~__}
0132 procedure qaVideoYes; forward;
0133 procedure qaVideoNo; forward;
0134 procedure qaVoteYes; forwarct;
0135 procedure qaVoteNo; forward;
0136 procedure qaNextl ; forward;
0137 procedure qaNext2; forward;
0138 procedure qaNext3; forward;
{______________________________________________________________________ __}
0140 implementation 0141 {$R '.DFM}
{________________________________________________________________________~}
0143 uses 0144 Main, PIayList, Tracks, Words, Info, 0145 QYesNo, TrkMedia, ScroIBar, TimeBar, VolumBar, 0146 Regions, Bitmaps, BitBtns, BitBars, Sysfig, 0147 Tube, Video, Comment, Counter, Logo, Inifig, 0148 IoMenu, IQAbout, CDPlayer, 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;
{_________________________________________________________________________}
0158 { Utility Routines }
SUBST]TUTE SHEET (RULE 26) {___________________.____________________________________________________-__}
olso {__~-____~___________________~___________) 0161 function TfrmRun.NextTrack(TrackFrom: longint): longint;
0162 var 0163 iTrack, iTracksEnabled: longint;
0164 iTrack1, 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 iTrack1 := TrackFrom to iAudioTracks do 0172 if bTrackEnabled[iTrack1 ] then begin 0173 iTrack2 := iTrackl ;
0174 break 0175 end;
0176 if iTrack2=0 then 0177 for iTrack1 :_ 1 to TrackFrom-1 do 0178 if bTrackEnabied[iTrackl] then begin 0179 iTrack2 :== iTrackl ;
0180 break 0181 end;
0182 if iTrack2=0 then begin 0183 SevereError('PIayNextTrack: all tracks dissabled!');
0184 Result := 1;
0185 exit 0186 end;
0187 if (eRandomButtanState=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.PIayNextTrack(TrackFrom: Integer);
0195 begin 0196 SetTrack(NextTrack(TrackFrom));
0197 PlayerPlay(IsNEXT, iLasiTrackNo) 0198 end;
SUBSTITUTE SHEET (RULE 26~
0199 {-______~______~_______w__________________}
0200 procedure TfrmRun.GoCopyFile(FileFrom, Filei'o: string);
0201 begin 0202 MouseDissable;
0203 with FileCopier do begin 0204 ProgressBar.Show;
0205 SourceFile := FileFrom;
0206 TargetFile := FileTo;
0207 Execute 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;
{_______________________________________________________________________-__}
0225 { Process button press }
{_________________________________________________________________________}
0227 procedure TfrmRun.PIayPressed;
0228 begin 0229 VideoStop;
0230 CommentaryStop;
0231 PlayerPlay(IsPLAY, TimeBarGetPosition) 0232 end;
0233 {-_----_________________~___________________}
0234 procedure TfrmRun.PausePressed;
0235 begin 0236 VideoStop;
0237 CommentaryStop;
SUBSTITUTE SHEET (RULE 26) WO 98,152189 PCT/US98/10035 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;
0256 {_---___________~____..___________~__________}
0257 procedure TfrmRun.EjectPressed;
0258 begin 0259 PlayerStop;
0260 VideoStop;
0261 CommentaryStop;
0262 PlayerEject;
0263 ExitPressed 0264 end;
0265 {-----------_-_-------_.._~________~_______}
0266 procedure TfrmRun.PrintPressed;
0267 begin 0268 TubePrint 0269 end;
0270 { _ ~_..__~~~~_____~_}
0271 procedure TfrmRun.'dideoPressed;
0272 begin 0273 if NoVideo then 0274 exit;
0275 if not bVideoAvailable[iLaslTrackNo] then begin 0276 En-orMessage(''This track does not have a video clip, sorry.');
0277 exit 0278 end;
SUBSTTTUTE SHEET (RULE 26) 0279 if eCDPIayerState=psPLAYtNG then begin 0280 ButtonsForcePause;
0281 PlayerPause 0282 end;
0283 VideoStop;
0284 CommentaryStop;
0285 VideoPlay(iLastTrackNo, nil) 0286 end;
0287 {_-----_______~w_________________________}
0288 procedure TfrmRun.CommentaryPressed;
0289 begin 0290 if not bCommentaryAvailabie[iLastTrackNoj 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 PtayerPause 0297 end;
0298 VideoStop;
0299 CommentaryStop;
0300 CommentaryPlay(iLastTrackNo) 0301 end;
0302 {_________________________________________________}
0303 procedure TfrmRun.ExitPressed;
0304 begin 0305 VideoStop;
0306 CommentaryStop;
0307 TubeDisplay(Thetntro);
0308 eTubeModeState := tmintro;
0309 PiayerStop;
0310 if iniPIayByeBye then 0311 frmRun.waveByeBye.PIaySound(sdSync);
0312 Close 0313 end;
~_________________________________________________________________________}
0315 { Process mode changes }
{_______________________________________________________________________-_-_}
0317 procedure TfrmRun.ModeSetlnfo;
SUBST1TUT~ SHEET (RULE 26) 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(ThePlayt_ist);
0339 MediaDraw(iLastTrackNo) 0340 end;
{-_________________._______________________________________________________}
0342 { Process Logo / Menu mouse click }
{_______________________________________________________________________-_.}
0344 procedure TfrmRun.LogoClicked;
0345 begin 0346 VideoStop;
0347 CommentaryStop;
0348 ButtonsForceNone;
0349 if eTubeModeState=tmMenu then begin 0350 TubeDisplay(Thelntro);
0351 eTubeModeState := tmlntro 0352 end 0353. else begin 0354 iMenuNom3alizeTimer := 0;
0355 TubeSetAlINormal(TheMenu);
0356 TubeDisplay(~'heMenu);
SUBSTITUTE SHEET (RULE 26~
0357 eTubeModeState := tmMenu 0358 end 0359 end;
0360 {_______~________________________________________) 0361 procedure TfrmRun.MenuClicked(Menuitem: 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 := tmIQABOUT;
0374 TubeDisplay(TheIQAbout) 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(startWaIIpaperName) then begin 0389 sCurrentWall := startWaIIpaperName;
0390 sCurrentTile := startWaIIpaperTile 0391 end 0392 else begin 0393 wavelnstallingWaIIpaper.Play;
0394 GoCopyFile(sRunDirectory+'Stuff\Wall.bmp', 0395 sWindowsDirectory+iniWallpaper+'.bmp');
0396 sCurrentWall := sWindowsDirectory+iniWallpaper+'.bmp';
0397 sCurrentTile :_ '0' SUBSTITUTE SHEET (RULE 26~
0398 end;
0399 SetWallpaper(sCurrentWall, sCurrentTile);
0401) MenuUpclate 0401 end;
0402 5: begin 040:3 if UsingOurSaver and not UsingThisSaver(startScreenSaver) then 0404 sCurrentSaver := startScreenSaver 040!i else begin 04011 wavelnstallingSaver.Play;
040't GoCopyFile(sRunDirectory+'StufflSaver.exe', 0408 sSystemDirectory+iniScreenSaver+'.scr');
0409 sCurrentSaver := sSystemDirectory+iniScreenSaver+'.scr' 0410 end;
041'1 SetSaver~(sCurrentSaver);
0412 MenuUpdate 041:3 end;
0414 6: begin 0415 VideoStop;
04111 CommentaryStop;
0417 ButtonsForceStop;
0418 StopPressed;
041!3 Run.CmdLine := sRunDirectory+'Stuff\WebLink.exe';
0420 if Run.Execute then 042'1 {$IFOEF WINDOWS}
0422 WindowState := TWindowState(wsMinimized) 042:3 {$ELSE}
0424 Applic~ation.Minimize 042:1 {$END!F}
0426 else 042'7 ErrorMlessage('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 043.5 SetWallpaper(sCurrentWall, sCurrentTile);
0436 MenuUpdate 043'1 end;
0438 8: begin SUBSTtTLJTE~SHEET (RULE 26) 0439 VideoStop;
0440 CommentaryStop;
0441 ButtonsForceStop;
0442 StopPressed;
0443 Run.CmdLine := sRunDireciory+'StufflActMovie.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: SheIlExecute(frmRun.Handle, 0458 'Open', 'http://www.baconbros.com/', 0459 nil, nil, SW SHOWNORMAL) 0460 else 0461 SevereError('MenuClicked - invalid item!') 0462 end 0463 end;
{_________________________________________________________________________}
0465 { Process Tracks/Words mouse click }
{_________________________________________________________________________}
0467 procedure TfrmRun.TrackClicked(Track: longint);
0468 begin 0489 if eCDPIayerState=psPAUSED then begin 0470 ButtonsForceStop;
0471 StopPressed 0472 end;
0473 {if eCDPlayerState=psPLAYING then}
0474 SetTrack(Track);
0475 if eCDPIayerState=psPLAYING then begin 0476 ButtonsForcePlay;
0477 PlayerPlay(IsTRACK, 0) SUBSTITUTE 5 H E ET (RU LE 26) 0478 end 0479 end;
0480 {_____w_~__________________________________}
0481 procedure TfrmRun.WordsClicked(WordTime: longint);
0482 begin 0483 if eCDPIayerState=psPLAYING then 0484 ScroIIBarStartDelay;
0485 TimeBarPosition(WordTime);
0485 if eCDPiayerState=psPLAYING then begin 0487 ButtonsForcePlay;
0488 PlayerPlay(IsWORDS, WordTime) 0489 end 0490 end;
0491 {_-________________..____________________________}
0492 procedure TfrmRun.SetTrack(TrackNo: longint);
0493 begin 0494 if TrackNo<>iLastTrackNo then begin 0495 TimeBarNev~iTrack(TrackNo);
0496 PIayListNewTrack(TrackNo);
0497 TracksNewTrackiTrackNo);
0498 WordsNewTrack(TrackNo);
0499 InfoNewTrack(TrackNo);
0500 MediaNewTracktTrackNo);
0501 iLastTrackNo := TrackNo 0502 end 0503 end;
0504 {________~~~_..___~________________~___}
0505 procedure TfrmRun.TrackDissabletTrackNo: longint);
0508 begin 0507 if iLastTrackNo=TrackNo then 0508 if eCDPlayerState=psPLAYING then 0509 PIayNextTrack(TrackNo+1 ) 0510 else 0511 SetTrack(NextTracktTrackNo+1)) 0512 end;
t==.________________._______________________________________________________}
0514 { Process mouse moved bars }
{__._______________________________________________________________________}
0516 procedure TfrmRun.TimeMoveStart;
SUBSTITUTE SHEET (RULE 26) ~i'~ ~8f s~183 ~~'1'fUS~~fl~t~35 0517 begin 0518 if eCDPIayerState=psPLAYING then begin 0519 ButtonsForcePause;
0520 PiayerPause 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(IsTIMEBAR, TimeBarGetPosition) 0533 end 0534 end;
{_________________________________________________________________________}
0536 { Backround processing }
{_________________________________________________________________________}
0538 procedure TfrmRun.IdleProcess(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 Ciose;
0550 goto exit1 0551 end;
0552 if eCDPIayerState=psPlAYING then begin 0553 PlayerGetTrackAndTime(iTrack,iTime);
0554 if (mmCDPIayer.Mode=mpStopped) and (iTrack=iAudioTracks) then begin 0555 PIayNextTrack(1 );
SUBSTITUTE SHEET (RULE 26) 0556 goto exit1 0557 end;
0558 if (iTrack<>iL.astTrackNo) and (iHoIdOffUpdate=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 PIayNextTrack(iTrack);
0565 iTrack := 0 0566 end 0567 else begin 0568 PIayNextTrack(iTrack+1 );
0569 iTrack := 0 0570 end 0571 end;
0572 If iTrack=il_astTrackNo 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 {_-----____~ _____________w__________}
0585 procedure TfrmRun.tmTimerTick(Sender: TObject);
0586 begin 0587 if iErrorMessageTimer>0 then begin 0588 Dec(iErrorMessageTimer);
0589 if iErrorMessageTimer=0 then 0590 frmRun.bIobMessage.HideMessage 0591 end;
0592 PlayerTimerTick;
0593 MenuTimerTick;
0594 TracksTimerTick;
0595 PIayListTimerTick;
0596 WordsTimerTic,k;
SUBSTITUTE SHEET (RULE 26) 0597 ScroIIBarTimerTick;
0598 TimeBarTimerTick;
0599 VolumeBarTimerTick; _ 0600 if not bStopPaint then begin 0601 ScroIIBarTimerTick;
0602 if iMenuNormalizeTimenO then begin 0603 Dec(iMenuNormalizeTimer);
0604 if iMenuNormalizeTimerO then 0605 TubeSetAiINormal(TheMenu) 0606 end 0607 end;
0608 if iDelaylntroVideo>0 then begin 0609 Dec(iDelaylnlroVideo};
0610 if iDelaylntroVideo=0 then 0611 VideoPlay(INTROVIDEO, IntroDone) 0612 end;
0613 end;
{_________________________________________________________________________}
0815 { Process mouse click/move }
{_________________________________________________________________________}
0617 procedure TfrmRun.MouseEnabfe;
0618 begin 0619 Cursor := crArrow;
0620 bMouseEnabled := true;
0621 end;
0622 {--____________~w__________________~w) 0623 procedure TfrmRun.MouseDissable;
0624 begin 0625 bMouseEnabled := false;
0626 Cursor := crHourGlass;
0627 end;
0628 {-----_________~___________________________}
0629 procedure TfmzRun.RunMouseDown(Sender: TObject;
0630 Button: TMouseButton; Shift: TShiftState;
0831 X, Y: Integer);
0632 begin 0633 if iErrorMessageTimer<>0 then 0634 frmRun.bIobMessage.HideMessage;
0635 if not bMouseEnabled then SUBSTITUTE SHEET (RULE 26) 0636 exit;
0637 if Button=mbLeft then begin 0638 iMouseDownX := X;
0639 iMouseDownY := Y;
0640 bMouseDown := true;
0641 ButtonsMouseDown ExiiCheck;
0642 QynMouseDown;
0643 if eTubeModeState<>tmQYN then begin 0644 ButtonsMouseDown;
0645 ScroIIBarMouseDown;
0646 TimeBarMouseDown;
0647 VolumeBarllAouseDown;
0648 MenuMouseDown;
0649 PIayListMouseDown;
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 ScroIIBarMouseUp;
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 067E~ X :_ -1;
0676 Y :_ -1 SUBSTITUTE SHEET (RULE 26) 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 ScroIIBarMouseMove(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 ScroIIBarMouseDrag(X,Y);
0695 TimeBarMouseDrag(X,Y);
0696 VolumeBarMouseDrag(X,Y) 0697 end;
0698 end;
{______________________________________________________________________ __}
0700 { Initalize / Exit }
{_________________________________________________________________________}
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 biniOk := tniFigLoad;
0714 if blniOk then begin 0715 Application.Icon.LoadFromFile(sRunDirectory+'Stuff\Icon.ico');
SUBSTITUTE SHEET (RULE 26) 0716 Application.Title := iniAppName;
0717 frmRun.Caption := iniAppTitle 07113 end; -071!a SysFigCheckVideo;
0720 Videolnitialize0;
0721 frmMain := TfrmMain.Create(nil);
072:? bmpPalette := TBitmap.Create;
072:3 bmpPalette.Assign(frmMain.imgPaiette.Picture.Bitmap);
0724 bmpPlayer := TBi#map.Create;
0725 bmpPlayer.Assign(frmMain.imgPlayer.Picture.Bitmap);
072E3 frmRun.CIientWidth := fmnMain.imgPlayer.Width;
072'7 frmRun.CIientHeight := frmMain.imgPlayer.Height;
07213 with bmpPlayer.Canvas do begin 072!a Brush.Cotor := WINDOWCOLOR_16BIT;
0730 Brush.Style :== bsSOLID;
0731 BrushCopy(CIipRect, frmMain.imgPlayer.Picture.Bitmap, 073;2 CIipRect, TRANSPARENT COLOR) 0733 end;
0734 {$IFNDEF WINDOWS}
073.5 with frmMain.imgPlayer do 0736 Outlinelmage( Canvas, Height, Width, WindowRegion);
073'7 SetWindowRgnl; Handle, WindowRegion, false);
0738 {$ENDIF}
0739 Buttonslnitialize;
0740 ScroIIBarlnitialize;
0741 TimeBarinitialize;
074;2 Tubelnitialize;
0743 PIayListlnitialize;
0744 Trackslnitiaiize;
0745 Wordslnilialize;
0746 Menuinitialize;
0747 Aboutlnitialize;
0748 Infolnitialize;
0749 Counterlnitialize;
0750 Logoinitialize;
0751 Commentaryinitialize;
0752 Videolnitialize;
0753 Medialnitialize;
0754 Qynlnitialize;
0755 VolumeBarlnitialize;
0756 frmMain.Free;
SUBSTITUTE SH~~T (RULE 26) 0757 Thelntro.TextList := TStringList.Create;
0758 TubeInitList(spriteTubelntro, Thelntro, 0, 0);
0759 iLastTrackNo := 0; -0760 SetTrack(1);
0761 ModeSetTracks;
0762 TubeDisplay(Thelntro);
0763 eTubeModeState := tmINTRO;
0764 ProgressBar.Hide;
0765 ProgressBar.Position := 0;
0766 ProgressBar.Top := iTextBIockTop+iTextBIockHeight+2;
0767 ProgressBar.Left := iTextBIockLeft+((iTextBIockWidth-ProgressBar.Width) div 2);
0768 bStopPaint := false;
0769 Playerlnitialize;
0770 if bIniOK 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=qfALWAYS);
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: reginfoEnabled := false 0796 end 0797 end;
SUBSTITUTE SHEET (RULE 26) WO 9:8/52189 PCT/US98/10035 0798 if bStopPaint then 0799 exit;
0800 iHintLastX := 100; -0801 iHintLastY := 10CI;
0802'. sHintLastMsg :_ 'No Hini!';
0803 bHintsEnabled := tme;
0804 bGwideo := false;
0805 bQvote := false:
0806. tmTimer.Enabled := true;
0807 Application.OnException := DefauItException;
080E~ Application.Onldle := IdIeProcess;
0809 if not blniOk then 0810 SevereError('Unable to Start!');
0811 PostMessage(Handle, UM REALSTART, 0, 0) 0812 end;
081 °~ {_-_________________..______________________}
08141 procedure TfrmRun.FormClose(Sender: TObject; var Action: TCIoseAction);
081 ~i begin 081Ei tmTimer.Enabled := false;
081 i' bStopPaint := tn~e;
081 ft RegFigUpdate;
0819 TubeExitList(Thelntro);
082(1 VolumeBarExif;
0821 QynExit;
0822. MediaExit;
082;1 VideoExit;
0824 LogoExit;
082:1 CounterExit;
082Ei InfoExit;
0827 AboutFacit;
0828 MenuExit;
0829 WordsExit;
0830 TracksExit;
083'1 PIayListExit;
083:? TubeExit;
083;3 TimeBarExit;
0831 ScroIIBarF~cit;
083!1 ButtonsExit;
08311 bmpPlayer.Free 083'7 end;
0838 {____________ _~__~__________________}
SUBSTITUTE SHEET (RULE 26) 0839 procedure TfrmRun.ReaIStart(var Msg: TMessage);
0840 begin 0841 if bqAskVideo and (not bVideoEnable) then 0842 QynAsk(TheQvideo, qaVideoYes, qaVideoNO) 0843 else 0844 qaNext1;
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 qaNext1 0858 end 0859 end;
0860 {_____________w_____________________________}
0861 procedure qaVideoNO;
0862 begin 0863 regVideoAsked := true;
0864 qaNext1 0865 end;
0866 {--_-______ _________________w______}
0867 procedure qaVideoYes;
0868 begin 0869 regVideoAsked := true;
0870 bQvideo := true;
0871 frmRun.Run.CmdLine := sRunDirectory+'Stuff~ActMovie.exe';
0872 if frmRun.Run.Execute then 0873 {$IFDEF WINDOWS}
0874 WindowState := TWindowState(wsMinimized) 0875 {$ELSE}
0878 AppIIcation.Mlnlmlze 0877 {$ENDIF}
0878 else begin 0879 frmRun.ErrorMessage('Unable to Install Active Movie!');
SUBSTITUTE SHEET (RULE 26) 088() bQvideo := false;
088,1 qaNext1 088:? end 0883 end;
088~E {_--___________________~____________________}
088!i procedure qaNextl;
088Ei begin 0887 TubeDisplay(Thelntro);
08813 eTubeModeState := tmINTRO;
088!3 if bVideoEnable and bqPlaylntro then begin 0890 bqPlaylntro := false;
0891 if bqAskVote then 0892 eTubeModeState := tmQYN;
089:3 iDelaylntroVideo := DELAY INTROVIDEO
0894 end 089!i else 08913 qaNext2 089'7 end;
0898 {________________~_.._________________________}
0899 procedure qaNext2;
0900 begin 090'1 if bqAskVote then 0902 QynAsk(TheQvote, qaVoteYes, qaVoteNo) 0903 else 0904 qaNext3 090.5 end;
0906 {-_--__w_____~..____________________~___}
090'7 procedure qaVoteNO;
0908 begin 0909 regVoteAsked : = true;
091 ~0 regVoteEnabled := false;
0911 qaNext3 091.2 end;
0913 {-___-_---_~__~__._~__________________}
0914 procedure qaVoteYes;
0915 begin 0916 regVoteAsked : = true;
0917 regVoteEnabled := true;
0918 qaNext3 0919 end;
0920 {_-----___~_~___,____~_________w___~___}
SUBSTITUTE SHEET (RULE 26) 0921 procedure qaNext3;
0922 begin 0923 TubeDisplay(Thelntro);
0924 eTubeModeState := tmINTRO
0925 end;
{_________________________________________________________________________}
0927 { Errors }
~_________________________________________________________________________}
0929 function TfrmRun.NoVideo: Boolean;
0930 begin 0931 if bVideoEnable then begin 0932 Result := false;
0933 exit 0934 end;
0935 waveSony.Play;
0936 with frmRun.bIobMessage do Begin 0937 MaxWidth := 152;
0938 ShowMessage('Your 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 pertorm 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.En'orMessage(const msg: string);
0951 begin 0952 waveSorry.Play;
0953 with frmRun.bIobMessage do begin 0954 MaxWidth := 152;
0955 ShowMessage(Msg, frmRun.Left+310, frmRun.Top+64) 0956 end;
0957 iErrorMessageTimer := 50 0958 end;
0959 t ----_____~_~_______________________}
SUBSTITUTE SHEET (RULE 26) 0960 procedure TfrmRun.SevereError(const msg: string);
0961 begin 096x' tmTimer.Enabled := false;
0963 bStopPaint := true;
0964. MessageDlg('('+msg+' )'+char(10)+char(10)+char(13)+
0965 'An unexpected problem occured, and IQcd must exil now:'+
0966 char(10)+char(13)+
0967 'All wilt be fine, but you should reboot your computer.', 0968 mtError, [], 0);
0969 Close;
0970 Application.Tem7inate 0971 end;
097! {-______~_____~_~_.___________________________}
097;1 procedure TfrmRun.DefauItException(Sender: TObject; E: Exception);
09741 begin 097si if true {Application.Terminated} then begin 0976 MessageDlg(E.Message, miError, [mbOK], 0);
097 i' exit 097f9 end;
0979 waveSorry.Play;
098() with frmRun.blobMessage do begin 09811 MaxWidth := 230;
098:' 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 "+
098Ei 'then exit IQcd or reboot your system.', 098fi frmRun.Left+310, frmRun.Top+64) 098 ~' end;
0988 iErrorMessageTimer :_ -1 0989 end;
{___.___________________________________________________________________ __}
099'1 { form repaint }
099:?
{___.______________________________________________________________________}
0993 {$1FDEF KILLERASE}
0994 procedure TfrmRun.FormErase(var Msg: TWMEraseBkgnd);
099:1 begin 0996 {if bVideo256 then begin 099'7 SeleciPalette(Handle, imgPalette.Picture.Bitmap.Palette, false);
0998 RealizePalette(Handle) SUBSTITUTE SHEET' (RULE 26) 0999 end;}
1000 Msg.Result := LRESULT(False) 1001 end; _ 1002 {$ENDIF}
1003 { ____~_____~_~________________________}
1004 procedure TfrmRun.FormPaini(Sender: TObject);
1005 var 1006 FuIIRect: TRect;
1007 begin 1008 if bStopPaint then 1009 exit;
1010 if bVideo256 then begin 1011 FuIIRect := Bounds(0, 0, ClientWidth, Clientlieight);
1012 BitmapUpdateScreen(FuiIRect) 1013 end 1014 else 1015 BitmapUpdateScreen(Canvas.CIipRect) 1016 end;
1017 end.
SUBSTITUTE SHEET (RULE 26) 0001 unit Saver;
000'.
{___._______________,_____________________ _ _____________________________-_}
OOO;f interface 000~I
{___._______________._____________________________________________________-_}
OOOfi {$IFDEF WINDOWS}
OOOfi uses 0007 WinTypes, Winprocs, SysUtils, Messages, Classes, Controls, Inifiles, OOOE3 Run, IniFig;
0009 {$ELSE}
0010 uses 001'1 Windows, SysUtils, Messages, Classes, Controls, Inifiles, 001:? Run, IniFig;
001;3 {$ENDIF}
0014 {_____________________________________________}
001!i function SaverOurslnstalled: Boolean;
001E3 function UsingThisSaver(const ThisSaver: string): Boolean;
0017 function UsingSaver: Boolean;
00113 function UsingOurSaver: Boolean;
001!) function SetSaver(const SaverName: string): Boolean;
0020 procedure GetSaver( var SaverName: siring);
002'1 {__________________________________________________________________________}
0022 implementation {________________________________________________________________________-}
0024 uses 002.5 Sysfig;
002r3 {__.________________.____________________________________________________ __}
002'7 { Code }
{__.________________._____________________________________________________-_-_}
0029 function SaverOurslnstalled: Boolean;
0030 var 0031 (Saver: TextFile;
0032 begin 0033 try 0034 AssignFile(fSaver, sSystemDirectory+iniScreenSaver+'.scr');
0035 Reset(fSaver);
SUBSTITUTE SH~ET (RULE 26) 0036 CIoseFile(fSaver);
0037 result := true 0038 except 0039 result := false 0040 end 0041 end;
0042 {____________________________________________~__) 0043 function UsingThisSaver(const ThisSaver: string): Boolean;
0044 var 0045 Ini: TIniFile;
0046 begin 0047 result := false;
0048 try 0049 Ini := TIniFile.Create(sWindowsDirectory+'System.ini') 0050 except 0051 exit 0052 end;
0053 try 0054 result :_ (Ini.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: TIniFile;
0073 begin 0074 result := true;
0075 try 0076 Ini := TIniFlle.Create(sWindowsDirectory+'System.ini') SUBSTITUTE SHEET (RULE 26) 0077 except 0078 exit 0079 end;
0080 try 0081 Ini.WriieString('boot', '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: TIniFile;
0091 begin 0092 SaverName :_ ";
0093 try 0094 ini := TIniFile.Create(sWindowsDirectory+'System.ini') 0095 except 0096 exit 0097 end;
0098 try 0099 SaverName := Ini.ReadString('boot', 'SCRNSAVE.EXE', ") 01 CIO except 01 CI1 end;
01CI2 ini.Free 01 CI3 end;
01 CI4 end.
SUBSTITUTE SHEET (RULE 26) 0001 unit ScroIBar;
{_______________________________________ _ _______________________________-~
0003 interface {________________________________________________________________________-}
0005 {$IFDEF WINDOWS}
0006 uses 0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 0008 Forms, Dialogs, LMDnonvS, 0009 Run, Main, CDPlayer, BitBtns, BitBars;
0010 {$ELSE}
0011 uses 0012 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 0013 ExtCtrls, StdCtrls, LMDnonvS, 0014 Run, Main, CDPlayer, BitBtns, BitBars;
0015 {$ENDIF}
0016 {_---_____~__~_______________~___________}
0017 procedure ScroIIBarlnitialize;
0018 procedure ScroIIBarExit;
0019 procedure ScroIIBarStartDelay;
0020 procedure ScroIIBarMouseDown;
0021 procedure ScroIlBarMouseUp;
0022 procedure ScroIIBarMouseDrag( x, y: longint);
0023 procedure ScroIIBarMouseMove(X,Y: longint);
0024 procedure ScroIIBarTimerTick;
0025 procedure ScrotIBarAbort;
0026 procedure ScroIIBarPosition(Position: longint);
0027 {---___~__ ~__~_w___________~~_}
0028 var 0029 Scroll: TBar;
{_______________________________________________________________________..}
0031 implementation {________________________________________________________________________-}
0033 uses 0034 Tube, Words;
0035 {_-----__w~_______~______~_________}
0036 var 0037 bScroIIBarMouseDown: Boolean;
SUBSTITUTE SHEET (RULE 2fi) 0038 iTimerPosition:longint;
0039 iTimerDelay:longint;
0040 iHintltem:longint; _ 0041 iHintX, iHintY: longint;
0042 iHiniDelayTimer:longint;
0043 sHintMsg: string[250];
0044 bHintVisible: Boolean;
0045 blnHintArea: Boolean;
{_______________________________________________________________________-__}
0047 ~; Main Code }
{____._____________________________________________________________________}
0049 procedure ScroIIBarPosition(Position: longint);
0050 begin 0051 if bScroliBarMouseDown or (iTimerDelay>=0) then 0052 iTimerPosiiion :~= Position 0053 else 0054 BarSetPosition(Scroll, Position);
0055 TubeScroll(ScroILiSIidePosition) 0056 end;
0057 ~;_----_-_________~________________________}
0058 procedure ScroIIBarStartDelay;
0059 begin 0060 iTimerDelay := SCROLL DELAY
0061 1?nd;
{____._____________________________________________________________________}
0063 ~; Mouse Handling }
~____._____________________________________________________________________}
0065 procedure ScrotIBarMouseDown;
0066 begin 0067 if ScroILbEnabled and BarButtonHit(Scroll) then begin 0068 iHintltem := 0;
0069 iHintDelayTimer := 0;
0070 if bHintVisibte then begin 0071 frmRun.blobHInt.HIdeMessage;
0072 bHintVisible := false 0073 end;
0074 BarMouseMoveStart(Scroll);
SUBSTITUTE SHEET (RULE 26) WO 98!52189 PCT/US98/10035 0075 bScroIIBarMouseDown := true;
0076 if (eTubeModeState=tmWORDS) and (eCDPIayerState=psPLAYING) then begin 0077 iTimerPosition := ScroILiSIidePosition;
0078 iTimerDelay := SCROLL DELAY
0079 end 0080 end 0081 end;
0082 {-_-__~___ ___________________}
0083 procedure ScroIlBarMouseUp;
0084 begin 0085 bScroIIBarMouseDown := false;
0086 end;
0087 {-----_-_____~~____ ______ 0088 procedure ScroIIBarMouseDrag( x, y: longint);
0089 begin 0090 if bScroIIBarMouseDown then begin 0091 BarMouseMoveDraw(Scroll,x,y);
0092 TubeScroll(ScroILiSIidePosition) 0093 end 0094 end;
0095 {-______~~_____~___~______________}
0096 procedure ScroIIBarMouseMove(X,Y: longint);
0097 var 0098 iltem:longint;
0099 x1,yl: fongint;
0100 label 0101 exit1;
0102 begin 0103 if not ScroILbEnabted then 0104 goto exit! ;
0105 if bScroIIBarMouseDown then 0106 goto exit1;
0107 iHintX := frmRun.Left+X-5;
0108 iHintY := frmRun.Top+Y-0;
0109 iltem := 0;
0110 with ScroILspriteBack 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;
SUBSTITUTE SHEET (RULE 26) 0116 if iltem>0 then begin 0117 if iliem<>iHintltem then begin 0118 iHintDelayTimer := HINT DELAY; _ 0119 iHintltem := iltem 0120 end;
0121 exit 0122 end;
0123 exitl:
0124 iHintDelayTimer := 0;
0125 iHintltem := 0;
0127 if bHintVisible then begin 0128 frmRun.bIobHint.HideMessage;
0129 bHintVisibie := false 0130 end 0131 end;
0132 {_-___________________..__________________________}
0133 procedure ScroIIBarTimerTick;
0134 begin 0135 if iHintDeiayTimer>0 then begin 0136 Dec(iHintDelayTimer);
0137 if iHintDelayTirner-0 then begin 0138 if bHintVisible then 0139 frmRun.bIobHint.HideMessage;
0140 iHintLastX :== iHintX;
0141 iHintLastY : = iHintY;
0142 sHintLasiMsg := sHintMsg;
0143 frmRun.bIobHint.Position := hpAboveLeft;
0144 frmRun.bIobHint.ShowMessage(sHintMsg, iHintX, iHintY);
0145 bHintVisible := true 0146 end 0147 end;
0148 if bScroIIBarMouseDown or (iTimerDeiay<0) then 0149 exit;
0150 Dec(iTimerDelay);
0151 it iTimerDelay<0 then begin 0152 SarSetPosition(Scroll, iTimerPosition);
0153 TubeScroll(iTimerPosition) 0154 end 0155 end;
_______________._____________________________________________________ SUBSTITUTE SHEET (RULE 26) 0157 { Mouse Handling }
{________________________________________ _ _______________________________}
0159 procedure ScroIIBarAbort;
0160 begin 0161 bScroliBarMouseDown := false;
0162 if iTimerDelay>-1 then begin 0163 iTimerDelay :_ -1;
0164 TubeScroll(iTimerPosition) 0165 end 0166 end;
{_________________________________________________________________________}
0168 { Initaiize / Exit }
{_________________________________________________________________________}
0170 procedure ScroIIBarlnitialize;
0171 begin 0172 Barlnitialize(Scroll, frmMain.imgScroll Back, 0173 frmMain.imgScroll Rod, frmMain.imgScroll Button, 0174 frmMain.imgScroll Endl, frmMain.imgScroll End2);
0175 iTimerDelay :_ -1;
0176 sHintMsg :='Drag button to scroll display.';
0177 iHintltem := 0;
0178 iHintDelayTimer := 0;
0179 bHintVisible := false;
0180 blnHiniArea := false;
0181 bScroIIBarMouseDown := false 0182 end;
0183 {----______~_______~~~______________}
0184 procedure ScroIIBarF~cit;
0185 begin 0186 BarF~cit(Scroll) 0187 end;
0188 end.
SUBSTITUTE SHEET (RULE 26) 0001 unit SysFig;
{___________________.____________________ _ _____________________________-_-_}
0003 interface {___.______________________________________________________________________}
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 bVideoEnable: Boolean;
0022 sRunDirectory: string[200];
0023 sWindowsDirectory: string[200];
0024 sSystemDirector!r: string[200];
0025 startWaIIpaperName, 0026 startWaIIpaperTile: string[200];
0027 startScreenSaver: string[100];
_____________________________________________________________________ 0029 implementation {_______________________________________________________________________-_-_}
0031 uses 0032: Wall, Saver;
0033'~
_____________________________________________________________________ 0034. { Code }
{__________________._____________________________________________________..}
SUBSTITUTE SHEET (RULE 26) 0036 procedure SysFigCheckVideo;
0037 var 0038 Ini: TIniFile; _ 0039 s: string[100];
0040 begin 0041 bVideoEnable := false;
0042 Ini := TIniFile.Create(sWindowsDirectory+'System.ini');
0043 try 0044 s := Ini.ReadString('MCI', 'MPEGVIDEO', ");
0045 except 0046 end;
0047 if s<>" then 0048 bVideoEnable := 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 SysFigLoad;
0064 var 0065 n: word;
0066 DC: HDC;
0087 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(t~sWindowsDirectory[1]), 200-1);
0075 if sWindowsDirectory[n]<>'1' then begin 0076 sWindowsDirectory[n+1] :_'\';
SUBSTITUTE SHEET (RULE 26) 0077 Inc(n) 0078 end;
0079 sWindowsDirectory[0] := Char(n);
0080 n := GetSystemDirectory(Pointer(~sSystemDirectory[1 )), 200-1 );
0081 if sSystemDirectory[n]<>'\' then begin 0082 sSystemDirectory[n+1 ) :_ '\';
0083 Inc(n) 0084 end;
0085 sSystemDirectory[0] := Char(n);
0086 GetWallpaper(startWaIIpaperName, startWaIIpaperTile);
0087 GetSaver(startScreenSaver) 0088 end;
0089 end.
SUBSTITUTE SHEET (RULE 26) 0001 unit TimeBar;
{________________________________________ _ ______________________________-}
0003 interface {________________________________________________________________________-}
0005 {$IFDEF WINDOWS}
0006 uses 0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 0008 Forms, Dialogs, LMDnonvS, 0009 Run, Main, BitBars, Tube, Words, ScroIBar, Counter;
0010 {$ELSE}
0011 uses 0012 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 0013 ExtCtrls, StdCtrls, LMDnonvS, 0014 Run, Main, BitBars, Tube, Words, ScroiBar, Counter;
0015 {$ENDIF}
0016 {-_-___________________________________________}
0017 procedure TimeBarinitialize;
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: longlnt);
0025 procedure TimeBarMouseMove(X,Y: longint);
0026 procedure TimeBarTimerTick;
0027 {_-___~~___w____~______________________}
0028 var 0029 Time: TBar;
{-______________________________________________________________________-_-_}
0031 implementation 0033 uses 0034 CDPlayer;
0035 {__~____~___________________________________}
0036 var 0037 bTimeBarMouseDown: Boolean;
SUBSTITUTE SHEET (RULE 26) 0038 iHintltem:longint;
0039 iHintX,iHintY:longint;
0040 iHintDelayTimer:longint;
0041 sHintMsg: string[250];
0042 bHintVisible: boolean;
0043 blnHintArea: Boolean;
{____.___________________________________________________________________-__}
0045 { Main Code ) {___.______________________________________________________________________}
0047 procedure TimeBarrJewTrack(TrackNo: longint);
0048 begin 0049 BarSetRange(Time, iAudioTrackLength[TrackNoJ);
0050 BarSetPosition(Time, 0);
0051 BarEnable(Time);;
0052 CounterNewTrack;
0053 CounterSetTime(0);
0054 TubeSetTime(TheWords[TrackNoJ, 0) 0055 end;
0056 {__~_______________..____________~__.~____J
0057 procedure TimeBarPosition(TrackTime: longint);
0058 begin 0059 if not bTimeBarMouseDown then begin 0060 BarSetPosition(Time, TrackTime);
0061 CounterSeiTime(TrackTime);
0062 TubeSetTime(fheWords[iLastTrackNoJ, TrackTime) 0063 end 0064 end;
0065 { --__-_----_--_..~____~______________) 0066 function TimeBarGetPosition: longint;
0067 begin 0068 result := BarGetPosition(Time) 0069 end;
{___.________________.____________________________________________________-_}
0071 { Mouse Handling }
{___________________.____________________________________________________-_-_) 0073 procedure TimeBarIUlouseDown;
0074 begin SUBST1'TLJTE SHEET (RULE 26~
0075 if BarButtonHit(Time) then begin 0076 iHintltem := 0;
0077 iHintDelayTimer := 0; _ 0078 if bHintVisible then begin 0079 frmRun.bIobHint.HideMessage;
0080 bHintVisible := false 0081 end;
0082 BarMouseMoveStart(Time);
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 ScroIIBarAbort;
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 xl,y1:longint;
0110 label 0111 exitl ;
0112 begin 0113 if bTimeBarMouseDown then 0114 goto exit1;
0115 iHintX := frmRun.!_eft+X+5;
SUBSTITUTE SHEET (RULE 26) 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;
Oi27 if iltem>0 then begin 0128 if iltem<>iHintltem 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.bIobHinl.HideMessage;
0139 bHintVisible :_~ false 0140 end 0141 end;
0142 {_______________~__.._____________~____________}
0143 procedure TimeBarTimerTick;
0144 begin 0145 if iHintDelayTimer-0 then 0146 exit;
0147 Dec(iHintDefayTimer);
0148 if iHintDeiayTimer=0 then begin 0149 if bHintVisible then 0150 frmRun.bIobHint.HideMessage;
0151 iHintLastX := iHintX;
0152 iHintLastY := iHintY;
0153 sNintLastMsg := sHintMsg;
0154 frmRun.bIobHint.Position := hpAboveRight;
0155 frmRun.bIobHint.ShowMessage(sHintMsg, iHintX, iHintY);
0156 bHintVisible :== true SUBSTITUTE SHEET (RULE 26) 0157 end 0158 end;
0159 _ {_________________________________________________________________________}
0160 { Initalize / Exit }
{_________________________________________________________________________}
0162 procedure TimeBarlnitiatize;
0163 begin 0164 Barlnitialize(Time, frmMain.imgTime_Back, 0165 frmMain.imgTime_Rod, frmMain.imgTime_Button, 0166 frmMain.imgTime Endl, frmMain.imgTime_End2);
0187 sHintMsg :_ 'Drag button to move track time.';
0168 iHintltem := 0;
0169 iHintDelayTimer := 0;
0170 bHintVisibfe := false;
0171 blnHintArea := false;
0172 bTimeBarMouseDown := false 0173 end;
0174 {_________~_______________________________}
0175 procedure TimeBarExit;
0176 begin 0177 BarExit(Time) 0178 end;
0179 end.
SUBSTITUTE SHEET (RULE 26) 0001 unit Tracks;
0003 interface {__________________________________________________________________________}
0005 {$IFDEF WINDOWS}
0006 uses 0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 0008 Forms, Dialogs, LMDnonvS, 0009 Run, Main, CDPlayer, Bitmaps, Tube;
0010 {$ELSE}
0011 uses 0012 Windows, Messages, SysUtils, Classes, Graphics, Conlrols, Forms, Dialogs, 0013 ExiCtrls, StdCtrls, LMDnonvS, 0014 Run, Main, CDPlayer, Bitmaps, Tube;
0015 {$ENDIF}
0016 {_--________________.._~_______________________}
0017 procedure Tracksfnitialize;
0018 procedure TracksExit;
0019 procedure TracksNewTrack(TrackNo: longint);
0020 procedure TracksMouseDown;
0021 procedure TracksMouseMove(X,Y: longint);
0022: procedure TracksTiimerTick;
{_______________________________________________________________________-__}
0024. implementation {________________________________________________________________________--_}
002fi~ uses 0027 PIayList;
0028 {_________~___-___~__~________________}
0029 const 0030 LEDTEXT ADJUST = 3;
0031 TRACKCLICK ADJUST = 1;
0032 {---_________________________________________~}
003a var 0034 spriteTracks Back, 003fi spriteTracks_LedOn, 003Ei spriteTracks LedOff: TSprite;
0037 bTracksMouseDown: booiean;
SUBST1TUT~ SH~~T (RULE 26) 0038 iTracksTop, iTracksSpacing: longint;
0039 iTracksTextLeft, iTracksTextWidth: longint;
0040 iTracksLEDLeft, iTracksLEDWidth: fongint;
0041 iHintltem:longint;
0042 iHintX,iHintY:longint;
0043 iHintDeiayTimer: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; EnabiedState: Boolean); forward;
0050 function TrackMouseHit(X,Y: longint): longint; forward;
0051 function LedMouseHit(X,Y: longint): longint; forward;
0053 { Local Routines }
{_________________________________________________________________________}
0055 procedure DrawTrack(TrackNo: longint; SelectedState: Boolean);
0056 var 0057 TextAlignFlags: word;
0058 iBitmapLine:longint;
0059 TrackRect: TRect;
0060 sTrack: string[4J;
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 bTrackEnabled[TrackNoJ then 0068 if SelectedState then 0089 Font.Color := TEXT HIGHLIGHT
0070 else 0071 Font.Color := TEXT NORMAL
0072 else 0073 Font.Color := TEXT_DISSABLED;
0074 sTrack := IntToStr(TrackNo);
0075 iBitmapLine := iTracksTop + (TrackNo-1)*iTracksSpacing - LEDTEXT_ADJUST;
0076 TrackRect := bounds(iTracksTextLeft, iBitmapLine, SUBSTITUTE SiiEET (RULE 26) 0077 iTracksTextWidth, iTracksSpacing);
0078 ExtTextOut(Handle, 0079 iTracksTextLeft+iTracksTextWidth-1, iBitmapLine, 0080 ETO CLIPPED, ~TrackRect, Pointer(~sTrack~1]), Length(sTrack), nil);
0081 SetTextAlign(Handle, TextAlignFlags);
0082 BitmapUpdateScreen(Trackrect) 0083 end;
0084 end;
0085 {-____-_----___-__--_._______________________) 0086 procedure DrawLED(TrackNo: longint; EnabIedStaie: Boolean);
0087 var 0088 iBitmapLine:longint;
0089 begin 0090 iBitmapLine := iTracksTop + (TrackNo-1)*iTracksSpacing;
0091 if EnabIedState then begin 0092 spriteTracks_LedOn.Top := iBiimapLine;
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 := i TracksTop + (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;
SUBSTITUTE SHEET (RULE 2fi~
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>iTracksLEDLefi+iTracksLEDWidth-1) then 0126 exit;
0127 for iTrack := 1 to iAudioTracks do begin 0128 iTrackLine := iTracksTop + (iTrack-1)*iTracksSpacing;
0129 if tY>=iTrackLine) and (Y<=iTrackLine+iTracksSpacing-1) then begin 0130 result := iTrack;
0131 exit 0132 end 0133 end 0134 end;
{_______________________________________________________________________-_-_}
0136 { Main code }
{_________________________________________________________________________}
0138 procedure TracksNewTrack(TrackNo: longint);
0139 begin Oi40 if TrackNo<>iLastTrackNo then begin 0141 if iLastTrackNo>0 then 0142 DrawTrack(iLastTrackNo, false);
0143 Drawi'rack(TrackNo, true) 0144 end 0145 end;
{_________________________________________________________________________~
0147 { Mouse Handling }
{_________________________________________________________________________}
0149 procedure TracksMouseDown;
0150 var 0151 iTrack, iTrackE: longint;
0152 iTracksEnabled:longint;
0153 begin 0154 iTrack := TrackMouseHit(iMouseDownX, iMouseDownY);
SUBSTITUTE SHEET (RULE 2fi) 0155 if iTrack>0 then begin 0156 iHintDelayTimer := 0;
015'7 -0158 if bHintVisible~ then begin 0159 frmRun.bIobHint.HideMessage;
0160 bHintVisible := false 0161 end;
0162 if bTrackEnabled[itrack] then 0163 frmRun.TrackClicked(iTrack);
0164 exit 0165 end;
0166 iTrack := LedMauseHit(iMouseDownX, iMouseDownY);
0167 if iTrack>0 then begin 0188 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.EnrorMessage( 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(i1'rack, (iLastTrackNO=iTrack));
0184 DrawLED(iTrack, bTrackEnabled[iTrack]);
0185 if bTrackEnabled[iTrack] then 0186 PIayListTrackEnable(iTrack) 0187 else 0188 PIayListTrackDissable(iTrack);
0189 exit 0190 end 0191 end;
0192 { ____w_ _________~____________) 0193 procedure TracksMouseMove(X,Y: longint);
0164 var 0195 iltem:longint;
SUBSTITUTE SHEET (RULE 26) 0196 begin 0197 iHintX := frmRun.Left+X_5;
0198 iHintY := frmRun.Top+Y-0;
0199 iltem :_ -TrackMouseHit(X,Y);
0200 if iltem<0 then begin 0201 if iltem<>iHintltem then begin 0202 if bHintVisible then begin 0203 frmRun.bIobHint.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 iltem<>iHintltem then begin 0214 if bHintVisible then begin 0215 frmRun.bIobHint.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.bIobHint.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 SUB ST1TUTE 5 H EET (RULE 26) WO !98/52189 PCT/US98/10035 023i' if bHintVisible then 023f: frmRun.bIobHint.HideMessage;
0239 sHintMsg :_ 'No hint, song.';
024() if iHintltem>0 then 02411 if bTrackEnabled[iHintltem] then 024a sHintMsg :_ 'Click indicator to disable the track' 024a else 0244 sHintMsd :='Click indicator to enable the track.';
024Ei if iHintltem<0 then 024fi sHintMsg :_ 'Click number to select the track.';
0247 iHintLastX := iHintX;
024!3 iHintLastY := iiHintY;
0249 sHintl.astMsg := sHintMsg;
0250 frmRun.bIobHint.Position := hpAboveLeft;
0251 frmRun.bIobHIint.ShowMessage(sHintMsg, iHintX, iHintY);
0252 bHintVisible :~= true 025;3 end 0254 end;
{__..______________________________________________________________________}
0256 { Initalize / Exit }
025'7 {__________________________________________________________________________}
0258 procedure Trackslnitialize;
0259 var 0260 TrackNo:longini;
0261 sTrack: string[4];
0262 begin 0263 BitmapCreate(spriteTracks_Back, frmMain.imgTracks Back, false);
0264 BitmapCreate(spriteTracks_LedOn, frmMain.imgTracks LedOn, true);
0265 BitmapCreaie(spriteTracks LedOff, frmMain.imgTracks LedOff, tme);
0266 iTracksTop := iTextBIockTop;
0267 iTracksSpacing := iTextBIockHeight div iAudioTracks;
0268 iTracksLEDLeft := spriteTracks_LedOn.Left;
0269 iTracksLEDWidih := spriteTracks LedOn.Width;
0270 iTracksTextLeft := spriteTracks Back.Left +
0271 ((spriteTracks_Back.Left+spriteTracks_Back.Width-1) 0272 (ITracksLEDLeft+ITracksLEDWtdth-1 ) );
0273 with frmRun.Canvas do begin 0274 Font.Size := iiTextFontSize;
0275 Font.Style :_ [fsBold];
SUBSTITUTE SHEET (RULE 26) 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 iHintitem := 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.
SUBSTITUTE SHEET (RULE 26) 0001 unit TrkMedia;
000 3 intertace {_______________________________________________________________________--}
OOOti {$IFDEF WINDOWS}
OOOEi uses OOOi' SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, OOOF3 Forms, Dialogs, OOOS) Run, Main, Bitmaps, Tube, Video, Comment;
001 t) {$ELSE}
0011 uses 001:? Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 001',3 ExtCids, StdCtrls, 0014 Run, Main, Bitmaps, Tube, Video, Comment;
0015 {$ENDIF}
001 Ei {-_____________w__..___w____________________}
001; procedure Medialnitialize;
00113 procedure MediaF~cit;
0019 procedure MediaDraw(TrackNo: longint);
002i) procedure MediaNewTrack(TrackNo: longini);
002'1 {_______________________________________________________________________-__-}
0022 implementation 0024 var 0025 spriteMedia_Video, 002t~ spriteMedia_Comment, 002'7 spriteMedia_Vyes, 0028 spriteMedia_Vno, 0021) spriteMedia_Cyes, 0030 spriteMedia_cno, 0031 spriteMedia_Block: TSprite;
003.2 bmpBlockO: TBitmap;
{__________________._____________________________________________________-_-_}
0034 { Main code }
{__________________._____________________________________________________-__-}
SUBSTITUTE SHEET (RULE 26) 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 BitmapOverlay(Image, spriteMedia_Video, TSprite(nil~));
0043 BitmapOveriay(Image, spriteMedia_Comment, TSprite(nil~));
0044 if not bVideoAvailable[TrackNo] then 0045 BitmapOveriay(Image, spriteMedia_Vno, TSprite(nil"));
0046 if not bCommentaryAvailable[TrackNo] then 0047 BitmapOverlay(Image, 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=tmINFO)) then 0057 if TrackNo<>iLastTrackNo then 0058 MediaDraw(TrackNo) 0059 end;
{_________________________________________________________________________}
0061 { Initatize / Exit }
{_________________________________________________________________________}
0063 procedure Mediainitialize;
0064 var 0065 I: string[50j;
0066 p: integer;
0067 x,y:longint;
0068 Rect1, Rect2: Trect;
0069 begin 0070 BitmapCreate(spriteMedia_Video, frmMain.imgTracks Video, true);
0071 8itmapCreate(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);
SUBSTITUTE SHEET (RULE 26) 0075 BitmapCreate(spriteMedia_Cno, frmMain.imgTracks Cno, true);
0071; with frmMain.irrigTracks_Block do begin 0077 I := Hint;
0078 p := Pos(',',I);
007'9 x := SirTolnt(Copy(1,1,p-1));
0080 y := StrTolnt(Copy(I,p+1,99));
0081 Rect1 := 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 := T'Bitmap.Create;
0087 bmpBlockO.Assign(spriteMedia_Block.lmage) 0088 end;
008'9 {_________~~_____________________________) 0090 procedure MediaExit;
0091 begin 0092 BitmapDestroy(spriteMedia_Video);
0093 BitmapDestroy(spriteMedia_Comment);
0094 BitmapDestroy(spriteMedia_Vyes);
0095 BitmapDestroy(spriteMedia_Vno);
0096 BitmapDestroy(speiteMedia_Cyes);
0097 BitmapDestroy(spr9teMedia_Cno);
0098 BitmapDestroy(spr9teMedia_Block);
0099 bmpBlockO.Free 0100 end;
0101 end.
SUBSTITUTE SHEET (RULE 26) 0001 unit Tube;
0002 {$DEFINE NOSCROLL_LEADER}
0003 {$DEFINE NOSCROLL_TRAILER}
{_________________________________________________________________________}
0005 interface {_________________________________________________________________________}
0007 {$IFDEF WINDOWS}
0008 uses 0009 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, OOiO Forms, Dialogs, Printers, 0011 Run, Main, CDPlayer, Bitmaps, ScrolBar, BitBars;
0012 {$ELSE}
0013 uses 0014 Windows, Messages, SysUtifs, Classes, Graphics, Controls, Forms, Dialogs, 0015 ExtCtrls, StdCtrls, Printers, 0016 Run, Main, CDPlayer, Bitmaps, ScroIBar, 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 = recorci 0029 bEnabled: Boolean;
0030 bHighlight: Boolean;
0031 iMaxFontSize:longint;
0032 iBitmapHeight:longint;
0033 iBitmapLeft, iBitmapTop: longint;
0034 iTimeStamp:longint 0035 end;
0036 pTTubeLine = ~TTubeLine;
0037 {--_-_~~______~___~________~___}
0038 var 0039 iTextFontSize:longint;
SUBSTITUTE SHEET (RULE 26) 0040 iTextBiockLeft, i f-extBIockTop, 0041' iTexlBIockWidth, iTexiBIockHeight: longint;
0042 spriteTubelntro, 0043 spriteTubeText, 0044 spriteTubeMenu: TSprite;
0045 spriteMenuBullet: TSprite;
0046 pCurrentTubeList: ~TTubeList;
0047 pCurrentTube: p'fSprite;
0048 iLastTubeScroll:longint;
0049 {_ ___~____~_________) 0050 procedure Tubelnitialize;
0051 procedure TubeExit;
0052 procedure Tubelnitl_ist(var spriteTube; var TubeList: TTubei_ist;
005~~ t_ineSpacing, LeftOffset: longint);
0054 procedure TubeExitList(var TubeList: TTubeList);
0055 procedure TubeRefresh(var TubeList: TTubeList);
005fi~ procedure TubeDisplay(var TubeList: TTubeList);
0057 procedure TubeSet'TopLine(var TubeList: TTubeList; TopTextLine: longint);
0058 procedure TubeSetAtINormal(var TubeList: TTubeList);
0059 procedure TubeSetHighlight(var TubeList: TTubeList; TextLine: longint);
00601 procedure TubeSetNormal(var Tubel_ist: TTubeList; TextLine: longint);
0061 procedure TubeSetBnable(var Tubet_ist: TTubeList; TextLine: longint);
0062. procedure TubeSetDissable(var TubeList: TTubeList; TextLine: longint);
0063 procedure TubeSet'Time(var TubeList: TTubeList; LineTime: longint);
0064 procedure TubePrint;
0065 function TubeHit(X,Y: longint): longint;
0066 function TubeItemHit(X,Y: longint): longint;
0067 procedure TubeScroll(fopBitmapLine: longint);
oosa {_________________________________________________________________________~
0069 implementation {___________________.___________________________________________________ __) 0071 uses 0072 Words;
0073 {--____~__~_~_____________________________}
0074 const 0075 FORCE DRAW - _9999;
0076 { ___ __~_~_________..____}
0077 function SteppedBitmapLine(var Tubel_ist: TTUbeList; BitmapLine:
longint):
0078 longint; forward;
SUBSTITUTE SHEET (RULE 26) 0079 procedure GetVisibIeLinesRange(var iStartLine, iLastLine: iongint);
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, i!_eftOffset: longint;
0086 ScreenUpdate: Boolean): longint; forward;
0087 procedure DrawLine(TextLine: longint; ScreenUpdate: Boolean); forward;
0088 procedure DrawList(var TubeList: TTubeList); forwarcl;
0089 procedure SetTopLine(var TubeList: TTubeList; TopBitmapLine: longint);
forward;
0090 procedure UpdateScroIIBar(var TubeList: TTubeList; BitmapLine: longint);
forward;
{_________________________________________________________________________}
0092 { Local Routines }
{_________________________________________________________________________}
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 := pTTubeLine(TubeList.TextList.Objects[iLinej);
0104 if pTubeLine~.iBitmapTop = 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.TextList.Objects[iStartLine])~.iBitmapTop 0114 {$ELSE}
0115 begin 0116 result := BitmapLine 0117 {$ENDIF}
SUBSTITUTE SHEET (RULE 26) 011!3 end;
0119 {_---_-_--___~_____~__________________}
012() procedure GetVisibIeLinesRange(var iStartLine: longint; var iLastLine:
longint);
0121 var 012:? iBitmapTop, iBitmapBottom: longint;
0123 iMaxLine, iLine: longint;
0124 pTubeLine: pTT~ubeLine;
012 5 begin 012(i iBitmapTop := pCurrentTubeList~.iCurrentSteppedTop;
0127 iBitmapBottom := iBitmapTop + (iTextBIockHeight-1);
0128 iMaxLine := pCun-entTubeList".TextList.Count-1;
012!3 iStartLine := iLastLine+1;
0130 for iLine := 0 to iMaxLine do begin 0131 pTubeLine := pTTubeLine(pCurrentTubeList".TextList.Objects[iLine]);
0132 if pTubeLine~.iBitmapTop = iBitmapTop then begin 0133 iStartLine := iLine;
0134 break 0135 end;
0136 if pTubeLine~.iSitmapTop > iBitmapTop then begin 013'T iStartLine := iLine-1;
0138 break 013! end 0140 end;
0141 if iStartLine<0 then 014;2 iStartLine := 0;
0143 iLastLine := iMaxLine;
0144 for iLine := iStartLine+1 to iMaxLine do begin 014.5 pTubeLine := pTTubeLine(pCurrentTubeList".TextList.Objects[iLine]);
0146 if pTubeLine~.i8itmapTop > iBitmapBottom then begin 014'7 iLastLine :~= iLine-1;
014$ break 0149 end 0150 end 0151 end;
0152 {----_---___________________________________}
0153 procedure GetLineSizes(const sText: string; var iSpace: longint; var iSize: longint);
0154 var 0155 p0, p1, p2, p9: longint;
0156 c0, c9, n: longint;
0157 s: string[250];
0158 begin SUBSTITUTE SHEET (RULE 26) 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,pl+1,249));
0166 if p2=((p1 +1 )-1 ) then 0167 break;
0168 s := Copy(sText,pl+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[c0) of 0174 's': begin 0175 if [s[c0+1}) <_ ['0'..'9'] then begin 0176 n := StrTolnt(Copy(s,c0+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,c0+1,2));
0188 inc(c0,3) 0189 end 0190 else 0191 tnc(c0) 0192 end 0193 end 0194 end 0105 end;
0196 {_-_--__________________~___________________}
0197 procedure Formatlt(const sText: string; iStart, iEnd: longint);
0198 var 0199 p0:longint;
SUBSTiTUT~ SHEET (RULE 26) 020() red, green, blue: byte;
02011 Stylel: TFontStyles;
0202 begin 020;3 with bmpPlayer.~:,anvas do begin 0204 p0 := iStart;
020Ei while p0<=iEnd do begin 020f3 Stylel :_ [];
020 ~~ case sText(pOj of 0208 '!': begin 0209 Stylel :_ [fsBoid];
0210 Inc(p0) 02111 end;
021:? 'i': begin 0213 Style1 :_ [fsltalic];
0214 Inc;(p0) 021 Ei end;
021f _': begin 021 ~~ Stylel :_ (fsUnderline];
0218 Inc(p0) 0219 end;
022() 'c': begin 0221 red := byte(sText[p0+1 ])-byte('0');
022:? green := byte(sText[p0+2])-byte('0');
0223 blue := byte(sText[p0+3])-byte('0');
0224 Font.Color := RGB(28*red, 28*green, 28*blue);
022!i I nc:(p0,4) 022(3 end;
022 ~~ 's': begin 0228 if [sText[p0+1 ]j <_ ('0'..'9'] then begin 0229 Font.Size := StrTolnt(Copy(sText,p0+1,2));
023() I nc(p0, 3) 0231 end 023:? else begin 023;3 Font.Size := iTextFontSize;
0234 inc(p0,1 ) 0230 end 023!3 end;
023'.7 'q': begin 0238 if [sText[p0+1]] <_ (~p'"~g'j then begin 023!3 red := byte(sText[p0+1 ])-byte('0');
0240 green := byte(sText[p0+2j)-byte('0');
SUBSTITUTE SHEET (RULE 26) 0241 blue := byte(sText[p0+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 Inc(p0) 0249 end 0250 end 0251 else 0252 Inc(p0) 0253 end;
0254 if Stylel <= Font.Style then 0255 Font.Style := Font.Style-Style1 0256 else 0257 Font.Style := Font.Style+Stylel 0258 end 0259 end 0260 end;
0261 {_-__________~__~____________________________}
0262 function Drawit(pTubeLine: pTTUbeLine;
0263 coast 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 TextBIockRect: TRect;
0274 label 0275 Exit Text;
0276 begin 0277 with bmpPlayer.Canvas do begin 0278 TextAlignFlags := SefTextAlign(Handle, TA
LEFT+TA_BASELINE+TA_NOUPDATECP);
0279 SetTextJustification(Handle, 0, 0);
0280 result := iLeftOffset;
0281 if pTubeLine".bHighlight then SUBSTITUTE SHEET (RULE 26) 0282 Font.Color := TEXT HIGHLIGHT;
0283 if not pTubel_ine~.bEnabled then 0284 Font.Cotor := TEXT DISSABLED;
0285 iTextLeft := pTubeLine".iBitmapLeft+iLeftOffset;
0286 iTextTop :_ 'iBitmapLine;
0287 if iEnd>Lenglth(sText) then 0288 iEnd := Le;ngth(sText);
0289 iLength := iE:nd-iStart+1;
020 {$IFDEF WINDOWS}
02!X1 GetTextExle~ntPoint(Handle, ~sText[iStart], iLength, TextEx);
022 {$ELSE}
0293 GetTextExtentPoint32(Handle, ~sText[iStart], iLength, TextEx);
024 {$ENDIF) 025 iTextWidth := TextEx.cx;
026 iTexlHeight := pTubeLine~.iBitmapHeight;
02!7 if (iTextLeft+iTextWidth)>(iTextBIockWidth-1) then begin 028 iTextWidth :_ (iTexiBIockWidth-1)-iTextLeft;
0299 font.Color := clFuchsia 0300 end;
0301 if iTextWidih<=0 then 0302 goto Exit_ Text;
03173 if (iTextTop+iTextHeight-1 )>(iTextBIockHeight-1 ) then 03174 iTextHeight := iTextBIockHeight-iTextTop;
0305 if iTextHeight<=0 then 0306 goto Exit. Text;
03177 TexiLineRec;t := Bounds(iTextBIockLeft+iTextLeft, 0308 iTextBIockTop+iTextTop, 0309 iTextWidth, iTextHeight);
0310 if ScreenUpdate then 0311 BitBlt(bmpPlayer.Canvas.Handle, 03t2 Textl.-ineRect.Left, TextLineRect.Top, 0313 iTextWidth, iTextHeight, 0314 pCunrentTube".Image.Canvas.Handle, 03'15 (iTextBtockLeft-pCurrentTube".Left)+iTextLeft, 0316 (iTextBIockTop-pCurrentTube".Top)+iTextTop, 03'17 srcCOPI~;
0318 ExtTextOut(Handle, 0319 iTextBIockLeft+iTextLeft, 0320 iTextBIockTop+iTextTop+pTubeLine~.iMaxFontSize, 0321 ETO_ CLIPPED, ~Textt_ineRect, ~sTexi[iStart], iLength, nil);
0322 result := iLeftOffset+iTextWidth;
SUBSTITUTE SHEF1' (RULE 26) 0323 TextBIockRect := Bounds(iTextBIockLeft, iTextBIockTop, 0324 iTextBIockWidth, iTextBIockHeight);
0325 if ScreenUpdate then 0326 BitmapUpdateScreen(TextLineRect);
0327 Exit Text:
0328 SetTextAlign(Handle, TextAlignFlags) 0329 end 0330 end;
0331 {_____---______________~_______________~__}
0332 procedure DrawLine(TextLine: longint; ScreenUpdate: Boolean);
0333 var 0334 pTubeLine: pTTubeLine;
0335 iBitmapLine:longint;
0336 iBitmapHeight:longint;
0337 p0,p1,p2,o:longint;
0338 sText: string[255];
0339 illem:longint;
0340 begin 0341 pTubeLine := pTTubeLine(pCurrentTubeList~.TextList.Objects[TextLine-1]);
0342 iBitmapLine := pTubeLine~.iBitmapTop-pCurrentTubeList~.iCurrentSteppedTop;
0343 iBitmapHeight := pTubeLine~.iBitmapHeight;
0344 if (iBitmapLine+igitmapHeight<0) or (iBitmapLine>iTextBIockHeight-1) then 0345 exit;
0346 {$IFDEF NOSCROLL_LEADER}
0347 if iBitmapLine<0 then 0348 exit;
0349 {$ENDIF}
0350 {$IFDEF NOSCROLL TRAILER}
0351 if iBitmapLine+iBitmapHeight>(iTextBIockHeight-1) then 0352 exit;
0353 {$ENDIF}
0354 sText := pCurrentTubeList~.TextList.Strings[TextLine-1];
0355 iltem := pTubeLine~.iTimeStamp;
0356 with bmpPlayer.Canvas do begin 0357 Brush.Styte := bsClear;
0358 Font.Size := iTextFontSize;
0359 Font.Color := TEXT NORMAL;
0360 Font.Style := p;
0361 p0 := 1;
0362 0:= pTubeLine~.iBitmapLeft;
0363 if (0>0) and (iltem>0) then begin SUBSTITUTE SHEET (RULE 26) 0364 with spriteAAenuBullet do begin 036li Left := i'1i extBIockLeft+2"o;
0366 Top := ilfextBIockTop+iBitmapLine+2;-036.T o := o+Width+7 0368 end;
0369 BitmapDraw(spriteMenuBullet) 0371) end;
0371 while p0<=Length(sText) do begin 0372 p1 :_ (p0-1) + Pos('{', Copy(sText,p0,249));
037:3 p2 :_ ((p1+1)-1) + Pos('}',Copy(sText,p1+1,249));
0374 if p2>p1 then begin 037!i o := Drawlt(pTubeLine,sText,p0,p1-l,iBitmapLine,o,ScreenUpdate);
03713 Formatll:(sText,pl+1,p2-1);
0377 p0 := p2+1 03713 end 037!3 else begin 0380 0 := Drawlt(pTubeLine,sText,p0,249,iBitmapLine,o,ScreenUpdate);
038'1 p0 := 249 038:? end 0383 end 0384 end 0385 end;
0386 {__-___________________..___________________________}
038'7 procedure DrawList(var Tubet.ist: TTubeList);
0388 var 0389 iStartLine, iLastLine, iLine: iongint;
0390 TextBIockRect: TRect;
0391 begin 0392 if ~TubeList<>pCurrentTubeList then 039:3 exit;
0394 with pCurrentTube~ do begin 039.5 BitBlt(bmpPlayer.Canvas.Handle, 0396 iTextBIockLeft, iTextBIockTop, iTextBIockWidth, iTextBIockHeight, 039'7 Image.Canvas.Handle, (iTextBIockLeft-Left)+0, (iTextBIockTop-Top)+0, 0398 srcCOPI~;
0399 GetVisibIeLinesRange(iStartLine, iLastLine);
0400 for iLine := iStartLine to iLastLine do 0401 DrawLine(iLine+1, false);
0402 TextBIockRect := Bounds(iTextBIockLeft, iTextBIockTop, 0403 iTextBIockWidth, iTextBIockHeight);
0404 BitmapUpdateScreen(TextBIockRect) SUBSTITUTE SHEET (RULE 26) 0405 end 0406 end;
0407 {___~_____M___~___________________________]
0408 procedure SetTopLine(var TubeList: TTubeList; TopBitmapLine: longint);
0409 begin 0410 TubeList.iCurrentBitmapTop := TopBitmapLine;
0411 TopBitmapLine := SteppedBitmapLine(TubeList, TopBitmapLine);
0412 if TopBitmapLine = TubeList.iCurrentSteppedTop then 0413 exit;
0414 TubeList.iCurrentSteppedTop := TopBitmapLine 0415 end;
0416 {_______________~_________________________) 0417 procedure UpdateScroIlBar(var TubeList: TTubeList; BitmapLine: Iongint);
0418 begin 0419 if ~TubeList=pCurrentTubeList then 0420 ScroIIBarPosition(BitmapLine) 0421 end;
{_________________________________________________________________________) 0423 { Main code }
{_________________________________________________________________________}
0425 procedure TubeInitList(var spriteTube; var TubeList: TTubeList;
0426 LineSpacing, LeftOffsei: longint);
0427 var 0428 iLastLine, iLine: longint;
0429 iTime:longint;
0430 iTop: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 iTime := longint(TubeList.TextList.Objects[iLine]);
0440 TubeLlst.TextLlst.Ob]ects(ILlne] := TOb]ect(pTubeLlne);
0441 pTubeLine~.iTimeStamp := iTime;
0442 iSpace :_ -1;
0443 iSize := iTextFontSize;
SUBSTITUTE SHEET (RULE 26) 0444 GetLineSizes(TubeList.Textt_ist.Strings[iLine], iSpace, iSize);
0445 if iSpace=-1 then 0446 if LineSpaci~ng<0 then 0447 iSpace :=~ (iSize - LineSpacing) 0448 else 0449 iSpace :== LineSpacing;
0450 pTubeLine~.bE:nabled := true;
0451 pTubeLine".bH ightight := false;
0452 pTubeLine~.iMaxFontSize := iSize;
0453 pTubeLine".iBitmapLeft := LeftOffset;
0454 pTubeLine~.i8itmapTop := iTop;
0455 pTubeLine~.iBitmapHeight := iSpace;
0456 Inc(iTop,iSpac:e) 0457 end;
0458 TubeList.iCurrentBitmapTop := 0;
0459 TubeList.iCurrentSteppedTop := 0;
0460 TubeList.iBitmap~MaxTop :_ (iTop-1)-iTexlBIockHeight;
0461 if TubeList.iBitm:apMaxTop<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 := TubE:List.TextList.Count-1;
0472 for iLine := 0 to il_astLine do begin 0473 pTubeLine := jaTTubeLine(TubeList.TextList.Objects[iLine]);
0474 Dispose(pTub~eLine);
0475 TubeList.Textl_ist.Objects[iLine] := nil;
0476 end;
0477 TubeList.TextList.Free;
0478 TubeList.TextList := nil 0479 end;
0480 {_----___~.~_____,____~____________~_}
0481 procedure TubeRefresh(var TubeList: TTubeList);
0482 begin 0483 ScroIIBarAborlt;
0484 iLastTubeScra~ll :_ -1;
SUBSTITUTE SHEET (RULE 2fi~
0485 BitmapDraw(pCurreniTube~);
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 ~TubeList<>pCurrentTubeList then begin 0495 ScroIlBarAbort;
0496 pCurrentTubeList :_ ~TubeList;
0497 iLastTubeScroll :_ -1;
0498 if pCurrentTube<>TubeList.pTube then begin 0499 pCurrentTube := Tubet_ist.pTube;
0500 BitmapDraw(pCurrentTube~) 0501 end;
0502 TubeList.iCurrentSteppedTop := FORCE DRAW;
0503 BarSetRange(Scroll, TubeList.iBitmapMaxTop);
0504 UpdateScroIIBar(TubeList, TubeList.iCurrentBitmapTop);
0505 BarEnable(Scroll) 0506 end 0507 end;
0508 {______________________________________________) 0509 procedure TubeSetTopLine(var TubeLisf: TTubeList; TopTextLine: longint);
0510 begin 0511 UpdateScroIIBar(TubeList, 0512 pTTubeLine(TubeList.TextList.Objects[TopTextLine-1])~.iBitmapTop) 0513 end;
0514 {-_----_____M_~___ _____________M}
0515 procedure TubeSetAlINormal(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);
SUBSTITUTE SHfET (RULE 2fi) 0526 begin 0527 with pTTubeLine(TubeList.TextList.Objects[TextL.ine-1])~ do 0528 if not bHighlight then begin 0529 bHighlight := true;
0530 if ~Tubel_ist=pCurrentTubeList then 0531 DrawLine(TextLine,lrue) 0532 end 0533 end;
0534 {___________w___..__________________________}
0535 procedure TubeSetNormal(var TubeList: TTubeList; TextLine: longint);
0536 begin 0537 with pTTubeLine(TubeList.Textlist.Objects[TeotLine-1])~ do 0538 if bHighlight then begin 0539 bNighlight := false;
0540 if ~Tubel.ist=pCurrentTubeList then 0541 DrawLine(TextLine,true) 0542 end 0543 end;
0544 {_---________________.___________________________) 0545 procedure TubeSE~iEnable(var TubeList: TTubeList; TextLine: longint);
0546 begin 0547 with pTTubeLine(TubeList.TextList.Objects[TextLine-1 ])~ do 0548 if not bEnabled then begin 0549 bEnabled := true;
0550 if ~TubeL.ist=pCurrentTubeList then 0551 DrawLine(TextLine,true) 0552 end 0553 end;
0554 {__________~_______________________________) 0555 procedure TubeSEaDissable(var TubeList: TTubeList; Textl_ine: iongint);
0556 begin 0557 with pTTubeLine(TubeList.TextList.Objects[TextLine-1])~ do 0558 if bEnabied then begin 0559 bEnabled := false;
0560 if ~TubeL.ist=pCurrentTubeList then 0561 DrawLine(TextLine,true) 0562 end 0563 end;
0564 {--_--_-___ _____~____________~__) 0565 procedure TubeSEaTime(var TubeList: TTubeList; LineTime: longint);
0566 var SU B ST1TUTE S H E~T {RULE 26) 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 iLine2 :_ -1;
0579 iTime3 := 0; {kill compiler warning}
0580 iTimePrev := 0; {kill compiler warning}
0581 for iLine := 0 to iLasit-ine 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 := pTTubeLine(TubeList.TextList.Objects[iLine+1]).iTimeStamp;
0586 iTime3 :_ (iTimePrev+iTime2) div 2 0587 end 0588 else begin 0589 iTime2 := pTubeLine~.iTimeStamp;
0590 iTime3 := iTime2 0591 end;
0592 iTimePrev := pTubeLine~.iTimeStamp;
0593 if iTime2>LineTime then begin 0594 iLine2 := pTubeLine".iBitmapTop;
0595 iTextLine := iLine-1;
0596 break 0597 end 0598 end;
0599 if iLine2=-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 := pTubeLine~.iTimeStamp;
0606 iLinel := pTubeLine~.iBitmapTop 0607 end SUBSTITUTE SHEET (RULE 26) 0606 else begin 0609 iTimel := 0;
0610 iLinel := 0 0611 end;
0612 iTimeSpan := iTime3-iTimel;
0613 iLineSpan := iLine2-iLinel ;
0614 if iTimeSpan=0 then 0615 iScroll := iLine2 0616 else 0617 iScroll := iLine1 + (iLineSpan*(LineTime-iTime1)) div iTimeSpan 0616 end;
0619 iScroll := iScroll - ({iTextBIockHeight-iTextFontSize) div 2);
0620 if iScroll<0 then 0621 iScroil := 0;
062! if iScroll>TubeLiat.iBitmapMaxTop then 0623 iScroll := TubE:List.iBitmapMaxTop;
0624 if ~TubeList=pC,urrentTubeList then 0625 UpdateScroIIBar(TubeList, iScroll) 0626 else 0627 SetTopLine(TubeList, iScroll);
0626 for iLine := 0 to iLastLine do 0629 if iLine<>iTexllLine then 0630 TubeSetNormal(TubeList, iLine+1);
0631 if iTextLine>=0 tlhen 0632 TubeSetHighli~ght(TubeList, iTextLine+1}
0633 end;
_______________._____________________________________________________ 0635 { Printer support }
_______________._____________________________________________________ 0637 procedure TubePrint;
0636 var 0639 Printer: TextFile;
0640 iLine, iLastLine: Ilongint;
0641 p0, p1, p2, p9: Ic~ngint;
0642 sText, sprint: strung[250];
0643 begin 0644 frmRun.PrintDiafog.Options :_ [poWarningJ;
0645 if frmRun.PrintDiialog.Execute=False then 0646 exit;
SUBSTITUTE SHEET (RULE 2fi) 0647 try 0648 AssignPm(Printer) 0649 except _ 0850 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.Error1111essage('There is a problem with the printer!');
0658 try 0659 CIoseFile(Printer);
0660 except 0661 end;
0662 exit 0663 end;
0664 for iLine := 0 to iLastLine do begin 0665 sText := pCurreniTubet.ist".TextList.Strings[iLine];
0666 sprint :_ ' ;
0667 p0 := 1;
0868 p9 := Length(sText);
0669 while p0<=p9 do begin 0670 p1 :_ (p0-1)+Pos('{',Copy(sText,p0,249));
0671 if p1=(p0-1) then begin 0672 sprint := sprint + Copy(sText,p0,249);
0673 break 0674 end;
0875 sprint := sprint + Copy(sText,p0,(p1-p0));
0676 p2 :_ ((p1+1)-1)+Pos('}',Copy(sText,pl+1,249));
0877 if p2=((p1+1)-1) then 0678 break;
0679 p0 := p2+1;
0680 end;
0681 try 0682 WriteLn(Printer, sprint) 0683 except 0884 frmRun.ErrorMessage('There is a problem printing to the printerl');
0685 try 0686 CIoseFile(Printer);
0687 except SUBSTITUTE SHEET (RULE 26) 0688 end;
0689 exit 0690 end 0691 end;
0692 try 0693 CIoseFile(Printer);
0694 except 0695 end 0696 end;
{__________________._______________________________________________________}
0698 { Mouse support }
{_________________________________________________________________________}
0700 function TubeHit(X,Y: longint): fongint;
0701 var 0702 iMouseX, iMous~sY: longint;
0703 i8itmapLine:longint;
0704 begin 0705 result := 0;
0706 iMouseX := X-iTextBIockLeft;
0707 iMouseY := Y-iTextBIockTop;
0708 if (iMouseX<0) or (iMouseX>iTextBIockWidth-1) then 0709 exit;
0710 if (iMouseY<0) or (iMouseY>iTextBIockHeight-1) then 07i 1 exit;
0712 iBitmapLine := illAouseY + pCurrentTubeList~.iCurrentSteppedTop;
0713 if (iBitmapLine<0) or (iBitmapLine>pCurrentTubeList~.iBottomBitmapLine) then 0714 exit;
0715 result := 1 0716 end;
0717 {--____~~__..___~___________________}
0718 function TubeItemIHit(X,Y: longint): longint;
0719 var 0720 iMouseX, iMouseY: longint;
0721 iBitmapLine:longint;
0722 iLastLine, iLine: longint;
0723 iFoundLine: iongint;
0724 pTubeLine: pTT'ubeLine;
0725 begin 0726 result := 0;
SUBSTITUTE SHEET (RULE 26) 0727 iMouseX := X-iTextBIockLeft;
0728 iMouseY := Y-iTextBlockTop;
0729 if (iMouseX<0) or (iMouseX>iTextBIockWidih-1) then 0730 exit;
0731 if (iMouseY<0) or (iMouseY>iTextBIockHeight-1) then 0732 exit;
0733 iBitmapLine := iMouseY + pCurrentTubeList~.iCurrentSteppedTop;
0734 if (iBitmapLine<0) or (iBitmapLine>pCurrentTubeList".iBottomBitmapLine) then 0735 exit;
0736 iLastLine := pCurrentTubeList~.TextList.Count-1;
0737 iFoundLine :_ -2;
0738 for iLine := 0 to iLastLine do begin 0739 pTubeLine := pTTubeLine(pCurrentTubeList~.TextList.Objects(iLine]);
0740 if pTubeLine~.iBitmapTop = iBitmapLine then begin 0741 iFoundLine := iLine;
0742 break 0743 end;
0744 if pTubeLine~.iBitmapTop > iBitmapLine then begin 0745 iFoundLine := it_ine-1;
0746 break 0747 end 0748 end;
0749 if iFoundLine=-2 then 0750 iFoundLine := iLasiLine;
0751 if iFoundLine<0 ihen begin 0752 frmRun.SevereError('TubeItemHit - Mouse hit line -ve found!;
0753 exit 0754 end;
0755 with pTTubeLine(pCurrentTubeList~.TextList.Objects[iFoundLinej)~ do 0756 if bEnabled then 0757 result := iTimeStamp 0758 end;
{_________________________________________________________________________}
0760 { ScrollBar support ) {_________________________________________________________________________) 0782 procedure TubeScroIItTopBItmapLine: longint);
0763 begin 0764 SetTopLine(pCurrentTubeList~, TopBitmapLine);
0765 DrawList(pCurrentTubeList~);
SUBSTITUTE SHEET (RULE 26) 0766 if eCDPIayerState<>psPLAYING then 0767 wiih frmRun.tdobHint do 0768 if TopBitmapLine<>iLastTubeScroll then begin 0769 if IsDisplaying then 0770 ShowllAessage(sHintLastMsg, iHintLastX, iHintl_astY);
0771 iLastTub~eScroll := TopBitmapLine 0772 end 0773 end;
{_________________________________________________________________________}
0775 { Initalize I F~cit }
{_________________________________________________________________________}
0777 procedure Tubetnitiaiize;
0778 var 0779 I: string[50];
0780 p: integer;
0781 begin 0782 BitmapCreate(spriieTubelntro, frmMain.imgTube_Intro, true);
0783 BitmapCreate(spriteTubeText, frmMain.imgTube_Text, true);
0784 BitmapCreate(spriteTubeMenu, frmMain.imgTube_Menu, true);
0785 BitmapCreate(spriteMenuBullet, frmMain.imgMenu Bullei, tnue);
078 with bmpPlayer.Canvas do begin 078'1 Font.Assign(fnnRun.Font);
0788 iTextFontSize~ := Font.Size 0789 end;
0790 I := frmMain.imgiPlayer.Hint;
0791 p := Pos(',',I);
0792 iTextBIockLeft :== StrTolnt(Copy(1,1,p-1));
0793 I := Copy(I,p+1,19);
0794 p := Pos(',',I);
0795 iTextBIockTop :~= StrTolnt(Copy(i,1,p-1));
0796 I := Copy(I,p+1,99);
0797 p := Pos(',',I);
0798 iTextBIockWidth := StrTolnt(Copy(1,1,p-1));
0799 iTextBIockHeight := StrTolnt(Copy(I,p+1,99));
0800 pCurrentTube :_~ nit;
0801 pCurrentTubeList := nll;
0802 iLastTubeScroll :_ -1;
0803 end;
0804 {_-_--_____~___~__.~~~__________._~___}
SUBSTITUTE SHEET (RULE 26) WO 98/52189 PCT/tTS98/10035 0805 procedure TubeExit;
0806 begin 0807 BitmapDestroy(spriteMenuBullet);
0808 BitmapDestroy(spriteTubeText);
0809 BitmapDestroy(spriteTubelntro) 0810 end;
0811 end.
SUBSTITUTE SHEET (RULE 26) 0001 unit Video;
0002 l-$DEFINE KILLEIRASE}
0004 interface {__________________._____________________________________________________-__-}
0008 {$IFDEF WINDOUVS}
0007 uses 0008 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 0009 Forms, Dialogs, ExtCtrls, Registry, MPlayer, 0010 Run, Main, CDF'layer, Tube, Regions, Bitmaps, SysFig, Logging;
0011 {$ELSE}
0012 uses 0013 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 0014 ExtCtrls, StdCtrls, Registry, MPlayer, 0015 Run, Main, CDF'layer, Tube, Regions, Bitmaps, SysFig, Logging;
0016 {$ENDIF}
0017 {--_-_____w_~_,_______________________}
0018 type 0019 TfrmVideo = clas~s(TForm) 0020 pnVideo: TPane~l;
0021 mmVideo: TMediaPlayer;
0022 imgVideo: Tlma~ge;
0023 {_-__~______~~_.._______________________}
0024 procedure FormiCreate(Sender: TObject);
0025 procedure mmVideoNotify(Sender: TObject);
0026 {_-________~_~_.______~__________~}
0027 protected 0028 {$IFDEF KILLERA.SE}
0029 procedure FormiErase(var Msg: TWMEraseBkgnd);
0030 message WM_EraseBkgnd;
0031 {$ENDIF}
0032 end;
0033 type ~o~ {__ _~__~___~______________~___}
0035 TProc = Procedure;
0036 {-------_ ~_._____________________}
0037 const 0038 INTROVIDEO =~ 90;
0039 {-----____-------__-----_- -_________}
SUBSTITUTE SHEET (RULE 26) 0040 var 0041 bVideoAvailable: array [1..MAX_TRACKS] of Boolean;
0042 {_------- -------________~__________}
0043 procedure VideoStop;
0044 procedure VideoPlay(TrackNo: longint; xFinished: Tproc);
0045 procedure Videolnitiaiize0;
0046 procedure Videolnitialize;
0047 procedure VideoExit;
0048 { __~___~_~ _w_______~~_}
0049 var 0050 fmzVideo: TfrmVideo;
{_-_______________________________________________________________________}
0052 implementation 0053 {$R *.DFM}
{_______________________________________________________________________-__}
0055 var 0056 VideoRegion: hRGN;
0057 endVideo: TProc;
0058 iVideoOffsetLeft, iVideoOffsetTop: longint;
0059 iVideoWidth, iVideoHeight: longint;
{_______________________________________________________________________-__-}
0061 { Main Code }
{_________________________________________________________________________}
0063 procedure VideoStop;
0064 var 0065 TubeRect: TRect;
0066 begin 0067 with frmVideo.mmVideo do begin 0068 TimeFormat := tfMilliseconds;
0069 LoggingLoglt(IeVIDEO, Position div 100);
0070 try 0071 Wait := true;
0072 Notify := false;
0073 Stop;
0074 except 0075 end 0076 end;
SUBSTITUTE SHEET (RULE 2fi) 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(IeVIDEO, Position div 100);
0089 try 0090 Wait := truce;
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.p~nVideo 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 := frtnRun.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\Intro.mpg' 0117 else SUBSTITUTE SHEET (RULE 26) 0118 FifeName := sRunDirectory+'StufflVideo'+IntToStr(TrackNo)+'.mpg';
0119 Wait := true;
0120 Notify := false;
0121 Open 0122 except 0123 if TrackNo<>INTROVIDEO then 0124 frmRun.ErrorMessage('There 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;
0138 frmRun.ErrorMessage('There is a problem with video playback!');
0137 xFinished 0138 end;
0139 LoggingEvent(IeVIDEO, IsOTHER, TrackNo, 0) 0140 end 0141 end;
{_________________________________________________________________________}
0143 { Video Play end processing }
{_______________________________________________________________________-__}
0145 procedure TFrmVideo.mmVideoNotify(Sender: TObject);
0148 var 0147 ev: TProc;
0148 begin 0149 frmVideo.Hide;
0150 with frmVideo.mmVideo do begin 0151 TimeFormat := tfMilliseconds;
0152 Loggingl_oglt(IeVIDEO, Position div 100) 0153 end;
0154 ev := endVideo;
0155 endVideo := nil;
0156 if Assigned(ev) then SUBSTITUTE SHEET (RULE 26) 0157 ev 0158 end;
0159 {_ _~__~_____~__________~______} _ 0160 {$IFDEF KILLERASE}
0181 procedure TfrmVideo.FormErase(var Msg: TWMEraseBkgnd);
016 begin 0163 Msg.Result := LI~ESULT(False) 0164 end;
0165 {$ENDIF}
{_________________________________________________________________________}
0167 { Initialize and exit }
{_________________________________________________________________________}
0169 procedure TfrmVideo.FormCreate(Sender: TObject);
0170 var 0171 p:longint;
0172 I: string[50];
0173 begin 0174 I := imgVideo.Hint;
0175 p := Pos(',',I);
0176 iVideoOffsetLeft := StrTolnt(Copy(1,1,p_1));
0177 iVideoOffsetTop~ := StrTolnt(Copy(I,p+1,99));
0178 iVideoWidth := imgVideo.Width;
0179 iVideoHeight := imgVideo.Height;
0180 {$IFNDEF WINDOWS}
0181 Outlinelmage( irngVideo.Canvas, 018 imgVideo.Height, imgVideo.Width, 0183 VideoF;egion);
0184 SetWindowRgnl; Handle, VideoRegion, False);
0185 {$ENDIF}
0186 end;
0187 {_---__~__~~__ _________~___~~}
0188 procedure Videolnitialize0;
0189 var 0190 Reg: TRegistry;
019'1 sKey, sValue: string;
019 begin 0193 Reg := TRegistry.Create;
0194 Reg.RootKey := HKEY CURRENT USER;
0195 sKey :='\Softwa~reWlicrosoftWIuItimedia~ActiveMovie FiltersUIIPEG
Decoder;
SUB STTTUTE S H EET (RULE 26) 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,l) 0211 end 0212 except 0213 end;
0214 Reg.Free;
0215 frmVideo := TfrmVideo.Create(nil);
0216 with frmVideo.mmVideo do 0217 try 0218 FileName := sRunDirectory+'Stuff\Intro.mpg';
0219 Wait := true;
0220 Notify := false;
0221 Open 0222 except 0223 end .
0224 end;
0225 {-_-____ _~______~____w_}
0226 procedure Videolnitialize;
0227 var 0228 (Video: TextFile;
0229 iTrack:lnteger;
0230 begin 0231 for iTrack := 1 to iAudioTracks do begin 0232 bVideoAvailable[iTrack] := true;
0233 try 0234 AssignFile(fVideo, sRunDirectory+'Stuff\Video'+IntToStr(iTrack)+'.mpg');
0235 Reset(fVideo);
0236 CIoseFile(fVideo) SUBSTITUTE SHEET (RULE 26) 0237 except 0238 bVideoAvailable[iTrack] := false 0239 end 0240 end;
0241 endVideo := nil;
0242 end;
0243 { _ ___..~____________w~___}
0244 procedure VideoF~ctt;
0245 begin 0246 frmVideo.Free 0247 end;
0248 end.
SUBSTITUTE SHEET (RULE 26) 0001 unit Volumbar;
{--_____________________________________ ______________________________-}
0003 interface {_________________________________________________________________________}
0005 {$IFDEF WINDOWS}
0006 uses 0007 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 0008 Forms, Dialogs, MMSystem, MPlayer, LMDnonvS, 0009 Run, Main, BitBars, Video;
0010 {$ELSE}
0011 uses 0012 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 0013 ExtCtrls, StdCtrls, MMSystem, MPlayer, LMDnonvS, 0014 Run, Main, BitBars, Video;
0015 {$ENDIF}
0016 {______________~________________________}
0017 procedure VolumeBarlnitialize;
0018 procedure VolumeBarExit;
0019 procedure VoiumeBackgroundProcess;
0020 procedure VolumeBarMouseDown;
0021 procedure VolumeBarMouseUp;
0022 procedure VolumeBarMouseDrag( x, y: longlnt);
0023 procedure VolumeBarMouseMove(X,Y: longint);
0024 procedure VolumeBarTimerTick;
0025 {__w__~_ ~_ ______~________}
0028 var 0027 Volume: TBar;
{-________________________________________________________________________}
0029 implementation {_________________________________________________________________________}
0031 const 0032 NO VOLUME = $FFFF;
0033 {_____~_______~__________________~__w__}
0034 var 0035 wCDVolumeld: word;
0036 bVolumeBarMouseDown: Boolean;
0037 iHintltem:longint;
SUBSTITUTE SHEET (RULE 26) 0038 iHintX, iHintY: la~ngint;
0039 iHintDelayTimer:longint;
0040 sHintMsg: string[250j;
0041 bHintVisible: Boolean;
0042 blnHintArea: Boolean;
0043 {_-_--_--___ _____________________________}
0044 procedure SetVolu~me(NewVolume: longint); forward;
0045 function GetVolume: longing forvvard;
0047 { Local Routines }
{________________________________________________________________________=}
0049 procedure SetVotu~me(NewVolume: longint);
0050 begin 0051 auxSetVolume(vvCDVolumelD, (NewVolume shl 16) or NewVolume) 0052 end;
0053 {___________ _______________________________}
0054 function GetVolume: longint;
0055 var 0056 dwVolume: longing 0057 begin 0058 auxGetVolume(vvCDVoiumeld, '(,aDdwVolume);
0058 result :_ (dwVolume and longint($FFFF)) 0060 end;
{_______________________________________________________________________-__}
0062 { Background processing }
{______________________________________________________________________ __}
0064 procedure Voiumel3ackgroundProcess;
0065 begin 0066 if (frmRun.mmCommentary.Mode=mpPLAYING) or 0067 (frmVideo.mmVideo.Mode=mpPLAYING) then begin 0068 BarDissabletl/olume);
0069 exit 0070 end 007'1 else begin 0072 BarEnable(Vcdume) 0073 end;
0074 if not bVolumeBarMouseDown then SUBSTITUTE SHEET (RULE 26~
WO 98!52189 PCT/US98/10035 0075 BarSetPosition(Volume, longint($FFFF)-GetVolume) 0076 end;
{_________________________________________________________________________}
0078 { Mouse Handling }
{_________________________________________________________________________~
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.bIobHini.HideMessage;
0089 bHintVisible := false 0090 end;
0091 BarMouseMoveStart(Volume);
0092 bVolumeBarMouseDown := true;
0093 end 0094 end;
0095 {_________________________w___________________}
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.iSIidePosition) 0110 end 0111 end;
0112 {______~_~~__~__________________w}
0113 procedure VolumeBarMouseMove(X,Y: longint);
SUBSTITUTE SHEET (RULE 26) 0114 var 0115 iltem:longint;
0115 xl,yl:longint; _ 0117 label 0118 exitl ;
011 U begin 0120 if not Volume.bE:nabled then 0121 goto exitl ;
0122 if not Volume.bE:nabled then 0123 goto exitl ;
0124 if bVolumeBarMouseDown then 0125 goto exitl ;
0126 iHintX := frmRun.Left+X+5;
0127 iHintY := frmRurt.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 0138 if iltem<>iHintltem then begin 0137 iHintDelayTimer := HINT DELAY;
0138 iHintltem :_= iltem 0138 end;
0140 exit 0141 end;
0142 exitl:
0143 iHintDelayTimer := 0;
0144 iHintltem := 0;
0145 if bHintVisible then begin 0146 frmRun.blob~lint.HideMessage;
0147 bHintVisible :~= false 0148 end 0148 end;
0150 {__~___~________.____________________________}
015 t procedure VolumeIBarTimerTick;
0152 begin 0153 if not Volume.bE:nabled then 0154 exit;
SUBSTITUTE SHEET (RULE 26) WO 98/52189 PCT/fJS98/10035 0155 if iHintDelayTimer=0 then 0156 exit;
0157 Dec(iHintDelayTimer); _ 0158 if iHintDelayTimer=0 then begin 0159 if bHintVisible then 0160 frmRun.bIobHint.HideMessage;
0161 iHintLastX := iHintX;
0162 iHintLastY := iHintY;
0163 sHintLastMsg := sHintMsg;
0164 frmRun.biobHint.Position := hpAboveRight;
0165 frmRun.bIobHint.ShowMessage(sHintMsg, iHintX, iHintY);
0166 bHintVisibie := true 0167 end 0168 end;
{_________________________________________________________________________}
0170 { Initialize and exit }
{_________________________________________________________________________}
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 iLas#Aux do begin 0181 if auxGetDevCaps(iAux, ~AuxCaps, SizeOf(TAuxCaps))=0 then 0182 if (auxcaps.wTechnoiogy=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 SUBSTITUTE SHEET (RULE Z6) 0194 end 0195 end;
0196 Barlnitialize(Volume, frmMain.imgVolume_Back, 0197 frmMain.imgVolume_Rod, frmMain.imgVolume_Button, 0198 fm~Main.imgVolume Endl, frmMain.imgVolume_End2);
0199 BarSetRange(Volume, longint($FFFF));
0200 if wCDVotumeld<:>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 VolumeE~arExit;
0212 begin 0213 BarF~cit(Volume) 0214 end;
0215 end.
SUBSTiTUTF SHEET (RULE 26~
0001 unit Wall;
~_-_____________________________________________________________________-_}
0003 intertace ~_______________________________________________________________________-_-_}
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 {_____________M_______________________________}
0015 function WaIIpaperOurslnstalled: Boolean;
0016 function UsingThisWalfpaper(const ThisWalipaper: string): Boolean;
0017 function UsingWallpaper: Boolean;
0018 function UsingOurWallpaper: Boolean;
0019 function SeiWallpaper(const WaIIpaperName, WaIIpaperTile: string):
Boolean;
0020 procedure GetWalipaper( var WaIIpaperName, WaIIpaperTile: string);
{_________________________________________________________________________}
0022 implementation {_______________________________________________________________________-__-}
0024 uses 0025 Sysfig;
{_______________________________________________________________________-_-_}
0027 { Code }
{________________________________________________________________________--_}
0029 function WallpaperOurslnstalled: Boolean;
0030 var 0031 fWallpaper: TextFile;
0032 begin 0033 try 0034 AssignFile(fWallpaper, sWindowsDirectory+iniWallpaper);
0035 Reset(fWalipaper);
SUBSTITUTE SHEET (RULE 26) 0036 CIoseFile(fWallpaper);
0037 result := true 0038 except -0039 result := false 0040 end 0041 end;
0042 {_____________________._________________________~_}
0043 function UsingThisWallpaper(const ThisWaBpaper: string): Boolean;
0044 var 0045 Reglni: TReginiFile;
0046 begin 0047 Regini := TregIniFile.Create('Control Panel');
0048 result :_ (RegIni.ReadString('desktop', 'Wallpaper', ")=ThisWallpaper);
0049 RegIni.Free 0050 end;
0051 {_-___________________._____________________________) 0052 function UsingWallpaper: Boolean;
0053 begin 0054 result := not UsingThisWallpaper(");
0055 end;
0056 {-_______________________________________________) 0057 function UsingOurWallpaper: Boolean;
0058 begin 0059 result := UsingT'hisWallpaper(sWindowsDirectory+iniWallpaper+'.bmp');
0060 end;
0061 {___________~____________~_______~______________) 0062 function SetWallpaper( const WaIIpaperName, WaIIpaperTile: string):
booiean;
0063 var 0064 Reglni: TRegIniFile;
0065 begin 0066 result := true;
0067 try 0068 Reglni := TregIniFiie.Create('Control Panel') 0069 except 0070 exit 0071 end;
0072 try 0073 RegIni.Write~String('desktop', 'Wallpaper', WalipaperName);
0074 RegIni.WriteString('desktop', 'TileWallpaper', WaIIpaperTile);
0075 SystemPararneterslnfo(SPI SETDESKWALLPAPER, 0, nil, SPIF_SENDWININICHANGE) 0076 except SUBSTITUTE SHEET (RULE 26) 0077 RegIni.Free;
0078 exit 0079 end;
0080 RegIni.Free;
0081 result := false 0082 end;
0083 {___________~________________________________}
0084 procedure GetWallpaper( var WallpaperName, WallpaperTile: string);
0085 var 0086 Reglni: TRegIniFile;
0087 begin 0088 WaIIpaperName :_ ";
0089 WaIIpaperTile :_ '0';
0090 try 0091 Reglni := TregIniFile.Create('Control Panel') 0092 except 0093 exit 0094 end;
0095 try 0096 WaIIpaperName := RegIni.ReadString('desktop', 'Wallpaper', ");
0097 WaIIpaperTile := RegIni.ReadString('desktop', 'TileWallpaper', '0') 0098 except 0099 end;
0100 RegIni.Free 0101 end;
0102 end.
SUBSTITUTE SHEET (RULE 26) 0001 unit Words;
0003 interface {_-______________________________________________________________________-_-}
0005 {$1FDEF WINDOWS}
OOOS uses OOOJ SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 0008 Forms, Dialogs, LMDnonvS, OOOg Run, Main, Tube, CDPlayer, SysFig;
0010 {$ELSE}
0011 uses 0012 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 0013 ExtCtrls, StdCtrls, LMDnonvS, 0014 Run, Main, Tube, CDPlayer, SysFig;
0015 {$ENDIF}
0016 {_-____.______________.,____________________________}
001 var 0018 TheWords: array [1..MAX_TRACKS] of TTubeList;
0010 {_________________.____..____________________________}
0020 procedure Wordslnitialize;
002'1 procedure WordsE:xit;
0022 procedure WordsNewTrack(TrackNo: longint);
0023 procedure WordsMouseDown;
0024 procedure WordsMouseMove(X,Y: longint);
0025 procedure WordsTimerTick;
_______________._____________________________________________________ 002'T implementation {__________________._______________________________________________________}
0028 var 0030 iHintX, iHintY: longint;
0031 iHintDelayTimei°:longint;
0032 sHintMsg: string[250];
0033 bHintVisible: Boolean;
0034 blnHintArea: Boolean;
~_-________________._____________________________________________________-_-_}
0036 { Code }
SUBSTITUTE SHEET (RULE 26) {_________________________________________________________________________) 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;
{_________________________________________________________________________) 0046 { Mouse Handling }
{_________________________________________________________________________) 0048 procedure WordsMouseDown;
0049 var 0050 iWordsTime:longint;
0051 begin 0052 if eTubeModeState<>tmWORDS then 0053 exit;
0054 iWordsTime := TubeltemHit(iMOuseDownX,iMOuseDownY);
0055 if (iWords'fime>0) and (iWordsTime<9999) then begin 0056 iHintDelayTimer := 0;
0057 if bHintVisible then begin 0058 frmRun.bIobHint.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 eTubeModeState<>tmWORDS 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;
SUBSTITUTE SH E~T (RULE 26) 0075 if bHintVisible then begin 0078 frmRun.bIobHint.HideMessage;
0077 bHintVisible :== false 0078 end;
0079 iHintDelayTimer := HINT DELAY;
0080 exit;
0081 exit1:
0082 iHintDelayTimer := 0;
0083 if bHiniVisibie then begin 0084 frmRun.bIobHint.HideMessage;
0085 bHintVisible :=~ false 0086 end 0087 end;
0088 {_____________w___..__________________________}
0089 procedure WordsTimerTick;
0090 begin 0091 if iHintDelayTimer=0 then 0092 exit;
0093 Dec(iHintDelayTiimer);
0094 if iHintDelayTime;r=0 then begin 0095 if bHintVisible then 0096 frmRun.blobHint.HideMessage;
0097 iHintLastX := iHiniX;
0098 iHintLastY := iHintY;
0099 sHintLastMsg := sHintMsg;
0100 if eCDPIayerState=psPLAYING then begin 0101 frmRun.bIobHint.Position := hpAbovei.eft;
0102 frmRun.bIobHint.ShowMessage(sHintMsg, frmRun.Left+312, frmRun.Top+55) 0103 end 0104 else begin 0105 frmRun.bIobHint.Position := hpAboveRight;
0106 frmRun.bIobHint.ShowMessage(sHintMsg, iHintX, iHintY) 0107 end;
0108 bHintVisible :_ true 0109 end 0110 end;
{___________________.______________________________________________________}
0112 { Initalize / Exit }
{___________________.______________________________________________________}
SUBST1TUT~ SHEET (RULE 26) 0114 procedure Wordslnitialize;
0115 var 0116 fWords: TextFile;
0117 iTrack:lnteger;
0118 I: string[250];
0119 begin 0120 for iTrack := 1 to iAudioTracks do begin 0121 AssignFile(fWords, sRunDirectory+'Stuff\Words'+IntToSir(iTrack)+'.txt');
0122 Reset(fWords);
0123 ReadLn(fWords, I);
0124 iAudioTrackLength[iTrack] := 10"StrTolnt(I);
0125 TheWords[iTrack].TextList := TStringList.Create;
0126 while not Eof(fWords) do begin 0127 ReadLn(fWords, I);
0128 TheWords[iTrackJ.TextList.AddObject(Copy(1,7,255), 0129 Pointer(StrTolnt(Copy(1,1,5))));
0130 end;
0131 CIoseFile(fWords);
0132 TubeInitList(spriteTubeText, TheWords[iTrack], -3, 0);
0133 end;
0134 sHintMsg :_ 'Click the words to jump there.';
0135 iHintDelayTimer := 0;
0136 bHintVisible := false;
Oi37 blnHintArea := false 0138 end;
Oi 39 (___________________~_______________________________) 0140 procedure WordsExit;
0141 var 0142 iTrack:lnteger;
0143 begin 0144 for iTrack := 1 to iAudioTracks do 0145 TubeF~ciiList(TheWords[iTrack]) 0146 end;
0147 end.
SUBSTITUTE SHEET (RULE 26) 0001 unit Loglt;
~__________________._____________________________________________________-_-_}
000;3 intertace {==r_______________._______________________________________________________}
0005 uses Forms, Windows, SysUtils, Registry, ipwHTTP, 0006 Main;
0007 {_--___~___~_.._________________~}
0008 procedure LogSend(const CDhandle: string);
0009 procedure Log ipwHTTPStartTransfer;
001 U procedure Log ipwHTTPTransfer(const Text: String);
0011 procedure Log ipwHTTPEndTransfer;
0012 procedure Log ipwHTTPError;
{__________________._______________________________________________________}
0014 implementation {__________________._______________________________________________________}
0016 type 0017 EVoteSendFailure = class(Exception);
0018 {__~_____~______..________________________}
0019 var 0020 bHTTPDone, 0021 bHTTPAckOK: Boolean;
0022 sResponse: string;
0023 sAckOK: string =~ 'Status: Complete';
{__________________.______________________________________________________-_}
0025 { Main Code }
{-_________________._______________________________________________________}
0027 procedure IogSend(const CDhandle: string);
0028 var 0029 iln, i0ut: longint;
0030 iOutNew, iOutOld: longint;
0031 iEntry:longint;
0032 sURLVote: string;
0033 sVote: string;
0034 iChunk: integer;
0035 bNoEntries: boollean;
SUBSTITUTE SHEET (RUL~ 26) 0036 bVoteEnabled: Boolean;
0037 begin 0038 bVoteEnabled := false; _ 0039 TheRegistry.RootKey := HKEY LOCAL MACHINE;
0040 sKey :_ '1SOFTWARE\PalantirllQcd\'+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.CIoseKey;
0048 exit 0049 end;
0050 TheRegistry.CIoseKey;
0051 if not bVoteEnabled then 0052 exit;
0053 TheRegistry.RootKey := HKEY LOCAL MACHINE;
0054 sKey :_ '1SOFTV11ARE\Palantir\IQcd\'+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.CIoseKey;
0062 exit 0063 end;
0064 TheRegistry.CIoseKey;
0065 TheRegistry.RootKey := HKEY LOCAL MACHINE;
0066 sKey :='1SOFTWAREIPalantirllQcd\'+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.CIoseKey;
0075 exit 0076 end;
SUBSTITUTE SHEET (RULE 26) 0077 TheRegistry.CIoseKey;
0078 TheRegistry.RootKey := HKEY LOCAL MACHINE;
0079 sKey :_ '\SOFT~JVARE\F'alantir\IQcd\'+CDhandle+'\Vote';
ooso try 0081 if TheRegistry.OpenKey(sKey,true) then begin 0082 if not TheRegistry.ValueExists('In') then begin 0083 TheRegistry.Writelnteger('In',1);
0084 iln := 1 0085 end 0086 else begin 0087 iin := TheRegistry.Readlnteger('In') 0088 end;
0089 if not TheRegistry.ValueExists('Ouf) then begin 0090 TheRegistry.Writelnteger('Out',1);
0091 i0ut :_ '1 0092 end 0093 else begin 0094 i0ut :='fheRegistry.Readlnteger('Out') 0095 end 0096 end 0097 else begin 0098 exit 0099 end 0100 except 0101 TheRegistry.~~loseKey;
0102 exit 0103 end;
0104 if i0ut>=iln then begin 0105 TheRegistry.CIoseKey;
0106 exit 0107 end;
0108 if regTnace then 0109 frmMain.IbTrace.Items.Add(' ... send log for'+CDhandle);
0110 if regTrace then 0111 frmMain.IbTrace.Items.Add("+IntToStr(i0ut)+','+IntToStr(iln-1));
0112 iOutOld := i0ut;
0113 iOutNew := i0ut;
0114 bNoEntries := five;
0115 sVote := sURLVote;
0116 try 0117 for iEntry := i0u1 to i0ui+(iChunk-1) do begin SUBSTITUTE SHEET (RULE 26) 0118 if iEntry>=iln then 0119 break;
0120 try _ 0121 sVote := sVote+
0122 TheRegistry.ReadString(Format('x%.9d', [iEntryJ))+
0123 '%OA' 0124 except 0125 end;
0126 iOutNew := iEntry+1;
0127 bNoEntries := false 0128 end;
0129 if bNoEntries then begin 0130 TheRegistry.CIoseKey;
0131 exit 0132 end;
0133 bAlIVotesEmpty := false;
0134 if frmMain.ipwHTTP.Action<>httpldle then 0135 raise EVoteSendFailure.Create('HTTP not idle at start.');
0136 sResponse :_ 'None';
0137 bHTTPDone := false;
0138 bHTTPAckOK := false;
0139 frmMain.ipwHTTP.Action := htlpResetHeaders;
0140 while frmMain.ipwHTTP.Action<>httpldle do;
0141 frmMain.ipwHTTP.URL := sVote;
0142 frmMain.ipwHTTP.Action := httpGet;
0143 while not bHTTPDone do;
0144 if bHTTPAckOk then begin 0145 i0ut := iOutNew;
0146 TheRegistry.Writelnteger('Out', i0ut);
0147 try 0148 for iEntry := iOutOld to iOutNew-1 do begin 0149 sValue := Format('x%.9d', [iEntryJ);
0150 if TheRegistry.ValueExists(sValue) then 0151 TheRegistry.DeleteValue(sValue) 0152 end 0153 except 0154 end 0155 end 0156 else begin 0157 raise EVoteSendFailure.Create('Vote send failure.') 0158 end SUBSTITUTE SHEET (RULE 26) 0159 except 0160 TheRegistry.C:loseKey;
0161 exit 0162 end 0163 end;
0164 {_-____________~__.________________________}
0165 procedure Log ipwHTTPStartTransfer;
0166 begin 0167 sResponse :_ "
0168 end;
0169 {-_---__~____..____.__._______________}
0170 procedure Log ipwHTTPTransfer(const Text: String);
0171 begin 0172 sResponse := sF;esponse+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 := firue;
0181 frmMain.IbTrace.Items.Add('Response -'+sResponse) 0182 end;
0183 {_--_--_____~_______._~_____________________}
0184 procedure Log ipwIHTTPError;
0185 begin 0186 bHTTPDone := true;
0187 bHTTPAckOK := false 0188 end;
0189 end.
SUBSTITUTE SHEET (RULE 26) 0001 unit Main;
{_________________________________________________________________________) 0003 intertace {_________________________________________________________________________}
0005 uses 0006 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 0007 StdCtrls, 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: TLMDOnefnstance;
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; BytesTransferred: Inleger;
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 repExitOnEmpty: Boolean;
0037 bWinsockAccessOk: Boolean = false;
0038 sPaIHandle: string;
0039 sPaIZip, sPalAge, sPaISex: string;
SUBSTITUTE SHEET (RULE 26) 0040 bAltVotesEmptyO~, bAIlVotesEmpty: Boolean;
{___________________.______________________________________________________}
0042 implementation 0043 {$R *.DFM}
{___________________.______________________________________________________}
0045 uses 0046 Loglt;
0047 {______________~_M__________________________}
0048 var 0049 bDialerCheck: Boolean = false;
0050 bWinsockAccessOkO: Boolean = false;
0051 CD: TStrings;
0052 iTimerBusy: intecter = 0;
{___.________________.______________________________________________________}
0054 { Local Routines }
{__________________________________________________________________________}
0056 function GetPalUser(const Value: siring): string;
0057 begin 0058 result :_ '?';
0059 TheRegistry.RootKey := HKEY LOCAL MACHINE;
0060 sKey :='\SOFTV~JARE\PatantirlUser';
0061 try try 0062 if TheRegistry.OpenKey(sKey,false) then 0063 if TheRegistry.ValueExists(Value) then 0064 result :_ 'TheRegistry.ReadString(Value) 0065 except 0066 end 0067 finally 0068 TheRegistry.CIoseKey 0069 end 0070 end;
0071 {__-________ ~__.__________________________}
0072 procedure GetPallnfo;
0073 var 0074 i: integer;
0075 begin 0076 sPaiHandle :_ ";
SUBSTITUTE SHEET (RULE 26) 0077 TheRegis#ry.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 sPaIHandle := TheRegistry.ReadString(sValue) 0084 end 0085 else begin 0086 for i := 1 to 10 do 0087 sPaIHandle := sPaIHandle + Chr(Ord('A')+Random(26));
0088 TheRegistry.WriteString(sValue,sPaIHandle) 0089 end 0090 except 0091 end 0092 finally 0093 TheRegistry.CIoseKey 0094 end;
0095 if sPalHandle=" then 0096 sPaIHandle :_ 'XXXXX~UUUC';
0097 sPaIZip := GetPalUser('Zip');
0098 sPalAge := GetPalUser('Age');
0099 sPaISex := GetPalUser('Sex');
0100 end;
0102 { Main Code }
{_________________________________________________________________________}
0104 procedure TfrmMain.tmTimerTimer(Sender: TObject);
0105 var 0106 iCD1, iCD: integer;
0107 label 0108 WinsockUpdate;
0110 begin 0111 if iTimerBusy>0 then 0112 exit;
0113 Inc(iTimerBusy);
0114 if not bWinsockAccessOk then 0115 goto WinsockUpdate;
SUBSTITUTE SHEET (RULE 26) 0116 if regTrace then begin 0117 if bWinsockAccessOk and not bWinsockAccessOkO then begin 0118 IbTrace.Items.Add('<Dialer activated>');
0119 IbTrace.Items.Add(") 0120 end;
012'1 if bWinsockAccessOkO and not bWinsockAccessOk then begin 0122 IbTrace.Items.Add('<Dialer shut down>');
0123 IbTrace.Items.Add(") 0124 end 0125 end;
0126 bWinsockAcces;sOkO := bWinsockAccessOk;
012'7 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 013'7 TheRegistry.CIoseKey;
0138 if iTimerBusy>0 then 0139 Dec(iTimerBusy);
0140 exit 0141 end;
0142 TheRegistry.CIoseKey;
0143 GetPallnfo;
0144 bAlIVotesEmptyO := bAlIVotesEmpty;
0145 bAlIVotesEmpty := true;
0146 iCD1 := CD.Count-1;
0147 frmMain.ipwHTlfP.WinsockLoaded := true;
0148 for iCD := 0 to i(~D1 do 0149 LogSend(CD.Strings[iCD]);
0150 frmMain.ipwHl'"~P.WinsockLoaded := false;
0151 if bAlIVotesEmp~ty and not bAlIVotesEmpiyO then begin 0152 if regTrace then begin 0153 IbTrace.Items.Add(");
0154 IbTrace.Items.Add('<All Votes Empty>');
0155 IbTrace.Items.Add(") 0156 end;
SUBSTITUTE SHEET (RULE 26) 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 := ntdLisiConnections 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; coast Entry, DeviceName, DeviceType, 0178 StatusDescription: String);
0179 begin 0180 if (DeviceName<>") or (DeviceType<>") or (StatusDescription<>") then 0181 bWinsockAccessOk := true 0182 end;
0183 {-______~___________________________________) 0184 procedure TfrtnMain.ipwHTTPStartTransfer(Sender: TObject);
0185 begin 0186 Log ipwHTTPStartTransfer 0187 end;
0188 { ___~ ~________________________) 0189 procedure TfrmMain.ipwHTTPTransfer(Sender: TObject;
0190 BytesTransfen-ed: Integer; Text: String);
0191 begin 0192 Log ipwHTTPTransfer{Text) 0193 end;
01 A4 {_-_--__~_ ______~____________~______~
0195 procedure TfrmMain.ipwHTTPEndTransfer(Sender: TObject);
0196 begin 0197 Log ipwHTTPEndTransfer SUBSTITUTE SHEET (RULE Z6) 0198 end;
0199 {_----_________ ~_.._______________________}
0200 procedure TfrmMain.ipwHTTPError(Sender: TObject; ErrorCode: Integer;
0201 const Description: String);
0202 begin 0203 Log ipwHTTPError 0204 end;
{______________________________________________________________________ __}
0206 { Initalize I Exit }
{_________________________________________________________________________}
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 bAlIVotesEmpty := false;
0217 bAlIVotesEmptyO := false;
0218 TheRegistry := TRegistry.Create;
0219 CD := TStringLisl.Create;
0220 {----- set send control flags }
0221 regTrace := false;
0222 regExilOnEmpty := true;
0223 TheRegistry.RootKey := HKEY LOCAL_MACHINE;
0224 sKey :='\SOFTW'ARE\PalantirllQcd ;
0225 sValue :_ 'Trace';
0226 try 0227 if TheRegistry.OpenKey(sKey,true) then 0228 if TheRegistny.ValueExists(sValue) then 0229 regTrace := TheRegistry.ReadBool(sValue) 0230 except 0231 end;
0232 Application.ShowMainForm := regTrace;
0233 TheRegistry.RootKey := HKEY LOCAL MACHINE;
0234 sKey :='\SOFTW'ARE\PalantirllQcd';
0235 sValue :_ 'ExitOnEmpty ;
0236 try SUBSTITUTE SHEET (F~ULE 26) 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.HasBindToDiaIUP 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 IbTrace.Items.Add('<Server Start>');
0253 IbTrace.Items.Add(");
0254 if TCPinfo.HasAutoDiaISetup then 0255 IbTrace.items.Add(' ... uses autodial');
0256 if TCPinfo.HasTCPIP then 0257 IbTrace.Items.Add(' ... networking has TCP/IP protocol');
0258 if TCPinfo.HasDialup then 0259 IbTrace.Items.Add(' ... networking has dial-up adapter');
0260 if TCPinfo.HasBindToDialUp then 0261 IbTrace.Items.Add(' ... dial-up adapter bound to TCP/IP');
0262 if TCPinfo.HasModem then 0263 IbTrace.ltems.Add(' ... has modem');
0264 if TCPinfo.HasTCPIP then 0265 if bWinsockAccessOk then 0266 IbT~ace.Items.Add(' --> Winsock access always allowed') 0267 else 0268 IbTrace.Items.Add(' --> Winsock access only when modem active') 0269 else 0270 IbTrace.Items.Add(' --> No Winsock access allowed (no TCP/IP)');
0271 IbTrace.Items.Add('~
0272 end;
0273 {--------- lets go }
0274 tmTimer.Enabled := true 0275 end;
0276 {__________~_ __~_~_____________~_}
0277 procedure TfrmMain.FormClose(Sender: TObject; var Action: TCIoseAction);
SUBSTITUTE SHEET (RULE 26) 0278begin 0279tmTimer.Enabled := true;
0280CD.Free;
0281CD := nil;
0282TheRegistry.Free;
0283TheRegistry :=
nil 0284end;
0285end.
SUBSTITUTE SHEET (RULE 26) program Vote;
{$R '. RES}
uses Forms, Windows, Registry, Main in 'Main.pas' {frmMain}, Loglt in 'Loglt.pas ;
begin Application.lnilialize;
Application.Title :_ 'IQcd Vote';
Application.CreateForm(TfrmMain, frmMain);
Application.Run end.
SUBSTITUTE SHEET (RULE 26) 0001 #!/usr/bin/pert #**~r*wmrww*r***w*r**r****w***w**w**r*w**rwwr***r*r**ww*rrwrwrr**w*ww**xr***,t*
r*w # Record Movement Script #**rw**xrrrrr**wwr*r***rr*r**********rrwrwr**rrwwrwrww*wrwwrrw*wwr**t******r*w*
r # Author: Steve Bliss #**rw*wrrww*wrw*w*******rr*rr***rrr*r***************************w****www*rr*r**
*
# Revision History:
#
# 1997/01/09 - 1.00.000/DWS - Created file.
#*********************************rw*****r*rrr*r******r**r****r**r******rrr*r**
*
require("cgi-lib.pl");
#*************************r**r******r*******w********w*******************w*****
*
# Parse the input parameters #*******rr*rw*r*********wr******,t****r*w**r*wr*wwt*r**r******w*rr***********wr **
&ReadParse(rinput);
#r*wr*r*wrrwxr***wr****wrrr***r*r**w**r*w***r****w*****r***wa*r*rr***********wr *
# Inform the server of our content type #*******r*******rw*******rw***~****************r*r**********w*****w*****r******
r*
print "'Content-type: textlplain\n\n";
#****w*wrr**rw*****w*r*w*rr*w*~*w*wt**w**w*r*rr*w*r*r*r***w****w*******ww***r*r r*
# Open and Write the data file for append #******rrrrrr***r****w****w***~**r***rr*r************r********rw**rr****r***t**
**
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";}
SUBSTITUTE SHEET (RULE 26) program pTCPinfo;
uses Forms, TCPinfo;
{$R *.RES}
begin Application.initialize;
Application.Run;
end.
SUHST(TtJTE SHEET (RULE 26) 0001 unit TCPinfo;
0002.
0003 interface {__________________._______________________________________________________}
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 FHasAutoDiaISetup: booiean;
0014 FHasTCPIP: Boolean;
0015 FHasBindT~oDialUP: Boolean;
0016 procedure Writelnvalid(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 Ha~sAutoDiaISetup: Boolean read FHasAutoDiaISetup 0025 write Writelnvalid;
0026 property HasDialUp: Boolean read FHasDialUp 0027 write Writelnvalid;
0028 property HasTCPIP: Boolean read FHasTCPIP
0029 write Writelnvalid;
0030 property HasBindToDiaIUP: Boolean read FHasBindToDialUp 0031 write Writelnvalid;
0032 end;
0033 {-_ -----_ __.._ 0034 procedure Register;
~~e___o.=ass==vsmaa:e.=c=ax==o=caeo~ccc=~c~~cn==oars===c~co~~c==e~=ae=~~=~cl 0038 implementation {__________________._______________________________________________________) SUBSTITUTE SHEET (RULE 26) 0038 type 0039 EReadOnly = class(Exception);
{_________________________________________________________________________}
0042 { Register Component }
{_________________________________________________________________________}
0044 procedure Register;
0045 begin 0046 RegisterComponents('Palantir', [TpsTCPinfo]);
0047 end;
{_________________________________________________________________________}
0049 { Local routines }
{_________________________________________________________________________}
0051 procedure TpsTCPinfo.Writelnvalid(X: Boolean);
0052 begin 0053 end;
{_________________________________________________________________________}
0055 { Methods }
{_________________________________________________________________________}
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, iProt1: integer;
0065 begin 0066 FHasModem := false;
0067 FHasDialUp := false;
0068 FHasAutoDiaISetup := false;
0069 FHasTCPIP := false;
0070 FHasBindToDiaIUP '= false;
0071 Reg := TRegistry.Create;
0072 Nets := TStringList.Create;
SUBSTITUTE SHEET (RULE 26) 0073 Prots := TStringl_ist.Create;
0074 try 0076 {---------- has modem installed ? }
0077 Reg.RootKey := HKEY~LOCAL MACHINE;
0078 sKey :='\Syst~emlCurrentControlSetlServices\Class\Modem';
0079 try 0080 if Reg.KeyE_xists(sKey) then 0081 FHasMo~dem := true 0082 except 0083 end;
0084 {------ has AutoDial enabled ? ) 0085 Reg.RootKey := HKEY_CURRENT USER;
0088 sKey :='lSoftwarelMicrosoft\WindowslCurrentVersion\Internet Settings';
0087 sValue :='En<~bleAutodial' 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 in~teger(N)<>0 then 0093 FHasAutodialSetup := true 0094 except 0095 end;
0098 {--~--~-- has'fCPIP protocol installed ? }
009'.7 Reg.RootKey := HKEY_LOCAL MACHINE;
0098 sKey :='lEnum\Network\MSTCP';
0099 try 0100 if Reg.Keyl=xists(sKey) then 0101 FHasTCPIP := true 0102 except 0103 end;
0104 {~------- has Dial-Up adapter installed 8 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 iNet1 := Nets.Count-1;
0110 for iNet ::= 0 to iNet1 do begin 0111 skey :='\EnumlRootWet\'+Nets.Strings[iNetJ;
0112 if not Reg.OpenKey(sKey,false) then continue;
0113 if not Reg.ValueExists('DeviceDesc') then continue;
SUBSTITUTE SHEET (RULE 26) 0114 if Reg.ReadString('DeviceDesc')<>'Dial-Up Adapter then continue;
0115 FHasDialUp := true;
0116 if not Reg.OpenKey(sKey+'\Bindings',faise) then continue;
0117 Reg.GetValueNames(Prots);
0118 iProtl := Prots.Count-1;
0119 for iProt := 0 to iProt1 do 0120 if Copy(Prots.Strings[iProt],1,6)='MSTCP\' 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;
{_______________________________________________________________________-__}
0133 { Create/Destroy }
{-________________________________________________________________________}
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.
SUBSTITUTE SHEET (RULE 26) APPENDIX I
xx**xwx*xxw**w*x*wwwwxxxtrw*w**e**x*x*wx*x********wwx*xx****x*x*x***xw*w*rxrxw*
*
1.
2: * BC (Browser Controller) v1.10 3:*
4: * Browser.pas .
ie*ww**x*x*x**w**x**x*r*ewier***xxw*xxx*****x***xwx****xw*****x***xw*w**rxxwr**
w,tw 5.
6:*
7:*
8: * This module contains functions to find and capture a browser. Currently 9: * Netscape and Internet Explorer are supported.
1 0:
x'****ww****www**x**x*x*x*~*w***************xx*******w*******xxw********w*w***w w*) 34: unit Browser;
35:
36: interface 37:
38: uses Messages, Syst.)tils, WinProcs, WinTypes, SheIIAPI, Ver, Classes, HTTP;
39:
40:
{*wr*w**w**ww*wwwwwwww***x****x***x******x*w*w***x*w*******x*w*x***wx**x******x *
41: * Command button constants 42:
'********"***"****twwwwww***x**x****wx*xx*w*wwwww*w*w*x*wxw***x**xwwx**wwwxx*w*
) 43: coast BTN_COUNT = 8;
44:
45: coast BTN HOME = 0;
48: coast BTN_BACK = 1;
47: coast BTN_FORWAF~D = 2;
48: coast BTN_RELOAD = 3;
49: coast BTN_STOP = 4;
50: coast BTN_EXIT == 5;
51: coast BTN_PRINT = 6;
52: coast BTN_FIND -= 7;
53:
54: type TMRect = record 55: case Integer of 56: 0: (Left, Top, Right, Bottom: Integer);
57: 1: (TopLeft, BottomRighi: TPoint);
58: end;
59:
B0: type xtBrowserData =~ record 61: strEXE: String;
62: strlD: String;
63: strVersion: String;
SUBSTITUTE SHEF1' (RULE 26) 64: strSystem: String;
65: hWnd: THandle;
66: hEditWnd: THandle;
67: hOutputWnd: THandle;
68: hHTMLWnd: THandle;
69: hMenu: THandle;
70: xRect: TRect;
71: strBrowserEXE: String;
72:
73: IRectArea: Longlnt;
74: iLeftExtra:lnteger;
75: iTopExtra:lnteger;
76: iRightExtra:lnteger;
77: iBottomExtra:lnteger;
78: IyButtons: array [O..BTN-COUNT - 1 ] of Longlnt;
79: hyMenus: array [O..BTN_COUNT - 1 ] of THandle;
80: bMenuDone: Boolean;
81:
82: hDialerWnd: THandle;
83: hConnectWnd: THandie;
84: strButtonCaption: String;
85: end;
86:
87: const /NIT ERR NOBROWSER - -1;
88: const /NIT ERR NOEDITWND = -2;
89: const /NIT SUCCESS = 0;
90:
91: function brwlnitializeBrowser(hMainWnd: THandie;
92: var xBrowserData: xtBrowserData;
93: strlnitialURL: String; oHTTP: THTTP): Longlnt;
94: function brwFindURLField(hwnd: THandle;
95: var xBrowserData: xtBrowserData): Integer; export;
96: function brwWaIkMenu(var xBrowserData: xtBrowserData): Boolean;
97: function brwFindConnectButton(hwnd: THandle;
98: var xBrowserData: xtBrowserData): Integer;
99: function brvvFindLargestChild(hWnd: THandle;
100: var xBrowserData: xtBrowserData): Integer; export;
101:
102: implementation 103:
104: uses LongFN, Forms, SpIshDlg;
SUBSTITUTE SHEET (RULE 26) 105:
106: var 107: iCount:lnteger;
108:
1 09:
{,r*»*********w*x**w***w,r***********************************w*****************
***
110: * brvvFindBrowserWindow 111;
***********************,.*************,t***************************************
***
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 tlhe callback function 1 19:
***********************..******************************************************
**
120: * This callback function is called to enumerate ail the top level windows.
121: * The purpose of thia function is to find the browser window after it has been 122: * executed.
123:
°***r********s***a****wr*r****r******w**w*********w*****w*************w*
w***s**) 124: function brwFindBrowserWindow(hwnd: THandle; var pxBrowserData:
xtBrowserData):
125: Integer; export;
126: var 127: szTitle: array [0..!i00J of Char; {Title of the window) 128: strTitle: String; {Title of the window}
129: begin 130:
{*******************,.*******************************************************
131: * Get the window title 132:
**************************************************************************.) 133: GetWindowText(hWnd, szTitie, 500);
134: strTitle := StrPas(szTitle);
135:
1 36:
{******************.,.*******************************************************
137: * Determine whether or not the window meets out search criteria 1 38.
~****************.*******************************************************
139: if pxBrowserData.strlD = 'N' then 140: begin 141: if ('NETSCAPE' = UpperCase(strTitle)) or 142: (Pos('NETSC;APE = , UpperCase(strTitle)) <> 0) then 143.: begin 144:: brwFindBrorNSerWindow := 0;
145:: pxBrowserData.hWnd := hWnd;
SUBSTITUTE SHEET (RULE 26) 146: end 147: else 148: brwFindBrowserWindow := 1;
149: end 150: else 151: begin 152: if ('MICROSOFT INTERNET EXPLORER' = UpperCase(sirTitle)) or 153: (Pos('- MICROSOFT INTERNET EXPLORER', UpperCase(strTitle)) <> 0) then 154: begin 155: brwFindBrowserWindow := 0;
156: pxBrowserData.hWnd := hWnd;
157: end 158: else 159: brvvFindBrowserWindow := 1;
160: end;
181:
i 62: end;
163:
1 64:
{********************t***r*******************t*********************************
*
165: * brwFindURLField 1 66:
********r***********************************************w*x********************
*
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: """"***~""""*******************,t***************************x******
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.
1 78:
'*"""'**"********************************************************************}
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);
SUgSTITUTF SH EET (RULE 2fi) 18'7:
188: if ((Pos(':/P, strTitle) <> 0)) or 189: ((Pos('BLANK.', UpperCase(strTitle)) <> 0)) then 190: begin 191: iCount := iConnt + 1;
192:
193: xBrowserData.hEditWnd := hWnd;
194: end 195: else 196: brwFindURLF'iefd := 1;
197: end;
198:
199:
{***,tt*rtir**w**,tirtrtttr**ww*yww****,twattrww*w*wwww,e,t*w***~,t***,tw*waw*w ***w*fr*,t*»»xx*
200: * brwFindConnectButton 20'I:
*w,e.tv***wwt*ww*******wt**w*.twtr,twwwww*w*w***w**rwwwww**w,ew*www*ww**w*wwa,t ,t,t*w»»*
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:
****wrww*wwwwwwwwtr*,tw*,t*wewrr*w*»wrw**,tw*wr****wwww*ww***w****,t,~,t**ww***
,ew»»»,rw*
210: * This callback function attempts to get the window handle of the connect 211: * button in the dialer window.
212:
~~*.***.***.....*..***...~**,r**.,.*****.****,~******..***.*,M*.****.**.*.*****
*.**.) 213: function brwFindConnectButton(hwnd: THandle;
214: var xBrowserData: xtBrowserData): Integer;
215: var 216: szTitle: an-ay [0..500] of Char;
217: strTitle: String;
218: begin 219: SendMessage(hWnd, WM_GETTEXT, 500, Longlnt(~szTiile));
220: strTitle := StrPas(szTitle);
221:
222: if (Pos(UpperCa;se(xi3rowserData.str8uttonCaption), 223: UpperCase(strTitle)) <> 0) then 224: begin 225: xBrowserDatai.hConnectWnd := hWnd;
226: brwFindConnectButton := 0;
227: end SUBSTITUTE SHEET (RULE 26) 228: else 229: brwFindConnectButton := 1;
230: end;
231:
232:
{~*********************************************.*******************************
*
233: * brvvWaIkMenu 234:
**************************************************************w*******t*t***
235: * Parameters:
236: * str8rowserEXE - 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:
*****~******************t**********************tr*******************w*********
242: * This function searches the registry to find the executable tile associated 243: * with the .htm extension. This executable is assumed to be a browser which 244: * can be controlled by BC.
245:
~******************************************************************************
) 246: function brvvFindBrowserFile(var strBrowserEXE: String): Boolean;
247: var 248: hFoundKey: HKey;
249: bFound: Boolean;
250: szKeyVal: array [0..511] of char;
251: IKeyLen: Longlnt;
252: pcChar: PChar;
253: begin 254: IKeyLen:= 512;
255: bFound := False;
256:
257: strBrowserEXE :_ ";
258:
259: if RegQueryValue(HKEY CLASSES ROOT, '.htm', szKeyVal, 280: IKeyLen) = ERROR SUCCESS then 261: begin 262: if RegOpenKey(HKEY CLASSES ROOT, szKeyVal, 263: hFoundKey) = ERROR SUCCESS then 264: begin 285: if RegOpenKey(hFoundKey, 'shell', 266: hFoundKey) = ERROR SUCCESS then 267: begin 268: if RegOpenKey(hFoundKey, 'open', SUBSTITUTE SHEET (RULE 26) 269: hFoundKey) = ERROR SUCCESS then 270: begin 27 t : IKeyL~sn := 512;
272:
273: if RegQueryValue(hFoundKey, 'command', szKeyVal, 274: IKeyLen) = ERROR SUCCESS then 275: begun 276: bFound := True;
277: endl;
278: end;
279: end;
280: end;
281: end;
282:
283: if bFound = Trues then 284: begin 285: pcChar := StrIPos(szKeyVal, ' ');
286:
287: if pcChar <> Phil then 288: pcChar[Oj := Chr(0);
289:
290: strBrowserEXE := StrPas(szKeyVal);
29'1: brwFindBrowserFile := True;
292: end 293: else 294: brwFindBrowserFile := Fafse;
295: end;
296:
29'l:
{******ir*vrt,rrwr~rwew*wwwwww**w*wrt*w,twa**.tr~rrwr*rr*i.*w*w*w**wwrw*****w*w ww,Hw*
298: * brvvWaIkMenu 299:
*************~~**w*www**w*nw*ww*w*w**********w*tw*,krwwwww*+a+*,rww*"*~r~rt*
300: * Parameters:
30't: * xBrowserl7ata - Info~nation 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 308:
********w***~*~r~w~w~~wwwwo*w*w***waw*w~****vw~rww*w*www**wow**r*~***w*w*wwew*
30'7: * 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:
******************w*wf~wwww*~**war+,rtwwww*ww*.e*www*w***www*r**w**,tww**ww*~) SUBSTITUTE SHEET (RULE 26) 310: function brwWaIkMenu(var xBrowserData: xtBrowserData): Boolean;
311: var 312: iSubMenuPos:lnteger;
313: iSubMenuItemPos:lnteger;
314: iSubMenuldx:lnleger;
315: iBuitonldx:lnteger;
316: hSubMenu: THandle;
317: szSubMenuItemText: 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: iSubMenuItemPos := 0;
327:
328: for iSubMenuidx := 0 to 50 do 329: begin 330: GetMenuSUing(hSubMenu, iSubMenuItemPos, szSubMenuItemText, 331: 256, MF BYPOSITION);
332: StrUpper(szSubMenuItemText);
333:
334: if StrPos(szSubMenuItemText, 'BACK') <> Nil then 335: begin 336: if xBrowserData.lyButtons[BTN_BACK] = 0 then 337: begin 338: xBrowserData.lyButtons[BTN_BACK] :_ 339: GetMenuItemID(hSubMenu, iSubMenuItemPos);
340: xBrowserData.hyMenus[BTN_BACK] := hSubMenu;
341: end;
342: end;
343:
344: if StrPos(szSubMenuItemText, 'FORWARD') <> Nil then 345: begin 346: if xBrowserData.lyButtons[BTN_FORWARD] = 0 then 347: begin 348: x8rowserData.lyButtons[BTN_FORWARD] :_ 349: GetMenuItemID(hSubMenu, iSubMenuItemPos);
350: xBrowserData.hyMenus[BTN_FORWARD] := hSubMenu;
SUBSTITUTE SHEET (RULE 2fi) 351: end;
352: end;
353: -354: if xBrowserData.strlD = 'N' then 355: begin 356: if StrPos(szSubMenuItemText, 'CLOSE') <> Nil then 357: begin 358: if xBrowserData.lyButtons[BTN_EXITJ
= 0 then 359: begin 360: xBrowserData.lyButtons[BTN_EXIT] :_ 361: GetMenuItemID(hSubMenu, iSubMenuItemPos);
362: xBrowserData.hyMenus[BTN_EXIT] := hSubMenu;
363: end;
364: end;
365: end 368: else 367: begin 388: if StrPos(szSubMenuitemText, 'CLOSE') <> Nit then 369: begin 370: if xBrowserData.lyButtons[BTN_EXIT]
= 0 then 371: begin 372: xBrowserData.IyButtons[BTN_EXIT] :_ 373: GetMenuItemID(hSubMenu, iSubMenuItemPos);
374: xBrowserData.hyMenus[BTN_EXIT) := hSubMenu;
375: end;
376: end;
377: end;
378:
379: if xBrowserData.strlD = 'N' then 380: begin 381: if StrPos(azSubMenuItemText, 'STOP') <> Nil Then 382: begin 383: if xBrowserData.lyButtons[BTN_STOP]
= 0 then 384: begin 385: xBrowserData.lyButtons[BTN_STOP] :_ 386: GetMenuItemID(hSubMenu, iSubMenuItemPos);
387: xBrowserData.hyMenus[BTN_STOP] := hSubMenu;
388: end;
389: end;
390: end 391: else SUBSTITUTE SHEET (RULE 26) 392: begin 393: if StrPos(szSubMenuItemText, 'STO&P') <> Nit then 394: begin 395: if xBrowserData.lyButtons[BTN_STOP]
= 0 then 396: begin 397: xBrowserData.lyButtons[BTN_STOP] :_ 398: GetMenuItemID(hSubMenu, iSubMenuttemPos);
399: xBrowserData.hyMenus[BTN_STOP] := hSubMenu;
400: end;
401: end;
402: end;
403:
404: if (StrPos(szSubMenuItemText, 'REFRESH') <> Nil) Or 405: (StrPos(szSubMenuItemText, 'RELOAD') <> Nil) then 406: begin 407: if xBrowserData.lyButtons[BTN_RELOAD]
= 0 then 408: begin 409: xBrowserData.lyButtons[BTN_RELOAD]
:_ 410: GetMenuItemID(hSubMenu, iSubMenuItemPos);
411: xBrowserData.hyMenus[BTN_RELOAD] :=
hSubMenu;
412: end;
413: end;
414:
415: if StrPos(szSubMenuttemText, 'PRINT') <> Nil then 416: begin 417: if xBrowserData.IyButtons[BTN_PRINT]
= 0 then 418: begin 4i9: xBrowserData.lyButtons[BTN_PRINT] :_ 420: GetMenuItemID(hSubMenu, tSubMenuItemPos);
421: xBrowserData.hyMenus[BTN_PRINT] :=
hSubMenu;
422: end;
423: end;
424:
425: if StrPos(szSubMenuItemText, 'FIND') <> Nil then 426: begin 427: if xBrowserData.lyButions[BTN_FIND]
= 0 then 428: begin 429: xBrowserData.lyButtons[BTN_FIND] :_ 430: GetMenultemtD(hSubMenu, iSubMenuItemPos);
431: xBrowserData.hyMenus[BTN_FIND] := hSubMenu;
432: end;
SUBST1TUTF SHEET (RULE 26) 433: end;
434:
435: iSubMenultemPos := iSubMenuItemPos +-1;
436: end;
43T:
438: iSubMenuPos := iSubMenuPos + 1;
439: hSubMenu :_ ~GetSubMenu(xBrowserData.hMenu, iSubMenuPos);
440: end;
441:
442: brwWaIkMenu := True;
443:
444: for iButtonldx := 1 to (BTN_COUNT - 1) do 445: if xBrowserDai:a.lyButtons[iButtonldx] = 0 then 446: brwWaIkMenu := False;
447: end;
448:
449:
{***************.**************************************************************
*
450: * brwFindLargeslChild 451:
***"'************r***rw*********w*************w***x****************************
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:
*********w*x*******************************************************************
*
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:
*n******w********rx*************x**********************************************
~
466: function brwFindLargestChild(hWnd: THandle;
467: var xBrowserData: xtBrowserData): Integer;
468: var 469: xRect: TMRect;
470: xParentRect: TMRect;
471: IRectArea: Longlnt;
472: begin 473: GetWindowRect{hWnd, TRect(xRect));
SUBSTITUTE SHEET (RULE 26) 474:
475: IRectArea := Longlnt(xRect.Right - xRect.Left + i) 476: Longint(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 - xParentReci.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:
{*wa*i*w,tww*****,t******r****w*ww***wt*,t*rr****wwwrrwwwwwww***ww*wt*www**www*
ww**
496: " brvvlnitializeBrowser 497:
****trwt*.tww*ww*w*wwwr**wwtwx*wt**w*ww**,t******v***ww*wwwf.wwwww*wtrw***w,rwt www***
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:
***~*'*'~******""*"****""*www*****iwwr***ww*r*,rrrtww**wwwww.~w*n**rrrr**a**x*x ww 508: * This function attempts to find the browser window and encapsulate it within 509: * the BC window.
510:
*******w**,twwxw*»*w*wwr*nwtir*w*www*~rw******,r*wuw*swww*,rw**ww*w*,er******,r w,~www~
511: function brwlnitializeBrowser(hMainWnd: THandle;
512: var xBrowserDala: xt8rowserData;
513: strinitialURL: String; oHTTP: THTTP): Longlnt;
514: var SUBSTITUTE SHEET (RULE 26) 515: xCurTime: TDate:Time;
516: szBrowserEXE: array [0..255] of char;
517: strBrowserEXE: String;
518: oFile: TFileStream;
519: xPoint: TPoint;
520: xClientRect: TRe~ct;
521: dlgSplash: TdIgSplash;
522: hDC: THandle;
523: { strDir: String;}
524: { szWinDir: array [0..255] of char;
525: szSystemDir: array [0..255] of char}
526: ildx:lnteger;
527: strPath: String;
528:
529: pxVerlnfo: "TVS. FIXEDFILEINFO;
530: pszVerlnfo: PChar;
531: IVerSize: Longlnt;
532: wVerSize: Word;
533: hVersion: Longlni;
534: szBuffer: array [0..1024] of char;
535: pszBuffer: PChar;
536: begin 537:
{******************vr****r***,r***ww******w*********************w***w********~r 538: * Display the splash dialog 539:
***********x*******,t********w**,r************the*****w*ww******w*******t*****}
540: dlgSplash := TdIgSpIash.Creaie(Nil);
541: dIgSpIash.Show;
542.:
543:
{******************n*********.**********************************************
544: * Find the browser 545:
~****************~.****..******************************.********.*********}
546: dIgSpIash.pnStaltus.Caption :='Searching for a web browser...';
547: Application.Proc~essMessages;
548:
549: if xBrowserData.strBrowserEXE = " then 55G: brwFindBrowserFile(strBrowserEXE) 551: else 552: strBrowserEXl° :~ xBrowse~Data.strBrowse~EXE;
553:
554: if strBrowserEXE: _ " then 555: strBrowserEXE :='c:lprogra~1lintem~1liexplore.exe' SUBSTITUTE SHEET (RULE 26) 556: else 557: IfGetShortPathName(strBrowserEXE, strBrowserEXE);
558:
559:
{***************..********************.***.*********************************
560: * Add the OS Version 561: ~***~**************rwr*****************w*****,~*********w*******w***x*) 562: if IfLongFileNames = True then 563: xBrowserData.strSystem :='32' 564: else 565: xBrowserData.strSystem :_ '16';
586:
567: xBrowserData.strSystem := xBrowserData.strSystem + '-';
568: xBrowserData.strSystem := xBrowserData.strSystem +
569: IntToStr(LOBYTE(LOWORD(GetVersion)));
570: xBrowserData.strSystem := xBrowserData.strSystem + ' ';
571: xBrowserData.strSystem := xBrowserData.strSystem +
572: IntToStr(HIBYTE(LOWORD(GetVersion)));
573:
574:
~***********w***********w****,t*********.w*********************************~,t 575: * Try to determine the browser version 576: ********w* ************************************************) 577: StrPCopy(szBrowserEXE, strBrowserEXE);
578:
579: IVerSize := GeiFileVersionlnfoSize(szBrowserEXE, hVersion);
580:
581:
582: if GetFileVersionlnfo(szBrowserEXE, hVersion, IVerSize, szBuffer) = True then 583: begin 584: pszBuffer := szBuffer;
585:
586: if VerQueryValue(pszBuffer, 587: '\\StringFilelnfo\1040904E4\\ProductVersion', 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:
~**s********w***********w***************t****w*****x*wx*******************}
SUBSTITUTE SHEET (RULE 26) 597: if Pos('NETSCAPE', UpperCase(strBrowserEXE)) <> 0 then 598: xBrowserData.strlD :_ 'N' 599: else 600: if Pos('IEXPLORE', UpperCase(strBrowserEXE)) <> 0 then 601: xBrowserDal:a.strlD :_ 'I' 602: else 603: begin 604: brvvlnitializeE3rowser := INIT ERR NOBROWSER;
605: dIgSpIash.Destroy;
606: Exit;
607: end;
808:
609:
{********************ww*********x***********************w*******************
610: * Run the browses 61 1:
****.***************~,******************************************************}
612: if xBrowserData.strlD = 'N' then 613: begin 614: dIgSpIash.pnStatus.Caption :_ 'Loading Netscape Navigator...';
615: StrPCopy(szBnowserEXE, strBrowserEXE + ' ' + strlnitialURL);
616: end 617: else 618: begin 619: dIgSpIash.pnStatus.Caption :='Loading Microsoft Internet Explorer...';
620:
621: { for ildx := Length(Application.EXEName) downto 1 do 622: begin 623: if Application.EXEName[ildx) _ '\' then 624: begin 625: strPath := Copy(Application.EXEName, 1, ildx);
626: break;
627: end;
628: end;
629:
630: StrPCopy(szBnowserEXE, strBrowserEXE + ' ' + strPath + 'BLANK.HTM');) 631: StrPCopy(szBnowserEXE, strBrowserEXE + ' ' + strlnitialURL);
632: end;
633:
634: Appiication.ProcessMessages;
635:
636: if WinExec(szBrowserEXE, SW SHOWNORMAL) < 32 then 637: begin SUBSTITUTE SHEET (RULE 26) 638: brwlnitializeBrowser := INIT ERR NOBROWSER;
639: dlgSpiash.Destroy;
840: Exit; -641: end;
642:
643:
{***,.*****,.********.*****.*************************************.************
644: * Find the window handle of the browser 645:
*'"'****"*'**"'************************************************************}
646: xCurTime := Time;
647:
648: while ((Time - xCurTime) < 0.0003472) do 849: 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: brvvlnitiaiizeBrowser := iNIT ERR NOBROWSER;
662: dIgSpIash.Destroy;
663: Exit;
664: end;
665:
666: {**~*********************************************************w***********
667: ' Store the current size of the browser window for future reference 688:
******"********************************************************************~
669: GetWindowRect(xBrowserData.hWnd, xBrowserData.xRect);
670:
671:
{*~****************xw*******************e*******************,t************
672: " Set the palantir window as the parent 673: ~***************w******x************s***************w*******************~
674: SetParent(xBrowserData.hWnd, hMainWnd);
875:
676: {*~~*w *w****************************rw***w*****rr****
677: " Get the browser menu and make it a child of BC
678: ~*******************x**********r*******w*******xr***************x*******~
SUBSTITUTE SHEET (RULE 26) 679: { xCurTime := Time;
680:
681: dIgSpIash.pnStatus.Caplion :='Searching for hotkeys...';
682: Application.Proce~ssMessages;
683:
684: while ((Time - xCurTime) < 0.0001156) do 685: begin 686: if brwWaIkMenu(xBrowserData) = True then 687: xCurTime :_~ -1;
6sa:
689: Application.ProcessMessages;
690: end;}
691:
692: { if xBrowserData.strlD = 'N' then 693: begin}
694: { xBrowserData.IyButtons[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.IyButtons[BTN_FIND] := 32819;
701: xBrowserData.iyButtons[BTN_ABOUT] := 65199;
702: xBrowserData.iyButtons[BTN_EXIT] := 57665;}
703:
704: { brwWaIkMenu(xBrowserData);
705: xBrowserData.lyButtons[BTN EXIT] := 57665;
708: end 707: else 708: begin 709: brwWaIkMenu(xBrowserData);
710: end;}
711:
712:
{***************************************************************************
713: * Find the largest window in the browser 714:
***************************.***********************************************}
715: { xCurTime := Time;
716:
717: if xBrowserDala.strlD = 'I' then 718: while ((Time - xCurTime) < 0.0000231 ) do 719: begin SUBSTITUTE SHEET (RULE 26) 720: end;
721:
722: xBrowserData.IRectArea := 0;} -723:
724: xBrowserData.IRectArea := 0;
725: EnumChiIdWindows(xBrowserData.hWnd, ~brvvFindLargestChild, 726: Longlnt(~xBrowserData));
727:
728: ifxBrowserDala.strlD='I'then 729: begin 730: xBrowserData.IRectArea := 0;
731: EnumChiIcfWindows(xBrowserData.hOutputWnd, ~brwFindLargestChild, 732: Long I nt(t~xBrowserDaia));
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:
{*******w******************.**********************************,t*************
740: * Find the window handle of the edit window 741:
*~*************************************************************************}
742: { dIgSpIash.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: EnumChiIdWindows(xBrowserData.hWnd, t~brwFindURLField, 753: Longlnt(~xBrowserData));
754:
755: if xBrowserData.hEditWnd <> 0 then 756: xCurTime :_ -1;
757:
758: Application.ProcessMessages;
759: end;
760:
SUBSTITUTE SHEET (RULE 26) 781: if xBrowserData.hEditWnd = 0 then 762: begin 763: oHTTP.AddFeedback('E1,NOURL') -764: end;}
785:
76fi: dIgSpIash.Destroy;
767:
768: { .*******************************************************
769: * Return success 77~: **.****************************************************}
771: brvvlnitiaiizeBrowser := /NIT SUCCESS;
772: end;
773:
774: end.
SUBSTITUTE SHEET (RULE 26) APPENDIX II
.
***********r******rr**r*wwrrw*w**********r***********ra*r**rrw*r**rwwrw*r*w****
1.{
2:*
3:r 4: * Main.pas 5:
*"******r*******r**r*w***ww***rr********r******r*r**********wr***r*w*****w**rw*
*
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.
1 0:
x'****ww****www**x**x*x*x*~*w***************xx*******w*******xxw********w*w***w w*) 34: unit Browser;
35:
36: interface 37:
38: uses Messages, Syst.)tils, WinProcs, WinTypes, SheIIAPI, Ver, Classes, HTTP;
39:
40:
{*wr*w**w**ww*wwwwwwww***x****x***x******x*w*w***x*w*******x*w*x***wx**x******x *
41: * Command button constants 42:
'********"***"****twwwwww***x**x****wx*xx*w*wwwww*w*w*x*wxw***x**xwwx**wwwxx*w*
) 43: coast BTN_COUNT = 8;
44:
45: coast BTN HOME = 0;
48: coast BTN_BACK = 1;
47: coast BTN_FORWAF~D = 2;
48: coast BTN_RELOAD = 3;
49: coast BTN_STOP = 4;
50: coast BTN_EXIT == 5;
51: coast BTN_PRINT = 6;
52: coast BTN_FIND -= 7;
53:
54: type TMRect = record 55: case Integer of 56: 0: (Left, Top, Right, Bottom: Integer);
57: 1: (TopLeft, BottomRighi: TPoint);
58: end;
59:
B0: type xtBrowserData =~ record 61: strEXE: String;
62: strlD: String;
63: strVersion: String;
SUBSTITUTE SHEF1' (RULE 26) 64: strSystem: String;
65: hWnd: THandle;
66: hEditWnd: THandle;
67: hOutputWnd: THandle;
68: hHTMLWnd: THandle;
69: hMenu: THandle;
70: xRect: TRect;
71: strBrowserEXE: String;
72:
73: IRectArea: Longlnt;
74: iLeftExtra:lnteger;
75: iTopExtra:lnteger;
76: iRightExtra:lnteger;
77: iBottomExtra:lnteger;
78: IyButtons: array [O..BTN-COUNT - 1 ] of Longlnt;
79: hyMenus: array [O..BTN_COUNT - 1 ] of THandle;
80: bMenuDone: Boolean;
81:
82: hDialerWnd: THandle;
83: hConnectWnd: THandie;
84: strButtonCaption: String;
85: end;
86:
87: const /NIT ERR NOBROWSER - -1;
88: const /NIT ERR NOEDITWND = -2;
89: const /NIT SUCCESS = 0;
90:
91: function brwlnitializeBrowser(hMainWnd: THandie;
92: var xBrowserData: xtBrowserData;
93: strlnitialURL: String; oHTTP: THTTP): Longlnt;
94: function brwFindURLField(hwnd: THandle;
95: var xBrowserData: xtBrowserData): Integer; export;
96: function brwWaIkMenu(var xBrowserData: xtBrowserData): Boolean;
97: function brwFindConnectButton(hwnd: THandle;
98: var xBrowserData: xtBrowserData): Integer;
99: function brvvFindLargestChild(hWnd: THandle;
100: var xBrowserData: xtBrowserData): Integer; export;
101:
102: implementation 103:
104: uses LongFN, Forms, SpIshDlg;
SUBSTITUTE SHEET (RULE 26) 105:
106: var 107: iCount:lnteger;
108:
1 09:
{,r*»*********w*x**w***w,r***********************************w*****************
***
110: * brvvFindBrowserWindow 111;
***********************,.*************,t***************************************
***
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 tlhe callback function 1 19:
***********************..******************************************************
**
120: * This callback function is called to enumerate ail the top level windows.
121: * The purpose of thia function is to find the browser window after it has been 122: * executed.
123:
°***r********s***a****wr*r****r******w**w*********w*****w*************w*
w***s**) 124: function brwFindBrowserWindow(hwnd: THandle; var pxBrowserData:
xtBrowserData):
125: Integer; export;
126: var 127: szTitle: array [0..!i00J of Char; {Title of the window) 128: strTitle: String; {Title of the window}
129: begin 130:
{*******************,.*******************************************************
131: * Get the window title 132:
**************************************************************************.) 133: GetWindowText(hWnd, szTitie, 500);
134: strTitle := StrPas(szTitle);
135:
1 36:
{******************.,.*******************************************************
137: * Determine whether or not the window meets out search criteria 1 38.
~****************.*******************************************************
139: if pxBrowserData.strlD = 'N' then 140: begin 141: if ('NETSCAPE' = UpperCase(strTitle)) or 142: (Pos('NETSC;APE = , UpperCase(strTitle)) <> 0) then 143.: begin 144:: brwFindBrorNSerWindow := 0;
145:: pxBrowserData.hWnd := hWnd;
SUBSTITUTE SHEET (RULE 26) 146: end 147: else 148: brwFindBrowserWindow := 1;
149: end 150: else 151: begin 152: if ('MICROSOFT INTERNET EXPLORER' = UpperCase(sirTitle)) or 153: (Pos('- MICROSOFT INTERNET EXPLORER', UpperCase(strTitle)) <> 0) then 154: begin 155: brwFindBrowserWindow := 0;
156: pxBrowserData.hWnd := hWnd;
157: end 158: else 159: brvvFindBrowserWindow := 1;
160: end;
181:
i 62: end;
163:
1 64:
{********************t***r*******************t*********************************
*
165: * brwFindURLField 1 66:
********r***********************************************w*x********************
*
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: """"***~""""*******************,t***************************x******
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.
1 78:
'*"""'**"********************************************************************}
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);
SUgSTITUTF SH EET (RULE 2fi) 18'7:
188: if ((Pos(':/P, strTitle) <> 0)) or 189: ((Pos('BLANK.', UpperCase(strTitle)) <> 0)) then 190: begin 191: iCount := iConnt + 1;
192:
193: xBrowserData.hEditWnd := hWnd;
194: end 195: else 196: brwFindURLF'iefd := 1;
197: end;
198:
199:
{***,tt*rtir**w**,tirtrtttr**ww*yww****,twattrww*w*wwww,e,t*w***~,t***,tw*waw*w ***w*fr*,t*»»xx*
200: * brwFindConnectButton 20'I:
*w,e.tv***wwt*ww*******wt**w*.twtr,twwwww*w*w***w**rwwwww**w,ew*www*ww**w*wwa,t ,t,t*w»»*
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:
****wrww*wwwwwwwwtr*,tw*,t*wewrr*w*»wrw**,tw*wr****wwww*ww***w****,t,~,t**ww***
,ew»»»,rw*
210: * This callback function attempts to get the window handle of the connect 211: * button in the dialer window.
212:
~~*.***.***.....*..***...~**,r**.,.*****.****,~******..***.*,M*.****.**.*.*****
*.**.) 213: function brwFindConnectButton(hwnd: THandle;
214: var xBrowserData: xtBrowserData): Integer;
215: var 216: szTitle: an-ay [0..500] of Char;
217: strTitle: String;
218: begin 219: SendMessage(hWnd, WM_GETTEXT, 500, Longlnt(~szTiile));
220: strTitle := StrPas(szTitle);
221:
222: if (Pos(UpperCa;se(xi3rowserData.str8uttonCaption), 223: UpperCase(strTitle)) <> 0) then 224: begin 225: xBrowserDatai.hConnectWnd := hWnd;
226: brwFindConnectButton := 0;
227: end SUBSTITUTE SHEET (RULE 26) 228: else 229: brwFindConnectButton := 1;
230: end;
231:
232:
{~*********************************************.*******************************
*
233: * brvvWaIkMenu 234:
**************************************************************w*******t*t***
235: * Parameters:
236: * str8rowserEXE - 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:
*****~******************t**********************tr*******************w*********
242: * This function searches the registry to find the executable tile associated 243: * with the .htm extension. This executable is assumed to be a browser which 244: * can be controlled by BC.
245:
~******************************************************************************
) 246: function brvvFindBrowserFile(var strBrowserEXE: String): Boolean;
247: var 248: hFoundKey: HKey;
249: bFound: Boolean;
250: szKeyVal: array [0..511] of char;
251: IKeyLen: Longlnt;
252: pcChar: PChar;
253: begin 254: IKeyLen:= 512;
255: bFound := False;
256:
257: strBrowserEXE :_ ";
258:
259: if RegQueryValue(HKEY CLASSES ROOT, '.htm', szKeyVal, 280: IKeyLen) = ERROR SUCCESS then 261: begin 262: if RegOpenKey(HKEY CLASSES ROOT, szKeyVal, 263: hFoundKey) = ERROR SUCCESS then 264: begin 285: if RegOpenKey(hFoundKey, 'shell', 266: hFoundKey) = ERROR SUCCESS then 267: begin 268: if RegOpenKey(hFoundKey, 'open', SUBSTITUTE SHEET (RULE 26) 269: hFoundKey) = ERROR SUCCESS then 270: begin 27 t : IKeyL~sn := 512;
272:
273: if RegQueryValue(hFoundKey, 'command', szKeyVal, 274: IKeyLen) = ERROR SUCCESS then 275: begun 276: bFound := True;
277: endl;
278: end;
279: end;
280: end;
281: end;
282:
283: if bFound = Trues then 284: begin 285: pcChar := StrIPos(szKeyVal, ' ');
286:
287: if pcChar <> Phil then 288: pcChar[Oj := Chr(0);
289:
290: strBrowserEXE := StrPas(szKeyVal);
29'1: brwFindBrowserFile := True;
292: end 293: else 294: brwFindBrowserFile := Fafse;
295: end;
296:
29'l:
{******ir*vrt,rrwr~rwew*wwwwww**w*wrt*w,twa**.tr~rrwr*rr*i.*w*w*w**wwrw*****w*w ww,Hw*
298: * brvvWaIkMenu 299:
*************~~**w*www**w*nw*ww*w*w**********w*tw*,krwwwww*+a+*,rww*"*~r~rt*
300: * Parameters:
30't: * xBrowserl7ata - Info~nation 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 308:
********w***~*~r~w~w~~wwwwo*w*w***waw*w~****vw~rww*w*www**wow**r*~***w*w*wwew*
30'7: * 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:
******************w*wf~wwww*~**war+,rtwwww*ww*.e*www*w***www*r**w**,tww**ww*~) SUBSTITUTE SHEET (RULE 26) 310: function brwWaIkMenu(var xBrowserData: xtBrowserData): Boolean;
311: var 312: iSubMenuPos:lnteger;
313: iSubMenuItemPos:lnteger;
314: iSubMenuldx:lnleger;
315: iBuitonldx:lnteger;
316: hSubMenu: THandle;
317: szSubMenuItemText: 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: iSubMenuItemPos := 0;
327:
328: for iSubMenuidx := 0 to 50 do 329: begin 330: GetMenuSUing(hSubMenu, iSubMenuItemPos, szSubMenuItemText, 331: 256, MF BYPOSITION);
332: StrUpper(szSubMenuItemText);
333:
334: if StrPos(szSubMenuItemText, 'BACK') <> Nil then 335: begin 336: if xBrowserData.lyButtons[BTN_BACK] = 0 then 337: begin 338: xBrowserData.lyButtons[BTN_BACK] :_ 339: GetMenuItemID(hSubMenu, iSubMenuItemPos);
340: xBrowserData.hyMenus[BTN_BACK] := hSubMenu;
341: end;
342: end;
343:
344: if StrPos(szSubMenuItemText, 'FORWARD') <> Nil then 345: begin 346: if xBrowserData.lyButtons[BTN_FORWARD] = 0 then 347: begin 348: x8rowserData.lyButtons[BTN_FORWARD] :_ 349: GetMenuItemID(hSubMenu, iSubMenuItemPos);
350: xBrowserData.hyMenus[BTN_FORWARD] := hSubMenu;
SUBSTITUTE SHEET (RULE 2fi) 351: end;
352: end;
353: -354: if xBrowserData.strlD = 'N' then 355: begin 356: if StrPos(szSubMenuItemText, 'CLOSE') <> Nil then 357: begin 358: if xBrowserData.lyButtons[BTN_EXITJ
= 0 then 359: begin 360: xBrowserData.lyButtons[BTN_EXIT] :_ 361: GetMenuItemID(hSubMenu, iSubMenuItemPos);
362: xBrowserData.hyMenus[BTN_EXIT] := hSubMenu;
363: end;
364: end;
365: end 368: else 367: begin 388: if StrPos(szSubMenuitemText, 'CLOSE') <> Nit then 369: begin 370: if xBrowserData.lyButtons[BTN_EXIT]
= 0 then 371: begin 372: xBrowserData.IyButtons[BTN_EXIT] :_ 373: GetMenuItemID(hSubMenu, iSubMenuItemPos);
374: xBrowserData.hyMenus[BTN_EXIT) := hSubMenu;
375: end;
376: end;
377: end;
378:
379: if xBrowserData.strlD = 'N' then 380: begin 381: if StrPos(azSubMenuItemText, 'STOP') <> Nil Then 382: begin 383: if xBrowserData.lyButtons[BTN_STOP]
= 0 then 384: begin 385: xBrowserData.lyButtons[BTN_STOP] :_ 386: GetMenuItemID(hSubMenu, iSubMenuItemPos);
387: xBrowserData.hyMenus[BTN_STOP] := hSubMenu;
388: end;
389: end;
390: end 391: else SUBSTITUTE SHEET (RULE 26) 392: begin 393: if StrPos(szSubMenuItemText, 'STO&P') <> Nit then 394: begin 395: if xBrowserData.lyButtons[BTN_STOP]
= 0 then 396: begin 397: xBrowserData.lyButtons[BTN_STOP] :_ 398: GetMenuItemID(hSubMenu, iSubMenuttemPos);
399: xBrowserData.hyMenus[BTN_STOP] := hSubMenu;
400: end;
401: end;
402: end;
403:
404: if (StrPos(szSubMenuItemText, 'REFRESH') <> Nil) Or 405: (StrPos(szSubMenuItemText, 'RELOAD') <> Nil) then 406: begin 407: if xBrowserData.lyButtons[BTN_RELOAD]
= 0 then 408: begin 409: xBrowserData.lyButtons[BTN_RELOAD]
:_ 410: GetMenuItemID(hSubMenu, iSubMenuItemPos);
411: xBrowserData.hyMenus[BTN_RELOAD] :=
hSubMenu;
412: end;
413: end;
414:
415: if StrPos(szSubMenuttemText, 'PRINT') <> Nil then 416: begin 417: if xBrowserData.IyButtons[BTN_PRINT]
= 0 then 418: begin 4i9: xBrowserData.lyButtons[BTN_PRINT] :_ 420: GetMenuItemID(hSubMenu, tSubMenuItemPos);
421: xBrowserData.hyMenus[BTN_PRINT] :=
hSubMenu;
422: end;
423: end;
424:
425: if StrPos(szSubMenuItemText, 'FIND') <> Nil then 426: begin 427: if xBrowserData.lyButions[BTN_FIND]
= 0 then 428: begin 429: xBrowserData.lyButtons[BTN_FIND] :_ 430: GetMenultemtD(hSubMenu, iSubMenuItemPos);
431: xBrowserData.hyMenus[BTN_FIND] := hSubMenu;
432: end;
SUBST1TUTF SHEET (RULE 26) 433: end;
434:
435: iSubMenultemPos := iSubMenuItemPos +-1;
436: end;
43T:
438: iSubMenuPos := iSubMenuPos + 1;
439: hSubMenu :_ ~GetSubMenu(xBrowserData.hMenu, iSubMenuPos);
440: end;
441:
442: brwWaIkMenu := True;
443:
444: for iButtonldx := 1 to (BTN_COUNT - 1) do 445: if xBrowserDai:a.lyButtons[iButtonldx] = 0 then 446: brwWaIkMenu := False;
447: end;
448:
449:
{***************.**************************************************************
*
450: * brwFindLargeslChild 451:
***"'************r***rw*********w*************w***x****************************
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:
*********w*x*******************************************************************
*
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:
*n******w********rx*************x**********************************************
~
466: function brwFindLargestChild(hWnd: THandle;
467: var xBrowserData: xtBrowserData): Integer;
468: var 469: xRect: TMRect;
470: xParentRect: TMRect;
471: IRectArea: Longlnt;
472: begin 473: GetWindowRect{hWnd, TRect(xRect));
SUBSTITUTE SHEET (RULE 26) 474:
475: IRectArea := Longlnt(xRect.Right - xRect.Left + i) 476: Longint(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 - xParentReci.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:
{*wa*i*w,tww*****,t******r****w*ww***wt*,t*rr****wwwrrwwwwwww***ww*wt*www**www*
ww**
496: " brvvlnitializeBrowser 497:
****trwt*.tww*ww*w*wwwr**wwtwx*wt**w*ww**,t******v***ww*wwwf.wwwww*wtrw***w,rwt www***
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:
***~*'*'~******""*"****""*www*****iwwr***ww*r*,rrrtww**wwwww.~w*n**rrrr**a**x*x ww 508: * This function attempts to find the browser window and encapsulate it within 509: * the BC window.
510:
*******w**,twwxw*»*w*wwr*nwtir*w*www*~rw******,r*wuw*swww*,rw**ww*w*,er******,r w,~www~
511: function brwlnitializeBrowser(hMainWnd: THandle;
512: var xBrowserDala: xt8rowserData;
513: strinitialURL: String; oHTTP: THTTP): Longlnt;
514: var SUBSTITUTE SHEET (RULE 26) 515: xCurTime: TDate:Time;
516: szBrowserEXE: array [0..255] of char;
517: strBrowserEXE: String;
518: oFile: TFileStream;
519: xPoint: TPoint;
520: xClientRect: TRe~ct;
521: dlgSplash: TdIgSplash;
522: hDC: THandle;
523: { strDir: String;}
524: { szWinDir: array [0..255] of char;
525: szSystemDir: array [0..255] of char}
526: ildx:lnteger;
527: strPath: String;
528:
529: pxVerlnfo: "TVS. FIXEDFILEINFO;
530: pszVerlnfo: PChar;
531: IVerSize: Longlnt;
532: wVerSize: Word;
533: hVersion: Longlni;
534: szBuffer: array [0..1024] of char;
535: pszBuffer: PChar;
536: begin 537:
{******************vr****r***,r***ww******w*********************w***w********~r 538: * Display the splash dialog 539:
***********x*******,t********w**,r************the*****w*ww******w*******t*****}
540: dlgSplash := TdIgSpIash.Creaie(Nil);
541: dIgSpIash.Show;
542.:
543:
{******************n*********.**********************************************
544: * Find the browser 545:
~****************~.****..******************************.********.*********}
546: dIgSpIash.pnStaltus.Caption :='Searching for a web browser...';
547: Application.Proc~essMessages;
548:
549: if xBrowserData.strBrowserEXE = " then 55G: brwFindBrowserFile(strBrowserEXE) 551: else 552: strBrowserEXl° :~ xBrowse~Data.strBrowse~EXE;
553:
554: if strBrowserEXE: _ " then 555: strBrowserEXE :='c:lprogra~1lintem~1liexplore.exe' SUBSTITUTE SHEET (RULE 26) 556: else 557: IfGetShortPathName(strBrowserEXE, strBrowserEXE);
558:
559:
{***************..********************.***.*********************************
560: * Add the OS Version 561: ~***~**************rwr*****************w*****,~*********w*******w***x*) 562: if IfLongFileNames = True then 563: xBrowserData.strSystem :='32' 564: else 565: xBrowserData.strSystem :_ '16';
586:
567: xBrowserData.strSystem := xBrowserData.strSystem + '-';
568: xBrowserData.strSystem := xBrowserData.strSystem +
569: IntToStr(LOBYTE(LOWORD(GetVersion)));
570: xBrowserData.strSystem := xBrowserData.strSystem + ' ';
571: xBrowserData.strSystem := xBrowserData.strSystem +
572: IntToStr(HIBYTE(LOWORD(GetVersion)));
573:
574:
~***********w***********w****,t*********.w*********************************~,t 575: * Try to determine the browser version 576: ********w* ************************************************) 577: StrPCopy(szBrowserEXE, strBrowserEXE);
578:
579: IVerSize := GeiFileVersionlnfoSize(szBrowserEXE, hVersion);
580:
581:
582: if GetFileVersionlnfo(szBrowserEXE, hVersion, IVerSize, szBuffer) = True then 583: begin 584: pszBuffer := szBuffer;
585:
586: if VerQueryValue(pszBuffer, 587: '\\StringFilelnfo\1040904E4\\ProductVersion', 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:
~**s********w***********w***************t****w*****x*wx*******************}
SUBSTITUTE SHEET (RULE 26) 597: if Pos('NETSCAPE', UpperCase(strBrowserEXE)) <> 0 then 598: xBrowserData.strlD :_ 'N' 599: else 600: if Pos('IEXPLORE', UpperCase(strBrowserEXE)) <> 0 then 601: xBrowserDal:a.strlD :_ 'I' 602: else 603: begin 604: brvvlnitializeE3rowser := INIT ERR NOBROWSER;
605: dIgSpIash.Destroy;
606: Exit;
607: end;
808:
609:
{********************ww*********x***********************w*******************
610: * Run the browses 61 1:
****.***************~,******************************************************}
612: if xBrowserData.strlD = 'N' then 613: begin 614: dIgSpIash.pnStatus.Caption :_ 'Loading Netscape Navigator...';
615: StrPCopy(szBnowserEXE, strBrowserEXE + ' ' + strlnitialURL);
616: end 617: else 618: begin 619: dIgSpIash.pnStatus.Caption :='Loading Microsoft Internet Explorer...';
620:
621: { for ildx := Length(Application.EXEName) downto 1 do 622: begin 623: if Application.EXEName[ildx) _ '\' then 624: begin 625: strPath := Copy(Application.EXEName, 1, ildx);
626: break;
627: end;
628: end;
629:
630: StrPCopy(szBnowserEXE, strBrowserEXE + ' ' + strPath + 'BLANK.HTM');) 631: StrPCopy(szBnowserEXE, strBrowserEXE + ' ' + strlnitialURL);
632: end;
633:
634: Appiication.ProcessMessages;
635:
636: if WinExec(szBrowserEXE, SW SHOWNORMAL) < 32 then 637: begin SUBSTITUTE SHEET (RULE 26) 638: brwlnitializeBrowser := INIT ERR NOBROWSER;
639: dlgSpiash.Destroy;
840: Exit; -641: end;
642:
643:
{***,.*****,.********.*****.*************************************.************
644: * Find the window handle of the browser 645:
*'"'****"*'**"'************************************************************}
646: xCurTime := Time;
647:
648: while ((Time - xCurTime) < 0.0003472) do 849: 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: brvvlnitiaiizeBrowser := iNIT ERR NOBROWSER;
662: dIgSpIash.Destroy;
663: Exit;
664: end;
665:
666: {**~*********************************************************w***********
667: ' Store the current size of the browser window for future reference 688:
******"********************************************************************~
669: GetWindowRect(xBrowserData.hWnd, xBrowserData.xRect);
670:
671:
{*~****************xw*******************e*******************,t************
672: " Set the palantir window as the parent 673: ~***************w******x************s***************w*******************~
674: SetParent(xBrowserData.hWnd, hMainWnd);
875:
676: {*~~*w *w****************************rw***w*****rr****
677: " Get the browser menu and make it a child of BC
678: ~*******************x**********r*******w*******xr***************x*******~
SUBSTITUTE SHEET (RULE 26) 679: { xCurTime := Time;
680:
681: dIgSpIash.pnStatus.Caplion :='Searching for hotkeys...';
682: Application.Proce~ssMessages;
683:
684: while ((Time - xCurTime) < 0.0001156) do 685: begin 686: if brwWaIkMenu(xBrowserData) = True then 687: xCurTime :_~ -1;
6sa:
689: Application.ProcessMessages;
690: end;}
691:
692: { if xBrowserData.strlD = 'N' then 693: begin}
694: { xBrowserData.IyButtons[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.IyButtons[BTN_FIND] := 32819;
701: xBrowserData.iyButtons[BTN_ABOUT] := 65199;
702: xBrowserData.iyButtons[BTN_EXIT] := 57665;}
703:
704: { brwWaIkMenu(xBrowserData);
705: xBrowserData.lyButtons[BTN EXIT] := 57665;
708: end 707: else 708: begin 709: brwWaIkMenu(xBrowserData);
710: end;}
711:
712:
{***************************************************************************
713: * Find the largest window in the browser 714:
***************************.***********************************************}
715: { xCurTime := Time;
716:
717: if xBrowserDala.strlD = 'I' then 718: while ((Time - xCurTime) < 0.0000231 ) do 719: begin SUBSTITUTE SHEET (RULE 26) 720: end;
721:
722: xBrowserData.IRectArea := 0;} -723:
724: xBrowserData.IRectArea := 0;
725: EnumChiIdWindows(xBrowserData.hWnd, ~brvvFindLargestChild, 726: Longlnt(~xBrowserData));
727:
728: ifxBrowserDala.strlD='I'then 729: begin 730: xBrowserData.IRectArea := 0;
731: EnumChiIcfWindows(xBrowserData.hOutputWnd, ~brwFindLargestChild, 732: Long I nt(t~xBrowserDaia));
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:
{*******w******************.**********************************,t*************
740: * Find the window handle of the edit window 741:
*~*************************************************************************}
742: { dIgSpIash.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: EnumChiIdWindows(xBrowserData.hWnd, t~brwFindURLField, 753: Longlnt(~xBrowserData));
754:
755: if xBrowserData.hEditWnd <> 0 then 756: xCurTime :_ -1;
757:
758: Application.ProcessMessages;
759: end;
760:
SUBSTITUTE SHEET (RULE 26) 781: if xBrowserData.hEditWnd = 0 then 762: begin 763: oHTTP.AddFeedback('E1,NOURL') -764: end;}
785:
76fi: dIgSpIash.Destroy;
767:
768: { .*******************************************************
769: * Return success 77~: **.****************************************************}
771: brvvlnitiaiizeBrowser := /NIT SUCCESS;
772: end;
773:
774: end.
SUBSTITUTE SHEET (RULE 26) APPENDIX II
.
***********r******rr**r*wwrrw*w**********r***********ra*r**rrw*r**rwwrw*r*w****
1.{
2:*
3:r 4: * Main.pas 5:
*"******r*******r**r*w***ww***rr********r******r*r**********wr***r*w*****w**rw*
*
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.
11;
rrrrr***r*r*rr*****r*r****r****r*r******w*****r****trr************************r ) 51: unit Main;
52:
53: interface 54:
55:
{*~*r***ww***w**rt**rrrr******r*rrx*r**r*w*r*******rrr**r*r**,rrr*r*w******ww*
56: * Units used by the main form 57:
rr***wx*r**rrrr*w*r*w*rrrrr*w*rrrwrrw**rr*r********w***ww***r******r*r**r*rwr*r ~
58: uses 59: WinProcs, WinTypes, Messages, SysUtils, Classes, Graphics, Controls, Forms, 60: Dialogs, Menus, ExtCtrls, StdCtrls, Buttons, IniFiles, DdeMan, Browser, Misc, 61: HTTP, MPlayer, AboutDlg, CryptINl, MsgDlg;
62:
63:
{r~'~'*~wrrrr**w*w****rwwrrw****w**********w**w****r*wrwrww************rwrrr*
64: r Declaration of the main form object 65:
~'*~'~rr*rr***rrrrrw*rrrrrr*r*rr*r*r*r***rw****r*rr**r*rrrr*r***rrrr**rr**rrr) 68: type TfrmMain = class(TForm) 67:
{'H'w*r**rwrrrrrrr*r*ww*r*****rr*wrrr*rrrr:!*r**r*wrr*r***w*w***r***rw*r*wrrw 68: r Fom1 controls 69:
.rrr*r*r*rrrrr.r*r*w*rrrr**r**r*r******r*r**r*****r*r*r*****w***r*w*rwrwrr*~
70: pnTooIBar: TPanei;
71: sbBack: TSpeedButton;
72: sbForvvard: TSpeedButton;
73: sbReioad: TSpeedButton;
74: sbStop: TSpeedButton;
75: pnUser: TPanel;
76: pnUserDividor: TPanel;
77: sbUserl : TSpeedButton;
78: sbUser2: TSpeedButton;
SUBSTITUTE SHEET RULE 2fi) 79:sbUser3: TSpeedButton;
80:sbUser4: TSpeedButton;
81:sbUserS: TSpeedButton;
82:sbUser6: TSpeedButton;
83:sbUser7: TSpeedButton;
84:sbUserB: TSpeedButton;
85:pnBrowser: TPanel;
86:ddeConv: TDde~CIientConv;
87:tmPoll: TTimer;
88:tmHost: T'Timer;
89:tmAnim: TTimer;
90:pnLogo: TPanel;
91:sbPrint: TSpeedButton;
92:sbFind: TSpeeaIButton;
93:mpWAV: TMediaPlayer;
94:pnLogolnner: Tlaanel;
95:picLogoBC256:
Tlmage;
96:picLogoNetscape:
Tlmage;
97:picLogoExplorer:
Timage;
98:pnFilter: TPanell;
99:sbSite: TSpeedIButton;
100:sbHome: TSpeedButton;
101:pnSite: TPanel;
102:picSite: Tlmage;
103:pnHome: TPanel;
104:picHome: Tlmaige;
105:pnUserl: TPanel;
106:picUser1: Tlmage;
107:pnUser2: TPanel;
108:picUser2: Tlmage;
109:pnUser3: TParnel;
110:picUser3: Tlmage;
111:pnUser4: TParnet;
112:picUser4: Tlmage;
113:pnUserS: TPan~el;
114:picUserS: Tlmage;
115:pnUser6: TParnel;
116:picUserB: Tlmage;
117:pnUser7: TParnel;
118:picUser7: Tlmage;
119:pnUserB: TPan~el;
SUBSTITUTE SHEET (RULE 26) 120: picUserB: Tlmage;
121: tmSite: TTimer;
122: tmSiteAnim: TTimer; -123: tmHomeAnim: TTimer;
124: tmUserAnim: TTimer;
125: sbExit: TSpeedButton;
126: picLogoBCl6: Tlmage;
127: bvBrowser: TBevel;
128:
129:
{~******wt******,t************,t************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 tmPoIITimer(oSender: TObjeci);
138: procedure tmHostTimer(oSender: TObject);
139: procedure tmAnimTimer(oSender: TObject);
140: procedure mpWAVNotify(oSender: TObject);
141:
1 42:
~***********r*****w*********w**w********************************************
143: * User procedures 1 44:
*****w**********************************************w*********w**x*********) 145: procedure RequestDoc(strURL: string);
146: procedure SwitchSiteButtonToNextSite;
147: procedure PressButton(IButtonlD: Longlnt);
148: procedure CommandClick(oSender: TObject);
149: procedure picLogoBC256DbIClick(Sender: TObject);
150: procedure sbSiteMouseDown(Sender: TObject; Button: TMouseBuiton;
151: Shift: TShiftState; X, Y: Integer);
152: procedure sbSiteMouseUp(Sender: TObject; Button: TMouseBuiton;
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;
SUB ST1TUTE S H E ET (RU LE 26) 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 tmHa~meAnimTimer(Sender: TObject);
167: procedure tmUserAnimTimer(Sender: TObject);
168: procedure tmSiteAnimTimer(Sender: TObject);
169: procedure lmSiteTimer(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}
178:
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: :~tBrowserData; {Handles and stuff for the browser}
185:
186: oHTTP: THTTP; {HTTP client object}
187:
188: IAnimCount: Longlnt; {Current animation frame}
189: IAnimMax: Loncilnt; {Maximum animation count}
190: IAnimFIag:Boolean; {FALSE=palantir;TRUE=browser}
191: IAnimBC: Integer, {Iterations of BC Logo}
192: IAnimBrowser: 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.}
SUBSTITUTE SHEET (RULE 26) - WO 98/52189 1'CT/US98/10035 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: iUserVllidth: Integer; {...bitmap width}
217: iUserAnim: Integer; {...animation state: 0=done, 218: (iUserHeight+1)->0 seq.}
219: bmyUser: array [0..4,0..7] of TBiimap; {...bitmaps}
220: syUserURL: array [0..4,0..7] of String; {...URLs}
221: syUserHint: array [0..4,0..7] of Siring; {...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; {active home panel - points to pnHome or pnSite}
229: picActHome: Tfmage; {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: {~~wwww~weswr~~www:~w~e~r~~~tm~,~rwwwxwrwww~w~~wwer~eww~rr~~.
239: ' Include resource files 240: ~~w ww~nwwe~w~wwwwr~~f,Hwt~ewwwwww~.rwww~r~w~rtwxrrrrwr}
241: {$R *.DFM}
242:
SUBSTITUT~ SHEET {RULE 26) 243:
~*****t***tr,r****,r***~f************************************x***********w*****
***
244: ' TfrmMain.CommandClick 245:
****w****************yr****w*****w************************s.**t*****w********w*
r**
246: * Parameters:
24'7: * oSender - speed button object which was clicked 248: *
249: * Returns: None.
250.
***f******i*********MrN*************************************i******************
251: * This procedure ~orocesses all of the command button clicks.
252:
*********************.,********************************************************
*) 253: procedure TfrmMain.CommandClick(oSender: TObject);
254: begin 255: if oSender = TObject(sbBack) then 256: PressButton(E3TN_BACK);
257:
258: if oSender = TObject(sbForward) then 259: PressButton(BTN_FORWARD);
260:
281: if oSender = TObject(sbReioad) then 262: PressButton(BTN_RELOAD);
263:
264: if oSender = TObject(sbStop) then 285: begin 266: if xBrowserData.strlD ='I' then 267: begin 268: SendMessage(xBrowserData.hHTMLWnd, WM_KEYDOWN, VK_ESCAPE, 0);
269: SendMess~age(xBrowserData.hHTMLWnd, WM_CHAR, VK ESCAPE, 0);
270: SendMess~age(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(13TN_PRINT);
280: end;
281:
282: if oSender = TO~bject(sbFind) then 283: begin SUBSTITUTE SHEET (RULE 26) 284: BringWindowToTop(xBrowserData.hWnd);
285: PressButton(BTN_FIND);
286: end;
287:
288: if oSender = TObject(sbExit) then 289: begin 290: Close;
291: end;
292.
293: end;
294:
295:
{*****ww****w*****************w*******x*********w******************************
w 296: * TfrmMain.PressButton 297:
************************************r*************w****************************
*
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(IBuitonlD: Longlnt);
306: var 307: iCode: Longlnt;
308: begin 309:
{***************************************************************************
310: * Tell the browser to press the button 311: *** **********************************..*************}
312: PostMessage(xBrowserData.hWnd, WM_COMMAND, 313: xBrowserData.IyButtons[IButtonlD], 0);
314: end;
315:
316:
{***********.*.*.**************************************************************
*
317: * TfrmMain.FormCreate 31 8:
*************************r************ww***w***********************************
*
319: * Parameters:
320: * oSender - The form object which is being created 321: *
322: * Returns: None.
323:
***********'*****************************w**********w*********wr***rt**r*******
*
324: * This procedure loads all the settings from the ini file and opens the SUBSTITUTE SHEET (RULE Z6) 325: " browser.
326:
*~*********w***r************x*************t*********************************) 327: procedure TfrmM~ain.FormCreate(oSender: TObject);
328: var 329: iLoop, iLoop2: Integer;
330: iOffset:lnteger;
331: iResult:lnteger;
332: iCount:lnteger;
333: IResult: Longlnil;
334: wMinute, wHour, wSecond, wMSecond: Word;
335: strUserlnfo: String;
336: sSite: String;
337: sUser: String;
338: sFile: Siring;
339: sButton: String;
340: sDomain: Strincl;
341: iMove:lnteger;
342: iLeft:lnteger;
343: begin 344: iCount := 0;
345:
346:
{***************************************************************************
347: * Create the htt~p object 348:
***************************************************************************) 349: oHTTP := TH't~f'P.Create(Self);
350: oHTTP.Parent := Self;
351:
352:
~*********r**w***********a****************************************w*********
353: * Initialize the application path 354:
*~*********..************************************************************}
355: for iLoop := Length(Application.ExeName) downto 1 do 356: begin 357: if Application.EXEName[iLoop] _ '\' then 358: begin 359: strPath := Copy(Application.EXEName, 1, iLoop);
360: Break;
361: end;
362: end;
363:
364: oHTTP.strPath := strPath;
365:
SUBSTITUTE SHEET (RULE 26) 386:
{*rr**w***w**w*******w**********ww****w*****w*******ww**w***************r****
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:
***************************************************************************}
376: iniOpen(strPath +'BC.ini');
377:
378:
{******************************************************.********************
379: * Set the window caption 380:
**a****************************************************,t******a************) 381: Caption := iniGetString('WINDOW', 'TITLE', 'BC');
382: Application.Title := iniGetString('WINDOW', 'TITLE', '13C');
383:
384:
{****************,t*************x**w******w***w*w****w********w**************
385: * Set the window icon 386:
************************************************.**************************) 387: try 388: Icon.LoadFromFile(strPath + 'Data1' +
389: iniGetString('WINDOW , 'ICON', '~);
390: Application.Icon.LoadFromFile(strPath +'Data1' +
391: iniGetString('WINDOW', 'ICON', "));
392: except 393: end;
394:
395:
{*******.**,~*.**************************************************************
396: * Do we transmit our data? This is for debug purposes!
397:
***************************************************************************}
398: bTransmit := True;
399:
400: if iniGetString('HTTP', 'TRANSMIT', 'Y') _ 'N' then 401: bTransmit := False;
402:
403:
{***w**ww******ww***********w*w****w**************a********a****************
404: * Set the window size 405: ***********"*~********w*************************************************) 406: Left := iniGetLong('WINDOW , 'LEFT', -1 );
SUBSTITUT~ SH~ET (RUL~ 26) 407: Top := iniGetLong('WINDOW , 'TOP', -1);
408: Width := iniGetl.ong('WINDOW','WIDTH', -1);
409: Height := iniGetl_ong('WINDOW°, 'HEIGHT', -1-);
410:
411: if (Left = -1 ) or (Top = -1 } or (Vllidth = -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('WINDOW', "STATE', 2)};
420:
421:
~************a*******************************w******************************
422: * Set browser parameters 423:
**************************rr***w*******tnt*********************************t}
424: bCompress := False;
425:
426:
{'~'*******************************ww***********************************,t**
42'7: * Get host information 428:
*»*************************************************************************}
42'9: oHTTP.HostNanne := iniGetString('HTTP', 'HOST', 'www.truelogic.com');
430: oHTTP.HostPorl: := iniGetLong('HTTP', 'PORT', 80);
431: oHTTP.Timeout := iniGett_ong('HTTP', 'TIMEOUT', 40);
432:
433:
~***w****************w*********************w********************************
434: * Initialize the domain list 435:
*~***********************************************************************) 436: oDomains := TStringLisi.Create;
437:
438: for iLoop := 0 to 100 do 439: begin 440: sDomain := iniGetString('DOMAINS', 'DOMAIN'+IntToStr(iLoop+1), 'XXX');
441: if sDomain='X:XX' then break;
442: oDomains.Ad~d(sDomain);
443: end;
444:
44r'J:
{***w*******w********w*************w****************************************
44u: ' Initialize the user and customer variables 44'7:
'"*****************..****,.*************************************************}
SUBSTITUTE SHEET (RULE 26) 448: oHTTP.strSeriaINo := iniGetString('USER', 'ID', 'X');
449:
450: if oHTTP.strSeriaINo ='X' then 451: begin 452: oHTTP.strSerialNo :_ ";
453:
454: DecodeTime(Now, wHour, wMinute, wSecond, wMSecond);
455: RandSeed := GetFreeSpace(0) + DiskFree(0) + wHour + (wMinute * 100} +
456: (wSecond * 1000) + (wMSecond * 100000);
457:
458: for iLoop := 1 to 15 do 459: oHTTP.strSeriaINo := oHTTP.strSeriaINo + Chr(Ord('A') + Random(26));
460:
461: iniSetString('USER', 'ID', oHTTP.strSeriaINo);
462: end;
463:
464: oHTTP.strJobID := iniGetString('CUSTOMER', 'JOBID', 'X');
465: oHTTP.strCustID := iniGetSiring('CUSTOMER', 'ID', 'X');
466: oHTTP.strRecord := iniGetString('HTTP', 'RECORD', 'X');
467: oHTTP.iSessionCount := iniGetLong('BC', 'SESSION', 1);
468:
469: iniSetLong('BC', 'SESSION', oHTTP.iSessionCount + 1);
470:
471:
{********************w*******r**x***************************w***************
472: * Set buttons animation rate (lines/50Ms timer tick) 473:
~**********************************************************************.**) 474: iAnimationLines := iniGetLong('ANIMATION', 'BUTTONS LINERATE', 1);
475: lmSite.lnterval := iniGetLong('ANIMATION', 'SITECHANGE_TIME', 3000);
476:
477:
{***********************************************************************.***
478: * Find out how many sites defined in the ini file 479:
**~'****'~**********************r**r*****************w*********************) 480: for iLoop := 0 to 5 do 481: begin 482: sButton := iniGetString('SITE'+IniToStr(iLoop+1),'HOME','XXX');
483: if sButton='XXX' then break;
484: end;
485:
486: iSites := iLoop;
487:
488:
~***********************************************x**w************************
SUBSTITUTE SHEET (RULE 26) 489: " Find out how rnany user buttons by using [SITE1 j as the reference 490:
~wwww*wrwrwwwww~~wwwwwwwwwwwwwvwwwwwwwwwwrwwrwwwwwrwww*a,swraawwwwwwwwxrww~
491: -492: for iLoop2 := 0 to 8 do 493: begin 494: sButton := iniGetString('SITE1','BUTTON'+intToStr(iLoop2+1),'XXX');
495: if sButton='X;KX' then break;
496: end;
497:
498: iUsers := iLoop2;
499:
500:
{'H*wwwwww**rwwwwwwwmrwwwwxwetr:,ew*w*w*wwww**twwwwsrww*wwrwwwr*wxwwwwww*wwwwwr 501: ' Load the Home and Site button bitmaps, URLs etc.
502:
*~'w~*wtwwwwxx,~ww*,twwwwwwwwxttw*wxwwaw*:*wr,r***w*w*rrrrwr*wwwwwwwwww*w~
503: for iLoop := 0 to (iSites-1 ) do 504: begin 505: sSite :='SITE.' + IntToStr(iLoop+1);
506:
507: bmyHome[iLoopj := TBitmap.Create;
508: bmyHome[iLoopj.LoadFromFile(strPalh + 'DATA\' +
509: iniGetString(sSite,'HOME',"));
510: syHomeURL[iLoop] := iniGetString(sSiie, 'URLO', ");
511:
512: if iSites>1 thean 513: begin 514: bmySite[iLoopj := TBitmap.Create;
515:
516: sFile := iniGetString(sSite,'SITE','XXX');
517:
518: if sFile='~CX' then 519: bmySite~[iLoopj.LoadFromFile(strPath +'DATA\' +
520: iniGetString(sSite,'HOME',")) 521: else 522: bmySite~[iLoop].LoadFromi=ile(strPath +'DATA\' +
523: iniGetString(sSite,'SITE',"));
524:
525: sySiieGreet[iLoopj := iniGetString(sSite,'GREET','XXX');
828: end;
527: end;
528:
529:
{wwwwwrwwwrwwwwww~n~wwxwrwwwrwwwwr*wwwwwwxwwwwww*ww**www*wwwwwwwwwwwww*wwrrw*
SUBSTITUTE SHEET (RULE 26) 530: ' Load the user button bitmaps, URLs etc.
531:
**************************w*************************w***w******************}
532: for it_oop := 0 to (iSites-1) do _ 533: begin 534: sSite :='SITE' + IntToStr(iLoop+1);
535:
536: for iLoop2 := 0 to (iUsers-1) do 537: begin 538: sUser := IntToStr(iLoop2+1);
539: sButton := iniGetString(sSite,'BUTTON'+sUser,");
540:
541: bmyUser[iLoop,iLoop2] := TBitmap.Create;
542: bmyUser[iLoop,iLoop2].LoadFromFile(strPath +'DATA1' + s8utton);
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 Nome 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;
~3e7: pnt3lte.left :~ ~b8lte.Left+3;
568: pnSite.Height := iSiteHeight;
569: pnSite.Width := iSiteWidth;
570:
SUBSTITUTE SHEET (RULE 26) 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.Siyle := psSolid;
577: picSite.Picture.Bitmap.Canvas.Pen.Mode := pmCopy;
578: picSite.Picture.Bitmap.Canvas.Pen.Coior := clWhite;
579: picSite.Picture.Bitmap.Canvas.Pen.Width := 1;
580: picSite.Picture.Bitmap.Canvas.MoveTo(0, iSiteHeight);
581: picSite.Picture.Bitmap.Canvas.LineTo(iSiteWidth-i, 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.Visibl~e := 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:
{~***************************************************wx**********w**********
600: * Initialize the Acting Home button 601. *****..*.*****************************..***********.*****) 602:
603: iHomehleight :_ 32;
604: iHomeWidth := bmyHome[0].Width;
605:
606: iMove :_ (iHomeWidth+6) - sbActHome.Width;
607:
808: sbActHome.Height := iHomeHeight+6;
609: sbActHome.Width := iHomeWidth+6;
610:
611: pnActHome.Top := sbActHome.Top+3;
SUBSTITUTE SHEET (RULE 26) 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[O]);
629: picActHome.Top :_ -(iHomeHeight+1);
630:
631: sbActHome.Enabled := True;
632: sbActHome.Visible := True;
633: pnActHome.Visible := True;
634: picActHome.Visible := True;
635:
636:
{*******,tt******************************************************************
637: * Adjust the control buttons position to accomodate the HomeJSite button 638:
***************************************************************************}
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 := sbForvvard.Left + iMove;
645: sbReload.Left := sbReload.Left + iMove;
646: sbPrint.Left := sbPrint.Left + iMove;
647: { sbFind.Left := sbFind.Lefi + iMove;
648: sbStop.Left := sbStop.Left + iMove:}
649: sbExit.Left := sbExit.Left + iMove;
650:
651:
~********************w********r*********************************************
652: * Initialize the User buttons SUBSTITUTE SHEET (RULE 26) 653:
~~'w*rtwwww~twwr~wtw,rtwtw,r~tws~xrr.exrxwwwww~wwwrwvwwx:ww,rnw,ernwrxwwww,~~ew r,rw}
654: sbyUser[0] := s~bUser1; {} pnyUser[0]picyUser[0] := picUserl := pnUserl ; {} ;
655: sbyUser[1] := sbUser2; {} pnyUser[1]picyUser[1] := picUser2;
:= pnUser2; {}
656: sbyUser[2] :_ ::bUser3; {} pnyUser[2]picyUser[2] := picUser3;
:= pnUser3; {}
657: sbyUser[3] := s;bUser4; {} pnyUser[3]picytJser[3] := picUser4;
:= pnUser4; {}
658: sbyUser[4] :_ sbUserS; Q pnyUser[4]picyUser[4] := picUserS;
:= pnUserS; {}
659: sbyUser[5] := s;bUse~6; {} pnyUser[5]picyUser[5] := picUser6;
:= pnUser6; {}
660: sbyUser[6] := s;bUser7; {} pnyUser[6]picyUser[6] := picUser7;
:= pnUser7; {}
661: sbyUser[7] := s:bUserB; {) pnyUser[7]picyUser[7] := picUserB;
:= pnUserB; {}
662:
663: if iUsers>0 them 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 610: else 671: pnUser.Height := iSiteHeight+12;
672:
673: if iSiies>1 then 674: iLeft := sb~Site.Left + sbSite.Width 675: else 676: iLeft :_ -2;
677:
678: for iLoop2 := 0 to (iUsers-1) do 679: begin 650: sbyUser[it.oop2].Left :=
iLeft+iniGetLong('SITE1','SPACE'+IntToStr(iLoop2+1),5);
681: iLeft := sbyUser[iLoop2].Left + iUserWidth+6;
682:
683: sbyUser[il_oop2].Height := iUserHeight+6;
684: sbyUser[it_oop2].Width := iUserWidth+6;
685:
686: pnyUser[il_oop2].Top := sbyUser[iLoop2].Top+3;
687: pnyUser[il_oop2].Left := sbyUser[iLoop2].Left+3;
688: pnyUser[il_oop2].Height := iUserHeight;
689: pnyUser[il_oop2].Width := iUserWidth;
690:
8a1: picyUser[iLoop2].Height := 2"iUserHeight+1;
892: picyUser[ilLoop2].Picture.Bitmap.Height := picyUser[iLoop2].Height;
693: picyUser[ilLoop2].Width := iUserWidth;
SUBSTITUTE SH E~T (RUL~ 26) 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.Cofor := 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[O,iLoop2]);
704: picyUser[iLoop2].Top :=-(iUserHeight+1);
705:
706: sbyUser[iLoop2].Hint := syUserHint[O,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:
{************************x*********************************************w****
721: * Setup logo animation 722:
***************************************************************************) 723: if GetDeviceCaps(Canvas.Handle, NUMCOLORS) > 256 then 724: begin 725: picLogoBC := picLogoBC256;
726: picLogoBC16.Visible := Faise;
727: end 728: else 729: begin 730: picLogoBC := picLogoBCl6;
731: picLogoBC258.Vlslble := False;
732: end;
733:
734: IAnimBC := iniGetLong('ANIMATION', 'BC_REPEAT', 1 );
SUBSTITUTE SHEET (RULE 26) 735: IAnimBrowser :_ iniGetLong('ANIMATION', 'BROWSER_REPEAT', 0);
736:
737: if IAnimBC < 1 then IAnimBC := 1;
738: if IAnimBC > 50 then IAnimBC := 50;
739: if IAnimBrowser < 0 then IAnimBrowser := 0;
740: if IAnimBrowser > 50 then IAnimBrowser := 50;
741:
742: IAnimCount := 0;
743: IAnimMax :_ (pic;LogoBC.Widih div picLogoBC.Height) * IAnimBC;
744: IAnimFlag := False;
745:
746:
~******************,.********************************************************
747: * Initialize Home, Site and User button animation 748:
'~'~************r********************xx*****************x*x*****************) 749: iSiteAnim := 0;
750: iHomeAnim := 0;
751: iUserAnim := 0;
752:
753:
{*~************w*************,t****w**w********w***w***********w**w********
75d: * Set Current Site to the SITE1 755:
~'*****************,t***x************************w***ww*********************) 756: iSiieCurrent := 0;
757: iSiteButton := 1;
758:
759:
{******************~t******w*************************************************
760: * Get the browser name from the command line and initialize the browser 761:
************r******,e***x********w******************************************) 762: if Pos('-b', ParamStr(1)) = 1 then 76;l: x8rowserData.strBrowserEXE := Copy(ParamStr(1), 3, 764: Length(ParamStr(1)) - 2);
765:
766: (Result := brvvlnitializeBrowser(pnBrowser.Handle, xBrowserData, 767: iniGetString('SITE1', 'URLO', "), oHTTP);
768:
769:
t****************r*t~r**********w**************w******w*******************rw**
770: * Create the connect string and the info string 771: *AB4V3C4FF343XC1,AW,1,2,19960116-200504,11,42,M,11215,Netscape,32 772:
****************************************,ewr********r****************rt****,t) 773: strBuffer :_ 'L1 ;
774: oHTTP.AddFeedback(strBuffer);
775:
SUBSTITUTE SHEET (RULE 26) 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 = 'I' 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 IResuli <> INIT SUCCESS then 795: begin 796: oHTTP.AddFeedback('E1,BROWSER');
797: oHTTP.AddFeedback('01');
798: MsgBox(NII, 'BC was unable to find a browser!' +
799: Chr(13) + Chr(10) + Chr(13) + Chr(10) +
800: 'BC requires an infernet browser such as Netscape ' +
801: 'Navigator or Microsoft Internet Explorer. If you do ' +
802: 'not have one of these browsers on your system then you ' +
803: 'may not run BC.', 'Browser Error', 804: MSG_OK or MSG_ICON STOP);
805:
806: oHTfP.Connect;
807: while (oHTTP.Connected) do 808: Application.ProcessMessages;
809: Application.Terminate;
810: end;
811:
812:
{******waw**w*******r*w********w***********w*w*************w**********w*****
813: * Get the current URL
814:
~w*w****www*w*ww*w*w***ww***w*******,.**ww***wwww*ww**ww************www**) 815: StrCopy(szCurrentURL, ");
816:
SUBSTITUTE SHEET (RULE 26) 817:
t**w»********x»*»*,r**»***»»******w**»*******,r*********»*******x*w**»********
818: * Play the greetiing 819:
*************»**"*,.**************************************»***************»*}
820: if iniGetString('SOUNDS', 'START', 'XXX') <> 'XXX' then 821: begin 822: mpWAV.Wait := False;
823: mpWAV.Notify := False;
824: mpWAV.FileName := strPath +'Data\' +
825: iniGetString('SOUNDS', 'START', ");
826: mpWAV.Open;
827: mpWAV.PIay;
828: end;
829:
830:
{***************,t*******»»*******M***»***.t******»»*****»******»**»*»*,tw****
831: * Resize the window and make it visible 832:
**»»****rw*********:**********»*»»*******»*xw*****ww**********************»}
833: strCurrentMode :_ 'B';
834: { Application.ProcessMessages;}
835: { ShowWindow(I-landle, SW SHOW);}
836: ShowWindow(xE3rowserData.hWnd, SW SHOWNORMAL);
837: { SendMessage(xBrowserData.hWnd, WM SIZE, SIZE RESTORED, 0);}
838: Visible := True;
839: FormResize(Sellf);
840:
841: bDialerDone := F=alse;
842:
843:
{********»***»*****"****************************************»***************
844: * Enabled the timers 845:
**'"~"*"**»*********,~************************»**»*»***************»****.****}
846: tmPoILEnabled := True;
847:
848: if iSites>1 then 849: tmSite.Enabled := True;
850:
851: end;
852:
853:
{*******x***»**tx*r***,u*t*»»********r*»*****»*****************»***************
*»
854: * TfrmMain.RequestDoc 855:
*~rr****w**********w****,r***»*******»w********************w**************»**»*
**
856: * Parameters:
857: * strURL - The URL which should be loaded SUBSTITUTE SHEET (RULE 26) 858:
859: * Returns: None.
86~:
***************w**w**a**a**aa*w******w*w*w************aa*aaw**a******ww***aa***
*
861: * This procedure forces the browser to request the specified URL.
862:
****************a**xaa*********************************,t***********aat***a****
*) 863: procedure TfrmMain.RequeslDoc(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 + '"OxFFFFFFFF,OxO' + chr(0));
874: end 875: else 876: begin 877: StrPCopy(szURL, strURL);
878: SendMessage(xBrowserData.hEditWnd, WM_SETTEXT, 0, Longlnt(t~szURL));
879: SendMessage(xBrowserData.hEditWnd, WM_KEYDOWN, VK_RETURN, 0);
880: end;
881: end;
882:
883:
{***a*w**r*x************************a*****a************a******a*a*******a****x*
*
884: * TfrmMain.FormClose 885:
*******************************************************************************
a 886: * Parameters:
887: * oSender - The form which is being closed 888: * oAction - The close action to be performed 889: *
890: * Returns: None.
891:
"~****x**********w**************w**a*****aa*******a************x*****waaa******
**
892: * This procedure forces the browser to request the specified URL.
893:
**************w********a***w*****a**********a************a***********w*********
~
894: procedure TfrmMain.FormClose(oSender: TObject; var eAction:
TCIoseAction);
a95: var 896: eOIdWindowState: TWindowState;
897: xCurTime: TDateTime;
898: begin SUBSTfTLJTE SHEET (RULE 2fi) 899:
(*************************************************************************** -900: * Play the valediction 901:
't*~**************************w*******w*******************************,t**) 902: bSoundDone := True;
903:
904: if iniGetString('S~OUNDS', 'END', 'XXX') <> 'XXX' then 905: begin 906: mpWAV.FiIePJame := strPath + 'Data\' +
907: irniGetString('SOUNDS', 'END', 'XXX');
908: mpWAV.Opein;
909: bSoundDone := False;
910: mpWAV.Notify := True;
911: mpWAV.Waii := False;
912: mpWAV.PIay;
913: end;
914:
915:
~*****************************w*****xx**************************************
916: * Restore the palantir window to its previous state 917:
******r***w******x*********,tt**********************************************~
918: eOIdWindowState := WindowState;
919: WindowState := wsNormal;
920: Visible := False;
921:
922:
~******************w*****************,r*******r***************************t**
923: * Make sure that. the browser is not currently loading a URL
924:
******************,anr***********************************,r*******************) 925: PressButton(BTIV STOP);
926: PressButton(BTIV STOP);
927: PressButton(BTIV STOP);
928: PressButton(BTIV STOP);
929:
930: xCurTime := Time;
931: while ((Time - xCurTime) < 0.0000115) do 932: Application.ProcessMessages;
933:
934:
{~'**************~,t************************w*****t******w*****************
ti35: * 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 -SUBSTITUTE SHEET (RULE Z6) 940: xBrowserData.xRect.Top + 1, SWP_NOREDRAW);
941:
942:
~*****,t,t*********************************************i**********************
943: * Disable all timers 944:
w*ww****ww*r**********ww************************w*********t**w*****w***w***) 945: tmPoll.Enabled := False;
946: tmHost.Enabled := Fatse;
947: tmAnim.Enabled := False;
948:
949: tmSite.Enabled := False;
950: tmSiteAnim.Enabled := False;
951: tmHomeAnim.Enabled := False;
952: tmUserAnim.Enabled := False;
953:
954:
{************"*****************************s*********x****w*****************
955: * Wait while the HTTP object is busy 956:
'~*i'*******r**xw*******************************************w************w***) 957: while (oHTTP.Connected) do 958: Application.ProcessMessages;
959:
960:
{***s***r********w******************w************w*******w*****,t*****w******
961: * Add the logoff feedback 962: ~******************.****************************************************) 963: oHTTP.AddFeedback('01');
964:
965: if bTransmit = True then 966: oHTTP.Connect;
967:
968:
{***************************.***********************************************
989: * Wait while the logoff feedback is transmitted 970: **************************w************t*******
971: while (oHTTP.Connected) do 972: Application.ProcessMessages;
973:
974:
~***********tnt**************x*x*******************w*************************
975: * Wait for the valediction to complete 976:
*************~**w**frt*r*****r********************************************) 977: while bSoundDone = False do 978: Apptication.ProcessMessages;
979:
980:
{******'~******r*********rr*******w*w********************aw*********r******
SUBSTITUTE SHEET (RULE 26) WO 98/52189 PCTlUS98/10035 -981: * Siore the position of the palantir window 982:
*********w't*******w~***w*****r*************w*w**w*******w********w*w********) 983: iniSetLong('WINDOW', 'LEFT', Left); -984: iniSetLong('WINDOW , 'TOP', Top);
985: iniSetLong('WINDOW , 'WIDTH', Width);
988: iniSetLong('WINDOW', 'HEIGHT', Height);
987:
988: iniSetLong('WINDOW', 'STATE', Longlnt(eOIdWindowState));
989:
990: iniClose(False);
991:
992:
{*"'~********************************x***************************************
993: * Destroy all objects used by the program 994:
***tr**************~r********w*******w**************w***********************w) 995: oDomains.Destroy;
998: oHTTP.Destroy;
997:
998:
{*****************..*********************************************************
999: * Exit the browser 1 000:
*****w*************************************x******x********************w***) 1001: PressButton(B1'N_EXIT);
1002: end;
1003:
1004:
{**,t*************************************************************x************
**
1005: * TfrmMain.sbUserClick 1 006:
'~*************w**r*rw*********w*w***w********rw*w****w***w***************ww***
w*
1007: * Parameters:
1008: * 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:
~*******************.~r********************************************************
*) 1014: procedure TfrmMain.sbUserClick(oSender: TObject);
1015: var 1016: iLoop2:lnteger;
1017: begin 1010: for It_oop2 :~ 0 to (IUsers-1) do 1019: if Pointer(sbyUser[iLoop2]) = Pointer(oSender) then 1020: begin 1021: RequestDoc(syUserURL[iSiteCurrent,iLoop2J);
SUBSTITUTE SHfET (RULE 2fi) 1022: end;
1023: end;
1024: -1025:
(******************************************************************************
*
1026: * TfrmMain.FormResize 1027:
~'**,t******************x***w*****************w******************************w*
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.
1 034:
*******************************************************************************
}
1035: procedure TfrmMain.FormResize(oSender: TObject);
1036: begin 1037:
~**********************ww*****************r*********************************
1038: * Make sure that the window is not too small 1039:
***************************************************w***********************~
1040: if Width < 500 then 1041: Width := 500;
1042:
1043: if Height < 350 then 1044: Height := 350;
1045:
1 046:
f*~*****************************************x******x*********************
1047: * Resize the browser window 1048:
***********.*******,.*******************************************************}
1049: if xBrowserData.strlD ='I' lhen 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 +
SUBSTITUTE SHEET (RULE 26) 1063: xE3rowserData.iRightExtra, 1064: pnBrowser.Height + xBrowserData.iTopExtra +
1065: xE3rowserData.iBottomExtra, SWP SHOWWINDOW);
1066:
1067: xBrowserData.IRectArea := 0;
1068: EnumChiIdWindows(xBrowserData.hWnd, ~brwFindLargestChild, 1069: Longlnt(t~xBrowserData));
1070: end;
1071: end;
1072:
1 073:
{*****************,.*********************************************************
1074: * Move the animation 1 075:
*********w**************~*****************w**w****w***********************) 1076: pnt_ogo.Left := pnTooIBar.Width - pnLogo.Width - 3;
1077:
1078:
{,t***************,e,w********w*********************************************tr*
*
1079: * Figure out whE~ther any filler is needed at the bottom of the screen 1 080:
******************,~********************************************************) 1081: if xBrowserData.strlD = 'N' then 1082: begin 1083: if (pnBrowser.Height + pnFiller.Height + xBrowserData.iTopExtra +
1084: xBrowserData.iBottomExtra) > Screen.Height then 1085: pnFiller.He~ight :_ (pnFiller.Height + pnBrowser.Height +
1086: ;KBrowserData.iTopExtra +
1087: ;KBrowserData.iBottomExtra) - Screen.Height 1088: else 1089: pnFiller.He~ight := 0;
1090: end;
1091:
1092:
{********w*r***+**~r***w*******w*********************w*****w****rr***********
1093: * Resize the browser window 1094:
**~***************"********************************************************}
1095: if xBrowserData.hEditWnd = 0 then 1096: SetWindowPos(xBrowserData.hWnd, 0, -10000, 1097: -10000, 1098: pnBnowser.Width + xBrowserData.iLeftExtra +
1099: xBrowserData.iRightExtra, 1100: pnBr~owser.Height + xBrowserData.iTopExtra +
1101: xBro~NSerData.iBottomExtra, SWP_SHOWWINDOW) 1102: else 1103: SetWindowPos(xBrowserData.hWnd, 0, -xBrowserData.iLeftF~ctra, SUBSTITUTE SHEET (RULE 26) 1104: -xBrowserData. iTopExtra, 1105: pnBrowser.Width + xBrowserData.iLeftExtra +
1106: xBrowserData.iRightExtra, 1107: pnBrowser.Height + xBrowserData.iTopExtra +
1108: xBrowserData.iBottomExtra, SWP_SHOWWINDOW);
i 109: end;
1110:
1111:
{******************************************************************************
*
1112: * TfrmMain.tmPoIITimer 11 1 3:
*******************************************************************************
*
1114: * Parameters:
1115: * oSender - The timer which has been fired 1116:
1117: * Returns: None.
1 11 8:
""'*****************************************************w*********************
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.
1i 21:
'**'*'*'***********************************************************************
}
1122: procedure TfrmMain.tmPoIITimer(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:lnteger;
1128: pszCGl: PChar;
1129: pszDiff: PChar;
1130: iSameCount:lnteger;
1131: iLoop:lnteger;
1132: bDomainTest: Boolean;
1133: sConnect: String;
1134: iConnectldx:lnteger;
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:
1 1 43:
{****************************************************..**.******************
1144: ' Try to find all the menu items SUBSTITUTE SHEET (RULE 26) 1 1 45:
'~*'t******r*********************w************x******************************) 1146: if xBrowserData.bMenuDone = False then 1147: xBrowserData.bMenuDone := brwWaIkMeriu(xBrowserData);
1148:
1 1 49:
~*****.*********************************************************************
1150: * Attempt to find the URL edit window 1151:
***************************************************************************}
1152: if xBrowserData.hEditWnd = 0 then 1153: begin 1154: EnumChiIdWindows(xBrowserData.hWnd, cLDbrwFindURLField, 1155: Longlnt(~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:
1 1 66:
{**********r*x***************r*********w*************************rt*********
1167: * Attempt to bring the dialer window to the top if it exists 1168:
»*********************w********************************x******************~
1169: if bDialerDone == False then 1170: begin i 171: for iConnectl~dx := 1 to 100 do 1172: begin 1173: sConnect ::= iniGetString('CONNECT', 'WINDOW'+IntToStr(iConnectldx), 'XXX');
1174: if sConnect='XXX' then break;
1175:
1176: StrPCopy(szCaption, sConnect);
1177: xBrowserC)ata.hDialerWnd := FindWindow(Nil, szCaption);
1178:
1179: if (xBrowserData.hDialerWnd <> 0) and (bDialerDone = False) then 1180: begin 1181: BringWiindowToTop(xBrowserData.hDialerWnd);
1182: mscSetIFocus(xBrowserData.hDialerWnd);
1183:
1184: xBrowserData.hConnectWnd := 0;
1185: xBrowserData.strButtonCaption := iniGetString('CONNECT', SUBSTTTUT~ SHEET (RULE 26) 1186: 'BUTTON' + IntToStr(iConnectldx), ");
1187:
1188: EnumChiIdWindows(xBrowserData.hDialerWnd, ~brwFindConnectBution, 1189: Longlnt(t~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:
{***************************************************************************
1207: * Get the current URL
1208:
'"~~*******************ww*******************o***************x*******ww***~
1209: SendMessage(xBrowserData.hEditWnd, WM_GETTEXT, 500, Longlnt(~szURL));
1210:
1211: if StrComp(szURL, szCun-entURL) <> 0 then 1212: begin 1213: {*************************************.*********************************
1214: * Copy the old URL into a temp variable 1 21 5: ******** **************.******************************~
1216: StrCopy(szTempURL, szCurrentURL);
1217:
1218: ~*********.*******************************.*******************.*****.***
1219: * Resei the current URL
1220: *******************r***********w**************a********************r***) 1221: StrCopy(szCurrentURL, szURL);
1222:
1223: {****w******w**rrx********x*****ww************w**~*w***ww**w*****~*r**
1224: * Make sure that the URL is in a valid domain 1225: **~********************************************************************) 1226: if oDomains.Count > 0 then SUBSTITUTE SHEET (RULE 26) 1227: begin 1228: 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 bOulOfDomain = False then 1241: oHTTP.AddFeedback('D1');
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: ~*****************w******************************************w*******x**
1254: ' Truncate any unwanted CGI name/value pairs 1255: ~~*******.************.***.****.******..*************************.****) 125fi: pszCGl :_ ~~trPos(szURL, '?');
1257:
1258: if pszCGl <=> Nil then 1259: pszCG1[O] := Chr(0);
1260:
1261: pszCGl :_ ~~trPos(szURL, '#');
1282:
1263: if pszCGl <:> Nil then 1284: pszC01[O] := Chr(0);
1265:
1266: {****************.******************************..***********.******.***
1267: * Truncate amy unwanted CGI name/value pairs SUBSTITUTE SHEET (RULE 26) 1 268:
*****************************************************************a*****) 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 1 282: *~'*x****************************************************************) 1283: if iSameCount > 1 then 1284: oHTTP.AddFeedback('M1,' + strCurrentMode +',_ +
1285: IniToStr(iSameCount - 1) +' ' +
1286: StrPas(~szURL[iSameCount - 1 ])) 1287: else 1288: oHTTP.AddFeedback('M1,' + strCurrentMode + ',' + StrPas(szURl));
1289:
1 290:
{****************************************w*************************w****
1291: * Set the mode back hyperlink 1292: ***********************************************************************}
1293: strCurrentMode :_ 'H';
1294: end;
1295: end;
1296:
1297:
{"**************************************************************************.,*
*
1298: * TfrmMain.tmHosiTimer 1299:
*******************************************************************************
*
1300: * Parameters:
1301: * oSender - The timer which has been fired i 302:
1303: * Returns: None.
1304:
**t***r************************************************************r***********
*
1305: * This procedure prompts the HTTP object to send feedback to the server.
1 306:
*******************,t*****w**f***************,r**w*****x************a**s*******
**~
1307: procedure TfrmMain.tmHostTimer(oSender: TObject);
1308: begin SUBSTITUTE SHEET (RULE 26) 1309: if bTransmit = 'T'rue then 1310: begin 1311: if tmHost.Enabled = True then 1312: begin 1313: if oHTTP.C;onnected = False then 1314: oHTTP.Connect;
1315: end;
1316: end;
1317: end;
1318:
1319:
{***'****************~r*w******************************************************
**
1320: * TfrmMain.tmAnimTimer 1321:
*i'*****,t*w*******************x************************************w****ww***r ***
1322: * Parameters:
1323: * oSender - The timer which has been fired 1324:
1325: ' Returns: None.
1326:
*********w*****.rr******w******************************************************
**
132'7: * This procedure prompts the HTTP object to send feedback to the server.
1328:
*******************************************************************************
}
1329: procedure TfrmMaiin.tmAnimTimer(oSender: TObject):
1330: begin 1331:
{***************************************.***********************************
1332: * Increment the frame counter and concatenate the new frame name 1333:
wtt*******r**************************************r****w*******tnt***********) 1334: IAnimCount := IAnimCount + 1;
1335:
1336: if IAnimCount >=: IAnimMax then 1337: begin 1338: IAnimCount :=~ 0;
1339:
1340: if (IAnimFlag == False) and (IAnimBrowser > 0) then 1341: begin 1342: IAnimFlag := True;
1343:
1344: if xBrowserlData.strlD ='N' then 1345: begin 1346: IAnimMax :_ (picLogoNetscape.Width div picLogoNetscape.Height) *
1347: IAnimBrowser;
1348: picLogoNetscape.Visibie := True;
1349: end SUBSTITUTE SHEET (RULE 2fi) 1350: else 135t: begin 1352: IAnimMax :_ (picLogoExplorer.Width div piclogoExplorer.Height) *
1353: IAnimBrowser;
1354: picLogoExplorer.Visible := True;
1355: end;
1356:
1357: picLogoBC.Visibie := False;
1358: end 1359: else 1360: begin 1361: IAnimFlag := False;
1362:
1363: IAnimMax :_ (picLogoBC.Width div picLogoBC.Height) *
1364: IAnimBC;
1365:
1366: picl-ogoBC.Visible := True;
1367: picLogoExptorer.Visible := False;
1368: picLogoNetscape.Visible := False;
1369: end;
1370: end;
1371:
1372:
{'~'***,t*wwtwwxw*,ttr***,~xtww*,t*ww*w*ww**,r*w****~rrx********ww*ww**a.M,r*ww ***
1373: * Shift the visible part of the bitmap to show the correct frame 1374:
**~,ttw,tww*w+,~r***te,rw*~~tr*www*****w***w~*wtwwww****w*w*w***ww*rwwwwwww*w) 1375: if IAnimFlag = False then 1376: picLogoBC.Left :_ -((IAnimCount mod (picLogoBC.Width div 1377: picLogoBC.Height)) * 32) 1378: else 1379: if xBrowserData.strlD ='N'then 1380: picLogoNetscape.Left :_ -{(IAnimCount mod (picLogoNetscape.Width div 1381: picLogoNetscape.Height)) * 32) 1382: else 1383: picLogoExplorer.Left :=-((IAnimCount mod (picLogoF~cplorer.Width div 1384: picLogoExplorer.Height)) * 32);
1385: end;
1386:
1387:
{****www*,rne*,eyer*f~arr*,t****w~,~e.twtwr***w*,k*wwr**w**~*,t*w*****w***o*,ta w,Hn~ra+rr 1388: * TfrmMain.mpWAVNotify 1389:
**********w*xww~**wwwww*arw*****xwwwww***w*ww****,tea,rw*rwr*nsr~*,~,tyrw*wwtr*
1390: * Parameters:
SUBSTITUTE SHEET RULE 26~
1391: * oSender - The rnedia player which has finished playing 1392: *
1393: * Returns: None.
1394:
***wt**a****w*****w******************w**********a***********w******************
*
1395: * This procedure is called when the media player has finished playing.
1396:
**********************,t*******************************************************
*}
1397: procedure TfrmMain.mpWAVNotify(oSender: TObject);
1398: begin 1399: bSoundDone :='true;
1400: end;
1401:
1402:
{**********************~.*************************************x****************
**
1403: * TfnmMain.picLogoBCDbtClick 1404:
*********************,N~**************,tt*w*****************************w******
***
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 paiantir animation is 1411: * double-clicked.
1412:
***x*x*************t*******.t*******************w******************************
*) 1413: procedure TfrmMain.picLogoBC256DbIClick(Sender: TObject);
1414: var 1415: dlgAbout: TdIgAb~out;
1416: begin 1417: dlgAbout := TdIgAbout.Create(Self);
1418:
1419: if xBrowserData.strlD = 'N' then 1420: dlgAbout.laBrowser.Caption :='Running Netscape Navigator' 1421: else 1422.: dlgAbout.laBrowser.Caption :='Running Microsoft Internet ExpIoreP;
1423:
1424:: dlgAbout.ShowModal;
1425.. dlgAbout.Destroy;
1426:: end;
1427.:
1428.
{********************rtrt****w**********w**w***********a***w*sa****************
*
1429: * Button "fix up" procedures 1 430:
************'~~*****ww******a******r**************r****************w*******r***
*) 1431: procedure TfrmMain.sbUserMouseDown(Sender: TObject; Button:
TMouseButton;
SUBST1TUT~ SH~ET (RULE 26) 1432: Shift: TShiftState; X, Y: Integer);
1433: var 1434: iLoop2:lnteger;
1435: begin 1436: tmPoILEnabled := 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[iloop2J.Top+4;
1443: pnytJser[iLoop2].Left := sbyUser[iLoop2].Left+4;
1444: end;
1445: end;
1446: end;
1447:
1 448: {**************************************) 1449: procedure TfrmMain.sbUserMouseUp(Sender: TObject; Button: TMouseButton;
1450: Shift: TShiftState; X, Y: Integer);
1451: var 1452: iLoop2:lnteger;
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[iloop2J.Top+3;
1459: pnyUser[iLoop2].Left := sbyUser[iLoop2J.Left+3;
1460: end;
1461: end;
1462:
1463: tmPoILEnabled := True;
1464: end;
1465:
1466: {**************************************) 1467: procedure TfrmMain.sbSiteMouseDown(Sender: TObject; Button:
TMouseButton;
1468: Shift: TShiftState; X, Y: Integer);
1489: begin 1470: tmPoILEnabled := Fatse;
1471:
1472: pnSite.Top := sbSite.Top+4;
SUBSTITUTE SHEET (RULE 26) 1473: pnSite.Left := sb:Site.Left+4;
1474: end;
1475:
1476: {*******.*************..*************.**) 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: tmPoILEnabled :== True;
1484: end;
1485:
1486: {**************************************~
1487: procedure TfrmMain.sbHomeMouseDown(Sender: TObject; Button:
TMouseButton;
1488: Shift: TShiftState; X, Y: Integer);
1489: begin 1490: tmPoIl.Enabled :== False;
1491:
1492: pnActHome.Top := sbActHome.Top+4;
1493: pnActHome.Left := sbActHome.Left+4;
1494: end;
1495:
1496.: {**********************,.***************y 1497:: procedure Tf~nMain~.sbHomeMouseUp(Sender: TObject; Button:
TMouseButton;
1498: Shift: TShiftState; ;K, Y: Integer);
1499: begin 1500: pnActHome.Top := sbActHome.Top+3;
1501: pnActHome.Left := sbActHome.Left+3;
1502:
1503: tmPoILEnabled := True;
1504: end;
1505:
1506: { ~***************}
1507: procedure TfrmMain.sbBackMouseDown(Sender: TObject; Button:
TMouseButton;
1508: Shift: TShiftState; )(, Y: Integer);
1509: begin 1510: tmPoILEnabled := False;
1511: end;
1512:
1513: {**************************************}
SUB STiTUTE S H EET {RULE 26) 2so 1514: procedure TfrmMain.sbBackMouseUp(Sender: TObject; Button: TMouseButton;
1515: Shift: TShiftState; X, Y: Integer);
1516: begin 1517: tmPoILEnabled := True;
1518: end;
1519:
1520:
{***************************************************w************w******w******
*
1521: * Site button switch and animation initiator 1522:
~e****************************,rw**********************************************
*}
1523: procedure TfrmMain.SwitchSiteButtonToNextSite;
1524: var 1525: iLastSiteButton:lnteger;
1526: begin 1527: if tmSiteAnim.Enabled=True then exit;
1528:
1529: iLastSiteButton := iSiteButton;
1530:
1531: repeat 1532: iSiteButton :_ (iSiteButton+1) mod iSites;
1533: until iSiteButton<>iSiteCurrent;
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:
1 545:
{******************************************************************************
*
1546: * Switch to new site function, plus home and user buttons animation initiator 1 547:
**********************.********************************************************
*}
1548: procedure TfrmMain.sbSiteClick(Sender: TObject);
7549: var 1550: iLoop2:lnteger;
1551: sSound: String;
1552: begin 1553:
1554: {----- 1 site, process button like home}
SUBSTITUTE SHEET (RULE 26) 1555:
1556: if iSites=1 then 1557: begin -1558: RequestDoc(syHomeURL[OJ);
1559: exit;
1560: end;
1561:
1562: {----- >1 site, process button as site select}
1563:
1564: if iSiteCurrent=iSitei3utton then exit;
1565: if (tmHomeAnirn.Enabled=True) or (tmUserAnim.Enabted=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.Pic;ture.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[iSiteCun-ent,iLoop2]);
1581: picyUser[iLoop2].Hint := syUserHint[iSiteCurrent,iLoop2];
1582: end;
1583:
1584: SwitchSiteButtonToNextSite;
1585:
1586: iHomeAnim := ilHomeHeight+1;
1587: iUserAnim := iUserHeight+1;
1588:
1589: tmHomeAnim.Enabled := True;
1590: tmUserAnim.Enabled := True;
1591:
1592: bSoundDone := True;
1593:
t 594: if sySiteGreet[iS~iteCurrent]<>~~~ then 1595: begin SUBST1TUT~ SHEET (RUL~ 26) 1596: mpWAV.FileName := strPath+'Data\'+sySiteGreet[iSiteCurrent];
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:
1607:
{*****************************,t*****************************x*****************
**
1608: * go switch site button switch to next site 1609:
**********************************x**************************************,rw***
**~
1610: procedure TfrmMain.tmSiteTimer(Sender: TObject);
1611: begin 1612: tmSite.Enabied := False;
1613: SwitchSiteButtonToNextSite;
1614: end;
1615:
1616:
{**************************************************x*w*************************
*
1617: * Siie button animation 1618:
~'*****************************************************************************
**}
1619: procedure TfrmMain.tmSiteAnimTimer(Sender: TObject);
1620: begin 1621: iSiteAnim := iSiteAnim-iAnimationLines;
1622:
1623: if iSiteAnim>0 then 1624: begin 1625: picSite.Top :_ -iSiieAnim;
1626: exit;
1627: end;
1628:
1629: picSite.Picture.Bitmap.Canvas.Draw(0, iHomeHeight+1, bmySiie[iSiteButtonj);
1630: picSite.Top :_ -(iSiteHeight+1);
1631:
1632: sbSite.Enabled := True;
td33:
1634: tmSiteAnim.Enabled := False;
1635: tmSite.Enabled := True;
1636: end;
SUBSTITUTE SHEET (RULE 26) 1637:
1638:
{wwwwwrwwriw~ewr.~ewxwrwwww~~~,tw,~r~r,e,~tw*ww~~~t:vwwrwwwwww:*,ttrw~rx3wwxwwm trexw.t 1639: ' Home button animation 1640:
**wwr~x~ww,~wr~xrrwy~wwwmx:w,twwwrwtwwf:rwwxwye~wrtxtr*xt,txw,~~w,twxrww~**rw*w w~yw~
1641: procedure TfrmMain.tmHomeAnimTimer(Sender: TObject);
1642: begin 1643: iHomeAnim := iiHomeAnim-iAnimationLines;
1644:
1645: if iHomeAnim>I) then 1646: begin 1647: picActHome.Top :_ -iHomeAnim;
1848: exit;
1649: end;
1650:
1651: picActHome.Picture.Bitmap.Canvas.Draw(0, iHomeHeight+1, bmyHome[tSiteCurrent]);
1652: picActHome.Top:=-(iHomeHeight+1);
1653:
1654: sbActHome.Enabled := True;
1655:
1656: tmHomeAnim.Enabfed := False;
1657:end;
1658:
1659:
{~wfw*www*ww,ew*,wwrri~y~wr~~w*~*wwwwwrw*~rww*wwi~wrrww,rtt,~w,tart*irtrwrwt,tr ~rswr,r+~.*
1660: ' User buttons animation 1661:
""'rwrwx,r~w*re~wswmewwwwr~wr:wxwwwwwww,txr~~,exwwwtwfrwwt*ww~i:wiwrwwxw,tww~t.
~~
1662: procedure TfrmMain.tmUserAnimTimer(Sender: TObject);
1663: var 1664: iLoop2: Integer;
1665: begin 1666: iUserAnim := iU;serAnim-iAnimationLines;
1667:
1668: if iUserAnim>0 then 1669: begin 1670: for iLoop2 := 0 to (iUsers-1) do 1671: picyUser[Itoop2].Top :_ -iUserAnim;
1672: exit;
1673: end;
1674:
1675: for iLoop2 := 0 to (iUsers-1) do 1676: begin 1677: picyUser[iLoo~p2].Picture.Bitmap.Canvas.Draw( SUBSTITUTE SHEET (RULE 2fi) 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.
SUBSTITUTE SHEET (RULE 26) APPENDIX III
{*w***w*ww*****ww******ww***www**w******w**www***w*w***ww**www****wwww**www***w *
2:*
3::
4: * HTTP.pas CJ.
**************ww***ww*****w*w***w*www**w****ww**wwww**r**w**ww**w****w*w*r*w*w*
*
6:*
7: w 8: * This module contains functions to talk to the HTTP server where the CGI
9: * 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.
~ww******ww****www*w*s.****w******ww*w***ww*******wwww**w******w******ww*r*w*w*
}
21: unit HTTP;
22:
23: interface 24:
25: uses WinProcs, WinTypes, Messages, SysUtils, Classes, Graphics, Controls, 26: Forms, Dialogs, Misc;
27:
28: {$I 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: (Address: Longlnt;
37: strHostName: String; {HTTP host name}
38: iHostPort: Integer'; {HTTP host port}
39: iTimeout: Integer;: {Transaction timeout}
40: iState:lnteger;
41:
42: hSocket:lnteger;
43: bConnected: Boolean;
44: iLineCount:lnteger;
45: szBuffer: array [0..20000) of char;
46: szBuffer2: array [iD..20000) of char;
47: szCRLF: array [0..2] of char;
48: bLookup: Boolean;
SUBSTITUTE SH~~T (RULE 26) WO 98!52189 PCT/US98/10035 49:
50: pxHosiEntity: PTHostEntity;
51:
52: procedure AsyncSocket(var Message: TMessage); message WM_SOCKET;
53: procedure Timer(var Message: TMessage); message WM TIMER;
54:
55: public 56: strSeriaINo: Siring;
57: iTransCount: integer;
58: strJobID: String;
59: strCustID: String;
60: strRecord: String;
61: strPath: String;
62: iSessionCount:lnteger;
63:
64: oi=eedback: TStringList;
65: function Connect: Boolean;
66: property Connected: Boolean read bConnected;
67: constructor Create(AOwner: TComponent); override;
68: function GetDateTime: String;
69: procedure AddFeedback(strFeedback: String);
70:
71: properly HostName: String read strHostName write strHostName;
72: property HostPort: Integer read iHostPort write iHostPort;
73: property Timeout: integer read iTimeout write iTimeout;
74: end;
75:
76: procedure Register;
77:
78: implementation 79:
80: function sclosesocket (hSocket: TSOCKET): Integer; far;
81: extemai 'WINSOCK' index 3;
82: function sconnect(hSocket: TSOCKET; var pxSockAddr: TSockAddr;
83: iNameLen: Integer): Integer; far;
84: external'WINSOCK' index 4;
85: function gethostbyname(pszName: PChar): PTHostEntity; far;
86: external 'WINSOCK' index 52;
87: function htons(wHostShort: Word): Word; far;
88: external 'WINSOCK' index 9;
89: function recv(hSocket: TSOCKET; pszBuffer: PChar;
SUBSTITUTE SHEET (RUL~ 26) 90: it_ength, iFlags: Integer): Integer; far;
91: external 'VII1NSOCK' index 16;
92: function ssend(hSo<;ket: TSOCKET; pszBuffer: PChar;
93: iLength, iFilags: Integer): Integer; far;
94: external 'V111NSOCK' index 19;
95: function socket(iAddrFormat, iType, iProtocol: Integer): TSOCKET; far;
96: external 'ININSOCK' index 23;
97.. function WSAAsyncSeiect(hSocket: TSOCKET; hWnd: THandle; wMsg: Word;
98: (Event: Longlnt): Integer; far;
99: extemal'WINSOCK' index 101;
100: function WSAGetLastError: Integer; far;
101: external'WINSOCK' index 111;
t02: function WSAStartup(wVersionRequired: Word;
103: var IpWSAData: TWSAData): Integer; far;
104: extem;al'WINSOCK' index 115;
105: function inet addr(pszAddress: PChar): Longlnt; far;
106: external 'WINSOCK' index 10;
107: const NP MISC = 0;
108: const NP HEADER = 1;
109: const NP ARTICLE. = 2;
110: const NP GROUPLIST = 3;
111:
112: const STATE CONNECTING = 1;
113: const STATE RECEIVING = 2;
114:
115: procedure Register;
116: begin 117: RegisterComponents('Samples', [THTTP]);
118: end;
119:
120: function THTTP.GeIlDateTime: String;
121: begin 122: GetDateTime := I=ormatDateTime('yyyymmdd"='hhnnss', Now);
123: end;
124:
125: procedure THTTP.A,ddFeedback(strFeedback: String);
126:: var 127:: slrBuffer: String;
128: begin 129: strBuffer := strCustID + ',' + stcSeriaINo + ',' + strJobID + ',' +
130: IntToStr(iSessionCount) + ~,~ +
SUBSTITUTE SHEET (RULE 26) 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: iTransCount := iTransCount + 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: iTransCount := 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:
185: procedure THTTP.AsyncSocket(var Message: TMessage);
166: var 167: iLineldx:lnteger;
188: strBuffer: String;
169: begin 170: case LOWORD(Message.IParam) of 171: FD CONNECT:
SUBSTITUTE SH f F'T (RULE 26) 172: begin 173: if HIWORD(Mlessage.IParam) <> 0 then 174: begin 175: bConnecte;d := False;
176: AddFeedback('E1,CONNECT,' + strHostName + ',~ +
177: IntToStr(iHostPort));
178: Exit;
179: end;
180:
181: StrPCopy(szl3uffer, 'GET ' + strRecord + '?file=');
182:
183: StrPCopy(szl3uffer2, 'palantir');
184: StrCat(szBuf~fer, szBuffer2);
185: StrCai(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(azBuffer2, oFeedBack.Strings[iLineldxj);
196: StrCat(sz8uffer, szBuffer2);
197: StrCat(sz8uffer, ']');
198:
199: St~Cai(sz6uffer, '%OD%OA');
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(hSockEa, szBuffer, StrLen(szBuffer), 0);
209: end;
210:
211: FD READ:
212: begin SUBSTITUTE SHEET {RULE 26) 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(0);
220: end;
221:
222: oFeedback.SaveToFile(strPath + 'palantir.fdk');
223: end 224: else 225: begin 226: sUBuffer :_ 'E1,TRANSFER,' + 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: AddFeedback('E1,TIMEOUT,CONNECTING,' + IntToStr(iTimeout)) 241: else 242: AddFeedback('E1,TIMEOUT,RECEIVING,' + IntToSir(iTimeout));
243:
244: sclosesocket(hSocket);
245: bConnected := False;
246: KiIITimer(Handle, 1);
247: end;
248:
249: function THTTP.Connect: Boolean;
280: ver 251: xSockAddr: TSockAddr;
252: pcAddress: PChar;
253: begin SUBSTITUTE SHEET (RULE 26) 254: if Connected = True then 255: begin 256: Connect := Fal;>e; -257: Exit;
258: end;
259:
260: if oFeedback.Couint = 0 then 261: begin 262: Connect := True;
263: Exit;
264: end;
265:
266: if bLookup = False: then 267: begin 268: StrPCopy(szBuffer, strHostName);
269:
270: (Address := inet addr(szBuffer);
271:
272: if (Address = IN,ADDR NONE then 273: begin 274: pxHostEntity := gethostbyname(szBuffer);
275:
276: if pxHostEntii!y = Nil then 277: begin 278: Connect :_~ False;
279: AddFeedb;ack('E1,LOOKUP,' + strHostName +',' + IntToStr(iHostPort));
280: Exit;
281: end;
282:
283: mscMemCpy(r~pcAddress, pxHostEntity~.h_addr_list, 4);
284: PChar(~IAddress)[O] := pcAddress[0];
285: PChar(~IAddress)[1 ] := pcAddress[1 ];
286: PChar(~lAddress)[2] := pcAddress[2];
287: PChar(~IAddress)[3] := pcAddress[3];
288: end;
289:
290: bLookup := True;
291: end;
292:
293: xSockAddr.sin_fannily := AF (NET;
294: xSockAddr.sin_poit := htons(iHostPort};
SUBSTITUTE SHEET (RULE 26) 295: xSockAddr.sin_addr :_ (Address;
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, iTimeout * 1000, Nil);
305:
306: Connect := True;
307: bConnected := True;
308: end;
309:
310: end.
SUBSTITUTE SHEET (RULE 26)
rrrrr***r*r*rr*****r*r****r****r*r******w*****r****trr************************r ) 51: unit Main;
52:
53: interface 54:
55:
{*~*r***ww***w**rt**rrrr******r*rrx*r**r*w*r*******rrr**r*r**,rrr*r*w******ww*
56: * Units used by the main form 57:
rr***wx*r**rrrr*w*r*w*rrrrr*w*rrrwrrw**rr*r********w***ww***r******r*r**r*rwr*r ~
58: uses 59: WinProcs, WinTypes, Messages, SysUtils, Classes, Graphics, Controls, Forms, 60: Dialogs, Menus, ExtCtrls, StdCtrls, Buttons, IniFiles, DdeMan, Browser, Misc, 61: HTTP, MPlayer, AboutDlg, CryptINl, MsgDlg;
62:
63:
{r~'~'*~wrrrr**w*w****rwwrrw****w**********w**w****r*wrwrww************rwrrr*
64: r Declaration of the main form object 65:
~'*~'~rr*rr***rrrrrw*rrrrrr*r*rr*r*r*r***rw****r*rr**r*rrrr*r***rrrr**rr**rrr) 68: type TfrmMain = class(TForm) 67:
{'H'w*r**rwrrrrrrr*r*ww*r*****rr*wrrr*rrrr:!*r**r*wrr*r***w*w***r***rw*r*wrrw 68: r Fom1 controls 69:
.rrr*r*r*rrrrr.r*r*w*rrrr**r**r*r******r*r**r*****r*r*r*****w***r*w*rwrwrr*~
70: pnTooIBar: TPanei;
71: sbBack: TSpeedButton;
72: sbForvvard: TSpeedButton;
73: sbReioad: TSpeedButton;
74: sbStop: TSpeedButton;
75: pnUser: TPanel;
76: pnUserDividor: TPanel;
77: sbUserl : TSpeedButton;
78: sbUser2: TSpeedButton;
SUBSTITUTE SHEET RULE 2fi) 79:sbUser3: TSpeedButton;
80:sbUser4: TSpeedButton;
81:sbUserS: TSpeedButton;
82:sbUser6: TSpeedButton;
83:sbUser7: TSpeedButton;
84:sbUserB: TSpeedButton;
85:pnBrowser: TPanel;
86:ddeConv: TDde~CIientConv;
87:tmPoll: TTimer;
88:tmHost: T'Timer;
89:tmAnim: TTimer;
90:pnLogo: TPanel;
91:sbPrint: TSpeedButton;
92:sbFind: TSpeeaIButton;
93:mpWAV: TMediaPlayer;
94:pnLogolnner: Tlaanel;
95:picLogoBC256:
Tlmage;
96:picLogoNetscape:
Tlmage;
97:picLogoExplorer:
Timage;
98:pnFilter: TPanell;
99:sbSite: TSpeedIButton;
100:sbHome: TSpeedButton;
101:pnSite: TPanel;
102:picSite: Tlmage;
103:pnHome: TPanel;
104:picHome: Tlmaige;
105:pnUserl: TPanel;
106:picUser1: Tlmage;
107:pnUser2: TPanel;
108:picUser2: Tlmage;
109:pnUser3: TParnel;
110:picUser3: Tlmage;
111:pnUser4: TParnet;
112:picUser4: Tlmage;
113:pnUserS: TPan~el;
114:picUserS: Tlmage;
115:pnUser6: TParnel;
116:picUserB: Tlmage;
117:pnUser7: TParnel;
118:picUser7: Tlmage;
119:pnUserB: TPan~el;
SUBSTITUTE SHEET (RULE 26) 120: picUserB: Tlmage;
121: tmSite: TTimer;
122: tmSiteAnim: TTimer; -123: tmHomeAnim: TTimer;
124: tmUserAnim: TTimer;
125: sbExit: TSpeedButton;
126: picLogoBCl6: Tlmage;
127: bvBrowser: TBevel;
128:
129:
{~******wt******,t************,t************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 tmPoIITimer(oSender: TObjeci);
138: procedure tmHostTimer(oSender: TObject);
139: procedure tmAnimTimer(oSender: TObject);
140: procedure mpWAVNotify(oSender: TObject);
141:
1 42:
~***********r*****w*********w**w********************************************
143: * User procedures 1 44:
*****w**********************************************w*********w**x*********) 145: procedure RequestDoc(strURL: string);
146: procedure SwitchSiteButtonToNextSite;
147: procedure PressButton(IButtonlD: Longlnt);
148: procedure CommandClick(oSender: TObject);
149: procedure picLogoBC256DbIClick(Sender: TObject);
150: procedure sbSiteMouseDown(Sender: TObject; Button: TMouseBuiton;
151: Shift: TShiftState; X, Y: Integer);
152: procedure sbSiteMouseUp(Sender: TObject; Button: TMouseBuiton;
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;
SUB ST1TUTE S H E ET (RU LE 26) 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 tmHa~meAnimTimer(Sender: TObject);
167: procedure tmUserAnimTimer(Sender: TObject);
168: procedure tmSiteAnimTimer(Sender: TObject);
169: procedure lmSiteTimer(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}
178:
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: :~tBrowserData; {Handles and stuff for the browser}
185:
186: oHTTP: THTTP; {HTTP client object}
187:
188: IAnimCount: Longlnt; {Current animation frame}
189: IAnimMax: Loncilnt; {Maximum animation count}
190: IAnimFIag:Boolean; {FALSE=palantir;TRUE=browser}
191: IAnimBC: Integer, {Iterations of BC Logo}
192: IAnimBrowser: 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.}
SUBSTITUTE SHEET (RULE 26) - WO 98/52189 1'CT/US98/10035 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: iUserVllidth: Integer; {...bitmap width}
217: iUserAnim: Integer; {...animation state: 0=done, 218: (iUserHeight+1)->0 seq.}
219: bmyUser: array [0..4,0..7] of TBiimap; {...bitmaps}
220: syUserURL: array [0..4,0..7] of String; {...URLs}
221: syUserHint: array [0..4,0..7] of Siring; {...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; {active home panel - points to pnHome or pnSite}
229: picActHome: Tfmage; {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: {~~wwww~weswr~~www:~w~e~r~~~tm~,~rwwwxwrwww~w~~wwer~eww~rr~~.
239: ' Include resource files 240: ~~w ww~nwwe~w~wwwwr~~f,Hwt~ewwwwww~.rwww~r~w~rtwxrrrrwr}
241: {$R *.DFM}
242:
SUBSTITUT~ SHEET {RULE 26) 243:
~*****t***tr,r****,r***~f************************************x***********w*****
***
244: ' TfrmMain.CommandClick 245:
****w****************yr****w*****w************************s.**t*****w********w*
r**
246: * Parameters:
24'7: * oSender - speed button object which was clicked 248: *
249: * Returns: None.
250.
***f******i*********MrN*************************************i******************
251: * This procedure ~orocesses all of the command button clicks.
252:
*********************.,********************************************************
*) 253: procedure TfrmMain.CommandClick(oSender: TObject);
254: begin 255: if oSender = TObject(sbBack) then 256: PressButton(E3TN_BACK);
257:
258: if oSender = TObject(sbForward) then 259: PressButton(BTN_FORWARD);
260:
281: if oSender = TObject(sbReioad) then 262: PressButton(BTN_RELOAD);
263:
264: if oSender = TObject(sbStop) then 285: begin 266: if xBrowserData.strlD ='I' then 267: begin 268: SendMessage(xBrowserData.hHTMLWnd, WM_KEYDOWN, VK_ESCAPE, 0);
269: SendMess~age(xBrowserData.hHTMLWnd, WM_CHAR, VK ESCAPE, 0);
270: SendMess~age(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(13TN_PRINT);
280: end;
281:
282: if oSender = TO~bject(sbFind) then 283: begin SUBSTITUTE SHEET (RULE 26) 284: BringWindowToTop(xBrowserData.hWnd);
285: PressButton(BTN_FIND);
286: end;
287:
288: if oSender = TObject(sbExit) then 289: begin 290: Close;
291: end;
292.
293: end;
294:
295:
{*****ww****w*****************w*******x*********w******************************
w 296: * TfrmMain.PressButton 297:
************************************r*************w****************************
*
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(IBuitonlD: Longlnt);
306: var 307: iCode: Longlnt;
308: begin 309:
{***************************************************************************
310: * Tell the browser to press the button 311: *** **********************************..*************}
312: PostMessage(xBrowserData.hWnd, WM_COMMAND, 313: xBrowserData.IyButtons[IButtonlD], 0);
314: end;
315:
316:
{***********.*.*.**************************************************************
*
317: * TfrmMain.FormCreate 31 8:
*************************r************ww***w***********************************
*
319: * Parameters:
320: * oSender - The form object which is being created 321: *
322: * Returns: None.
323:
***********'*****************************w**********w*********wr***rt**r*******
*
324: * This procedure loads all the settings from the ini file and opens the SUBSTITUTE SHEET (RULE Z6) 325: " browser.
326:
*~*********w***r************x*************t*********************************) 327: procedure TfrmM~ain.FormCreate(oSender: TObject);
328: var 329: iLoop, iLoop2: Integer;
330: iOffset:lnteger;
331: iResult:lnteger;
332: iCount:lnteger;
333: IResult: Longlnil;
334: wMinute, wHour, wSecond, wMSecond: Word;
335: strUserlnfo: String;
336: sSite: String;
337: sUser: String;
338: sFile: Siring;
339: sButton: String;
340: sDomain: Strincl;
341: iMove:lnteger;
342: iLeft:lnteger;
343: begin 344: iCount := 0;
345:
346:
{***************************************************************************
347: * Create the htt~p object 348:
***************************************************************************) 349: oHTTP := TH't~f'P.Create(Self);
350: oHTTP.Parent := Self;
351:
352:
~*********r**w***********a****************************************w*********
353: * Initialize the application path 354:
*~*********..************************************************************}
355: for iLoop := Length(Application.ExeName) downto 1 do 356: begin 357: if Application.EXEName[iLoop] _ '\' then 358: begin 359: strPath := Copy(Application.EXEName, 1, iLoop);
360: Break;
361: end;
362: end;
363:
364: oHTTP.strPath := strPath;
365:
SUBSTITUTE SHEET (RULE 26) 386:
{*rr**w***w**w*******w**********ww****w*****w*******ww**w***************r****
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:
***************************************************************************}
376: iniOpen(strPath +'BC.ini');
377:
378:
{******************************************************.********************
379: * Set the window caption 380:
**a****************************************************,t******a************) 381: Caption := iniGetString('WINDOW', 'TITLE', 'BC');
382: Application.Title := iniGetString('WINDOW', 'TITLE', '13C');
383:
384:
{****************,t*************x**w******w***w*w****w********w**************
385: * Set the window icon 386:
************************************************.**************************) 387: try 388: Icon.LoadFromFile(strPath + 'Data1' +
389: iniGetString('WINDOW , 'ICON', '~);
390: Application.Icon.LoadFromFile(strPath +'Data1' +
391: iniGetString('WINDOW', 'ICON', "));
392: except 393: end;
394:
395:
{*******.**,~*.**************************************************************
396: * Do we transmit our data? This is for debug purposes!
397:
***************************************************************************}
398: bTransmit := True;
399:
400: if iniGetString('HTTP', 'TRANSMIT', 'Y') _ 'N' then 401: bTransmit := False;
402:
403:
{***w**ww******ww***********w*w****w**************a********a****************
404: * Set the window size 405: ***********"*~********w*************************************************) 406: Left := iniGetLong('WINDOW , 'LEFT', -1 );
SUBSTITUT~ SH~ET (RUL~ 26) 407: Top := iniGetLong('WINDOW , 'TOP', -1);
408: Width := iniGetl.ong('WINDOW','WIDTH', -1);
409: Height := iniGetl_ong('WINDOW°, 'HEIGHT', -1-);
410:
411: if (Left = -1 ) or (Top = -1 } or (Vllidth = -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('WINDOW', "STATE', 2)};
420:
421:
~************a*******************************w******************************
422: * Set browser parameters 423:
**************************rr***w*******tnt*********************************t}
424: bCompress := False;
425:
426:
{'~'*******************************ww***********************************,t**
42'7: * Get host information 428:
*»*************************************************************************}
42'9: oHTTP.HostNanne := iniGetString('HTTP', 'HOST', 'www.truelogic.com');
430: oHTTP.HostPorl: := iniGetLong('HTTP', 'PORT', 80);
431: oHTTP.Timeout := iniGett_ong('HTTP', 'TIMEOUT', 40);
432:
433:
~***w****************w*********************w********************************
434: * Initialize the domain list 435:
*~***********************************************************************) 436: oDomains := TStringLisi.Create;
437:
438: for iLoop := 0 to 100 do 439: begin 440: sDomain := iniGetString('DOMAINS', 'DOMAIN'+IntToStr(iLoop+1), 'XXX');
441: if sDomain='X:XX' then break;
442: oDomains.Ad~d(sDomain);
443: end;
444:
44r'J:
{***w*******w********w*************w****************************************
44u: ' Initialize the user and customer variables 44'7:
'"*****************..****,.*************************************************}
SUBSTITUTE SHEET (RULE 26) 448: oHTTP.strSeriaINo := iniGetString('USER', 'ID', 'X');
449:
450: if oHTTP.strSeriaINo ='X' then 451: begin 452: oHTTP.strSerialNo :_ ";
453:
454: DecodeTime(Now, wHour, wMinute, wSecond, wMSecond);
455: RandSeed := GetFreeSpace(0) + DiskFree(0) + wHour + (wMinute * 100} +
456: (wSecond * 1000) + (wMSecond * 100000);
457:
458: for iLoop := 1 to 15 do 459: oHTTP.strSeriaINo := oHTTP.strSeriaINo + Chr(Ord('A') + Random(26));
460:
461: iniSetString('USER', 'ID', oHTTP.strSeriaINo);
462: end;
463:
464: oHTTP.strJobID := iniGetString('CUSTOMER', 'JOBID', 'X');
465: oHTTP.strCustID := iniGetSiring('CUSTOMER', 'ID', 'X');
466: oHTTP.strRecord := iniGetString('HTTP', 'RECORD', 'X');
467: oHTTP.iSessionCount := iniGetLong('BC', 'SESSION', 1);
468:
469: iniSetLong('BC', 'SESSION', oHTTP.iSessionCount + 1);
470:
471:
{********************w*******r**x***************************w***************
472: * Set buttons animation rate (lines/50Ms timer tick) 473:
~**********************************************************************.**) 474: iAnimationLines := iniGetLong('ANIMATION', 'BUTTONS LINERATE', 1);
475: lmSite.lnterval := iniGetLong('ANIMATION', 'SITECHANGE_TIME', 3000);
476:
477:
{***********************************************************************.***
478: * Find out how many sites defined in the ini file 479:
**~'****'~**********************r**r*****************w*********************) 480: for iLoop := 0 to 5 do 481: begin 482: sButton := iniGetString('SITE'+IniToStr(iLoop+1),'HOME','XXX');
483: if sButton='XXX' then break;
484: end;
485:
486: iSites := iLoop;
487:
488:
~***********************************************x**w************************
SUBSTITUTE SHEET (RULE 26) 489: " Find out how rnany user buttons by using [SITE1 j as the reference 490:
~wwww*wrwrwwwww~~wwwwwwwwwwwwwvwwwwwwwwwwrwwrwwwwwrwww*a,swraawwwwwwwwxrww~
491: -492: for iLoop2 := 0 to 8 do 493: begin 494: sButton := iniGetString('SITE1','BUTTON'+intToStr(iLoop2+1),'XXX');
495: if sButton='X;KX' then break;
496: end;
497:
498: iUsers := iLoop2;
499:
500:
{'H*wwwwww**rwwwwwwwmrwwwwxwetr:,ew*w*w*wwww**twwwwsrww*wwrwwwr*wxwwwwww*wwwwwr 501: ' Load the Home and Site button bitmaps, URLs etc.
502:
*~'w~*wtwwwwxx,~ww*,twwwwwwwwxttw*wxwwaw*:*wr,r***w*w*rrrrwr*wwwwwwwwww*w~
503: for iLoop := 0 to (iSites-1 ) do 504: begin 505: sSite :='SITE.' + IntToStr(iLoop+1);
506:
507: bmyHome[iLoopj := TBitmap.Create;
508: bmyHome[iLoopj.LoadFromFile(strPalh + 'DATA\' +
509: iniGetString(sSite,'HOME',"));
510: syHomeURL[iLoop] := iniGetString(sSiie, 'URLO', ");
511:
512: if iSites>1 thean 513: begin 514: bmySite[iLoopj := TBitmap.Create;
515:
516: sFile := iniGetString(sSite,'SITE','XXX');
517:
518: if sFile='~CX' then 519: bmySite~[iLoopj.LoadFromFile(strPath +'DATA\' +
520: iniGetString(sSite,'HOME',")) 521: else 522: bmySite~[iLoop].LoadFromi=ile(strPath +'DATA\' +
523: iniGetString(sSite,'SITE',"));
524:
525: sySiieGreet[iLoopj := iniGetString(sSite,'GREET','XXX');
828: end;
527: end;
528:
529:
{wwwwwrwwwrwwwwww~n~wwxwrwwwrwwwwr*wwwwwwxwwwwww*ww**www*wwwwwwwwwwwww*wwrrw*
SUBSTITUTE SHEET (RULE 26) 530: ' Load the user button bitmaps, URLs etc.
531:
**************************w*************************w***w******************}
532: for it_oop := 0 to (iSites-1) do _ 533: begin 534: sSite :='SITE' + IntToStr(iLoop+1);
535:
536: for iLoop2 := 0 to (iUsers-1) do 537: begin 538: sUser := IntToStr(iLoop2+1);
539: sButton := iniGetString(sSite,'BUTTON'+sUser,");
540:
541: bmyUser[iLoop,iLoop2] := TBitmap.Create;
542: bmyUser[iLoop,iLoop2].LoadFromFile(strPath +'DATA1' + s8utton);
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 Nome 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;
~3e7: pnt3lte.left :~ ~b8lte.Left+3;
568: pnSite.Height := iSiteHeight;
569: pnSite.Width := iSiteWidth;
570:
SUBSTITUTE SHEET (RULE 26) 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.Siyle := psSolid;
577: picSite.Picture.Bitmap.Canvas.Pen.Mode := pmCopy;
578: picSite.Picture.Bitmap.Canvas.Pen.Coior := clWhite;
579: picSite.Picture.Bitmap.Canvas.Pen.Width := 1;
580: picSite.Picture.Bitmap.Canvas.MoveTo(0, iSiteHeight);
581: picSite.Picture.Bitmap.Canvas.LineTo(iSiteWidth-i, 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.Visibl~e := 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:
{~***************************************************wx**********w**********
600: * Initialize the Acting Home button 601. *****..*.*****************************..***********.*****) 602:
603: iHomehleight :_ 32;
604: iHomeWidth := bmyHome[0].Width;
605:
606: iMove :_ (iHomeWidth+6) - sbActHome.Width;
607:
808: sbActHome.Height := iHomeHeight+6;
609: sbActHome.Width := iHomeWidth+6;
610:
611: pnActHome.Top := sbActHome.Top+3;
SUBSTITUTE SHEET (RULE 26) 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[O]);
629: picActHome.Top :_ -(iHomeHeight+1);
630:
631: sbActHome.Enabled := True;
632: sbActHome.Visible := True;
633: pnActHome.Visible := True;
634: picActHome.Visible := True;
635:
636:
{*******,tt******************************************************************
637: * Adjust the control buttons position to accomodate the HomeJSite button 638:
***************************************************************************}
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 := sbForvvard.Left + iMove;
645: sbReload.Left := sbReload.Left + iMove;
646: sbPrint.Left := sbPrint.Left + iMove;
647: { sbFind.Left := sbFind.Lefi + iMove;
648: sbStop.Left := sbStop.Left + iMove:}
649: sbExit.Left := sbExit.Left + iMove;
650:
651:
~********************w********r*********************************************
652: * Initialize the User buttons SUBSTITUTE SHEET (RULE 26) 653:
~~'w*rtwwww~twwr~wtw,rtwtw,r~tws~xrr.exrxwwwww~wwwrwvwwx:ww,rnw,ernwrxwwww,~~ew r,rw}
654: sbyUser[0] := s~bUser1; {} pnyUser[0]picyUser[0] := picUserl := pnUserl ; {} ;
655: sbyUser[1] := sbUser2; {} pnyUser[1]picyUser[1] := picUser2;
:= pnUser2; {}
656: sbyUser[2] :_ ::bUser3; {} pnyUser[2]picyUser[2] := picUser3;
:= pnUser3; {}
657: sbyUser[3] := s;bUser4; {} pnyUser[3]picytJser[3] := picUser4;
:= pnUser4; {}
658: sbyUser[4] :_ sbUserS; Q pnyUser[4]picyUser[4] := picUserS;
:= pnUserS; {}
659: sbyUser[5] := s;bUse~6; {} pnyUser[5]picyUser[5] := picUser6;
:= pnUser6; {}
660: sbyUser[6] := s;bUser7; {} pnyUser[6]picyUser[6] := picUser7;
:= pnUser7; {}
661: sbyUser[7] := s:bUserB; {) pnyUser[7]picyUser[7] := picUserB;
:= pnUserB; {}
662:
663: if iUsers>0 them 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 610: else 671: pnUser.Height := iSiteHeight+12;
672:
673: if iSiies>1 then 674: iLeft := sb~Site.Left + sbSite.Width 675: else 676: iLeft :_ -2;
677:
678: for iLoop2 := 0 to (iUsers-1) do 679: begin 650: sbyUser[it.oop2].Left :=
iLeft+iniGetLong('SITE1','SPACE'+IntToStr(iLoop2+1),5);
681: iLeft := sbyUser[iLoop2].Left + iUserWidth+6;
682:
683: sbyUser[il_oop2].Height := iUserHeight+6;
684: sbyUser[it_oop2].Width := iUserWidth+6;
685:
686: pnyUser[il_oop2].Top := sbyUser[iLoop2].Top+3;
687: pnyUser[il_oop2].Left := sbyUser[iLoop2].Left+3;
688: pnyUser[il_oop2].Height := iUserHeight;
689: pnyUser[il_oop2].Width := iUserWidth;
690:
8a1: picyUser[iLoop2].Height := 2"iUserHeight+1;
892: picyUser[ilLoop2].Picture.Bitmap.Height := picyUser[iLoop2].Height;
693: picyUser[ilLoop2].Width := iUserWidth;
SUBSTITUTE SH E~T (RUL~ 26) 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.Cofor := 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[O,iLoop2]);
704: picyUser[iLoop2].Top :=-(iUserHeight+1);
705:
706: sbyUser[iLoop2].Hint := syUserHint[O,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:
{************************x*********************************************w****
721: * Setup logo animation 722:
***************************************************************************) 723: if GetDeviceCaps(Canvas.Handle, NUMCOLORS) > 256 then 724: begin 725: picLogoBC := picLogoBC256;
726: picLogoBC16.Visible := Faise;
727: end 728: else 729: begin 730: picLogoBC := picLogoBCl6;
731: picLogoBC258.Vlslble := False;
732: end;
733:
734: IAnimBC := iniGetLong('ANIMATION', 'BC_REPEAT', 1 );
SUBSTITUTE SHEET (RULE 26) 735: IAnimBrowser :_ iniGetLong('ANIMATION', 'BROWSER_REPEAT', 0);
736:
737: if IAnimBC < 1 then IAnimBC := 1;
738: if IAnimBC > 50 then IAnimBC := 50;
739: if IAnimBrowser < 0 then IAnimBrowser := 0;
740: if IAnimBrowser > 50 then IAnimBrowser := 50;
741:
742: IAnimCount := 0;
743: IAnimMax :_ (pic;LogoBC.Widih div picLogoBC.Height) * IAnimBC;
744: IAnimFlag := False;
745:
746:
~******************,.********************************************************
747: * Initialize Home, Site and User button animation 748:
'~'~************r********************xx*****************x*x*****************) 749: iSiteAnim := 0;
750: iHomeAnim := 0;
751: iUserAnim := 0;
752:
753:
{*~************w*************,t****w**w********w***w***********w**w********
75d: * Set Current Site to the SITE1 755:
~'*****************,t***x************************w***ww*********************) 756: iSiieCurrent := 0;
757: iSiteButton := 1;
758:
759:
{******************~t******w*************************************************
760: * Get the browser name from the command line and initialize the browser 761:
************r******,e***x********w******************************************) 762: if Pos('-b', ParamStr(1)) = 1 then 76;l: x8rowserData.strBrowserEXE := Copy(ParamStr(1), 3, 764: Length(ParamStr(1)) - 2);
765:
766: (Result := brvvlnitializeBrowser(pnBrowser.Handle, xBrowserData, 767: iniGetString('SITE1', 'URLO', "), oHTTP);
768:
769:
t****************r*t~r**********w**************w******w*******************rw**
770: * Create the connect string and the info string 771: *AB4V3C4FF343XC1,AW,1,2,19960116-200504,11,42,M,11215,Netscape,32 772:
****************************************,ewr********r****************rt****,t) 773: strBuffer :_ 'L1 ;
774: oHTTP.AddFeedback(strBuffer);
775:
SUBSTITUTE SHEET (RULE 26) 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 = 'I' 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 IResuli <> INIT SUCCESS then 795: begin 796: oHTTP.AddFeedback('E1,BROWSER');
797: oHTTP.AddFeedback('01');
798: MsgBox(NII, 'BC was unable to find a browser!' +
799: Chr(13) + Chr(10) + Chr(13) + Chr(10) +
800: 'BC requires an infernet browser such as Netscape ' +
801: 'Navigator or Microsoft Internet Explorer. If you do ' +
802: 'not have one of these browsers on your system then you ' +
803: 'may not run BC.', 'Browser Error', 804: MSG_OK or MSG_ICON STOP);
805:
806: oHTfP.Connect;
807: while (oHTTP.Connected) do 808: Application.ProcessMessages;
809: Application.Terminate;
810: end;
811:
812:
{******waw**w*******r*w********w***********w*w*************w**********w*****
813: * Get the current URL
814:
~w*w****www*w*ww*w*w***ww***w*******,.**ww***wwww*ww**ww************www**) 815: StrCopy(szCurrentURL, ");
816:
SUBSTITUTE SHEET (RULE 26) 817:
t**w»********x»*»*,r**»***»»******w**»*******,r*********»*******x*w**»********
818: * Play the greetiing 819:
*************»**"*,.**************************************»***************»*}
820: if iniGetString('SOUNDS', 'START', 'XXX') <> 'XXX' then 821: begin 822: mpWAV.Wait := False;
823: mpWAV.Notify := False;
824: mpWAV.FileName := strPath +'Data\' +
825: iniGetString('SOUNDS', 'START', ");
826: mpWAV.Open;
827: mpWAV.PIay;
828: end;
829:
830:
{***************,t*******»»*******M***»***.t******»»*****»******»**»*»*,tw****
831: * Resize the window and make it visible 832:
**»»****rw*********:**********»*»»*******»*xw*****ww**********************»}
833: strCurrentMode :_ 'B';
834: { Application.ProcessMessages;}
835: { ShowWindow(I-landle, SW SHOW);}
836: ShowWindow(xE3rowserData.hWnd, SW SHOWNORMAL);
837: { SendMessage(xBrowserData.hWnd, WM SIZE, SIZE RESTORED, 0);}
838: Visible := True;
839: FormResize(Sellf);
840:
841: bDialerDone := F=alse;
842:
843:
{********»***»*****"****************************************»***************
844: * Enabled the timers 845:
**'"~"*"**»*********,~************************»**»*»***************»****.****}
846: tmPoILEnabled := True;
847:
848: if iSites>1 then 849: tmSite.Enabled := True;
850:
851: end;
852:
853:
{*******x***»**tx*r***,u*t*»»********r*»*****»*****************»***************
*»
854: * TfrmMain.RequestDoc 855:
*~rr****w**********w****,r***»*******»w********************w**************»**»*
**
856: * Parameters:
857: * strURL - The URL which should be loaded SUBSTITUTE SHEET (RULE 26) 858:
859: * Returns: None.
86~:
***************w**w**a**a**aa*w******w*w*w************aa*aaw**a******ww***aa***
*
861: * This procedure forces the browser to request the specified URL.
862:
****************a**xaa*********************************,t***********aat***a****
*) 863: procedure TfrmMain.RequeslDoc(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 + '"OxFFFFFFFF,OxO' + chr(0));
874: end 875: else 876: begin 877: StrPCopy(szURL, strURL);
878: SendMessage(xBrowserData.hEditWnd, WM_SETTEXT, 0, Longlnt(t~szURL));
879: SendMessage(xBrowserData.hEditWnd, WM_KEYDOWN, VK_RETURN, 0);
880: end;
881: end;
882:
883:
{***a*w**r*x************************a*****a************a******a*a*******a****x*
*
884: * TfrmMain.FormClose 885:
*******************************************************************************
a 886: * Parameters:
887: * oSender - The form which is being closed 888: * oAction - The close action to be performed 889: *
890: * Returns: None.
891:
"~****x**********w**************w**a*****aa*******a************x*****waaa******
**
892: * This procedure forces the browser to request the specified URL.
893:
**************w********a***w*****a**********a************a***********w*********
~
894: procedure TfrmMain.FormClose(oSender: TObject; var eAction:
TCIoseAction);
a95: var 896: eOIdWindowState: TWindowState;
897: xCurTime: TDateTime;
898: begin SUBSTfTLJTE SHEET (RULE 2fi) 899:
(*************************************************************************** -900: * Play the valediction 901:
't*~**************************w*******w*******************************,t**) 902: bSoundDone := True;
903:
904: if iniGetString('S~OUNDS', 'END', 'XXX') <> 'XXX' then 905: begin 906: mpWAV.FiIePJame := strPath + 'Data\' +
907: irniGetString('SOUNDS', 'END', 'XXX');
908: mpWAV.Opein;
909: bSoundDone := False;
910: mpWAV.Notify := True;
911: mpWAV.Waii := False;
912: mpWAV.PIay;
913: end;
914:
915:
~*****************************w*****xx**************************************
916: * Restore the palantir window to its previous state 917:
******r***w******x*********,tt**********************************************~
918: eOIdWindowState := WindowState;
919: WindowState := wsNormal;
920: Visible := False;
921:
922:
~******************w*****************,r*******r***************************t**
923: * Make sure that. the browser is not currently loading a URL
924:
******************,anr***********************************,r*******************) 925: PressButton(BTIV STOP);
926: PressButton(BTIV STOP);
927: PressButton(BTIV STOP);
928: PressButton(BTIV STOP);
929:
930: xCurTime := Time;
931: while ((Time - xCurTime) < 0.0000115) do 932: Application.ProcessMessages;
933:
934:
{~'**************~,t************************w*****t******w*****************
ti35: * 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 -SUBSTITUTE SHEET (RULE Z6) 940: xBrowserData.xRect.Top + 1, SWP_NOREDRAW);
941:
942:
~*****,t,t*********************************************i**********************
943: * Disable all timers 944:
w*ww****ww*r**********ww************************w*********t**w*****w***w***) 945: tmPoll.Enabled := False;
946: tmHost.Enabled := Fatse;
947: tmAnim.Enabled := False;
948:
949: tmSite.Enabled := False;
950: tmSiteAnim.Enabled := False;
951: tmHomeAnim.Enabled := False;
952: tmUserAnim.Enabled := False;
953:
954:
{************"*****************************s*********x****w*****************
955: * Wait while the HTTP object is busy 956:
'~*i'*******r**xw*******************************************w************w***) 957: while (oHTTP.Connected) do 958: Application.ProcessMessages;
959:
960:
{***s***r********w******************w************w*******w*****,t*****w******
961: * Add the logoff feedback 962: ~******************.****************************************************) 963: oHTTP.AddFeedback('01');
964:
965: if bTransmit = True then 966: oHTTP.Connect;
967:
968:
{***************************.***********************************************
989: * Wait while the logoff feedback is transmitted 970: **************************w************t*******
971: while (oHTTP.Connected) do 972: Application.ProcessMessages;
973:
974:
~***********tnt**************x*x*******************w*************************
975: * Wait for the valediction to complete 976:
*************~**w**frt*r*****r********************************************) 977: while bSoundDone = False do 978: Apptication.ProcessMessages;
979:
980:
{******'~******r*********rr*******w*w********************aw*********r******
SUBSTITUTE SHEET (RULE 26) WO 98/52189 PCTlUS98/10035 -981: * Siore the position of the palantir window 982:
*********w't*******w~***w*****r*************w*w**w*******w********w*w********) 983: iniSetLong('WINDOW', 'LEFT', Left); -984: iniSetLong('WINDOW , 'TOP', Top);
985: iniSetLong('WINDOW , 'WIDTH', Width);
988: iniSetLong('WINDOW', 'HEIGHT', Height);
987:
988: iniSetLong('WINDOW', 'STATE', Longlnt(eOIdWindowState));
989:
990: iniClose(False);
991:
992:
{*"'~********************************x***************************************
993: * Destroy all objects used by the program 994:
***tr**************~r********w*******w**************w***********************w) 995: oDomains.Destroy;
998: oHTTP.Destroy;
997:
998:
{*****************..*********************************************************
999: * Exit the browser 1 000:
*****w*************************************x******x********************w***) 1001: PressButton(B1'N_EXIT);
1002: end;
1003:
1004:
{**,t*************************************************************x************
**
1005: * TfrmMain.sbUserClick 1 006:
'~*************w**r*rw*********w*w***w********rw*w****w***w***************ww***
w*
1007: * Parameters:
1008: * 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:
~*******************.~r********************************************************
*) 1014: procedure TfrmMain.sbUserClick(oSender: TObject);
1015: var 1016: iLoop2:lnteger;
1017: begin 1010: for It_oop2 :~ 0 to (IUsers-1) do 1019: if Pointer(sbyUser[iLoop2]) = Pointer(oSender) then 1020: begin 1021: RequestDoc(syUserURL[iSiteCurrent,iLoop2J);
SUBSTITUTE SHfET (RULE 2fi) 1022: end;
1023: end;
1024: -1025:
(******************************************************************************
*
1026: * TfrmMain.FormResize 1027:
~'**,t******************x***w*****************w******************************w*
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.
1 034:
*******************************************************************************
}
1035: procedure TfrmMain.FormResize(oSender: TObject);
1036: begin 1037:
~**********************ww*****************r*********************************
1038: * Make sure that the window is not too small 1039:
***************************************************w***********************~
1040: if Width < 500 then 1041: Width := 500;
1042:
1043: if Height < 350 then 1044: Height := 350;
1045:
1 046:
f*~*****************************************x******x*********************
1047: * Resize the browser window 1048:
***********.*******,.*******************************************************}
1049: if xBrowserData.strlD ='I' lhen 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 +
SUBSTITUTE SHEET (RULE 26) 1063: xE3rowserData.iRightExtra, 1064: pnBrowser.Height + xBrowserData.iTopExtra +
1065: xE3rowserData.iBottomExtra, SWP SHOWWINDOW);
1066:
1067: xBrowserData.IRectArea := 0;
1068: EnumChiIdWindows(xBrowserData.hWnd, ~brwFindLargestChild, 1069: Longlnt(t~xBrowserData));
1070: end;
1071: end;
1072:
1 073:
{*****************,.*********************************************************
1074: * Move the animation 1 075:
*********w**************~*****************w**w****w***********************) 1076: pnt_ogo.Left := pnTooIBar.Width - pnLogo.Width - 3;
1077:
1078:
{,t***************,e,w********w*********************************************tr*
*
1079: * Figure out whE~ther any filler is needed at the bottom of the screen 1 080:
******************,~********************************************************) 1081: if xBrowserData.strlD = 'N' then 1082: begin 1083: if (pnBrowser.Height + pnFiller.Height + xBrowserData.iTopExtra +
1084: xBrowserData.iBottomExtra) > Screen.Height then 1085: pnFiller.He~ight :_ (pnFiller.Height + pnBrowser.Height +
1086: ;KBrowserData.iTopExtra +
1087: ;KBrowserData.iBottomExtra) - Screen.Height 1088: else 1089: pnFiller.He~ight := 0;
1090: end;
1091:
1092:
{********w*r***+**~r***w*******w*********************w*****w****rr***********
1093: * Resize the browser window 1094:
**~***************"********************************************************}
1095: if xBrowserData.hEditWnd = 0 then 1096: SetWindowPos(xBrowserData.hWnd, 0, -10000, 1097: -10000, 1098: pnBnowser.Width + xBrowserData.iLeftExtra +
1099: xBrowserData.iRightExtra, 1100: pnBr~owser.Height + xBrowserData.iTopExtra +
1101: xBro~NSerData.iBottomExtra, SWP_SHOWWINDOW) 1102: else 1103: SetWindowPos(xBrowserData.hWnd, 0, -xBrowserData.iLeftF~ctra, SUBSTITUTE SHEET (RULE 26) 1104: -xBrowserData. iTopExtra, 1105: pnBrowser.Width + xBrowserData.iLeftExtra +
1106: xBrowserData.iRightExtra, 1107: pnBrowser.Height + xBrowserData.iTopExtra +
1108: xBrowserData.iBottomExtra, SWP_SHOWWINDOW);
i 109: end;
1110:
1111:
{******************************************************************************
*
1112: * TfrmMain.tmPoIITimer 11 1 3:
*******************************************************************************
*
1114: * Parameters:
1115: * oSender - The timer which has been fired 1116:
1117: * Returns: None.
1 11 8:
""'*****************************************************w*********************
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.
1i 21:
'**'*'*'***********************************************************************
}
1122: procedure TfrmMain.tmPoIITimer(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:lnteger;
1128: pszCGl: PChar;
1129: pszDiff: PChar;
1130: iSameCount:lnteger;
1131: iLoop:lnteger;
1132: bDomainTest: Boolean;
1133: sConnect: String;
1134: iConnectldx:lnteger;
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:
1 1 43:
{****************************************************..**.******************
1144: ' Try to find all the menu items SUBSTITUTE SHEET (RULE 26) 1 1 45:
'~*'t******r*********************w************x******************************) 1146: if xBrowserData.bMenuDone = False then 1147: xBrowserData.bMenuDone := brwWaIkMeriu(xBrowserData);
1148:
1 1 49:
~*****.*********************************************************************
1150: * Attempt to find the URL edit window 1151:
***************************************************************************}
1152: if xBrowserData.hEditWnd = 0 then 1153: begin 1154: EnumChiIdWindows(xBrowserData.hWnd, cLDbrwFindURLField, 1155: Longlnt(~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:
1 1 66:
{**********r*x***************r*********w*************************rt*********
1167: * Attempt to bring the dialer window to the top if it exists 1168:
»*********************w********************************x******************~
1169: if bDialerDone == False then 1170: begin i 171: for iConnectl~dx := 1 to 100 do 1172: begin 1173: sConnect ::= iniGetString('CONNECT', 'WINDOW'+IntToStr(iConnectldx), 'XXX');
1174: if sConnect='XXX' then break;
1175:
1176: StrPCopy(szCaption, sConnect);
1177: xBrowserC)ata.hDialerWnd := FindWindow(Nil, szCaption);
1178:
1179: if (xBrowserData.hDialerWnd <> 0) and (bDialerDone = False) then 1180: begin 1181: BringWiindowToTop(xBrowserData.hDialerWnd);
1182: mscSetIFocus(xBrowserData.hDialerWnd);
1183:
1184: xBrowserData.hConnectWnd := 0;
1185: xBrowserData.strButtonCaption := iniGetString('CONNECT', SUBSTTTUT~ SHEET (RULE 26) 1186: 'BUTTON' + IntToStr(iConnectldx), ");
1187:
1188: EnumChiIdWindows(xBrowserData.hDialerWnd, ~brwFindConnectBution, 1189: Longlnt(t~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:
{***************************************************************************
1207: * Get the current URL
1208:
'"~~*******************ww*******************o***************x*******ww***~
1209: SendMessage(xBrowserData.hEditWnd, WM_GETTEXT, 500, Longlnt(~szURL));
1210:
1211: if StrComp(szURL, szCun-entURL) <> 0 then 1212: begin 1213: {*************************************.*********************************
1214: * Copy the old URL into a temp variable 1 21 5: ******** **************.******************************~
1216: StrCopy(szTempURL, szCurrentURL);
1217:
1218: ~*********.*******************************.*******************.*****.***
1219: * Resei the current URL
1220: *******************r***********w**************a********************r***) 1221: StrCopy(szCurrentURL, szURL);
1222:
1223: {****w******w**rrx********x*****ww************w**~*w***ww**w*****~*r**
1224: * Make sure that the URL is in a valid domain 1225: **~********************************************************************) 1226: if oDomains.Count > 0 then SUBSTITUTE SHEET (RULE 26) 1227: begin 1228: 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 bOulOfDomain = False then 1241: oHTTP.AddFeedback('D1');
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: ~*****************w******************************************w*******x**
1254: ' Truncate any unwanted CGI name/value pairs 1255: ~~*******.************.***.****.******..*************************.****) 125fi: pszCGl :_ ~~trPos(szURL, '?');
1257:
1258: if pszCGl <=> Nil then 1259: pszCG1[O] := Chr(0);
1260:
1261: pszCGl :_ ~~trPos(szURL, '#');
1282:
1263: if pszCGl <:> Nil then 1284: pszC01[O] := Chr(0);
1265:
1266: {****************.******************************..***********.******.***
1267: * Truncate amy unwanted CGI name/value pairs SUBSTITUTE SHEET (RULE 26) 1 268:
*****************************************************************a*****) 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 1 282: *~'*x****************************************************************) 1283: if iSameCount > 1 then 1284: oHTTP.AddFeedback('M1,' + strCurrentMode +',_ +
1285: IniToStr(iSameCount - 1) +' ' +
1286: StrPas(~szURL[iSameCount - 1 ])) 1287: else 1288: oHTTP.AddFeedback('M1,' + strCurrentMode + ',' + StrPas(szURl));
1289:
1 290:
{****************************************w*************************w****
1291: * Set the mode back hyperlink 1292: ***********************************************************************}
1293: strCurrentMode :_ 'H';
1294: end;
1295: end;
1296:
1297:
{"**************************************************************************.,*
*
1298: * TfrmMain.tmHosiTimer 1299:
*******************************************************************************
*
1300: * Parameters:
1301: * oSender - The timer which has been fired i 302:
1303: * Returns: None.
1304:
**t***r************************************************************r***********
*
1305: * This procedure prompts the HTTP object to send feedback to the server.
1 306:
*******************,t*****w**f***************,r**w*****x************a**s*******
**~
1307: procedure TfrmMain.tmHostTimer(oSender: TObject);
1308: begin SUBSTITUTE SHEET (RULE 26) 1309: if bTransmit = 'T'rue then 1310: begin 1311: if tmHost.Enabled = True then 1312: begin 1313: if oHTTP.C;onnected = False then 1314: oHTTP.Connect;
1315: end;
1316: end;
1317: end;
1318:
1319:
{***'****************~r*w******************************************************
**
1320: * TfrmMain.tmAnimTimer 1321:
*i'*****,t*w*******************x************************************w****ww***r ***
1322: * Parameters:
1323: * oSender - The timer which has been fired 1324:
1325: ' Returns: None.
1326:
*********w*****.rr******w******************************************************
**
132'7: * This procedure prompts the HTTP object to send feedback to the server.
1328:
*******************************************************************************
}
1329: procedure TfrmMaiin.tmAnimTimer(oSender: TObject):
1330: begin 1331:
{***************************************.***********************************
1332: * Increment the frame counter and concatenate the new frame name 1333:
wtt*******r**************************************r****w*******tnt***********) 1334: IAnimCount := IAnimCount + 1;
1335:
1336: if IAnimCount >=: IAnimMax then 1337: begin 1338: IAnimCount :=~ 0;
1339:
1340: if (IAnimFlag == False) and (IAnimBrowser > 0) then 1341: begin 1342: IAnimFlag := True;
1343:
1344: if xBrowserlData.strlD ='N' then 1345: begin 1346: IAnimMax :_ (picLogoNetscape.Width div picLogoNetscape.Height) *
1347: IAnimBrowser;
1348: picLogoNetscape.Visibie := True;
1349: end SUBSTITUTE SHEET (RULE 2fi) 1350: else 135t: begin 1352: IAnimMax :_ (picLogoExplorer.Width div piclogoExplorer.Height) *
1353: IAnimBrowser;
1354: picLogoExplorer.Visible := True;
1355: end;
1356:
1357: picLogoBC.Visibie := False;
1358: end 1359: else 1360: begin 1361: IAnimFlag := False;
1362:
1363: IAnimMax :_ (picLogoBC.Width div picLogoBC.Height) *
1364: IAnimBC;
1365:
1366: picl-ogoBC.Visible := True;
1367: picLogoExptorer.Visible := False;
1368: picLogoNetscape.Visible := False;
1369: end;
1370: end;
1371:
1372:
{'~'***,t*wwtwwxw*,ttr***,~xtww*,t*ww*w*ww**,r*w****~rrx********ww*ww**a.M,r*ww ***
1373: * Shift the visible part of the bitmap to show the correct frame 1374:
**~,ttw,tww*w+,~r***te,rw*~~tr*www*****w***w~*wtwwww****w*w*w***ww*rwwwwwww*w) 1375: if IAnimFlag = False then 1376: picLogoBC.Left :_ -((IAnimCount mod (picLogoBC.Width div 1377: picLogoBC.Height)) * 32) 1378: else 1379: if xBrowserData.strlD ='N'then 1380: picLogoNetscape.Left :_ -{(IAnimCount mod (picLogoNetscape.Width div 1381: picLogoNetscape.Height)) * 32) 1382: else 1383: picLogoExplorer.Left :=-((IAnimCount mod (picLogoF~cplorer.Width div 1384: picLogoExplorer.Height)) * 32);
1385: end;
1386:
1387:
{****www*,rne*,eyer*f~arr*,t****w~,~e.twtwr***w*,k*wwr**w**~*,t*w*****w***o*,ta w,Hn~ra+rr 1388: * TfrmMain.mpWAVNotify 1389:
**********w*xww~**wwwww*arw*****xwwwww***w*ww****,tea,rw*rwr*nsr~*,~,tyrw*wwtr*
1390: * Parameters:
SUBSTITUTE SHEET RULE 26~
1391: * oSender - The rnedia player which has finished playing 1392: *
1393: * Returns: None.
1394:
***wt**a****w*****w******************w**********a***********w******************
*
1395: * This procedure is called when the media player has finished playing.
1396:
**********************,t*******************************************************
*}
1397: procedure TfrmMain.mpWAVNotify(oSender: TObject);
1398: begin 1399: bSoundDone :='true;
1400: end;
1401:
1402:
{**********************~.*************************************x****************
**
1403: * TfnmMain.picLogoBCDbtClick 1404:
*********************,N~**************,tt*w*****************************w******
***
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 paiantir animation is 1411: * double-clicked.
1412:
***x*x*************t*******.t*******************w******************************
*) 1413: procedure TfrmMain.picLogoBC256DbIClick(Sender: TObject);
1414: var 1415: dlgAbout: TdIgAb~out;
1416: begin 1417: dlgAbout := TdIgAbout.Create(Self);
1418:
1419: if xBrowserData.strlD = 'N' then 1420: dlgAbout.laBrowser.Caption :='Running Netscape Navigator' 1421: else 1422.: dlgAbout.laBrowser.Caption :='Running Microsoft Internet ExpIoreP;
1423:
1424:: dlgAbout.ShowModal;
1425.. dlgAbout.Destroy;
1426:: end;
1427.:
1428.
{********************rtrt****w**********w**w***********a***w*sa****************
*
1429: * Button "fix up" procedures 1 430:
************'~~*****ww******a******r**************r****************w*******r***
*) 1431: procedure TfrmMain.sbUserMouseDown(Sender: TObject; Button:
TMouseButton;
SUBST1TUT~ SH~ET (RULE 26) 1432: Shift: TShiftState; X, Y: Integer);
1433: var 1434: iLoop2:lnteger;
1435: begin 1436: tmPoILEnabled := 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[iloop2J.Top+4;
1443: pnytJser[iLoop2].Left := sbyUser[iLoop2].Left+4;
1444: end;
1445: end;
1446: end;
1447:
1 448: {**************************************) 1449: procedure TfrmMain.sbUserMouseUp(Sender: TObject; Button: TMouseButton;
1450: Shift: TShiftState; X, Y: Integer);
1451: var 1452: iLoop2:lnteger;
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[iloop2J.Top+3;
1459: pnyUser[iLoop2].Left := sbyUser[iLoop2J.Left+3;
1460: end;
1461: end;
1462:
1463: tmPoILEnabled := True;
1464: end;
1465:
1466: {**************************************) 1467: procedure TfrmMain.sbSiteMouseDown(Sender: TObject; Button:
TMouseButton;
1468: Shift: TShiftState; X, Y: Integer);
1489: begin 1470: tmPoILEnabled := Fatse;
1471:
1472: pnSite.Top := sbSite.Top+4;
SUBSTITUTE SHEET (RULE 26) 1473: pnSite.Left := sb:Site.Left+4;
1474: end;
1475:
1476: {*******.*************..*************.**) 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: tmPoILEnabled :== True;
1484: end;
1485:
1486: {**************************************~
1487: procedure TfrmMain.sbHomeMouseDown(Sender: TObject; Button:
TMouseButton;
1488: Shift: TShiftState; X, Y: Integer);
1489: begin 1490: tmPoIl.Enabled :== False;
1491:
1492: pnActHome.Top := sbActHome.Top+4;
1493: pnActHome.Left := sbActHome.Left+4;
1494: end;
1495:
1496.: {**********************,.***************y 1497:: procedure Tf~nMain~.sbHomeMouseUp(Sender: TObject; Button:
TMouseButton;
1498: Shift: TShiftState; ;K, Y: Integer);
1499: begin 1500: pnActHome.Top := sbActHome.Top+3;
1501: pnActHome.Left := sbActHome.Left+3;
1502:
1503: tmPoILEnabled := True;
1504: end;
1505:
1506: { ~***************}
1507: procedure TfrmMain.sbBackMouseDown(Sender: TObject; Button:
TMouseButton;
1508: Shift: TShiftState; )(, Y: Integer);
1509: begin 1510: tmPoILEnabled := False;
1511: end;
1512:
1513: {**************************************}
SUB STiTUTE S H EET {RULE 26) 2so 1514: procedure TfrmMain.sbBackMouseUp(Sender: TObject; Button: TMouseButton;
1515: Shift: TShiftState; X, Y: Integer);
1516: begin 1517: tmPoILEnabled := True;
1518: end;
1519:
1520:
{***************************************************w************w******w******
*
1521: * Site button switch and animation initiator 1522:
~e****************************,rw**********************************************
*}
1523: procedure TfrmMain.SwitchSiteButtonToNextSite;
1524: var 1525: iLastSiteButton:lnteger;
1526: begin 1527: if tmSiteAnim.Enabled=True then exit;
1528:
1529: iLastSiteButton := iSiteButton;
1530:
1531: repeat 1532: iSiteButton :_ (iSiteButton+1) mod iSites;
1533: until iSiteButton<>iSiteCurrent;
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:
1 545:
{******************************************************************************
*
1546: * Switch to new site function, plus home and user buttons animation initiator 1 547:
**********************.********************************************************
*}
1548: procedure TfrmMain.sbSiteClick(Sender: TObject);
7549: var 1550: iLoop2:lnteger;
1551: sSound: String;
1552: begin 1553:
1554: {----- 1 site, process button like home}
SUBSTITUTE SHEET (RULE 26) 1555:
1556: if iSites=1 then 1557: begin -1558: RequestDoc(syHomeURL[OJ);
1559: exit;
1560: end;
1561:
1562: {----- >1 site, process button as site select}
1563:
1564: if iSiteCurrent=iSitei3utton then exit;
1565: if (tmHomeAnirn.Enabled=True) or (tmUserAnim.Enabted=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.Pic;ture.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[iSiteCun-ent,iLoop2]);
1581: picyUser[iLoop2].Hint := syUserHint[iSiteCurrent,iLoop2];
1582: end;
1583:
1584: SwitchSiteButtonToNextSite;
1585:
1586: iHomeAnim := ilHomeHeight+1;
1587: iUserAnim := iUserHeight+1;
1588:
1589: tmHomeAnim.Enabled := True;
1590: tmUserAnim.Enabled := True;
1591:
1592: bSoundDone := True;
1593:
t 594: if sySiteGreet[iS~iteCurrent]<>~~~ then 1595: begin SUBST1TUT~ SHEET (RUL~ 26) 1596: mpWAV.FileName := strPath+'Data\'+sySiteGreet[iSiteCurrent];
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:
1607:
{*****************************,t*****************************x*****************
**
1608: * go switch site button switch to next site 1609:
**********************************x**************************************,rw***
**~
1610: procedure TfrmMain.tmSiteTimer(Sender: TObject);
1611: begin 1612: tmSite.Enabied := False;
1613: SwitchSiteButtonToNextSite;
1614: end;
1615:
1616:
{**************************************************x*w*************************
*
1617: * Siie button animation 1618:
~'*****************************************************************************
**}
1619: procedure TfrmMain.tmSiteAnimTimer(Sender: TObject);
1620: begin 1621: iSiteAnim := iSiteAnim-iAnimationLines;
1622:
1623: if iSiteAnim>0 then 1624: begin 1625: picSite.Top :_ -iSiieAnim;
1626: exit;
1627: end;
1628:
1629: picSite.Picture.Bitmap.Canvas.Draw(0, iHomeHeight+1, bmySiie[iSiteButtonj);
1630: picSite.Top :_ -(iSiteHeight+1);
1631:
1632: sbSite.Enabled := True;
td33:
1634: tmSiteAnim.Enabled := False;
1635: tmSite.Enabled := True;
1636: end;
SUBSTITUTE SHEET (RULE 26) 1637:
1638:
{wwwwwrwwriw~ewr.~ewxwrwwww~~~,tw,~r~r,e,~tw*ww~~~t:vwwrwwwwww:*,ttrw~rx3wwxwwm trexw.t 1639: ' Home button animation 1640:
**wwr~x~ww,~wr~xrrwy~wwwmx:w,twwwrwtwwf:rwwxwye~wrtxtr*xt,txw,~~w,twxrww~**rw*w w~yw~
1641: procedure TfrmMain.tmHomeAnimTimer(Sender: TObject);
1642: begin 1643: iHomeAnim := iiHomeAnim-iAnimationLines;
1644:
1645: if iHomeAnim>I) then 1646: begin 1647: picActHome.Top :_ -iHomeAnim;
1848: exit;
1649: end;
1650:
1651: picActHome.Picture.Bitmap.Canvas.Draw(0, iHomeHeight+1, bmyHome[tSiteCurrent]);
1652: picActHome.Top:=-(iHomeHeight+1);
1653:
1654: sbActHome.Enabled := True;
1655:
1656: tmHomeAnim.Enabfed := False;
1657:end;
1658:
1659:
{~wfw*www*ww,ew*,wwrri~y~wr~~w*~*wwwwwrw*~rww*wwi~wrrww,rtt,~w,tart*irtrwrwt,tr ~rswr,r+~.*
1660: ' User buttons animation 1661:
""'rwrwx,r~w*re~wswmewwwwr~wr:wxwwwwwww,txr~~,exwwwtwfrwwt*ww~i:wiwrwwxw,tww~t.
~~
1662: procedure TfrmMain.tmUserAnimTimer(Sender: TObject);
1663: var 1664: iLoop2: Integer;
1665: begin 1666: iUserAnim := iU;serAnim-iAnimationLines;
1667:
1668: if iUserAnim>0 then 1669: begin 1670: for iLoop2 := 0 to (iUsers-1) do 1671: picyUser[Itoop2].Top :_ -iUserAnim;
1672: exit;
1673: end;
1674:
1675: for iLoop2 := 0 to (iUsers-1) do 1676: begin 1677: picyUser[iLoo~p2].Picture.Bitmap.Canvas.Draw( SUBSTITUTE SHEET (RULE 2fi) 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.
SUBSTITUTE SHEET (RULE 26) APPENDIX III
{*w***w*ww*****ww******ww***www**w******w**www***w*w***ww**www****wwww**www***w *
2:*
3::
4: * HTTP.pas CJ.
**************ww***ww*****w*w***w*www**w****ww**wwww**r**w**ww**w****w*w*r*w*w*
*
6:*
7: w 8: * This module contains functions to talk to the HTTP server where the CGI
9: * 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.
~ww******ww****www*w*s.****w******ww*w***ww*******wwww**w******w******ww*r*w*w*
}
21: unit HTTP;
22:
23: interface 24:
25: uses WinProcs, WinTypes, Messages, SysUtils, Classes, Graphics, Controls, 26: Forms, Dialogs, Misc;
27:
28: {$I 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: (Address: Longlnt;
37: strHostName: String; {HTTP host name}
38: iHostPort: Integer'; {HTTP host port}
39: iTimeout: Integer;: {Transaction timeout}
40: iState:lnteger;
41:
42: hSocket:lnteger;
43: bConnected: Boolean;
44: iLineCount:lnteger;
45: szBuffer: array [0..20000) of char;
46: szBuffer2: array [iD..20000) of char;
47: szCRLF: array [0..2] of char;
48: bLookup: Boolean;
SUBSTITUTE SH~~T (RULE 26) WO 98!52189 PCT/US98/10035 49:
50: pxHosiEntity: PTHostEntity;
51:
52: procedure AsyncSocket(var Message: TMessage); message WM_SOCKET;
53: procedure Timer(var Message: TMessage); message WM TIMER;
54:
55: public 56: strSeriaINo: Siring;
57: iTransCount: integer;
58: strJobID: String;
59: strCustID: String;
60: strRecord: String;
61: strPath: String;
62: iSessionCount:lnteger;
63:
64: oi=eedback: TStringList;
65: function Connect: Boolean;
66: property Connected: Boolean read bConnected;
67: constructor Create(AOwner: TComponent); override;
68: function GetDateTime: String;
69: procedure AddFeedback(strFeedback: String);
70:
71: properly HostName: String read strHostName write strHostName;
72: property HostPort: Integer read iHostPort write iHostPort;
73: property Timeout: integer read iTimeout write iTimeout;
74: end;
75:
76: procedure Register;
77:
78: implementation 79:
80: function sclosesocket (hSocket: TSOCKET): Integer; far;
81: extemai 'WINSOCK' index 3;
82: function sconnect(hSocket: TSOCKET; var pxSockAddr: TSockAddr;
83: iNameLen: Integer): Integer; far;
84: external'WINSOCK' index 4;
85: function gethostbyname(pszName: PChar): PTHostEntity; far;
86: external 'WINSOCK' index 52;
87: function htons(wHostShort: Word): Word; far;
88: external 'WINSOCK' index 9;
89: function recv(hSocket: TSOCKET; pszBuffer: PChar;
SUBSTITUTE SHEET (RUL~ 26) 90: it_ength, iFlags: Integer): Integer; far;
91: external 'VII1NSOCK' index 16;
92: function ssend(hSo<;ket: TSOCKET; pszBuffer: PChar;
93: iLength, iFilags: Integer): Integer; far;
94: external 'V111NSOCK' index 19;
95: function socket(iAddrFormat, iType, iProtocol: Integer): TSOCKET; far;
96: external 'ININSOCK' index 23;
97.. function WSAAsyncSeiect(hSocket: TSOCKET; hWnd: THandle; wMsg: Word;
98: (Event: Longlnt): Integer; far;
99: extemal'WINSOCK' index 101;
100: function WSAGetLastError: Integer; far;
101: external'WINSOCK' index 111;
t02: function WSAStartup(wVersionRequired: Word;
103: var IpWSAData: TWSAData): Integer; far;
104: extem;al'WINSOCK' index 115;
105: function inet addr(pszAddress: PChar): Longlnt; far;
106: external 'WINSOCK' index 10;
107: const NP MISC = 0;
108: const NP HEADER = 1;
109: const NP ARTICLE. = 2;
110: const NP GROUPLIST = 3;
111:
112: const STATE CONNECTING = 1;
113: const STATE RECEIVING = 2;
114:
115: procedure Register;
116: begin 117: RegisterComponents('Samples', [THTTP]);
118: end;
119:
120: function THTTP.GeIlDateTime: String;
121: begin 122: GetDateTime := I=ormatDateTime('yyyymmdd"='hhnnss', Now);
123: end;
124:
125: procedure THTTP.A,ddFeedback(strFeedback: String);
126:: var 127:: slrBuffer: String;
128: begin 129: strBuffer := strCustID + ',' + stcSeriaINo + ',' + strJobID + ',' +
130: IntToStr(iSessionCount) + ~,~ +
SUBSTITUTE SHEET (RULE 26) 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: iTransCount := iTransCount + 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: iTransCount := 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:
185: procedure THTTP.AsyncSocket(var Message: TMessage);
166: var 167: iLineldx:lnteger;
188: strBuffer: String;
169: begin 170: case LOWORD(Message.IParam) of 171: FD CONNECT:
SUBSTITUTE SH f F'T (RULE 26) 172: begin 173: if HIWORD(Mlessage.IParam) <> 0 then 174: begin 175: bConnecte;d := False;
176: AddFeedback('E1,CONNECT,' + strHostName + ',~ +
177: IntToStr(iHostPort));
178: Exit;
179: end;
180:
181: StrPCopy(szl3uffer, 'GET ' + strRecord + '?file=');
182:
183: StrPCopy(szl3uffer2, 'palantir');
184: StrCat(szBuf~fer, szBuffer2);
185: StrCai(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(azBuffer2, oFeedBack.Strings[iLineldxj);
196: StrCat(sz8uffer, szBuffer2);
197: StrCat(sz8uffer, ']');
198:
199: St~Cai(sz6uffer, '%OD%OA');
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(hSockEa, szBuffer, StrLen(szBuffer), 0);
209: end;
210:
211: FD READ:
212: begin SUBSTITUTE SHEET {RULE 26) 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(0);
220: end;
221:
222: oFeedback.SaveToFile(strPath + 'palantir.fdk');
223: end 224: else 225: begin 226: sUBuffer :_ 'E1,TRANSFER,' + 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: AddFeedback('E1,TIMEOUT,CONNECTING,' + IntToStr(iTimeout)) 241: else 242: AddFeedback('E1,TIMEOUT,RECEIVING,' + IntToSir(iTimeout));
243:
244: sclosesocket(hSocket);
245: bConnected := False;
246: KiIITimer(Handle, 1);
247: end;
248:
249: function THTTP.Connect: Boolean;
280: ver 251: xSockAddr: TSockAddr;
252: pcAddress: PChar;
253: begin SUBSTITUTE SHEET (RULE 26) 254: if Connected = True then 255: begin 256: Connect := Fal;>e; -257: Exit;
258: end;
259:
260: if oFeedback.Couint = 0 then 261: begin 262: Connect := True;
263: Exit;
264: end;
265:
266: if bLookup = False: then 267: begin 268: StrPCopy(szBuffer, strHostName);
269:
270: (Address := inet addr(szBuffer);
271:
272: if (Address = IN,ADDR NONE then 273: begin 274: pxHostEntity := gethostbyname(szBuffer);
275:
276: if pxHostEntii!y = Nil then 277: begin 278: Connect :_~ False;
279: AddFeedb;ack('E1,LOOKUP,' + strHostName +',' + IntToStr(iHostPort));
280: Exit;
281: end;
282:
283: mscMemCpy(r~pcAddress, pxHostEntity~.h_addr_list, 4);
284: PChar(~IAddress)[O] := pcAddress[0];
285: PChar(~IAddress)[1 ] := pcAddress[1 ];
286: PChar(~lAddress)[2] := pcAddress[2];
287: PChar(~IAddress)[3] := pcAddress[3];
288: end;
289:
290: bLookup := True;
291: end;
292:
293: xSockAddr.sin_fannily := AF (NET;
294: xSockAddr.sin_poit := htons(iHostPort};
SUBSTITUTE SHEET (RULE 26) 295: xSockAddr.sin_addr :_ (Address;
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, iTimeout * 1000, Nil);
305:
306: Connect := True;
307: bConnected := True;
308: end;
309:
310: end.
SUBSTITUTE SHEET (RULE 26)
Claims (19)
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 monitor9ng 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.
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 io 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 uses 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.
(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 io 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 uses 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.
(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 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 chat 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.
(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 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 chat 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 ones 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, (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.
(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, (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.
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-browsing-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.
(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-browsing-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.
Applications Claiming Priority (7)
| Application Number | Priority Date | Filing Date | Title |
|---|---|---|---|
| US4651197P | 1997-05-15 | 1997-05-15 | |
| US60/046,511 | 1997-05-15 | ||
| US5180597P | 1997-07-07 | 1997-07-07 | |
| US60/051,805 | 1997-07-07 | ||
| US6931897P | 1997-12-06 | 1997-12-06 | |
| US60/069,318 | 1997-12-06 | ||
| PCT/US1998/010035 WO1998052189A2 (en) | 1997-05-15 | 1998-05-15 | Multimedia interface with user interaction tracking |
Publications (1)
| Publication Number | Publication Date |
|---|---|
| CA2289533A1 true CA2289533A1 (en) | 1998-11-19 |
Family
ID=27366918
Family Applications (1)
| Application Number | Title | Priority Date | Filing Date |
|---|---|---|---|
| CA002289533A Abandoned CA2289533A1 (en) | 1997-05-15 | 1998-05-15 | Multimedia supplement for pc accessible recorded media |
Country Status (4)
| Country | Link |
|---|---|
| EP (1) | EP1032934A2 (en) |
| AU (1) | AU7574998A (en) |
| CA (1) | CA2289533A1 (en) |
| WO (1) | WO1998052189A2 (en) |
Cited By (1)
| Publication number | Priority date | Publication date | Assignee | Title |
|---|---|---|---|---|
| CN114020187A (en) * | 2021-10-26 | 2022-02-08 | 济南浪潮数据技术有限公司 | Font icon display method and device and electronic equipment |
Families Citing this family (5)
| Publication number | Priority date | Publication date | Assignee | Title |
|---|---|---|---|---|
| US8326037B1 (en) | 2005-11-23 | 2012-12-04 | Matrox Electronic Systems, Ltd. | Methods and apparatus for locating an object in an image |
| WO2013086137A1 (en) | 2011-12-06 | 2013-06-13 | 1-800 Contacts, Inc. | Systems and methods for obtaining a pupillary distance measurement using a mobile computing device |
| US9286715B2 (en) | 2012-05-23 | 2016-03-15 | Glasses.Com Inc. | Systems and methods for adjusting a virtual try-on |
| US20130314401A1 (en) | 2012-05-23 | 2013-11-28 | 1-800 Contacts, Inc. | Systems and methods for generating a 3-d model of a user for a virtual try-on product |
| US9483853B2 (en) | 2012-05-23 | 2016-11-01 | Glasses.Com Inc. | Systems and methods to display rendered images |
Family Cites Families (4)
| Publication number | Priority date | Publication date | Assignee | Title |
|---|---|---|---|---|
| US5737395A (en) * | 1991-10-28 | 1998-04-07 | Centigram Communications Corporation | System and method for integrating voice, facsimile and electronic mail data through a personal computer |
| US5406557A (en) * | 1993-02-01 | 1995-04-11 | National Semiconductor Corporation | Interenterprise electronic mail hub |
| US5721908A (en) * | 1995-06-07 | 1998-02-24 | International Business Machines Corporation | Computer network for WWW server data access over internet |
| US5572643A (en) * | 1995-10-19 | 1996-11-05 | Judson; David H. | Web browser with dynamic display of information objects during linking |
-
1998
- 1998-05-15 EP EP98923457A patent/EP1032934A2/en not_active Withdrawn
- 1998-05-15 AU AU75749/98A patent/AU7574998A/en not_active Abandoned
- 1998-05-15 WO PCT/US1998/010035 patent/WO1998052189A2/en not_active Application Discontinuation
- 1998-05-15 CA CA002289533A patent/CA2289533A1/en not_active Abandoned
Cited By (2)
| Publication number | Priority date | Publication date | Assignee | Title |
|---|---|---|---|---|
| CN114020187A (en) * | 2021-10-26 | 2022-02-08 | 济南浪潮数据技术有限公司 | Font icon display method and device and electronic equipment |
| CN114020187B (en) * | 2021-10-26 | 2024-02-23 | 济南浪潮数据技术有限公司 | Font icon display method and device and electronic equipment |
Also Published As
| Publication number | Publication date |
|---|---|
| AU7574998A (en) | 1998-12-08 |
| EP1032934A2 (en) | 2000-09-06 |
| WO1998052189A2 (en) | 1998-11-19 |
| WO1998052189A3 (en) | 1999-04-15 |
Similar Documents
| Publication | Publication Date | Title |
|---|---|---|
| EP1010098B1 (en) | Network delivery of interactive entertainment complementing audio recording | |
| EP0875846B1 (en) | Multimedia information transfer via a wide area network | |
| US20020194260A1 (en) | Method and apparatus for creating multimedia playlists for audio-visual systems | |
| US6248946B1 (en) | Multimedia content delivery system and method | |
| US7877352B2 (en) | List building system | |
| US7020704B1 (en) | System and method for distributing media assets to user devices via a portal synchronized by said user devices | |
| KR101148235B1 (en) | Music marking system | |
| US9143809B2 (en) | Device associated with a user account | |
| US20010052028A1 (en) | Method and system for accessing web pages based on playback of recordings | |
| US20070271366A1 (en) | Multimedia player and browser system | |
| US20010030660A1 (en) | Interactive graphical user interface and method for previewing media products | |
| US20060195403A1 (en) | System and method for improved portable media file retention | |
| JP2004511032A (en) | Multimedia player and browser system | |
| US20030212613A1 (en) | System and method for providing access to digital goods over communications networks | |
| US20070011279A1 (en) | System and method for providing and displaying multimedia content in correlation with music files in an audio disc | |
| WO2002079902A2 (en) | Systems, methods and computer program products for managing multimedia content | |
| CA2289533A1 (en) | Multimedia supplement for pc accessible recorded media | |
| WO2004111882A1 (en) | Method and apparatus for organizing and playing data | |
| JP2004511838A (en) | Method and system for finding matches in a database for waveforms | |
| US20020116451A1 (en) | Method and apparatus of providing a link between artists, retailers, and fans | |
| WO2002033579A1 (en) | System and method for facilitating access by one remote user of another user"s files | |
| JP2004023696A (en) | Method and electronic equipment for controlling reproduction of video and audio files stored in cd | |
| KR20010110926A (en) | System and method for controlling a function of multi story contents add on | |
| JPH10285578A (en) | Information providing device and method and computer readable recording medium recording program for providing information | |
| WO2006093827A2 (en) | System and method for improved portable media file retention |
Legal Events
| Date | Code | Title | Description |
|---|---|---|---|
| FZDE | Dead |