roka/bds.mr.devmgr
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial check in

Browse Source
This commit is contained in:
Abu Abacus
2026-01-03 18:53:14 +01:00
commit b9305ab8af
36 changed files with 6720 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src.devmgr/dev/usb/trinity/modules/lcd/m.lcd.pas
+187
View File
@@ -0,0 +1,187 @@
unit m.lcd;
interface
uses
m.base,
m.lcd.types;
type
TmodLCD = class( TmodBase, ILCD)
// ------------------------------------------------------------
// ILCD
// ------------------------------------------------------------
protected
procedure Cls;
procedure GotoXY( x,y: word);
procedure putc( const c: AnsiChar );
procedure puts( const s: AnsiString);
end;
implementation
uses
Windows;
function CyWORD( value: word): word;
begin
result := (LoByte(value) shl 8) or HiByte(value);
end;
{ TmodLCD }
// @@@: ILCD ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// ILCD
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// cls
// ================================================================================================
procedure TmodLCD.Cls;
var
cnt : cardinal;
begin
if Assigned(fDevice) then
begin
with fDevice do
begin
if (VendorID = $16d0) and (ProductID = $0712) then
begin
cnt := 0;
Pipe0.Transfer( $00, // OUT
LCD_CLS, // cls
$0000, // Value (not used)
$0000, // Index (not used)
$0000, // Length (not used)
nil, // Buffer to receive data
0, // Length of buffer
cnt, // Transferred bytes
nil) // Overlapped (not used)
end;
end
end
else
// raise
end;
// ================================================================================================
// gotoxy
// ================================================================================================
procedure TmodLCD.GotoXY(x, y: word);
var
cnt : cardinal;
w : word;
begin
if Assigned(fDevice) then
begin
with fDevice do
begin
if (VendorID = $16d0) and (ProductID = $0712) then
begin
cnt := 0;
w := CyWord((x shl 8) +y);
Pipe0.Transfer( $00, // OUT
LCD_GOTOXY, //
w, // Value (not used)
$0000, // Index (not used)
$0000, // Length (not used)
nil, // Buffer to receive data
0, // Length of buffer
cnt, // Transferred bytes
nil) // Overlapped (not used)
end;
end
end
else
// raise
end;
// ================================================================================================
// putc
// ================================================================================================
procedure TmodLCD.putc(const c: AnsiChar);
var
cnt : cardinal;
w : word;
begin
if Assigned(fDevice) then
begin
with fDevice do
begin
if (VendorID = $16d0) and (ProductID = $0712) then
begin
cnt := 0;
w := CyWord(ord(c));
Pipe0.Transfer( $00, // OUT
LCD_PUTC, //
w, // Value (not used)
$0000, // Index (not used)
$0000, // Length (not used)
nil, // Buffer to receive data
0, // Length of buffer
cnt, // Transferred bytes
nil) // Overlapped (not used)
end;
end
end
else
// raise
end;
// ================================================================================================
// puts
// ================================================================================================
procedure TmodLCD.puts(const s: AnsiString);
var
cnt : cardinal;
buf : array [0..31] of AnsiChar;
begin
if Length(s) > 0 then
if Assigned(fDevice) then
begin
with fDevice do
begin
if (VendorID = $16d0) and (ProductID = $0712) then
begin
Windows.ZeroMemory(@buf[0],32);
cnt := 0;
buf[0] := '%';
Pipe0.Transfer( $00, // OUT
LCD_PUTS, //
$0000, // Value (not used)
$0000, // Index (not used)
32, // Length (not used)
@buf, // Buffer data to send
32, // Length of buffer
cnt, // Transferred bytes
nil) // Overlapped (not used)
end;
end
end
else
// raise
end;
end.