Example projects renamed, simplified and formatted to the Borland/Embarcadero style

This commit is contained in:
2020-05-10 21:38:18 +03:00
parent 8b9324a6ce
commit db03f7a14a
56 changed files with 1128 additions and 1529 deletions

View File

@@ -0,0 +1,58 @@
program ColorButtons;
uses
KolibriOS;
const
COLOR_BLUE = $000000FF;
COLOR_RED = $00FF0000;
COLOR_GREEN = $0000FF00;
COLOR_BLACK = $00000000;
BLACK_BUTTON = 1000;
BLUE_BUTTON = 2000;
GREEN_BUTTON = 3000;
RED_BUTTON = 4000;
var
Left, Right, Top, Bottom: Integer;
begin
with GetScreenSize do
begin
Right := Width div 4;
Bottom := Height div 4;
Left := (Width - Right) div 2;
Top := (Height - Bottom) div 2;
end;
while True do
case WaitEvent of
REDRAW_EVENT:
begin
BeginDraw;
DrawWindow(Left, Top, Right, Bottom, 'Color Buttons', $00FFFFFF,
WS_SKINNED_FIXED + WS_COORD_CLIENT + WS_CAPTION, CAPTION_MOVABLE);
DrawButton(10, 20, 50, 30, COLOR_RED, 0, RED_BUTTON);
DrawButton(70, 20, 50, 30, COLOR_GREEN, 0, GREEN_BUTTON);
DrawButton(10, 60, 50, 30, COLOR_BLUE, 0, BLUE_BUTTON);
DrawButton(70, 60, 50, 30, COLOR_BLACK, 0, BLACK_BUTTON);
EndDraw;
end;
KEY_EVENT:
GetKey;
BUTTON_EVENT:
case GetButton.ID of
BLUE_BUTTON:
SetWindowCaption('Blue');
GREEN_BUTTON:
SetWindowCaption('Green');
RED_BUTTON:
SetWindowCaption('Red');
BLACK_BUTTON:
SetWindowCaption('Black');
1:
TerminateThread;
end;
end;
end.

View File

@@ -0,0 +1,54 @@
program DateTime;
uses
KolibriOS;
var
hConsole: Pointer;
ConsoleInit: procedure(WndWidth, WndHeight, ScrWidth, ScrHeight: LongWord; Caption: PChar); stdcall;
ConsoleExit: procedure(bCloseWindow: Cardinal); stdcall;
Printf: function(const Format: PChar): Integer; cdecl varargs;
GetConsoleCursorPos: procedure(X, Y: PInteger); stdcall;
SetConsoleCursorPos: procedure(X, Y: Integer); stdcall;
kbhit: function: Boolean;
SetConsoleCursorHeight: function(Height: Integer): Integer; stdcall;
// ConsoleCls: procedure;
SystemDate: TSystemDate;
SystemTime: TSystemTime;
X, Y: Integer;
begin
hConsole := LoadLibrary('/sys/lib/console.obj');
ConsoleInit := GetProcAddress(hConsole, 'con_init');
ConsoleExit := GetProcAddress(hConsole, 'con_exit');
GetConsoleCursorPos := GetProcAddress(hConsole, 'con_get_cursor_pos');
SetConsoleCursorPos := GetProcAddress(hConsole, 'con_set_cursor_pos');
SetConsoleCursorHeight := GetProcAddress(hConsole, 'con_set_cursor_height');
Printf := GetProcAddress(hConsole, 'con_printf');
KBHit := GetProcAddress(hConsole, 'con_kbhit');
ConsoleInit($FFFFFFFF, $FFFFFFFF, $FFFFFFFF, $FFFFFFFF, 'Date/Time');
SetConsoleCursorHeight(0);
SetConsoleCursorPos(27, 11);
Printf(
'SystemDate and SystemTime'#10 +
' '
);
GetConsoleCursorPos(@X, @Y);
repeat
SystemDate := GetSystemDate;
SystemTime := GetSystemTime;
with SystemDate, SystemTime do
begin
Printf('%02x.%02x.%02x', Day, Month, Year);
Printf(' - %02x:%02x:%02x', Hours, Minutes, Seconds);
end;
SetConsoleCursorPos(X, Y);
Sleep(50);
until KBHit;
ConsoleExit(1);
TerminateThread;
end.

View File

@@ -0,0 +1,95 @@
program DrawImageApp;
uses
KolibriOS;
const
AppPath = PPChar(32);
type
THeader = packed record
IDLength: Byte;
ColorMapType: Byte;
ImageType: Byte;
CMapStart: Word;
CMapLength: Word;
CMapDepth: Byte;
XOffset: Word;
YOffset: Word;
Width: Word;
Height: Word;
PixelDepth: Byte;
ImageDescriptor: Byte;
end;
PTargaFile = ^TTargaFile;
TTargaFile = packed record
Header: THeader;
end;
procedure ExtractFileDirectory(Source, Dest: PChar); stdcall;
asm
PUSH ESI
PUSH EDI
XOR EAX, EAX
MOV EDI, Source
MOV ESI, EDI
MOV ECX, $FFFFFFFF
REPNE SCASB
MOV AL, '/'
STD
REPNE SCASB
CLD
SUB EDI, ESI
MOV ECX, EDI
INC ECX
MOV EDI, Dest
REP MOVSB
MOV byte [EDI], 0
POP EDI
POP ESI
end;
var
Left, Right, Top, Bottom: Integer;
TargaFile: PTargaFile;
Image: Pointer;
FileSize: LongWord;
begin
HeapCreate;
ExtractFileDirectory(AppPath^, AppPath^);
SetCurrentDirectory(AppPath^);
TargaFile := LoadFile('Lena.tga', FileSize);
with TargaFile^ do
Image := Pointer(PChar(TargaFile) + SizeOf(Header) + Header.IDLength);
with GetScreenSize do
begin
Right := Width div 4;
Bottom := Height div 4;
Left := (Width - Right) div 2;
Top := (Height - Bottom) div 2;
end;
while True do
case WaitEvent of
REDRAW_EVENT:
begin
BeginDraw;
DrawWindow(Left, Top, Right, Bottom, 'Draw Image', $00FFFFFF,
WS_SKINNED_FIXED + WS_COORD_CLIENT + WS_CAPTION, CAPTION_MOVABLE);
with TargaFile.Header do
DrawImage(Image^, 30, 20, Width, Height);
EndDraw;
end;
KEY_EVENT:
GetKey;
BUTTON_EVENT:
if GetButton.ID = 1 then
TerminateThread;
end;
end.

View File

Before

Width:  |  Height:  |  Size: 9.5 KiB

After

Width:  |  Height:  |  Size: 9.5 KiB

View File

@@ -0,0 +1,153 @@
program DrawImageExApp;
uses
KolibriOS;
const
AppPath = PPChar(32);
Picture1 = 'Flower(4bpp).bmp';
Picture2 = 'Mario(1bpp).bmp';
Picture3 = 'House(24bpp).bmp';
type
TBitmapFileHeader = packed record
bfType: Word;
bfSize: LongWord;
bfReserved1: Word;
bfReserved2: Word;
bfOffBits: LongWord;
end;
TBitmapInfoHeader = packed record
biSize: LongWord;
biWidth: LongInt;
biHeight: LongInt;
biPlanes: Word;
biBitCount: Word;
biCompression: LongWord;
biSizeImage: LongWord;
biXPelsPerMeter: LongInt;
biYPelsPerMeter: LongInt;
biClrUsed: LongWord;
biClrImportant: LongWord;
end;
TRGBQuad = packed record
Blue: Byte;
Green: Byte;
Red: Byte;
Reserved: Byte;
end;
PBitmapFile = ^TBitmapFile;
TBitmapFile = packed record
BitmapFileHeader: TBitmapFileHeader;
BitmapInfoHeader: TBitmapInfoHeader;
Palette: array[0..0] of TRGBQuad;
end;
procedure ExtractFileDirectory(Src, Dst: PChar); stdcall;
asm
PUSH ESI
PUSH EDI
XOR EAX, EAX
MOV EDI, Src
MOV ESI, EDI
MOV ECX, $FFFFFFFF
REPNE SCASB
MOV AL, '/'
STD
REPNE SCASB
CLD
SUB EDI, ESI
MOV ECX, EDI
INC ECX
MOV EDI, Dst
REP MOVSB
MOV BYTE [EDI], 0
POP EDI
POP ESI
end;
var
Left, Right, Top, Bottom: Integer;
BitmapFile1, BitmapFile2, BitmapFile3: PBitmapFile;
Image1, Image2, Image3: Pointer;
Padding1, Padding2, Padding3: LongWord;
BytesRead: LongWord;
FileAttributes: TFileAttributes;
begin
HeapCreate;
ExtractFileDirectory(AppPath^, AppPath^);
SetCurrentDirectory(AppPath^);
GetFileAttributes(Picture1, FileAttributes);
BitmapFile1 := HeapAllocate(FileAttributes.SizeLo);
ReadFile(Picture1, BitmapFile1^, FileAttributes.SizeLo, 0, 0, BytesRead);
with BitmapFile1^, BitmapFileHeader, BitmapInfoHeader do
begin
Padding1 := (32 - biWidth * biBitCount mod 32) and not 32 div 6;
Image1 := Pointer(LongWord(BitmapFile1) + bfOffBits);
end;
GetFileAttributes(Picture2, FileAttributes);
BitmapFile2 := HeapAllocate(FileAttributes.SizeLo);
ReadFile(Picture2, BitmapFile2^, FileAttributes.SizeLo, 0, 0, BytesRead);
with BitmapFile2^, BitmapFileHeader, BitmapInfoHeader do
begin
Padding2 := (32 - biWidth * biBitCount mod 32) and not 32 div 6;
Image2 := Pointer(LongWord(BitmapFile2) + bfOffBits);
end;
GetFileAttributes(Picture3, FileAttributes);
BitmapFile3 := HeapAllocate(FileAttributes.SizeLo);
ReadFile(Picture3, BitmapFile3^, FileAttributes.SizeLo, 0, 0, BytesRead);
with BitmapFile3^, BitmapFileHeader, BitmapInfoHeader do
begin
Padding3 := (32 - biWidth * biBitCount mod 32) and not 32 div 6;
Image3 := Pointer(LongWord(BitmapFile3) + bfOffBits);
end;
with GetScreenSize do
begin
Right := Width div 4;
Bottom := Height div 4;
Left := (Width - Right) div 2;
Top := (Height - Bottom) div 2;
end;
while True do
case WaitEvent of
REDRAW_EVENT:
begin
BeginDraw;
DrawWindow(Left, Top, Right, Bottom, 'Draw Image Extended', $00FFFFFF,
WS_SKINNED_FIXED + WS_COORD_CLIENT + WS_CAPTION, CAPTION_MOVABLE);
(* these image files was saved with 'flip row order' parameter *)
(* therefore they have negative biHeight field *)
(* also it is possible to use Nil instead of @Palette if you sure palette is absent *)
with BitmapFile1^, BitmapFileHeader, BitmapInfoHeader do
DrawImageEx(Image1^, 20, 35, biWidth, -biHeight, biBitCount, @Palette, Padding1);
with BitmapFile2^, BitmapFileHeader, BitmapInfoHeader do
DrawImageEx(Image2^, 120, 35, biWidth, -biHeight, biBitCount, @Palette, Padding2);
with BitmapFile3^, BitmapFileHeader, BitmapInfoHeader do
DrawImageEx(Image3^, 220, 45, biWidth, -biHeight, biBitCount, @Palette, Padding3);
EndDraw;
end;
KEY_EVENT:
GetKey;
BUTTON_EVENT:
if GetButton.ID = 1 then
TerminateThread;
end;
end.

