|
|
You can get all samples and compiled programs at the download page.
Example Nr.:
You'll need the directio01.dll to run this.
Look at the download page
You'll need the directio01.dll to run this.
You'll need the directio01.dll to run this.
###########################################
# LCD Testing Application in Visual Basic #
###########################################
Start Visual Basic.
Create a new application.
Draw a button to the form.
Name it btnINIT. Change it's caption to LCD Init.
Draw a second button to the form.
Name it btnTEST. Change it's caption to LCD Test.
Draw a Timer component to the form.
Copy the following code to the code section of form1:
----------------------snip--------------------------------
Option Explicit 'VB programmers rescue
Private Sub btnINIT_Click()
LCDInit 'Call LCD Init
End Sub
Private Sub btnTest_Click()
LCDTest 'call LCD Test
End Sub
Private Sub Form_Load()
Timer1.Enabled = False 'set timer properties
Timer1.Interval = 1
End Sub
Private Sub Timer1_Timer()
Timer1.Enabled = False 'If timer activates:
TimesUp = True 'disable it and set timeup flag
End Sub
----------------------snip--------------------------------
Add a code module to the project.
Copy the following code to it:
----------------------snip--------------------------------
Option Explicit
Public Declare Sub OutPort Lib "directio01" (ByVal Port As Integer, ByVal Value As Byte)
'Declares the OutPort function for direct port I/O from
'external dll 'directio01'. VB cannot access the ports
'and therefore needs a special dll.
'The dll is written in delphi.
Public TimesUp As Boolean
'flag for one-shot timer
Private Data As Byte
Const DataPort = 888 '378 Hex
'This is the port address of lpt1
'use 629 for lpt2 and 956 for lpt3
Private Sub WaitForTimer()
TimesUp = False 'flag false
Form1.Timer1.Enabled = True 'start timer
While TimesUp = False 'time expired ?
DoEvents 'if not, wait
Wend
End Sub
Private Sub Strobe() 'Pushes the data into LCD
Data = Data Or 32 'by toggeling E-Pin
OutPort DataPort, Data
WaitForTimer
Data = Data And 223
OutPort DataPort, Data
End Sub
Public Sub WriteLCD(ByVal LCDvalue As Byte)
Data = Int(LCDvalue \ 16) Or 16 'write high nibble and
Strobe 'low nibble to LCD in
Data = (LCDvalue And 15) Or 16 'data mode
Strobe
End Sub
Private Sub WriteLCDn(ByVal LCDvalue) 'write only low nibble
Data = LCDvalue ' to lcd in command mode
Strobe
End Sub
Public Sub LCDInit()
'General Init. 4Bit, 2(4)Lines, Display on, Cursor off}
WriteLCDn (3)
WaitForTimer
WriteLCDn (3)
WaitForTimer
WriteLCDn (3)
WaitForTimer
WriteLCDn (2)
WaitForTimer
WriteLCDn (2)
WaitForTimer
WriteLCDn (8)
WaitForTimer
WriteLCDn (0)
WaitForTimer
WriteLCDn (8)
WaitForTimer
WriteLCDn (0)
WaitForTimer
WriteLCDn (1)
WaitForTimer
WriteLCDn (0)
WaitForTimer
WriteLCDn (6)
WaitForTimer
WriteLCDn (0)
WaitForTimer
WriteLCDn (12)
WaitForTimer
End Sub
Public Sub LCDSetPos(ByVal X, Y As Byte) 'sets cursor position on LCD
If X <= 19 Then 'change this to 39 if you have a 2 line display
Select Case Y
Case 0
WriteLCDn (8)
WriteLCDn (X)
Case 1
WriteLCDn (12)
WriteLCDn (X)
Case 2
WriteLCDn (9)
WriteLCDn (4 + X)
Case 3
WriteLCDn (13)
WriteLCDn (4 + X)
End Select
End If
End Sub
Public Sub LCDWriteString(ByVal OutStr As String)
Dim i As Integer 'write a string to LCD
For i = 1 To Len(OutStr)
WriteLCD (Abs(Asc(Mid(OutStr, i, 1))))
Next i
End Sub
Public Sub LCDTest() 'write test chars to LCD
LCDSetPos 0, 0
LCDWriteString "ABCDEFGHIJKLMNOPQRST"
LCDSetPos 0, 1
LCDWriteString "UVWXYZabcdefghijklmn"
LCDSetPos 0, 2
LCDWriteString "opqrstuvwxyz01234567"
LCDSetPos 0, 3
LCDWriteString "89!""#$%&()=?+-*/<>:"
'use this for 2 line display:
'LCDSetPos 0, 0
'LCDWriteString "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmn"
'LCDSetPos 0, 1
'LCDWriteString "opqrstuvwxyz0123456789!""#$%&()=?+-*/<>:"
End Sub
----------------------snip--------------------------------
Run the Program.
After power on, the display shows 2 of 4 lines
in grey color (or one of 2 for 2 line display).
After clicking the 'LCD Init' button, the LCD should
clear.
After clicking the 'LCD Test' button, the LCD shows
the following pattern: (4*20 display)
ABCDEFGHIJKLMNOPQRST
UVWXYZabcdefghijklmn
opqrstuvwxyz01234567
89!"#$%&()=?+-*/<>:
or, for 2 line display: (2*40)
ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmn
opqrstuvwxyz0123456789!"#$%&()=?+-*/<>:
If you see nothing, or only scrambled letters,
check all connections.
You'll notice that the letters appear very slow.
This is due to the timer delay in subroutine strobe.
The smallest resolution of the standard timer component
is 55 ms. This is far too slow for our purpose.
Therefore we'll use a better timer in the next examples.
Example2:
Here's a simple program for testing the keypad in Visual Basic.
Look at the download page
##############################################
# Keypad Testing Application in Visual Basic #
##############################################
Start Visual Basic
Generate a new project.
Place a button in the upper left corner of the new form.
Change it's caption to 'A1' and adjust it's size to the caption.
Copy it and paste the copy to the right of the old button.
VB will warn you that another button with the same name exists and ask
you if you want to create a control array. Click 'YES'.
You'll notice that the old button has the index '0' and the new one index
'1'
Copy these two buttons and place the copy to the right of the old ones.
You should now have a row of four buttons, all named 'command1', but with
indices from 0 to 3.
Make a copy of the whole row and paste three copies below the old row.
You should now have a square of 16 buttons with indices from 0 to 15,
arranged like in fig.1
I------------------------I
I (0) (1) (2) (3) I
I I
I (4) (5) (6) (7) I
I I
I (8) (9) (10) (11) I
I I
I (12) (13) (14) (15) I
I------------------------I fig.1
Add a timer component to the form.
Copy the code below to the form's code window.
----------------------snip---------------------------------------------
Option Explicit
Private Declare Sub OutPort Lib "directio01" (ByVal Port As Integer, ByVal Value As Byte)
'Declares the OutPort function for direct port output from
'external dll 'directio01'. VB cannot access the ports
'and therefore needs a special dll.
'The dll is written in delphi.
'Place directio01.dll in your \windows\system subdir
Private Declare Function InPort Lib "directio01" (ByVal Port As Integer) As Byte
'Declares the OutPort function for direct port input from
'external dll 'directio01'.
Const DataPort = 888 '378 Hex
'This is the port address of lpt1
'use 629 for lpt2 and 956 for lpt3
Const StatusPort = DataPort + 1
Const ControlPort = DataPort + 2
Const C0 As Byte = 5, C1 As Byte = 6 'Constant values for accessing
Const C2 As Byte = 0, C3 As Byte = 12 'the bits of the control outputs
Const S3 As Byte = 8, S4 As Byte = 16 'Constant values for accessing
Const S5 As Byte = 32, S6 As Byte = 64 'the bits of the status inputs
Const S7 As Byte = 128
Dim RowArray As Variant
Dim ButtonCaption(0 To 15) As String
Private Sub Command1_Click(Index As Integer)
Command1(Index).Caption = "X" 'Change the pressed button's caption to 'X'
End Sub
Private Sub Form_Load()
Dim i As Integer
RowArray = Array(C0, C1, C2, C3) 'Load array for column output loop
'with defined values
For i = 0 To 3 'Load array for restoring the button
ButtonCaption(i) = "A" + Format(i + 1) 'captions
Next i
For i = 4 To 7
ButtonCaption(i) = "B" + Format(i - 3)
Next i
For i = 8 To 11
ButtonCaption(i) = "C" + Format(i - 7)
Next i
For i = 12 To 15
ButtonCaption(i) = "D" + Format(i - 11)
Next i
End Sub
Private Sub Timer1_Timer() 'every 55ms do:
Dim i, j As Integer
Dim bButton As Byte
For i = 0 To 3 'pull one column after another low,
OutPort ControlPort, RowArray(i)
bButton = InPort(StatusPort) 'then scan row inputs
If (bButton And S4) <> S4 Then 'test if button in row A pressed
Command1(3 - i).Value = True 'if so, trigger it's event
Else
Command1(3 - i).Caption = ButtonCaption(3 - i)
'else restore original caption
End If
If (bButton And S5) <> S5 Then 'same for row B
Command1(7 - i).Value = True
Else
Command1(7 - i).Caption = ButtonCaption(7 - i)
End If
If (bButton And S6) <> S6 Then 'same for row C
Command1(11 - i).Value = True
Else
Command1(11 - i).Caption = ButtonCaption(11 - i)
End If
If (bButton And S7) = S7 Then 'same for row D
Command1(15 - i).Value = True 'S7 is an inverted input
Else
Command1(15 - i).Caption = ButtonCaption(15 - i)
End If
Next i 'pull next column low
'and repeat row testing
End Sub
----------------------snip-------------------------------
Run the Program
The buttons should look like in picture 1.
If you press one button on the keypad, it's corresponding button
on the form changes to an 'X'.
Test all buttons.
picture1
Example3:
Now we'll enhance example2 to play same music and control it with the keypad.
Microsoft active movie must be installed. Win95b and Win98 already have
it. If you use Win95a, then you can get the amovie upgrade for free at www.microsoft.com
If you want to play mp3-wav files, you'll need to install the Microsoft Netshow player.
You can get it for free at www.microsoft.com.
Win98 already has it.
I've included a test file in the archiv at the download section.
##################################################
# Keypad Controlled Media Player in Visual Basic #
##################################################
Start Visual Basic
Load the project from example2.
Add an ActiveMovie control to the form.
Change the 'file' property of the ActiveMovie control to a
WAV file on your local hard disk.
This can be a mp3 file with wav header, if you have an installed mp3
ACM codec.
If you install the free Microsoft Netshow player, it will install such
a codec.
If you don't have a mp3 file with wav header, you can easily create
one from a normal mp3 file. There are several free tools for doing this.
Look at www.mp3.com.
Run the program.
You'll see the active movie player on the form.
If you click the play button, the file will play.
Now we'll add some keypad control.
Add some code to the 'Command1_Click' section:
--------------------------snip--------------------------------------------------
Private Sub Command1_Click(Index As Integer)
Command1(Index).Caption = "X" 'Change the pressed button's caption to 'X'
Select Case Index
Case 0 'If button A1 pressed:
ActiveMovie1.Run 'Run player
Case 1
ActiveMovie1.Stop 'If button B1 pressed:
End Select 'Stop player
End Sub
--------------------------snip---------------------------------------------------
Run the program.
Press the A1 button. The wave file starts playing!
Press the B1 button. It stops !
Gee, this was easy !
Let's add some volume control.
Again, add some code to the 'Command1_Click' section:
--------------------------snip--------------------------------------------------
Private Sub Command1_Click(Index As Integer)
Dim ActVolume As Integer
Command1(Index).Caption = "X" 'Change the pressed button's caption to 'X'
Select Case Index
Case 0 'If button A1 pressed:
ActiveMovie1.Run 'Run player
Case 1 'If button A2 pressed:
ActiveMovie1.Stop 'Stop player
Case 2 'If button A3 pressed:
ActVolume = ActiveMovie1.Volume + 100 'Increase volume
If ActVolume > 0 Then ActVolume = 0
ActiveMovie1.Volume = ActVolume
Case 3 'If button A4 pressed:
ActVolume = ActiveMovie1.Volume - 100 'Decrease volume
If ActVolume < -9460 Then ActVolume = -9460
ActiveMovie1.Volume = ActVolume
End Select
End Sub
--------------------------snip--------------------------------------------------
Run the program and start playing.
Change the volume with the A3 and A4 buttons.
Example4:
A test program for Graphic XIMP. If a button is pressed, its number in the display is inverted
Please note that this is a quick'n dirty hack for a 128*128 display.
For other geometries, you'll have to adjust the text and graphic area settings in the T6963_2 unit.
###########################################
# Keyboard and LCD Test in Borland Pascal #
###########################################
program lcdtest1;
Uses Dos, Crt, Graph, T6963_2;
var i,j,k,w : Word;
d, Value : Byte;
grDriver : Integer;
grMode : Integer;
ErrCode : Integer;
X0, X1, X2 : Integer;
Y0, Y1, Y2 : Integer;
ValueS : String;
Buffer, Name : String;
x,y : Byte;
OldValue : Byte;
fColor : Word;
{###########################################################################}
Begin
ClrScr;
grDriver := Detect;
InitGraph(grDriver, grMode,'');
ErrCode := GraphResult;
if ErrCode = grOk then
begin
Rectangle(0,0,127,127);
SetTextStyle(SmallFont, HorizDir, 4);
OuttextXY(4,113,'>>> Keyboard Test <<<');
for j := 1 to 4 do
for i := 1 to 4 do
Begin
circle (i*25,j*25,10);
str(j,Buffer);
Name := Buffer;
str(i,Buffer);
Name := Name + Buffer;
OutTextXY(i*25-5,j*25-6, Name);
End;
Screen2LCD;
While Keypressed do readkey;
OldValue := 0;
FColor := getcolor;
Repeat
Value := Readkeys;
if Value > 0 Then
Begin
str(Value,Name);
y := Value div 10;
x := Value - y * 10;
PieSlice(x*25, y*25, 0, 360, 10);
SetColor(0);
OutTextXY(x*25-5, y*25-6, Name);
SetColor(FColor);
Screen2LCD;
OldValue := Value;
End;
Until Keypressed;
While Keypressed do Readkey;
CloseGraph;
LCDClear;
end
else Writeln('Graphics error:', GraphErrorMsg(ErrCode));
end.
---------------------------------------------------------------------
Here's the Unit T6963_2 that controlls the display.
It contains a status check routine for the T6963's status registers, but this is never
used.
I've found that a PC's printer port is simply not fast enough to overclock the T6963, so
I leaved the busy check out.
####################################
# T6963 routines in Borland Pascal #
####################################
Unit T6963_2;
INTERFACE
Procedure LCDClear;
Procedure Screen2LCD;
Function ReadKeys: Byte;
Procedure TextTest;
Procedure GraphTest;
Procedure LCDTextClear;
Procedure LCDGraphClear;
IMPLEMENTATION
Uses Graph, Crt;
Type HiLo = (H, L);
RW = (Read, Write);
const
Data = $378;
Status = Data + 1;
Control = Data + 2;
var i,j,k,w : Word;
d, OldValue : Byte;
grDriver: Integer;
grMode : Integer;
ErrCode : Integer;
X0, X1, X2 : Integer;
Y0, Y1, Y2 : Integer;
OldValueS : String;
Puffer, Name : String;
x,y : Byte;
fColor : Word;
{***************************************************************************}
Procedure CE (Value:HiLo); {/CE is connected to C0-}
Begin
If Value = H Then Port[Control] := Port[Control] AND (Not 1)
else Port[Control] := Port[Control] OR 1;
End;
Procedure RD (Value: HiLo); {/RD is connected to C1-}
Begin
If Value = H Then Port[Control] := Port[Control] AND (Not 2)
else Port[Control] := Port[Control] OR 2;
End;
Procedure WR (Value: HiLo); {/WR is connected to C2+}
Begin
If Value = L Then Port[Control] := Port[Control] AND (Not 4)
else Port[Control] := Port[Control] OR 4;
End;
Procedure CD (Value: HiLo); {/CD is connected to C3-}
Begin
If Value = H Then Port[Control] := Port[Control] AND (Not 8)
else Port[Control] := Port[Control] OR 8;
End;
Procedure LPTMode (Mode: RW);
Begin
If Mode = Write Then Port[Control] := Port[Control] AND (Not 32)
Else Port[Control] := Port[Control] OR 32;
End;
{***************************************************************************}
Procedure Init;
Begin
LPTMode(Write);
CE(H);
RD(H);
WR(H);
CD(H);
End;
{***************************************************************************}
Procedure CheckStatus;
Var StatusByte: Byte;
Begin
Repeat
Delay(1);
LPTMode(Read);
CD(H);
WR(H);
CE(L);
RD(L);
StatusByte := Port[Data];
RD(H);
CE(H);
Until ((StatusByte AND 1) = 1) AND ((StatusByte AND 2) = 2);
LPTMode(Write);
End;
{***************************************************************************}
Procedure WriteData (DataByte: Byte);
Begin
LPTMode(Write);
CD(L);
Port[Data] := Databyte;
CE(L);
WR(L);
WR(H);
CE(H);
CD(H);
End;
{***************************************************************************}
Procedure WriteCommand (CommandByte: Byte);
Begin
LPTMode(Write);
CD(H);
Port[Data] := CommandByte;
CE(L);
WR(L);
WR(H);
CE(H);
End;
{***************************************************************************}
Procedure InitT6963;
Begin
Init;
WriteCommand(128+32+16+2); {Auto Mode Off}
WriteData($00); {Text Home Address 0780h}
WriteData($00);
WriteCommand($40);
WriteData($10); {Text Area for 128*128}
WriteData($00);
WriteCommand($41);
WriteData($00); {Grapic Home Address}
WriteData($02);
WriteCommand($42);
WriteData($10); {Graphic Area for 128*128}
WriteData($00);
WriteCommand($43);
WriteCommand($81); {EXOR Text Mode}
WriteData($00); {Address Pointer Set}
WriteData($00);
WriteCommand($24);
WriteCommand(97); {Cursor On, Blink On}
WriteData(0);
WriteData(0);
WriteCOmmand(33);
writecommand(7+32+128);
writecommand(147);
WriteCommand($98+4); {Set Display Mode (graphics only)}
End;
{***************************************************************************}
Function ReadKeys: Byte;
var OldValue: Byte;
Maske, Eins : Byte;
Begin
Init;
Eins := 1;
For i := 1 to 4 Do
Begin
Port[Data] := (Not Eins);
OldValue := Port[Status];
If (OldValue AND 16) <> 16 Then Begin ReadKeys := i+10; Exit; End; {S4+}
If (OldValue AND 32) <> 32 Then Begin ReaDKeys := i+20; Exit; End; {S5+}
If (OldValue AND 64) <> 64 Then Begin ReaDKeys := i+30; Exit; End; {S6+}
If (OldValue AND 128) = 128 Then Begin ReaDKeys := i+40; Exit; End; {S7-}
Eins := Eins shl 1;
End;
ReadKeys := 0;
End;
{***************************************************************************}
Procedure Screen2LCD;
var Maske,x,y,z: Byte;
Begin
WriteData($00); {Address Pointer Set}
WriteData($02);
WriteCommand($24);
WriteCommand($B0); {Data Auto Write On}
LPTMode(Write);
CD(L);
CE(L);
for y := 0 to 127 do
for x := 0 to 15 do
Begin
OldValue := 0;
Maske := 128;
for z := 0 to 7 do
Begin
If GetPixel (x*8+z,y) <> 0 Then OldValue := OldValue + Maske;
Maske := Maske shr 1;
End;
Port[Data] := OldValue;
WR(L);
WR(H);
End;
CE(H);
CD(H);
WriteCommand(128+32+16+2); {Auto Mode Off}
End;
{***************************************************************************}
Procedure LCDClearSlow;
Begin
WriteCommand($B0); {Data Auto Write On}
WriteData($00); {Address Pointer Set}
WriteData($00);
WriteCommand($24);
For i := 0 to 2047 do WriteData(0);
WriteCommand(128+32+16+2); {Auto Mode Off}
End;
{***************************************************************************}
Procedure LCDGraphClear;
Begin
WriteData($00); {Address Pointer Set}
WriteData($02);
WriteCommand($24);
WriteCommand($B0); {Data Auto Write On}
LPTMode(Write);
CD(L);
CE(L);
For i := 0 to 2047 do
Begin
Port[Data] := 0;
WR(L);
WR(H);
End;
CE(H);
CD(H);
WriteCommand(128+32+16+2); {Auto Mode Off}
End;
Procedure LCDTextClear;
Begin
WriteData($00); {Address Pointer Set}
WriteData($00);
WriteCommand($24);
WriteCommand($B0); {Data Auto Write On}
LPTMode(Write);
CD(L);
CE(L);
For i := 0 to 255 do
Begin
Port[Data] := 0;
WR(L);
WR(H);
End;
CE(H);
CD(H);
WriteCommand(128+32+16+2); {Auto Mode Off}
End;
Procedure LCDClear;
Begin
LCDTextClear;
LCDGraphClear;
End;
{***************************************************************************}
Procedure TextTest;
Begin
WriteData($00); {Address Pointer Set}
WriteData($00);
WriteCommand($24);
WriteCommand($B0);
for j:= 1 to 2 do
for i := 0 to 127 do Begin WriteData(i); End;
WriteCommand(128+32+16+2); {Auto Mode Off}
End;
Procedure GraphTest;
Begin
WriteData($00); {Address Pointer Set}
WriteData($02);
WriteCommand($24);
WriteCommand($B0);
for i := 0 to 2047 do Begin WriteData(255); End;
WriteCommand(128+32+16+2); {Auto Mode Off}
End;
{***************************************************************************}
Begin
InitT6963;
LCDClear;
End
.
------------------------------------------------------------------------------------
Example5:
A test program for Graphic XIMP. Shows Text and Graphics mixing capabilities of T6963.
Please note that this is a quick'n dirty hack for a 128*128 display.
For other geometries, you'll have to adjust the text and graphic area settings in the T6963_2 unit.
####################################################
# LCD Text & Graphic mixing Test in Borland Pascal #
####################################################
program test1;
Uses T6963_2, crt, Graph;
var grDriver: Integer;
grMode : Integer;
ErrCode : Integer;
Procedure WaitForKey;
Begin
While keypressed do readkey;
repeat until keypressed;
while keypressed do readkey;
End;
procedure LineToPlay;
{ Demonstrate MoveTo and LineTo commands }
const
MaxPoints = 15;
var
Points : array[0..MaxPoints] of PointType;
ViewInfo : ViewPortType;
I, J : integer;
CenterX : integer; { The center point of the circle }
CenterY : integer;
Radius : word;
StepAngle : word;
Xasp, Yasp : word;
Radians : real;
function AdjAsp(Value : integer) : integer;
{ Adjust a value for the aspect ratio of the device }
begin
AdjAsp := (LongInt(Value) * Xasp) div Yasp;
end; { AdjAsp }
begin
GetAspectRatio(Xasp, Yasp);
GetViewSettings(ViewInfo);
with ViewInfo do
begin
CenterX := (x2-x1) div 2;
CenterY := (y2-y1) div 2;
Radius := CenterY;
while (CenterY+AdjAsp(Radius)) < (y2-y1)-20 do
Inc(Radius);
end;
StepAngle := 360 div MaxPoints;
for I := 0 to MaxPoints - 1 do
begin
Radians := (StepAngle * I) * Pi / 180;
Points[I].X := CenterX + round(Cos(Radians) * Radius);
Points[I].Y := CenterY - AdjAsp(round(Sin(Radians) * Radius));
end;
Circle(CenterX, CenterY, Radius);
for I := 0 to MaxPoints - 1 do
begin
for J := I to MaxPoints - 1 do
begin
MoveTo(Points[I].X, Points[I].Y);
LineTo(Points[J].X, Points[J].Y);
end;
end;
end; { LineToPlay }
Begin
TextTest;
WaitForKey;
GraphTest;
WaitForKey;
LCDGraphClear;
grDriver := Detect;
InitGraph(grDriver, grMode,'');
ErrCode := GraphResult;
if ErrCode = grOk then
begin { Do graphics }
SetViewPort (0,0,127,127,clipon);
LineToPlay;
Screen2LCD;
WaitForKey;
LCDTextClear;
WaitForKey;
CloseGraph;
LCDClear;
end;
End.
----------------------------------------------------------------------------------