View File

Before

Width:  |  Height:  |  Size: 4.4 KiB

After

Width:  |  Height:  |  Size: 4.4 KiB

View File

Before

Width:  |  Height:  |  Size: 19 KiB

After

Width:  |  Height:  |  Size: 19 KiB

View File

Before

Width:  |  Height:  |  Size: 1.2 KiB

After

Width:  |  Height:  |  Size: 1.2 KiB

View File

@@ -0,0 +1,48 @@
program DrawTextApp;
uses
KolibriOS;
var
Left, Right, Top, Bottom, CurX, CurY: Integer;
Key: TKeyboardInput;
begin
with GetScreenSize do
begin
Right := Width div 4;
Bottom := Height div 4;
Left := (Width - Right) div 2;
Top := (Height - Bottom) div 2;
end;
CurX := 0;
CurY := 0;
while True do
case WaitEvent of
REDRAW_EVENT:
begin
CurX := 0;
CurY := 0;
BeginDraw;
DrawWindow(Left, Top, Right, Bottom, 'Get Key', $00FFFFFF,
WS_SKINNED_FIXED + WS_COORD_CLIENT + WS_CAPTION, CAPTION_MOVABLE);
EndDraw;
end;
KEY_EVENT:
begin
Key := GetKey;
DrawText(CurX, CurY, @Key.Code, $00000000, $00FFFFFF, 0, 1);
Inc(CurX, 6);
if CurX > 100 then
begin
Inc(CurY, 10);
CurX := 0;
end;
end;
BUTTON_EVENT:
if GetButton.ID = 1 then
TerminateThread;
end;
end.

View File

@@ -0,0 +1,63 @@
#------------------------------------------------------------------------------
VERSION = BWS.01
#------------------------------------------------------------------------------
!ifndef ROOT
ROOT = $(MAKEDIR)\..
!endif
#------------------------------------------------------------------------------
MAKE = $(ROOT)\bin\make.exe -$(MAKEFLAGS) -f$**
DCC = $(ROOT)\bin\dcc32.exe $**
BRCC = $(ROOT)\bin\brcc32.exe $**
#------------------------------------------------------------------------------
PROJECTS = ColorButtons.exe DateTime.exe DrawImage.exe DrawImageEx.exe DrawText.exe GetCurrentDirectory.exe GetPixel.exe \
GetPointOwner.exe Hello.exe LoadFile.exe ReadFolder.exe Screenshot.exe SetCursor.exe SetPixel.exe SetWindowPos.exe
#------------------------------------------------------------------------------
default: $(PROJECTS)
#------------------------------------------------------------------------------
ColorButtons.exe: ColorButtons\ColorButtons.dpr
$(DCC)
DateTime.exe: DateTime\DateTime.dpr
$(DCC)
DrawImage.exe: DrawImage\DrawImage.dpr
$(DCC)
DrawImageEx.exe: DrawImageEx\DrawImageEx.dpr
$(DCC)
DrawText.exe: DrawText\DrawText.dpr
$(DCC)
GetCurrentDirectory.exe: GetCurrentDir\GetCurrentDir.dpr
$(DCC)
GetPixel.exe: GetPixel\GetPixel.dpr
$(DCC)
GetPointOwner.exe: GetPointOwner\GetPointOwner.dpr
$(DCC)
Hello.exe: Hello\Hello.dpr
$(DCC)
LoadFile.exe: LoadFile\LoadFile.dpr
$(DCC)
ReadFolder.exe: ReadFolder\ReadFolder.dpr
$(DCC)
Screenshot.exe: Screenshot\Screenshot.dpr
$(DCC)
SetCursor.exe: SetCursor\SetCursor.dpr
$(DCC)
SetPixel.exe: SetPixel\SetPixel.dpr
$(DCC)
SetWindowPos.exe: SetWindowPos\SetWindowPos.dpr
$(DCC)

View File

@@ -0,0 +1,36 @@
program GetCurrentDir;
uses
KolibriOS;
const
AppPath = PPChar(32);
CmdLine = PPChar(28);
BUFFER_SIZE = 256;
var
hConsole: Pointer;
ConsoleInit: procedure(WndWidth, WndHeight, ScrWidth, ScrHeight: LongWord; Caption: PChar); stdcall;
ConsoleExit: procedure(bCloseWindow: Cardinal); stdcall;
printf: function(const Format: PChar): Integer; cdecl varargs;
Buffer: array[0..BUFFER_SIZE - 1] of Char;
begin
hConsole := LoadLibrary('/sys/lib/console.obj');
ConsoleInit := GetProcAddress(hConsole, 'con_init');
ConsoleExit := GetProcAddress(hConsole, 'con_exit');
printf := GetProcAddress(hConsole, 'con_printf');
ConsoleInit($FFFFFFFF, $FFFFFFFF, $FFFFFFFF, $FFFFFFFF, 'Test');
GetCurrentDirectory(Buffer, BUFFER_SIZE);
printf('AppPath is "%s"'#10, AppPath^);
printf('CmdLine is "%s"'#10, CmdLine^);
printf('CurrentDirectory is "%s"'#10, Buffer);
ConsoleExit(0);
TerminateThread;
end.

View File

@@ -0,0 +1,58 @@
program GetPixelApp;
uses
KolibriOS;
var
Window, Rectangle: TRect;
Point: TPoint;
begin
with Window, GetScreenSize do
begin
Right := Width div 4;
Bottom := Height div 4;
Left := (Width - Right) div 2;
Top := (Height - Bottom) div 2;
end;
with Rectangle do
begin
Left := 10;
Top := 10;
Right := Window.Right - 20;
Bottom := Window.Bottom - 40;
end;
SetEventMask(EM_REDRAW + EM_BUTTON + EM_MOUSE);
while True do
case WaitEvent of
REDRAW_EVENT:
begin
BeginDraw;
with Window do
DrawWindow(Left, Top, Right, Bottom, 'Get Pixel', $00FFFFFF,
WS_SKINNED_FIXED + WS_COORD_CLIENT + WS_CAPTION, CAPTION_MOVABLE);
with Rectangle do
begin
DrawLine(Left, Top, Left, Bottom, 0);
DrawLine(Right, Top, Right, Bottom, 0);
DrawLine(Left, Top, Right, Top, 0);
DrawLine(Left, Bottom, Right, Bottom, 0);
end;
EndDraw;
end;
MOUSE_EVENT:
begin
Point := GetMousePos;
with Rectangle, Point do
DrawRectangle(Left + 1, Top + 1, Right - Left - 1, Bottom - Top - 1, GetPixel(X, Y));
end;
BUTTON_EVENT:
if GetButton.ID = 1 then
TerminateThread;
end;
end.

View File

@@ -0,0 +1,64 @@
program GetPointOwnerApp;
uses
KolibriOS;
procedure UpdateInfo;
const
CHAR_WIDTH = 8;
CHAR_HEIGHT = 16;
var
MousePos: TPoint;
ID: LongWord;
ThreadInfo: TThreadInfo;
I: LongWord;
begin
MousePos := GetMousePos;
with MousePos do
ID := GetPointOwner(X, Y);
GetThreadInfo(ID, ThreadInfo);
(* get length of current name *)
I := 0;
while ThreadInfo.Name[I] <> #0 do
Inc(I);
(* clear unnecessary part of possible previous name by white rectangle *)
DrawRectangle(64 + I * CHAR_WIDTH, 16, (SizeOf(ThreadInfo.Name) - I) * CHAR_WIDTH, CHAR_HEIGHT, $00FFFFFF);
(* draw current name *)
DrawText(64, 16, ThreadInfo.Name, $00000000, $00FFFFFF, DT_CP866_8X16 + DT_FILL_OPAQUE + DT_ZSTRING, 0);
end;
const
NO_EVENT = 0;
var
Left, Top, Width, Height: Integer;
Screen: TSize;
begin
Screen := GetScreenSize;
Width := 189;
Height := 79;
Left := (Screen.Width - Width) div 2;
Top := (Screen.Height - Height) div 2;
SetEventMask(EM_BUTTON + EM_REDRAW);
while True do
case WaitEventByTime(5) of
REDRAW_EVENT:
begin
BeginDraw;
DrawWindow(Left, Top, Width, Height, 'Get Point Owner', $00FFFFFF,
WS_SKINNED_FIXED + WS_COORD_CLIENT + WS_CAPTION, CAPTION_MOVABLE);
DrawText(16, 16, 'Name:', $00000000, $00FFFFFF, DT_CP866_8X16 + DT_ZSTRING, 0);
EndDraw;
end;
BUTTON_EVENT:
if GetButton.ID = 1 then
TerminateThread;
NO_EVENT:
UpdateInfo;
end;
end.

View File

@@ -0,0 +1,33 @@
program Hello;
uses
KolibriOS;
var
Left, Right, Top, Bottom: Integer;
begin
with GetScreenSize do
begin
Right := Width div 4;
Bottom := Height div 4;
Left := (Width - Right) div 2;
Top := (Height - Bottom) div 2;
end;
while True do
case WaitEvent of
REDRAW_EVENT:
begin
BeginDraw;
DrawWindow(Left, Top, Right, Bottom, 'Hello!', $00FFFFFF,
WS_SKINNED_FIXED + WS_COORD_CLIENT + WS_CAPTION, CAPTION_MOVABLE);
EndDraw;
end;
KEY_EVENT:
GetKey;
BUTTON_EVENT:
if GetButton.ID = 1 then
TerminateThread;
end;
end.

View File

@@ -0,0 +1,28 @@
program LoadFileApp;
uses
KolibriOS;
var
hConsole: Pointer;
ConsoleInit: procedure(WndWidth, WndHeight, ScrWidth, ScrHeight: LongWord; Caption: PChar); stdcall;
ConsoleExit: procedure(bCloseWindow: Cardinal); stdcall;
WriteN: procedure(Str: PChar; Count: LongWord); stdcall;
FileSize: LongWord;
Buffer: Pointer;
begin
hConsole := LoadLibrary('/sys/lib/console.obj');
ConsoleInit := GetProcAddress(hConsole, 'con_init');
ConsoleExit := GetProcAddress(hConsole, 'con_exit');
WriteN := GetProcAddress(hConsole, 'con_write_string');
ConsoleInit($FFFFFFFF, $FFFFFFFF, $FFFFFFFF, $FFFFFFFF, 'Test');
Buffer := LoadFile('/sys/example.asm', FileSize);
WriteN(Buffer, FileSize);
ConsoleExit(0);
TerminateThread;
end.

View File

@@ -0,0 +1,64 @@
program ReadFolderApp;
uses
KolibriOS;
var
hConsole: Pointer;
ConsoleInit: procedure(WndWidth, WndHeight, ScrWidth, ScrHeight: LongWord; Caption: PChar); stdcall;
ConsoleExit: procedure(bCloseWindow: Cardinal); stdcall;
printf: function(const Format: PChar): Integer; cdecl varargs;
const
FolderPath = '/sys';
var
FolderInformation: TFolderInformation;
BlocksRead: LongWord;
Pos: LongWord;
begin
hConsole := LoadLibrary('/sys/lib/console.obj');
ConsoleInit := GetProcAddress(hConsole, 'con_init');
ConsoleExit := GetProcAddress(hConsole, 'con_exit');
printf := GetProcAddress(hConsole, 'con_printf');
if ReadFolder(FolderPath, FolderInformation, 0, 0, 0, BlocksRead) = 0 then
with FolderInformation do
begin
ConsoleInit($FFFFFFFF, $FFFFFFFF, $FFFFFFFF, {11 printf In Loop}11 * FileCount + {2 printf below}2 + 1, 'ReadFolder');
printf('Folder "%s" contains %u files and/or folders.'#10, FolderPath, FileCount);
printf(#10);
end
else
begin
ConsoleInit($FFFFFFFF, $FFFFFFFF, $FFFFFFFF, $FFFFFFFF, 'ReadFolder');
printf('Folder "%s" can not be read.'#10, FolderPath);
end;
Pos := 0;
while ReadFolder(FolderPath, FolderInformation, 1, Pos, 0, BlocksRead) = 0 do
begin
with FolderInformation, FileInformation[0] do
begin
printf('FileName = %s'#10, FileName);
with FileAttributes do
begin
printf('SizeHi = %u'#10, SizeHi);
printf('SizeLo = %u'#10, SizeLo);
with modifyDate do printf('modifyDate = %02d.%02d.%02d'#10, Day, Month, Year);
with modifyTime do printf('modifyTime = %02d:%02d:%02d'#10, Hours, Minutes, Seconds);
with AccessDate do printf('AccessDate = %02d.%02d.%02d'#10, Day, Month, Year);
with AccessTime do printf('AccessTime = %02d:%02d:%02d'#10, Hours, Minutes, Seconds);
with CreationDate do printf('CreationDate = %02d.%02d.%02d'#10, Day, Month, Year);
with CreationTime do printf('CreationTime = %02d:%02d:%02d'#10, Hours, Minutes, Seconds);
printf('Attributes = 0x%08x'#10, Attributes);
end;
end;
printf(#10);
Inc(Pos);
end;
ConsoleExit(0);
TerminateThread;
end.

View File

@@ -0,0 +1,95 @@
program Screenshot;
uses
KolibriOS;
const
BORDER_SIZE = 5;
type
TRGBTriple = packed record
Blue: Byte;
Green: Byte;
Red: Byte;
end;
PRGBTripleArray = ^TRGBTripleArray;
TRGBTripleArray = array[0..0] of TRGBTriple;
var
Left, Right, Top, Bottom: Integer;
Screen: TSize;
Image, Preview: PRGBTripleArray;
function Red(A, B: LongWord): LongWord;
begin
Red := Image[(Screen.Width * B + A)].Red;
end;
function Green(A, B: LongWord): LongWord;
begin
Green := Image[(Screen.Width * B + A)].Green;
end;
function Blue(A, B: LongWord): LongWord;
begin
Blue := Image[(Screen.Width * B + A)].Blue;
end;
procedure ResizeImage;
var
A, B, I: LongWord;
begin
A := 0;
while A < Screen.Width do
begin
B := 0;
while B < Screen.Height do
begin
I := ((Screen.Width div 2) * B + A) div 2;
Preview[i].Red := (Red(A, B) + Red(B + 1, B) + Red(A, B + 1) + Red(A + 1, B + 1)) div 4;
Preview[i].Green := (Green(A, B) + Green(A + 1, B) + Green(A, B + 1) + Green(A + 1, B + 1)) div 4;
Preview[i].Blue := (Blue(A, B) + Blue(A + 1, B) + Blue(A, B + 1) + Blue(A + 1, B + 1)) div 4;
Inc(B, 2);
end;
Inc(B, 2);
end;
end;
begin
HeapCreate;
Screen := GetScreenSize;
with Screen do
begin
Right := BORDER_SIZE * 2 + Width div 2 - 1;
Bottom := BORDER_SIZE + GetSkinHeight + Height div 2 - 1;
Left := (Width - Right) div 2;
Top := (Height - Bottom) div 2;
Image := HeapAllocate(Width * Height * 3);
Preview := HeapAllocate(Width * Height * 3 div 2);
GetScreenImage(Image^, 0, 0, Width, Height);
ResizeImage;
end;
while True do
case WaitEvent of
REDRAW_EVENT:
begin
BeginDraw;
DrawWindow(Left, Top, Right, Bottom, 'Screenshot', $00FFFFFF,
WS_SKINNED_FIXED + WS_COORD_CLIENT + WS_CAPTION + WS_FILL_TRANSPARENT, CAPTION_MOVABLE);
with Screen do
DrawImage(Preview^, 0, 0, Width div 2, Height div 2);
EndDraw;
end;
KEY_EVENT:
GetKey;
BUTTON_EVENT:
if GetButton.ID = 1 then
TerminateThread;
end;
end.

View File

@@ -0,0 +1,136 @@
program SetCursorApp;
uses
KolibriOS;
const
AppPath = PPChar(32);
ARROW_BUTTON = 2;
POINT_BUTTON = 3;
WAIT_BUTTON = 4;
type
TBitmapFileHeader = packed record
bfType: Word;
bfSize: LongWord;
bfReserved1: Word;
bfReserved2: Word;
bfOffBits: LongWord;
end;
TBitmapInfoHeader = packed record
biSize: LongWord;
biWidth: LongInt;
biHeight: LongInt;
biPlanes: Word;
biBitCount: Word;
biCompression: LongWord;
biSizeImage: LongWord;
biXPelsPerMeter: LongInt;
biYPelsPerMeter: LongInt;
biClrUsed: LongWord;
biClrImportant: LongWord;
end;
PBitmapFile = ^TBitmapFile;
TBitmapFile = packed record
BitmapFileHeader: TBitmapFileHeader;
BitmapInfoHeader: TBitmapInfoHeader;
end;
procedure ExtractFileDirectory(Src, Dst: PChar); stdcall;
asm
PUSH ESI
PUSH EDI
XOR EAX, EAX
MOV EDI, Src
MOV ESI, EDI
MOV ECX, $FFFFFFFF
REPNE SCASB
MOV AL, '/'
STD
REPNE SCASB
CLD
SUB EDI, ESI
MOV ECX, EDI
INC ECX
MOV EDI, Dst
REP MOVSB
MOV BYTE [EDI], 0
POP EDI
POP ESI
end;
var
Left, Right, Top, Bottom: Integer;
ArrowBitmapFile, PointBitmapFile, WaitBitmapFile: PBitmapFile;
ArrowBitmap, PointBitmap, WaitBitmap: Pointer;
hArrowCursor, hPointCursor, hWaitCursor: LongWord;
FileSize: LongWord;
begin
HeapCreate;
ExtractFileDirectory(AppPath^, AppPath^);
SetCurrentDirectory(AppPath^);
ArrowBitmapFile := LoadFile('arrow.bmp', FileSize);
PointBitmapFile := LoadFile('point.bmp', FileSize);
WaitBitmapFile := LoadFile('wait.bmp', FileSize);
ArrowBitmap := Pointer(LongWord(ArrowBitmapFile) + ArrowBitmapFile.BitmapFileHeader.bfOffBits);
PointBitmap := Pointer(LongWord(PointBitmapFile) + PointBitmapFile.BitmapFileHeader.bfOffBits);
WaitBitmap := Pointer(LongWord(WaitBitmapFile) + WaitBitmapFile.BitmapFileHeader.bfOffBits);
hArrowCursor := LoadCursorIndirect(ArrowBitmap^, 0, 0);
hPointCursor := LoadCursorIndirect(PointBitmap^, 12, 0);
hWaitCursor := LoadCursorIndirect(WaitBitmap^, 0, 0);
with GetScreenSize do
begin
Right := Width div 4;
Bottom := Height div 4;
Left := (Width - Right) div 2;
Top := (Height - Bottom) div 2;
end;
while True do
case WaitEvent of
REDRAW_EVENT:
begin
BeginDraw;
DrawWindow(Left, Top, Right, Bottom, 'Set Cursor', $00FFFFFF,
WS_SKINNED_FIXED + WS_COORD_CLIENT + WS_CAPTION, CAPTION_MOVABLE);
DrawText( 8, 8, 'Click on picture buttons', 0, $00FFFFFF, DT_CP866_8X16 + DT_FILL_OPAQUE + DT_ZSTRING, 0);
DrawText( 8, 25, 'below to select cursor:', 0, $00FFFFFF, DT_CP866_8X16 + DT_FILL_OPAQUE + DT_ZSTRING, 0);
DrawButton(8, 40, 32, 32, 0, BS_FILL_TRANSPARENT, ARROW_BUTTON);
DrawButton(52, 40, 32, 32, 0, BS_FILL_TRANSPARENT, POINT_BUTTON);
DrawButton(96, 40, 32, 32, 0, BS_FILL_TRANSPARENT, WAIT_BUTTON );
Blit(ArrowBitmap^, 0, 0, 32, 32, 8, 40, 32, 32, 32*4, BLIT_CLIENT_RELATIVE);
Blit(PointBitmap^, 0, 0, 32, 32, 52, 40, 32, 32, 32*4, BLIT_CLIENT_RELATIVE);
Blit(WaitBitmap^, 0, 0, 32, 32, 96, 40, 32, 32, 32*4, BLIT_CLIENT_RELATIVE);
EndDraw;
end;
KEY_EVENT:
GetKey;
BUTTON_EVENT:
case GetButton.ID of
ARROW_BUTTON:
SetCursor(hArrowCursor);
POINT_BUTTON:
SetCursor(hPointCursor);
WAIT_BUTTON:
SetCursor(hWaitCursor);
1:
TerminateThread;
end;
end;
end.

View File

Before

Width:  |  Height:  |  Size: 4.1 KiB

After

Width:  |  Height:  |  Size: 4.1 KiB

View File

Before

Width:  |  Height:  |  Size: 4.1 KiB

After

Width:  |  Height:  |  Size: 4.1 KiB

View File

Before

Width:  |  Height:  |  Size: 4.1 KiB

After

Width:  |  Height:  |  Size: 4.1 KiB

View File

@@ -0,0 +1,51 @@
program SetPixelApp;
uses
KolibriOS;
var
Left, Right, Top, Bottom: Integer;
X, Y: Integer;
begin
with GetScreenSize do
begin
Right := 180;
Bottom := 180;
Left := (Width - Right) div 2;
Top := (Height - Bottom) div 2;
end;
while True do
case WaitEvent of
REDRAW_EVENT:
begin
BeginDraw;
DrawWindow(Left, Top, Right, Bottom, 'Set Pixel', $00FFFFFF,
WS_SKINNED_FIXED + WS_COORD_CLIENT + WS_CAPTION, CAPTION_MOVABLE);
for Y := 0 to 50 do
for X := 0 to 50 do
if ((X mod 2) = 0) or ((Y mod 2) = 0) then
SetPixel(X, Y, $00FF0000);
for Y := 50 to 100 do
for X := 50 to 100 do
if ((X mod 3) = 0) or ((Y mod 3) = 0) then
SetPixel(X, Y, $00007F00);
for Y := 100 to 150 do
for X := 100 to 150 do
if ((X mod 4) = 0) or ((Y mod 4) = 0) then
SetPixel(X, Y, $000000FF);
EndDraw;
end;
KEY_EVENT:
GetKey;
BUTTON_EVENT:
if GetButton.ID = 1 then
TerminateThread;
end;
end.

View File

@@ -0,0 +1,84 @@
program SetWindowPosApp;
uses
KolibriOS;
const
KS_UP = #$48;
KS_DOWN = #$50;
KS_LEFT = #$4B;
KS_RIGHT = #$4D;
MOVE_STEP = 10;
LEFT_CTRL_PRESSED = 4;
RIGHT_CTRL_PRESSED = 8;
procedure OnKey;
var
Key: TKeyboardInput;
ThreadInfo: TThreadInfo;
ControlKeyState: LongWord;
begin
GetThreadInfo($FFFFFFFF, ThreadInfo);
ControlKeyState := GetControlKeyState;
Key := GetKey;
with ThreadInfo.Window do
begin
if Boolean(ControlKeyState and (RIGHT_CTRL_PRESSED or LEFT_CTRL_PRESSED)) then
case Key.Scan of
KS_UP:
Dec(Bottom, MOVE_STEP);
KS_DOWN:
Inc(Bottom, MOVE_STEP);
KS_LEFT:
Dec(Right, MOVE_STEP);
KS_RIGHT:
Inc(Right, MOVE_STEP);
end
else
case Key.Scan of
KS_UP:
Dec(Top, MOVE_STEP);
KS_DOWN:
Inc(Top, MOVE_STEP);
KS_LEFT:
Dec(Left, MOVE_STEP);
KS_RIGHT:
Inc(Left, MOVE_STEP);
end;
SetWindowPos(Left, Top, Right, Bottom);
end;
end;
var
Left, Right, Top, Bottom: Integer;
begin
with GetScreenSize do
begin
Right := Width div 4;
Bottom := Height div 4;
Left := (Width - Right) div 2;
Top := (Height - Bottom) div 2;
end;
while True do
case WaitEvent of
REDRAW_EVENT:
begin
BeginDraw;
DrawWindow(Left, Top, Right, Bottom, 'Set Window Position', $00FFFFFF,
WS_SKINNED_SIZABLE + WS_COORD_CLIENT + WS_CAPTION, CAPTION_MOVABLE);
DrawText(24, 26, 'Use arrow keys(Left, Right, Up, Down)', $00000000, $00FFFFFF, DT_ZSTRING, 0);
DrawText(24, 35, 'to move the window.', $00000000, $00FFFFFF, DT_ZSTRING, 0);
DrawText(24, 44, 'Use Ctrl+arrow keys to resize window.', $00000000, $00FFFFFF, DT_ZSTRING, 0);
EndDraw;
end;
KEY_EVENT:
OnKey;
BUTTON_EVENT:
if GetButton.ID = 1 then
TerminateThread;
end;
end.

View File

@@ -1,70 +0,0 @@
Unit Unit1;
(* -------------------------------------------------------- *)
Interface
(* -------------------------------------------------------- *)
Uses KolibriOS;
(* -------------------------------------------------------- *)
Var
hConsole: Pointer;
ConsoleInit: Procedure(WndWidth, WndHeight, ScrWidth, ScrHeight: Dword; Caption: PChar); StdCall;
ConsoleExit: Procedure(bCloseWindow: Cardinal); StdCall;
printf: Function(Const Format: PChar): Integer; CDecl VarArgs;
(* -------------------------------------------------------- *)
Procedure Main;
(* -------------------------------------------------------- *)
Implementation
(* -------------------------------------------------------- *)
Procedure Main;
Const
FolderPath = '/sys';
Var
FolderInformation: TFolderInformation;
BlocksRead: Dword;
Pos: Dword;
Begin
hConsole := LoadLibrary('/sys/lib/console.obj');
ConsoleInit := GetProcAddress(hConsole, 'con_init');
ConsoleExit := GetProcAddress(hConsole, 'con_exit');
printf := GetProcAddress(hConsole, 'con_printf');
If ReadFolder(FolderPath, FolderInformation, 0, 0, 0, BlocksRead) = 0 Then
Begin
With FolderInformation Do Begin
ConsoleInit($FFFFFFFF, $FFFFFFFF, $FFFFFFFF, {11 printf In Loop}11 * FileCount + {2 printf below}2 + 1, 'ReadFolder');
printf('Folder "%s" contains %u files and/or folders.'#10, FolderPath, FileCount);
printf(#10);
End;
End
Else
Begin
ConsoleInit($FFFFFFFF, $FFFFFFFF, $FFFFFFFF, $FFFFFFFF, 'ReadFolder');
printf('Folder "%s" can not be read.'#10, FolderPath);
End;
Pos := 0;
While ReadFolder(FolderPath, FolderInformation, 1, Pos, 0, BlocksRead) = 0 Do Begin
With FolderInformation Do Begin
With FileInformation[0] Do Begin
printf('FileName = %s'#10, FileName);
With FileAttributes Do Begin
printf('SizeHi = %u'#10, SizeHi);
printf('SizeLo = %u'#10, SizeLo);
With ModifyDate Do printf('ModifyDate = %02d.%02d.%02d'#10, Day, Month, Year);
With ModifyTime Do printf('ModifyTime = %02d:%02d:%02d'#10, Hours, Minutes, Seconds);
With AccessDate Do printf('AccessDate = %02d.%02d.%02d'#10, Day, Month, Year);
With AccessTime Do printf('AccessTime = %02d:%02d:%02d'#10, Hours, Minutes, Seconds);
With CreationDate Do printf('CreationDate = %02d.%02d.%02d'#10, Day, Month, Year);
With CreationTime Do printf('CreationTime = %02d:%02d:%02d'#10, Hours, Minutes, Seconds);
printf('Attributes = 0x%08x'#10, Attributes);
End;
End;
printf(#10);
End;
Inc(Pos);
End;
ConsoleExit(0);
ThreadTerminate;
End;
(* -------------------------------------------------------- *)
End.

View File

@@ -1,202 +0,0 @@
Unit Unit1;
(* -------------------------------------------------------- *)
Interface
(* -------------------------------------------------------- *)
Uses KolibriOS;
(* -------------------------------------------------------- *)
Const
AppPath = PPChar(32);
Picture1 = 'Flower(4bpp).bmp';
Picture2 = 'Mario(1bpp).bmp';
Picture3 = 'House(24bpp).bmp';
(* -------------------------------------------------------- *)
Type
TBitmapFileHeader = Packed Record
bfType: Word;
bfSize: Dword;
bfReserved1: Word;
bfReserved2: Word;
bfOffBits: Dword;
End;
TBitmapInfoHeader = Packed Record
biSize: Dword;
biWidth: Longint;
biHeight: Longint;
biPlanes: Word;
biBitCount: Word;
biCompression: Dword;
biSizeImage: Dword;
biXPelsPerMeter: Longint;
biYPelsPerMeter: Longint;
biClrUsed: Dword;
biClrImportant: Dword;
End;
TRGBQuad = Packed Record
Blue: Byte;
Green: Byte;
Red: Byte;
reserved: Byte;
end;
TBitmapFile = Packed Record
BitmapFileHeader: TBitmapFileHeader;
BitmapInfoHeader: TBitmapInfoHeader;
Palette: Packed Array[0..0] Of TRGBQuad;
End;
PBitmapFile = ^TBitmapFile;
(* -------------------------------------------------------- *)
Var
Window: TRect;
Screen: TSize;
BitmapFile1: PBitmapFile;
BitmapFile2: PBitmapFile;
BitmapFile3: PBitmapFile;
Image1: Pointer;
Image2: Pointer;
Image3: Pointer;
Padding1: Dword;
Padding2: Dword;
Padding3: Dword;
(* -------------------------------------------------------- *)
Procedure Main;
Procedure On_Key;
Procedure On_Button;
Procedure On_Redraw;
Procedure ExtractFileDirectory(Src, Dst: PChar); StdCall;
(* -------------------------------------------------------- *)
Implementation
(* -------------------------------------------------------- *)
Procedure Main;
Var
BytesRead: Dword;
FileAttributes: TFileAttributes;
Begin
HeapCreate;
ExtractFileDirectory(AppPath^, AppPath^);
SetCurrentDirectory(AppPath^);
GetFileAttributes(Picture1, FileAttributes);
BitmapFile1 := HeapAllocate(FileAttributes.SizeLo);
ReadFile(Picture1, BitmapFile1^, FileAttributes.SizeLo, 0, 0, BytesRead);
With BitmapFile1^ Do
With BitmapFileHeader Do
With BitmapInfoHeader Do Begin
Padding1 := (32 - biWidth * biBitCount Mod 32) And Not 32 Shr 3;
Image1 := Pointer(Dword(BitmapFile1) + bfOffBits);
End;
GetFileAttributes(Picture2, FileAttributes);
BitmapFile2 := HeapAllocate(FileAttributes.SizeLo);
ReadFile(Picture2, BitmapFile2^, FileAttributes.SizeLo, 0, 0, BytesRead);
With BitmapFile2^ Do
With BitmapFileHeader Do
With BitmapInfoHeader Do Begin
Padding2 := (32 - biWidth * biBitCount Mod 32) And Not 32 Shr 3;
Image2 := Pointer(Dword(BitmapFile2) + bfOffBits);
End;
GetFileAttributes(Picture3, FileAttributes);
BitmapFile3 := HeapAllocate(FileAttributes.SizeLo);
ReadFile(Picture3, BitmapFile3^, FileAttributes.SizeLo, 0, 0, BytesRead);
With BitmapFile3^ Do
With BitmapFileHeader Do
With BitmapInfoHeader Do Begin
Padding3 := (32 - biWidth * biBitCount Mod 32) And Not 32 Shr 3;
Image3 := Pointer(Dword(BitmapFile3) + bfOffBits);
End;
Screen := GetScreenSize();
With Window Do Begin
With Screen Do Begin
Right := 340;
Bottom := Height Shr 2;
Left := (Width - Right) Shr 1;
Top := (Height - Bottom) Shr 1;
End;
End;
While TRUE Do Begin
Case WaitEvent() Of
REDRAW_EVENT: On_Redraw;
KEY_EVENT: On_Key;
BUTTON_EVENT: On_Button;
End;
End;
End;
(* -------------------------------------------------------- *)
Procedure On_Redraw;
Begin
BeginDraw;
With Window Do
DrawWindow(Left, Top, Right, Bottom, 'DrawImageEx', $00FFFFFF, WS_SKINNED_FIXED + WS_COORD_CLIENT + WS_CAPTION, CAPTION_MOVABLE);
(* these image files was saved with 'flip row order' parameter *)
(* therefore they have negative biHeight field *)
(* also it is possible to use Nil instead of @Palette if you sure palette is absent *)
With BitmapFile1^ Do
With BitmapFileHeader Do
With BitmapInfoHeader Do
DrawImageEx(Image1^, 20, 35, biWidth, -biHeight, biBitCount, @Palette, Padding1);
With BitmapFile2^ Do
With BitmapFileHeader Do
With BitmapInfoHeader Do
DrawImageEx(Image2^, 120, 35, biWidth, -biHeight, biBitCount, @Palette, Padding2);
With BitmapFile3^ Do
With BitmapFileHeader Do
With BitmapInfoHeader Do
DrawImageEx(Image3^, 220, 45, biWidth, -biHeight, biBitCount, @Palette, Padding3);
EndDraw;
End;
(* -------------------------------------------------------- *)
Procedure On_Key;
Begin
GetKey;
End;
(* -------------------------------------------------------- *)
Procedure On_Button;
Begin
Case GetButton().ID Of
1: ThreadTerminate;
End;
End;
(* -------------------------------------------------------- *)
Procedure ExtractFileDirectory(Src, Dst: PChar); StdCall;
Asm
push esi
push edi
xor eax, eax
mov edi, Src
mov esi, edi
mov ecx, $FFFFFFFF
repne scasb
mov al, '/'
std
repne scasb
cld
sub edi, esi
mov ecx, edi
inc ecx
mov edi, Dst
rep movsb
mov byte [edi], 0
pop edi
pop esi
End;
(* -------------------------------------------------------- *)
End.

View File

@@ -1,170 +0,0 @@
Unit Unit1;
(* -------------------------------------------------------- *)
Interface
(* -------------------------------------------------------- *)
Uses KolibriOS;
(* -------------------------------------------------------- *)
Const
AppPath = PPChar(32);
ARROW_BUTTON = 2;
POINT_BUTTON = 3;
WAIT_BUTTON = 4;
(* -------------------------------------------------------- *)
Type
TBitmapFileHeader = Packed Record
bfType: Word;
bfSize: Dword;
bfReserved1: Word;
bfReserved2: Word;
bfOffBits: Dword;
End;
TBitmapInfoHeader = Packed Record
biSize: Dword;
biWidth: Longint;
biHeight: Longint;
biPlanes: Word;
biBitCount: Word;
biCompression: Dword;
biSizeImage: Dword;
biXPelsPerMeter: Longint;
biYPelsPerMeter: Longint;
biClrUsed: Dword;
biClrImportant: Dword;
End;
TBitmapFile = Packed Record
BitmapFileHeader: TBitmapFileHeader;
BitmapInfoHeader: TBitmapInfoHeader;
End;
PBitmapFile = ^TBitmapFile;
(* -------------------------------------------------------- *)
Var
Window: TRect;
Screen: TSize;
ArrowBitmapFile,
PointBitmapFile,
WaitBitmapFile: PBitmapFile;
ArrowBitmap,
PointBitmap,
WaitBitmap: Pointer;
hArrowCursor,
hPointCursor,
hWaitCursor: Dword;
(* -------------------------------------------------------- *)
Procedure Main;
Procedure On_Key;
Procedure On_Button;
Procedure On_Redraw;
Procedure ExtractFileDirectory(Src, Dst: PChar); StdCall;
(* -------------------------------------------------------- *)
Implementation
(* -------------------------------------------------------- *)
Procedure Main;
Var
FileSize: Dword;
Begin
HeapCreate;
ExtractFileDirectory(AppPath^, AppPath^);
SetCurrentDirectory(AppPath^);
ArrowBitmapFile := LoadFile('arrow.bmp', FileSize);
PointBitmapFile := LoadFile('point.bmp', FileSize);
WaitBitmapFile := LoadFile('wait.bmp', FileSize);
ArrowBitmap := Pointer(Dword(ArrowBitmapFile) + ArrowBitmapFile^.BitmapFileHeader.bfOffBits);
PointBitmap := Pointer(Dword(PointBitmapFile) + PointBitmapFile^.BitmapFileHeader.bfOffBits);
WaitBitmap := Pointer(Dword(WaitBitmapFile) + WaitBitmapFile^.BitmapFileHeader.bfOffBits);
hArrowCursor := LoadCursorIndirect(ArrowBitmap^, 0, 0);
hPointCursor := LoadCursorIndirect(PointBitmap^, 12, 0);
hWaitCursor := LoadCursorIndirect(WaitBitmap^, 0, 0);
Screen := GetScreenSize();
With Window Do Begin
With Screen Do Begin
Right := Width Shr 2;
Bottom := Height Shr 2;
Left := (Width - Right) Shr 1;
Top := (Height - Bottom) Shr 1;
End;
End;
While TRUE Do Begin
Case WaitEvent() Of
REDRAW_EVENT: On_Redraw;
KEY_EVENT: On_Key;
BUTTON_EVENT: On_Button;
End;
End;
End;
(* -------------------------------------------------------- *)
Procedure On_Redraw;
Begin
BeginDraw;
With Window Do
DrawWindow(Left, Top, Right, Bottom, 'LoadCursorIndirect', $00FFFFFF, WS_SKINNED_FIXED + WS_COORD_CLIENT + WS_CAPTION, CAPTION_MOVABLE);
DrawText( 8, 8, 'Click on picture buttons', 0, $00FFFFFF, DT_CP866_8X16 + DT_FILL_OPAQUE + DT_ZSTRING, 0);
DrawText( 8, 25, 'below to select cursor:', 0, $00FFFFFF, DT_CP866_8X16 + DT_FILL_OPAQUE + DT_ZSTRING, 0);
DrawButton(8, 40, 32, 32, 0, BS_FILL_TRANSPARENT, ARROW_BUTTON);
DrawButton(52, 40, 32, 32, 0, BS_FILL_TRANSPARENT, POINT_BUTTON);
DrawButton(96, 40, 32, 32, 0, BS_FILL_TRANSPARENT, WAIT_BUTTON );
Blit(ArrowBitmap^, 0, 0, 32, 32, 8, 40, 32, 32, 32*4, BLIT_CLIENT_RELATIVE);
Blit(PointBitmap^, 0, 0, 32, 32, 52, 40, 32, 32, 32*4, BLIT_CLIENT_RELATIVE);
Blit(WaitBitmap^, 0, 0, 32, 32, 96, 40, 32, 32, 32*4, BLIT_CLIENT_RELATIVE);
EndDraw;
End;
(* -------------------------------------------------------- *)
Procedure On_Key;
Begin
GetKey;
End;
(* -------------------------------------------------------- *)
Procedure On_Button;
Begin
Case GetButton().ID Of
1: ThreadTerminate;
ARROW_BUTTON: SetCursor(hArrowCursor);
POINT_BUTTON: SetCursor(hPointCursor);
WAIT_BUTTON: SetCursor(hWaitCursor);
End;
End;
(* -------------------------------------------------------- *)
Procedure ExtractFileDirectory(Src, Dst: PChar); StdCall;
Asm
push esi
push edi
xor eax, eax
mov edi, Src
mov esi, edi
mov ecx, $FFFFFFFF
repne scasb
mov al, '/'
std
repne scasb
cld
sub edi, esi
mov ecx, edi
inc ecx
mov edi, Dst
rep movsb
mov byte [edi], 0
pop edi
pop esi
End;
(* -------------------------------------------------------- *)
End.

View File

@@ -1,123 +0,0 @@
Unit Unit1;
(* -------------------------------------------------------- *)
Interface
(* -------------------------------------------------------- *)
Uses KolibriOS;
(* -------------------------------------------------------- *)
Const
BORDER_SIZE = 5;
(* -------------------------------------------------------- *)
Type
TRGBTriple = Packed Record
Blue: Byte;
Green: Byte;
Red: Byte;
End;
TRGBTripleArray = Packed Array[0..0] Of TRGBTriple;
PRGBTripleArray = ^TRGBTripleArray;
(* -------------------------------------------------------- *)
Var
Window: TRect;
Screen: TSize;
Image, ImagePreview: PRGBTripleArray;
(* -------------------------------------------------------- *)
Procedure Main;
Procedure On_Key;
Procedure On_Button;
Procedure On_Redraw;
Procedure ImageResize;
Function SrcR(a, b: Dword): Dword;
Function SrcG(a, b: Dword): Dword;
Function SrcB(a, b: Dword): Dword;
(* -------------------------------------------------------- *)
Implementation
(* -------------------------------------------------------- *)
Procedure Main;
Begin
HeapCreate;
Screen := GetScreenSize();
With Window Do Begin
With Screen Do Begin
Right := BORDER_SIZE * 2 + Width Shr 1 - 1;
Bottom := BORDER_SIZE + GetSkinHeight + Height Shr 1 - 1;
Left := (Width - Right) Shr 1;
Top := (Height - Bottom) Shr 1;
Image := HeapAllocate(Width * Height * 3);
ImagePreview := HeapAllocate(Width * Height * 3 Shr 1);
GetScreenImage(Image^, 0, 0, Width, Height);
ImageResize;
End;
End;
While TRUE Do Begin
Case WaitEvent() Of
REDRAW_EVENT: On_Redraw;
KEY_EVENT: On_Key;
BUTTON_EVENT: On_Button;
End;
End;
End;
(* -------------------------------------------------------- *)
Procedure On_Redraw;
Begin
BeginDraw;
With Window Do
DrawWindow(Left, Top, Right, Bottom, 'GetScreenImage', $00FFFFFF, WS_SKINNED_FIXED + WS_COORD_CLIENT + WS_CAPTION + WS_FILL_TRANSPARENT, CAPTION_MOVABLE);
With Screen Do
DrawImage(ImagePreview^, 0, 0, Width Shr 1, Height Shr 1);
EndDraw;
End;
(* -------------------------------------------------------- *)
Procedure On_Key;
Begin
GetKey;
End;
(* -------------------------------------------------------- *)
Procedure On_Button;
Begin
Case GetButton().ID Of
1: ThreadTerminate;
End;
End;
(* -------------------------------------------------------- *)
Function SrcR(a, b: Dword): Dword;
Begin
SrcR := Image[(Screen.Width * b + a)].Red;
End;
Function SrcG(a, b: Dword): Dword;
Begin
SrcG := Image[(Screen.Width * b + a)].Green;
End;
Function SrcB(a, b: Dword): Dword;
Begin
SrcB := Image[(Screen.Width * b + a)].Blue;
End;
(* -------------------------------------------------------- *)
Procedure ImageResize;
Var
a, b, i: Dword;
Begin
a := 0;
While a < Screen.Width Do Begin
b := 0;
While b < Screen.Height Do Begin
i := ((Screen.Width Shr 1) * b + a) Shr 1;
ImagePreview[i].Red := (SrcR(a, b) + SrcR(a + 1, b) + SrcR(a, b + 1) + SrcR(a + 1, b + 1)) Shr 2;
ImagePreview[i].Green := (SrcG(a, b) + SrcG(a + 1, b) + SrcG(a, b + 1) + SrcG(a + 1, b + 1)) Shr 2;
ImagePreview[i].Blue := (SrcB(a, b) + SrcB(a + 1, b) + SrcB(a, b + 1) + SrcB(a + 1, b + 1)) Shr 2;
Inc(b, 2);
End;
Inc(a, 2);
End;
End;
(* -------------------------------------------------------- *)
End.

View File

@@ -1,60 +0,0 @@
Unit Unit1;
(* -------------------------------------------------------- *)
Interface
(* -------------------------------------------------------- *)
Uses KolibriOS;
(* -------------------------------------------------------- *)
Var
hConsole: Pointer;
ConsoleInit: Procedure(WndWidth, WndHeight, ScrWidth, ScrHeight: Dword; Caption: PChar); StdCall;
ConsoleExit: Procedure(bCloseWindow: Cardinal); StdCall;
Printf: Function(Const Format: PChar): Integer; CDecl VarArgs;
GetConsoleCursorPos: Procedure(X, Y: PInteger); StdCall;
SetConsoleCursorPos: Procedure(X, Y: Integer); StdCall;
kbhit: Function: Boolean;
SetConsoleCursorHeight: Function(Height: Integer): Integer; StdCall;
ConsoleCls: Procedure;
(* -------------------------------------------------------- *)
Procedure Main;
(* -------------------------------------------------------- *)
Implementation
(* -------------------------------------------------------- *)
Procedure Main();
Var
SystemDate: TSystemDate;
SystemTime: TSystemTime;
X, Y: Integer;
Begin
hConsole := LoadLibrary('/sys/lib/console.obj');
ConsoleInit := GetProcAddress(hConsole, 'con_init');
ConsoleExit := GetProcAddress(hConsole, 'con_exit');
GetConsoleCursorPos := GetProcAddress(hConsole, 'con_get_cursor_pos');
SetConsoleCursorPos := GetProcAddress(hConsole, 'con_set_cursor_pos');
SetConsoleCursorHeight := GetProcAddress(hConsole, 'con_set_cursor_height');
Printf := GetProcAddress(hConsole, 'con_printf');
KBHit := GetProcAddress(hConsole, 'con_kbhit');
ConsoleInit($FFFFFFFF, $FFFFFFFF, $FFFFFFFF, $FFFFFFFF, 'Test');
SetConsoleCursorHeight(0);
SetConsoleCursorPos(27, 11);
Printf('SystemDate and SystemTime'#10' ');
GetConsoleCursorPos(@X, @Y);
Repeat
SystemDate := GetSystemDate();
SystemTime := GetSystemTime();
With SystemDate, SystemTime Do
Begin
Printf('%02x.%02x.%02x', Day, Month, Year);
Printf(' - %02x:%02x:%02x', Hours, Minutes, Seconds);
End;
SetConsoleCursorPos(X, Y);
Sleep(50);
Until KBHit;
ConsoleExit(1);
ThreadTerminate;
End;
(* -------------------------------------------------------- *)
End.

View File

@@ -1,96 +0,0 @@
Unit Unit1;
(* -------------------------------------------------------- *)
Interface
(* -------------------------------------------------------- *)
Uses KolibriOS;
(* -------------------------------------------------------- *)
Const
KS_UP = #$48;
KS_DOWN = #$50;
KS_LEFT = #$4B;
KS_RIGHT = #$4D;
MOVE_STEP = 10;
LEFT_CTRL_PRESSED = 4;
RIGHT_CTRL_PRESSED = 8;
(* -------------------------------------------------------- *)
Var
Window: TRect;
Screen: TSize;
(* -------------------------------------------------------- *)
Procedure Main;
Procedure On_Key;
Procedure On_Button;
Procedure On_Redraw;
(* -------------------------------------------------------- *)
Implementation
(* -------------------------------------------------------- *)
Procedure Main;
Begin
Screen := GetScreenSize();
With Window, Screen Do Begin
Right := Width Shr 2;
Bottom := Height Shr 2;
Left := (Width - Right) Shr 1;
Top := (Height - Bottom) Shr 1;
End;
While TRUE Do Begin
Case WaitEvent() Of
REDRAW_EVENT: On_Redraw;
KEY_EVENT: On_Key;
BUTTON_EVENT: On_Button;
End;
End;
End;
(* -------------------------------------------------------- *)
Procedure On_Redraw;
Begin
BeginDraw;
With Window Do
DrawWindow(Left, Top, Right, Bottom, 'SetWindowPos', $00FFFFFF, WS_SKINNED_SIZABLE + WS_COORD_CLIENT + WS_CAPTION, CAPTION_MOVABLE);
DrawText(24, 26, 'Use arrow keys(Left, Right, Up, Down)', $00000000, $00FFFFFF, DT_ZSTRING, 0);
DrawText(24, 35, 'to move window.', $00000000, $00FFFFFF, DT_ZSTRING, 0);
DrawText(24, 44, 'Use Ctrl+arrow keys to resize window.', $00000000, $00FFFFFF, DT_ZSTRING, 0);
EndDraw;
End;
(* -------------------------------------------------------- *)
Procedure On_Key;
Var
Key: TKeyboardInput;
ThreadInfo: TThreadInfo;
ControlKeyState: Dword;
Begin
GetThreadInfo($FFFFFFFF, ThreadInfo);
ControlKeyState := GetControlKeyState;
Key := GetKey;
With ThreadInfo.Window Do
Begin
If Boolean(ControlKeyState And (RIGHT_CTRL_PRESSED Or LEFT_CTRL_PRESSED)) Then Begin
Case Key.Scan Of
KS_UP: Dec(Bottom, MOVE_STEP);
KS_DOWN: Inc(Bottom, MOVE_STEP);
KS_LEFT: Dec(Right, MOVE_STEP);
KS_RIGHT: Inc(Right, MOVE_STEP);
End;
End
Else Begin
Case Key.Scan Of
KS_UP: Dec(Top, MOVE_STEP);
KS_DOWN: Inc(Top, MOVE_STEP);
KS_LEFT: Dec(Left, MOVE_STEP);
KS_RIGHT: Inc(Left, MOVE_STEP);
End;
End;
SetWindowPos(Left, Top, Right, Bottom);
End;
End;
(* -------------------------------------------------------- *)
Procedure On_Button;
Begin
Case GetButton().ID Of
1: ThreadTerminate;
End;
End;
(* -------------------------------------------------------- *)
End.

View File

@@ -1,82 +0,0 @@
Unit Unit1;
(* -------------------------------------------------------- *)
Interface
(* -------------------------------------------------------- *)
Uses KolibriOS;
(* -------------------------------------------------------- *)
Const
NO_EVENT = 0;
(* -------------------------------------------------------- *)
Var
Window: TBox;
Screen: TSize;
(* -------------------------------------------------------- *)
Procedure Main;
Procedure On_Button;
Procedure On_Redraw;
Procedure UpdateInfo;
(* -------------------------------------------------------- *)
Implementation
(* -------------------------------------------------------- *)
Procedure Main;
Begin
Screen := GetScreenSize();
With Window Do Begin
Width := 189;
Height := 79;
Left := (Screen.Width - Width) Shr 1;
Top := (Screen.Height - Height) Shr 1;
End;
SetEventMask(EM_BUTTON + EM_REDRAW);
While TRUE Do Begin
Case WaitEventByTime(5) Of
REDRAW_EVENT: On_Redraw;
BUTTON_EVENT: On_Button;
NO_EVENT: UpdateInfo;
End;
End;
End;
(* -------------------------------------------------------- *)
Procedure On_Redraw;
Begin
BeginDraw;
With Window Do
DrawWindow(Left, Top, Width, Height, 'GetPointOwner', $00FFFFFF, WS_SKINNED_FIXED + WS_COORD_CLIENT + WS_CAPTION, CAPTION_MOVABLE);
DrawText(16, 16, 'Name:', $00000000, $00FFFFFF, DT_CP866_8X16 + DT_ZSTRING, 0);
EndDraw;
End;
(* -------------------------------------------------------- *)
Procedure UpdateInfo;
Const
CHAR_WIDTH = 8;
CHAR_HEIGHT = 16;
Var
MousePos: TPoint;
ID: Dword;
ThreadInfo: TThreadInfo;
i: Dword;
Begin
MousePos := GetMousePos;
With MousePos Do
ID := GetPointOwner(X, Y);
GetThreadInfo(ID, ThreadInfo);
(* get length of current name *)
i := 0;
While ThreadInfo.Name[i] <> #0 Do Inc(i);
(* clear unnecessary part of possible previous name by white rectangle *)
DrawRectangle(64 + i * CHAR_WIDTH, 16, (SizeOf(ThreadInfo.Name) - i) * CHAR_WIDTH, CHAR_HEIGHT, $00FFFFFF);
(* draw current name *)
DrawText(64, 16, ThreadInfo.Name, $00000000, $00FFFFFF, DT_CP866_8X16 + DT_FILL_OPAQUE + DT_ZSTRING, 0);
End;
(* -------------------------------------------------------- *)
Procedure On_Button;
Begin
Case GetButton().ID Of
1: ThreadTerminate;
End;
End;
(* -------------------------------------------------------- *)
End.

View File

@@ -1,62 +0,0 @@
Unit Unit1;
(* -------------------------------------------------------- *)
Interface
(* -------------------------------------------------------- *)
Uses KolibriOS;
(* -------------------------------------------------------- *)
Var
Window: TRect;
Screen: TSize;
(* -------------------------------------------------------- *)
Procedure Main;
Procedure On_Key;
Procedure On_Button;
Procedure On_Redraw;
(* -------------------------------------------------------- *)
Implementation
(* -------------------------------------------------------- *)
Procedure Main;
Begin
Screen := GetScreenSize();
With Window Do Begin
With Screen Do Begin
Right := Width Shr 2;
Bottom := Height Shr 2;
Left := (Width - Right) Shr 1;
Top := (Height - Bottom) Shr 1;
End;
End;
While TRUE Do Begin
Case WaitEvent() Of
REDRAW_EVENT: On_Redraw;
KEY_EVENT: On_Key;
BUTTON_EVENT: On_Button;
End;
End;
End;
(* -------------------------------------------------------- *)
Procedure On_Redraw;
Begin
BeginDraw;
With Window Do
DrawWindow(Left, Top, Right, Bottom, 'Hello!', $00FFFFFF, WS_SKINNED_FIXED + WS_COORD_CLIENT + WS_CAPTION, CAPTION_MOVABLE);
EndDraw;
End;
(* -------------------------------------------------------- *)
Procedure On_Key;
Begin
GetKey;
End;
(* -------------------------------------------------------- *)
Procedure On_Button;
Begin
Case GetButton().ID Of
1: ThreadTerminate;
End;
End;
(* -------------------------------------------------------- *)
End.

View File

@@ -1,83 +0,0 @@
Unit Unit1;
(* -------------------------------------------------------- *)
Interface
(* -------------------------------------------------------- *)
Uses KolibriOS;
(* -------------------------------------------------------- *)
Const
COLOR_BLUE = $000000FF;
COLOR_RED = $00FF0000;
COLOR_GREEN = $0000FF00;
COLOR_BLACK = $00000000;
BLUE_BUTTON = 10050;
GREEN_BUTTON = 9000;
RED_BUTTON = 42;
BLACK_BUTTON = 0;
(* -------------------------------------------------------- *)
Var
Window: TRect;
Screen: TSize;
(* -------------------------------------------------------- *)
Procedure Main;
Procedure On_Key;
Procedure On_Button;
Procedure On_Redraw;
(* -------------------------------------------------------- *)
Implementation
(* -------------------------------------------------------- *)
Procedure Main;
Begin
Screen := GetScreenSize();
With Window Do Begin
With Screen Do Begin
Right := Width Shr 2;
Bottom := Height Shr 2;
Left := (Width - Right) Shr 1;
Top := (Height - Bottom) Shr 1;
End;
End;
While TRUE Do Begin
Case WaitEvent() Of
REDRAW_EVENT: On_Redraw;
KEY_EVENT: On_Key;
BUTTON_EVENT: On_Button;
End;
End;
End;
(* -------------------------------------------------------- *)
Procedure On_Redraw;
Begin
BeginDraw;
With Window Do
DrawWindow(Left, Top, Right, Bottom, 'DrawButton', $00FFFFFF, WS_SKINNED_FIXED + WS_COORD_CLIENT + WS_CAPTION, CAPTION_MOVABLE);
DrawButton(10, 20, 50, 30, COLOR_RED, 0, RED_BUTTON);
DrawButton(70, 20, 50, 30, COLOR_GREEN, 0, GREEN_BUTTON);
DrawButton(10, 60, 50, 30, COLOR_BLUE, 0, BLUE_BUTTON);
DrawButton(70, 60, 50, 30, COLOR_BLACK, 0, BLACK_BUTTON);
EndDraw;
End;
(* -------------------------------------------------------- *)
Procedure On_Key;
Begin
GetKey;
End;
(* -------------------------------------------------------- *)
Procedure On_Button;
Begin
Case GetButton().ID Of
1: ThreadTerminate;
BLUE_BUTTON: SetWindowCaption('Blue');
GREEN_BUTTON: SetWindowCaption('Green');
RED_BUTTON: SetWindowCaption('Red');
BLACK_BUTTON: SetWindowCaption('Black');
End;
End;
(* -------------------------------------------------------- *)
End.

View File

@@ -1,73 +0,0 @@
Unit Unit1;
(* -------------------------------------------------------- *)
Interface
(* -------------------------------------------------------- *)
Uses KolibriOS;
(* -------------------------------------------------------- *)
Var
Window: TRect;
Screen: TSize;
CurX, CurY: Integer;
(* -------------------------------------------------------- *)
Procedure Main;
Procedure On_Key;
Procedure On_Button;
Procedure On_Redraw;
(* -------------------------------------------------------- *)
Implementation
(* -------------------------------------------------------- *)
Procedure Main;
Begin
Screen := GetScreenSize();
With Window Do Begin
With Screen Do Begin
Right := Width Shr 2;
Bottom := Height Shr 2;
Left := (Width - Right) Shr 1;
Top := (Height - Bottom) Shr 1;
End;
End;
While TRUE Do Begin
Case WaitEvent() Of
REDRAW_EVENT: On_Redraw;
KEY_EVENT: On_Key;
BUTTON_EVENT: On_Button;
End;
End;
End;
(* -------------------------------------------------------- *)
Procedure On_Redraw;
Begin
CurX := 0;
CurY := 0;
BeginDraw;
With Window Do
DrawWindow(Left, Top, Right, Bottom, 'GetKey', $00FFFFFF, WS_SKINNED_FIXED + WS_COORD_CLIENT + WS_CAPTION, CAPTION_MOVABLE);
EndDraw;
End;
(* -------------------------------------------------------- *)
Procedure On_Key;
Var
Key: TKeyboardInput;
Begin
Key := GetKey();
DrawText(CurX, CurY, @Key.Code, $00000000, $00FFFFFF, 0, 1);
Inc(CurX, 6);
If CurX > 100 Then Begin
Inc(CurY, 10);
CurX := 0;
End;
End;
(* -------------------------------------------------------- *)
Procedure On_Button;
Begin
Case GetButton().ID Of
1: ThreadTerminate;
End;
End;
(* -------------------------------------------------------- *)
End.

View File

@@ -1,36 +0,0 @@
Unit Unit1;
(* -------------------------------------------------------- *)
Interface
(* -------------------------------------------------------- *)
Uses KolibriOS;
(* -------------------------------------------------------- *)
Var
hConsole: Pointer;
ConsoleInit: Procedure(WndWidth, WndHeight, ScrWidth, ScrHeight: Dword; Caption: PChar); StdCall;
ConsoleExit: Procedure(bCloseWindow: Cardinal); StdCall;
WriteN: Procedure(Str: PChar; Count: Dword); StdCall;
(* -------------------------------------------------------- *)
Procedure Main;
(* -------------------------------------------------------- *)
Implementation
(* -------------------------------------------------------- *)
Procedure Main;
Var
FileSize: Dword;
Buffer: Pointer;
Begin
hConsole := LoadLibrary('/sys/lib/console.obj');
ConsoleInit := GetProcAddress(hConsole, 'con_init');
ConsoleExit := GetProcAddress(hConsole, 'con_exit');
WriteN := GetProcAddress(hConsole, 'con_write_string');
ConsoleInit($FFFFFFFF, $FFFFFFFF, $FFFFFFFF, $FFFFFFFF, 'Test');
Buffer := LoadFile('/sys/example.asm', FileSize);
WriteN(Buffer, FileSize);
ConsoleExit(0);
ThreadTerminate;
End;
(* -------------------------------------------------------- *)
End.

View File

@@ -1,43 +0,0 @@
Unit Unit1;
(* -------------------------------------------------------- *)
Interface
(* -------------------------------------------------------- *)
Uses KolibriOS;
(* -------------------------------------------------------- *)
Const
AppPath = PPChar(32);
CmdLine = PPChar(28);
Var
hConsole: Pointer;
ConsoleInit: Procedure(WndWidth, WndHeight, ScrWidth, ScrHeight: Dword; Caption: PChar); StdCall;
ConsoleExit: Procedure(bCloseWindow: Cardinal); StdCall;
printf: Function(Const Format: PChar): Integer; CDecl VarArgs;
(* -------------------------------------------------------- *)
Procedure Main;
(* -------------------------------------------------------- *)
Implementation
(* -------------------------------------------------------- *)
Procedure Main;
Const
BUFFER_SIZE = 256;
Var
Buffer: Array[0..BUFFER_SIZE - 1] Of Char;
Begin
hConsole := LoadLibrary('/sys/lib/console.obj');
ConsoleInit := GetProcAddress(hConsole, 'con_init');
ConsoleExit := GetProcAddress(hConsole, 'con_exit');
printf := GetProcAddress(hConsole, 'con_printf');
ConsoleInit($FFFFFFFF, $FFFFFFFF, $FFFFFFFF, $FFFFFFFF, 'Test');
GetCurrentDirectory(Buffer, BUFFER_SIZE);
printf('AppPath is "%s"'#10, AppPath^);
printf('CmdLine is "%s"'#10, CmdLine^);
printf('CurrentDirectory is "%s"'#10, Buffer);
ConsoleExit(0);
ThreadTerminate;
End;
(* -------------------------------------------------------- *)
End.

View File

@@ -1,130 +0,0 @@
Unit Unit1;
(* -------------------------------------------------------- *)
Interface
(* -------------------------------------------------------- *)
Uses KolibriOS;
(* -------------------------------------------------------- *)
Const
AppPath = PPChar(32);
(* -------------------------------------------------------- *)
Type
TTargaFileHeader = Packed Record
IDLength: Byte;
ColorMapType: Byte;
ImageType: Byte;
CMapStart: Word;
CMapLength: Word;
CMapDepth: Byte;
XOffset: Word;
YOffset: Word;
Width: Word;
Height: Word;
PixelDepth: Byte;
ImageDescriptor: Byte;
End;
TTargaFile = Packed Record
TargaFileHeader: TTargaFileHeader;
End;
PTargaFile = ^TTargaFile;
(* -------------------------------------------------------- *)
Var
Window: TRect;
Screen: TSize;
TargaFile: PTargaFile;
Image: Pointer;
(* -------------------------------------------------------- *)
Procedure Main;
Procedure On_Key;
Procedure On_Button;
Procedure On_Redraw;
Procedure ExtractFileDirectory(Src, Dst: PChar); StdCall;
(* -------------------------------------------------------- *)
Implementation
(* -------------------------------------------------------- *)
Procedure Main;
Var
FileSize: Dword;
Begin
HeapCreate;
ExtractFileDirectory(AppPath^, AppPath^);
SetCurrentDirectory(AppPath^);
TargaFile := LoadFile('Lena.tga', FileSize);
With TargaFile^ Do
With TargaFileHeader Do
Image := Pointer(Dword(TargaFile) + SizeOf(TargaFileHeader) + IDLength);
Screen := GetScreenSize();
With Window Do Begin
With Screen Do Begin
Right := Width Shr 2;
Bottom := Height Shr 2;
Left := (Width - Right) Shr 1;
Top := (Height - Bottom) Shr 1;
End;
End;
While TRUE Do Begin
Case WaitEvent() Of
REDRAW_EVENT: On_Redraw;
KEY_EVENT: On_Key;
BUTTON_EVENT: On_Button;
End;
End;
End;
(* -------------------------------------------------------- *)
Procedure On_Redraw;
Begin
BeginDraw;
With Window Do
DrawWindow(Left, Top, Right, Bottom, 'DrawImage', $00FFFFFF, WS_SKINNED_FIXED + WS_COORD_CLIENT + WS_CAPTION, CAPTION_MOVABLE);
With TargaFile^ Do
With TargaFileHeader Do
DrawImage(Image^, 30, 20, Width, Height);
EndDraw;
End;
(* -------------------------------------------------------- *)
Procedure On_Key;
Begin
GetKey;
End;
(* -------------------------------------------------------- *)
Procedure On_Button;
Begin
Case GetButton().ID Of
1: ThreadTerminate;
End;
End;
(* -------------------------------------------------------- *)
Procedure ExtractFileDirectory(Src, Dst: PChar); StdCall;
Asm
push esi
push edi
xor eax, eax
mov edi, Src
mov esi, edi
mov ecx, $FFFFFFFF
repne scasb
mov al, '/'
std
repne scasb
cld
sub edi, esi
mov ecx, edi
inc ecx
mov edi, Dst
rep movsb
mov byte [edi], 0
pop edi
pop esi
End;
(* -------------------------------------------------------- *)
End.

View File

@@ -1,79 +0,0 @@
Unit Unit1;
(* -------------------------------------------------------- *)
Interface
(* -------------------------------------------------------- *)
Uses KolibriOS;
(* -------------------------------------------------------- *)
Var
Window: TRect;
Screen: TSize;
(* -------------------------------------------------------- *)
Procedure Main;
Procedure On_Key;
Procedure On_Button;
Procedure On_Redraw;
(* -------------------------------------------------------- *)
Implementation
(* -------------------------------------------------------- *)
Procedure Main;
Begin
Screen := GetScreenSize();
With Window Do Begin
With Screen Do Begin
Right := 180;
Bottom := 180;
Left := (Width - Right) Shr 1;
Top := (Height - Bottom) Shr 1;
End;
End;
While TRUE Do Begin
Case WaitEvent() Of
REDRAW_EVENT: On_Redraw;
KEY_EVENT: On_Key;
BUTTON_EVENT: On_Button;
End;
End;
End;
(* -------------------------------------------------------- *)
Procedure On_Redraw;
Var
X, Y: Integer;
Begin
BeginDraw;
With Window Do
DrawWindow(Left, Top, Right, Bottom, 'SetPixel', $00FFFFFF, WS_SKINNED_FIXED + WS_COORD_CLIENT + WS_CAPTION, CAPTION_MOVABLE);
For Y := 0 To 50 Do
For X := 0 To 50 Do
If ((X Mod 2) = 0) Or ((Y Mod 2) = 0) Then
SetPixel(X, Y, $00FF0000);
For Y := 50 To 100 Do
For X := 50 To 100 Do
If ((X Mod 3) = 0) Or ((Y Mod 3) = 0) Then
SetPixel(X, Y, $00007F00);
For Y := 100 To 150 Do
For X := 100 To 150 Do
If ((X Mod 4) = 0) Or ((Y Mod 4) = 0) Then
SetPixel(X, Y, $000000FF);
EndDraw;
End;
(* -------------------------------------------------------- *)
Procedure On_Key;
Begin
GetKey;
End;
(* -------------------------------------------------------- *)
Procedure On_Button;
Begin
Case GetButton().ID Of
1: ThreadTerminate;
End;
End;
(* -------------------------------------------------------- *)
End.

View File

@@ -1,86 +0,0 @@
Unit Unit1;
(* -------------------------------------------------------- *)
Interface
(* -------------------------------------------------------- *)
Uses KolibriOS;
(* -------------------------------------------------------- *)
Var
Window: TRect;
Screen: TSize;
Rectangle: TRect;
(* -------------------------------------------------------- *)
Procedure Main;
Procedure On_Button;
Procedure On_Redraw;
Procedure On_Mouse;
(* -------------------------------------------------------- *)
Implementation
(* -------------------------------------------------------- *)
Procedure Main;
Begin
Screen := GetScreenSize();
With Window Do Begin
With Screen Do Begin
Right := Width Shr 2;
Bottom := Height Shr 2;
Left := (Width - Right) Shr 1;
Top := (Height - Bottom) Shr 1;
End;
End;
With Rectangle Do Begin
Left := 10;
Top := 10;
Right := Window.Right - 20;
Bottom := Window.Bottom - 40;
End;
SetEventMask(EM_REDRAW + EM_BUTTON + EM_MOUSE);
While TRUE Do Begin
Case WaitEvent() Of
REDRAW_EVENT: On_Redraw;
BUTTON_EVENT: On_Button;
MOUSE_EVENT: On_Mouse;
End;
End;
End;
(* -------------------------------------------------------- *)
Procedure On_Redraw;
Begin
BeginDraw;
With Window Do
DrawWindow(Left, Top, Right, Bottom, 'GetPixel', $00FFFFFF, WS_SKINNED_FIXED + WS_COORD_CLIENT + WS_CAPTION, CAPTION_MOVABLE);
With Rectangle Do Begin
DrawLine(Left, Top, Left, Bottom, 0);
DrawLine(Right, Top, Right, Bottom, 0);
DrawLine(Left, Top, Right, Top, 0);
DrawLine(Left, Bottom, Right, Bottom, 0);
End;
EndDraw;
End;
(* -------------------------------------------------------- *)
Procedure On_Button;
Begin
Case GetButton().ID Of
1: ThreadTerminate;
End;
End;
(* -------------------------------------------------------- *)
Procedure On_Mouse;
Var
Point: TPoint;
Begin
Point := GetMousePos();
With Rectangle Do
With Point Do
DrawRectangle(Left + 1, Top + 1, Right - Left - 1, Bottom - Top - 1, GetPixel(X, Y));
End;
(* -------------------------------------------------------- *)
End.

View File

@@ -328,7 +328,7 @@ Const
BLIT_CLIENT_RELATIVE = $20000000; BLIT_CLIENT_RELATIVE = $20000000;
(* -------------------------------------------------------- *) (* -------------------------------------------------------- *)
{-1} Procedure ThreadTerminate; StdCall; {-1} Procedure TerminateThread; StdCall;
{0} Procedure DrawWindow(Left, Top, Right, Bottom: Integer; Caption: PChar; BackColor, Style, CapStyle: Dword); StdCall; {0} Procedure DrawWindow(Left, Top, Right, Bottom: Integer; Caption: PChar; BackColor, Style, CapStyle: Dword); StdCall;
{1} Procedure SetPixel(X, Y: Integer; Color: Dword); StdCall; {1} Procedure SetPixel(X, Y: Integer; Color: Dword); StdCall;
{2} Function GetKey: TKeyboardInput; StdCall; {2} Function GetKey: TKeyboardInput; StdCall;
@@ -358,7 +358,7 @@ Const
{16} Function FlushFloppyCache(FloppyNumber: Dword): Dword; StdCall; {16} Function FlushFloppyCache(FloppyNumber: Dword): Dword; StdCall;
{17} Function GetButton: TButtonInput; StdCall; {17} Function GetButton: TButtonInput; StdCall;
{18.1} Procedure DeactivateWindow(Slot: Dword); StdCall; {18.1} Procedure DeactivateWindow(Slot: Dword); StdCall;
{18.2} Procedure ThreadTerminateBySlot(Slot: Dword); StdCall; {18.2} Procedure TerminateThreadBySlot(Slot: Dword); StdCall;
{18.3} Procedure ActivateWindow(Slot: Dword); StdCall; {18.3} Procedure ActivateWindow(Slot: Dword); StdCall;
{18.4} Function GetIdleTime: Dword; StdCall; {18.4} Function GetIdleTime: Dword; StdCall;
{18.5} Function GetCPUClock: Dword; StdCall; {18.5} Function GetCPUClock: Dword; StdCall;
@@ -375,7 +375,7 @@ Const
{18.15} Function CenterMousePointer: Integer; StdCall; {18.15} Function CenterMousePointer: Integer; StdCall;
{18.16} Function GetFreeMemory: Dword; StdCall; {18.16} Function GetFreeMemory: Dword; StdCall;
{18.17} Function GetAvailableMemory: Dword; StdCall; {18.17} Function GetAvailableMemory: Dword; StdCall;
{18.18} Function ThreadTerminateById(ID: Dword): Integer; StdCall; {18.18} Function TerminateThreadById(ID: Dword): Integer; StdCall;
{18.19.0} Function GetMouseSpeed: Dword; StdCall; {18.19.0} Function GetMouseSpeed: Dword; StdCall;
{18.19.1} Procedure SetMouseSpeed(Speed: Dword); StdCall; {18.19.1} Procedure SetMouseSpeed(Speed: Dword); StdCall;
{18.19.2} Function GetMouseSensitivity: Dword; StdCall; {18.19.2} Function GetMouseSensitivity: Dword; StdCall;
@@ -637,7 +637,7 @@ Const
(* -------------------------------------------------------- *) (* -------------------------------------------------------- *)
Implementation Implementation
(* -------------------------------------------------------- *) (* -------------------------------------------------------- *)
{-1} Procedure ThreadTerminate; StdCall; {-1} Procedure TerminateThread; StdCall;
Asm Asm
mov eax, $FFFFFFFF mov eax, $FFFFFFFF
int 64 int 64
@@ -985,7 +985,7 @@ Implementation
pop ebx pop ebx
End; End;
(* -------------------------------------------------------- *) (* -------------------------------------------------------- *)
{18.2} Procedure ThreadTerminateBySlot(Slot: Dword); StdCall; {18.2} Procedure TerminateThreadBySlot(Slot: Dword); StdCall;
Asm Asm
push ebx push ebx
mov eax, 18 mov eax, 18
@@ -1139,7 +1139,7 @@ Implementation
pop ebx pop ebx
End; End;
(* -------------------------------------------------------- *) (* -------------------------------------------------------- *)
{18.18} Function ThreadTerminateById(ID: Dword): Integer; StdCall; {18.18} Function TerminateThreadById(ID: Dword): Integer; StdCall;
Asm Asm
push ebx push ebx
mov eax, 18 mov eax, 18

View File

@@ -1,127 +0,0 @@
Program Test;
(* -------------------------------------------------------- *)
Uses KolibriOS;
(* -------------------------------------------------------- *)
Type
PPChar = ^PChar;
(* -------------------------------------------------------- *)
Const
AppPath = PPChar(32);
CmdLine = PPChar(28);
CURRENT_DIRECTORY_SIZE = 1024;
(* -------------------------------------------------------- *)
Var
hConsole: Pointer;
ConsoleInit: Procedure(WndWidth, WndHeight, ScrWidth, ScrHeight: Dword; Caption: PChar); StdCall;
ConsoleExit: Procedure(bCloseWindow: Boolean); StdCall;
Printf: Function(Const Format: PChar): Integer; CDecl VarArgs;
GetCh: Function(): Char; StdCall;
CurrentDirectory: Array[0..CURRENT_DIRECTORY_SIZE - 1] Of Char;
BytesRead: Dword;
BytesWritten: Dword;
FileAttributes: TFileAttributes;
FileBuffer: Pointer;
Res: LongInt;
(* -------------------------------------------------------- *)
Procedure ExtractFileDirectory(Src, Dst: PChar); StdCall;
Asm
push esi
push edi
xor eax, eax
mov edi, Src
mov esi, edi
mov ecx, $FFFFFFFF
repne scasb
mov al, '/'
std
repne scasb
cld
sub edi, esi
mov ecx, edi
inc ecx
mov edi, Dst
rep movsb
mov byte [edi], 0
pop edi
pop esi
End;
(* -------------------------------------------------------- *)
Procedure WaitKeyAndExit;
Begin
Printf(#10'Press key to exit ...');
GetCh;
ConsoleExit(TRUE);
ThreadTerminate;
End;
(* -------------------------------------------------------- *)
Begin
hConsole := LoadLibrary('/sys/lib/console.obj');
ConsoleInit := GetProcAddress(hConsole, 'con_init');
ConsoleExit := GetProcAddress(hConsole, 'con_exit');
Printf := GetProcAddress(hConsole, 'con_printf');
GetCh := GetProcAddress(hConsole, 'con_getch');
ConsoleInit($FFFFFFFF, $FFFFFFFF, $FFFFFFFF, $FFFFFFFF, AppPath^);
GetCurrentDirectory(CurrentDirectory, CURRENT_DIRECTORY_SIZE);
Printf('AppPath = "%s"'#10, AppPath^);
Printf('CmdLine = "%s"'#10, CmdLine^);
Printf('CurrentDirectory = "%s"'#10, CurrentDirectory);
ExtractFileDirectory(AppPath^, CurrentDirectory);
SetCurrentDirectory(CurrentDirectory);
Printf('Set current directory to "%s"'#10, CurrentDirectory);
GetCurrentDirectory(CurrentDirectory, CURRENT_DIRECTORY_SIZE);
Printf('CurrentDirectory = "%s"'#10, CurrentDirectory);
Res := GetFileAttributes(AppPath^, FileAttributes);
If Res = 0 Then
Printf('File size = %d bytes'#10, FileAttributes.SizeLo)
Else Begin
Printf('GetFileAttributes error = %d'#10, Res);
WaitKeyAndExit;
End;
FileBuffer := HeapAllocate(FileAttributes.SizeLo);
Res := ReadFile(AppPath^, FileBuffer^, FileAttributes.SizeLo, 0, 0, BytesRead);
If Res = 0 Then
Printf('ReadFile success, BytesRead = %d bytes'#10, BytesRead)
Else Begin
Printf('ReadFile error = %d'#10, Res);
WaitKeyAndExit;
End;
Res := CreateFolder('NewFolder');
If Res = 0 Then
Printf('CreateFolder success.'#10)
Else Begin
Printf('CreateFolder error = %d'#10, Res);
WaitKeyAndExit;
End;
SetCurrentDirectory('./NewFolder');
Res := CreateFile('CopyOfProgramFile.kex');
If Res = 0 Then
Printf('CreateFile success.'#10)
Else Begin
Printf('CreateFile error = %d'#10, Res);
WaitKeyAndExit;
End;
Res := WriteFile('CopyOfProgramFile.kex', FileBuffer^, FileAttributes.SizeLo, 0, 0, BytesWritten);
If Res = 0 Then
Printf('WriteFile success, BytesWritten = %d bytes'#10, BytesWritten)
Else Begin
Printf('WriteFile error = %d'#10, Res);
WaitKeyAndExit;
End;
HeapFree(FileBuffer);
WaitKeyAndExit;
End.

View File

@@ -1,4 +1,5 @@
Copyright © 2017-2019 0CodErr Copyright © 2017-2019 0CodErr
Copyright © 2020 Vladislav Javadov (aka Freeman)
All rights reserved. All rights reserved.
Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: