Тема: TextView(пример Scrollbar + OpenDialog)
Пример, аналогичный ImageView, но вместо картинки грузится текстовый файл, из текста которого и формируется выводимое на экран изображение.
По умолчанию грузится файл "/sys/example.asm".
Вызов OpenDialog для выбора файла осуществляется зелёной кнопкой в левом верхнем углу, а также клавишей Enter.
Клавиши со стрелками вверх\вниз\влево\вправо — для скроллинга изображения.
Некоторые нюансы:
На практике формировать изображение сразу целиком и полностью крайне не рационально из-за слишком большого расхода памяти.
Но цель этого примера — показать саму возможность вывода системного шрифта с помощью системной функции DrawText в буфер и последующий вывод изображения из буфера на экран.Ограничение системной функции: координаты X, Y могут быть только в пределах 0..65535 — этого может быть недостаточно для практического использования.
Тем более, удивление может вызвать формат структуры буфера: Width, Height(ширина и высота) могут принимать 32-битные значения, которые могут быть больше 65535,
в то время как размерность координат ограничена 16-ю битами.
type
// структура буфера, в который DrawText выводит текст
PDrawTextBuffer = ^TDrawTextBuffer;
TDrawTextBuffer = packed record
Width: LongWord; // ширина изображения
Height: LongWord; // высота изображения
Img: array [0..0{Width * Height * SizeOf(LongWord)}] of LongWord; // само 32-битное изображение
end;из-за ограничения по координатам вытекает и ограничение на максимальное количество строк
var
// координаты X, Y в DrawText могут быть в пределах 0..65535 — ограничение системной функции
// путём нехитрых вычислений для шрифта 8x16 получаем:
// 65535 / 16 = 4095.9375 — это максимально возможное число
// поэтому количество строк у нас будет максимум 4095
Strings: array [0..4094] of PAnsiChar;
StringsCount: LongWord = 0;Конечно, в реальных проектах лучше использовать буфер размером, сравнимым с размером области отображения на экране.
Также можно использовать не системный шрифт, 8-битный формат итогового буфера с палитрой(экономия по памяти в 4 раза).
Вот полностью исходный код:
program TextView;
uses
KolibriOS;
type
PScrollbar = ^TScrollbar;
TScrollbar = packed record
size_x : SmallInt;
start_x : SmallInt;
size_y : SmallInt;
start_y : SmallInt;
btn_high : LongInt; // высота боковых кнопок (левая и правая для гориз. и верхняя и нижняя для верт.)
type_ : LongInt;
max_area : LongInt; // область максимальная, актуально когда не влазит в отображаемую область, т.е. случай активности компонента. (весь максимальный размер документа)
cur_area : LongInt; // область отображаемая (какая часть документа влазит в экран)
position : LongInt; // позиция бегунка изменяемая от 0 до значения x=(max_area-cur_area)
bckg_col : LongInt; // цвет внутренний, применяется для областей между бегунком и кноками
frnt_col : LongInt; // цвет наружный, применяется для областей отличных от применяемых в bckg_col
line_col : LongInt; // цвет линий и стрелок на кнопках
redraw : LongInt; // индикатор необходимости перерисовки управляемой области учитывая изменение position и cur_area
delta : SmallInt;
delta2 : SmallInt; // индикатор захвата фокуса скроллбаром (удержание бегунка)
r_size_x : SmallInt;
r_start_x : SmallInt;
r_size_y : SmallInt;
r_start_y : SmallInt;
m_pos : LongInt;
m_pos_2 : LongInt;
m_keys : LongInt;
run_size : LongInt;
position2 : LongInt;
work_size : LongInt;
all_redraw : LongInt; // флаг устанавливаемый в 1 для перерисовки всего компонента, если поставить 0, то перерисовка происходит только для области бегунка
ar_offset : LongInt; // величина смещения при однократном нажатии боковой кнопки
end;
const
BUTTON_OPEN = 100; // зелёная кнопка вызова OpenDialog
// key codes
KC_LEFT = #176;
KC_RIGHT = #179;
KC_UP = #178;
KC_DOWN = #177;
KC_ENTER = #13;
const
FilePath: PAnsiChar = '/sys/example.asm';
var
WndLeft, WndTop: LongInt;
WndWidth, WndHeight: LongWord;
ImgViewPort: TBox = (Left: 17; Top: 17);
SC: TStandardColors;
ThreadInfo: TThreadInfo;
BoxLib: Pointer;
scrollbar_v_draw: procedure(var Scrollbar: TScrollbar); stdcall;
scrollbar_v_mouse: procedure(var Scrollbar: TScrollbar); stdcall;
scrollbar_h_draw: procedure(var Scrollbar: TScrollbar); stdcall;
scrollbar_h_mouse: procedure(var Scrollbar: TScrollbar); stdcall;
VScrollbar: TScrollbar = (
size_x: 16;
start_x: 0;
size_y: 150;
start_y: 17;
btn_high: 16;
type_: 1);
HScrollbar: TScrollbar = (
size_x: 150;
start_x: 17;
size_y: 16;
start_y: 0;
btn_high: 16;
type_: 1);
procedure On_Redraw; forward;
const
// OpenDialog.Mode constants
ODM_OPEN = 0;
ODM_SAVE = 1;
ODM_DIR = 2;
// OpenDialog.Status constants
ODS_CANCEL = 0;
ODS_OK = 1;
ODS_ALTER = 2;
type
// actually structure is:
// first four bytes - size of this structure
// and next are zero separated string values
TOpenDialogFilter = packed record
Size: LongWord;
Text: array [0..SizeOf(ShortString) - 1] of AnsiChar;
end;
TOpenDialog = packed record
Mode: LongWord;
ProcInfo: Pointer;
ComAreaName: PAnsiChar;
ComArea: Pointer;
OpenDirPath: PAnsiChar;
DirDefaultPath: PAnsiChar;
StartPath: PAnsiChar;
DrawWindow: procedure;
Status: LongWord;
OpenFilePath: PAnsiChar;
FileNameArea: PAnsiChar;
FilterArea: ^TOpenDialogFilter;
XSize: Word; // at least 350
XStart: SmallInt;
YSize: Word; // at least 250
YStart: SmallInt;
end;
const
PROC_INFO_BUFFER_SIZE = SizeOf(TThreadInfo);
OPEN_FILE_PATH_BUFFER_SIZE = 4096;
FILE_NAME_AREA_BUFFER_SIZE = 1024;
OPEN_DIR_PATH_BUFFER_SIZE = OPEN_FILE_PATH_BUFFER_SIZE - FILE_NAME_AREA_BUFFER_SIZE;
var
ProcLib: Pointer;
OpenDialogInit: procedure(var OpenDialog: TOpenDialog); stdcall;
OpenDialogStart: procedure(var OpenDialog: TOpenDialog); stdcall;
OpenDialogFilter: TOpenDialogFilter;
FileNameAreaBuffer: array [0..FILE_NAME_AREA_BUFFER_SIZE - 1] of AnsiChar;
OpenFilePathBuffer: array [0..OPEN_FILE_PATH_BUFFER_SIZE - 1] of AnsiChar;
OpenDirPathBuffer: array [0..OPEN_DIR_PATH_BUFFER_SIZE - 1] of AnsiChar;
ProcInfoBuffer: array [0..PROC_INFO_BUFFER_SIZE - 1] of Byte;
OpenDialog: TOpenDialog = (
Mode: ODM_OPEN;
ProcInfo: @ProcInfoBuffer;
ComAreaName: 'FFFFFFFF_open_dialog';
OpenDirPath: @OpenDirPathBuffer[0];
DirDefaultPath: '/sys';
StartPath: '/sys/File managers/opendial';
DrawWindow: On_Redraw;
OpenFilePath: @OpenFilePathBuffer[0];
FileNameArea: @FileNameAreaBuffer[0];
FilterArea: @OpenDialogFilter;
XSize: 400;
YSize: 480);
// copy comma separated string values from Filter
// to OpenDialogFilter and replace commas with zeroes
// 'txt,png,bmp' -> 'txt'#0'png'#0'bmp'#0
procedure OpenDialogSetFilter(Filter: PAnsiChar);
var
i: LongWord;
begin
i := 0;
with OpenDialogFilter do
begin
Text[High(Text)] := #0;
repeat
if Filter[i] = ',' then
Text[i] := #0
else
Text[i] := Filter[i];
Inc(i);
until (Filter[i - 1] = #0) or (i = High(Text));
Size := i + SizeOf(Size);
end;
end;
const
// флаг для DrawText, чтобы выводить текст в буфер
DT_BUFFER = $8000000;
type
// структура буфера, в который DrawText выводит текст
PDrawTextBuffer = ^TDrawTextBuffer;
TDrawTextBuffer = packed record
Width: LongWord; // ширина изображения
Height: LongWord; // высота изображения
Img: array [0..0{Width * Height * SizeOf(LongWord)}] of LongWord; // само 32-битное изображение
end;
var
// координаты X, Y в DrawText могут быть в пределах 0..65535 — ограничение системной функции
// путём нехитрых вычислений для шрифта 8x16 получаем:
// 65535 / 16 = 4095.9375 — это маскимально возможное число
// поэтому количество строк у нас будет максимум 4095
Strings: array [0..4094] of PAnsiChar;
StringsCount: LongWord = 0;
imgBuffer: PDrawTextBuffer;
ForeColor: LongWord = $00CFCFC0;
BackColor: LongWord = $0040404F;
CharWidth: LongWord = 8; // ширина системного шрифта 8x16
CharHeight: LongWord = 16; // высота системного шрифта 8x16
TxtFile: PAnsiChar;
TxtFileSize: LongWord;
function StrLen(Src: PAnsiChar): LongWord;
var
P: PAnsiChar;
begin
P := Src;
while (P^ <> #0) do
Inc(P);
Result := P - Src;
end;
procedure FillLongWord(var Dest; Count: LongInt; Value: LongWord);
type
PLongWordArray = ^TLongWordArray;
TLongWordArray = array [0..0] of LongWord;
var
i: LongInt;
begin
for i := 0 to Count - 1 do
PLongWordArray(@Dest)[i] := Value;
end;
procedure AddString(PtrToString: PAnsiChar);
begin
Strings[StringsCount] := PtrToString;
Inc(StringsCount);
end;
function GetMaxStringLength: LongInt;
var
i, CurrentLength: LongInt;
begin
Result := 0;
for i := 0 to StringsCount - 1 do
begin
CurrentLength := StrLen(Strings[i]);
if CurrentLength > Result then
Result := CurrentLength;
end;
end;
procedure DrawStringsToBuffer;
var
i: LongInt;
Y: LongInt;
begin
Y := 0;
for i := 0 to StringsCount - 1 do
begin
DrawText(0, Y, Strings[i], ForeColor, LongWord(imgBuffer), DT_ZSTRING + DT_CP866_8x16 + DT_BUFFER, 0);
Inc(Y, CharHeight);
end;
end;
procedure DrawImg(const Src; SrcX, SrcY: LongInt; SrcW, SrcH: LongWord; DstX, DstY: LongInt; DstW, DstH, BPP: LongWord; Palette: Pointer);
var
W, H, Pad: LongWord;
Img: Pointer;
begin
Img := Pointer(LongInt(@Src) + (SrcY * LongInt(SrcW) + SrcX) * LongInt(BPP) div 8);
if DstW > SrcW then
begin
W := SrcW;
Pad := 0;
end
else
begin
W := DstW;
Pad := (SrcW - DstW) * BPP div 8;
end;
if DstH > SrcH then
H := SrcH
else
H := DstH;
DrawImageEx(Img^, DstX, DstY, W, H, BPP, Palette, Pad);
end;
procedure On_Change;
begin
if TxtFileSize > 0 then
DrawImg(imgBuffer.Img, HScrollbar.Position, VScrollbar.Position,
imgBuffer.Width, imgBuffer.Height, ImgViewPort.Left, ImgViewPort.Top,
ImgViewPort.Width, ImgViewPort.Height, 32, nil);
end;
procedure On_Redraw;
begin
BeginDraw;
GetStandardColors(SC, SizeOf(TStandardColors));
DrawWindow(WndLeft, WndTop, WndWidth, WndHeight, 'Text View; Enter - open file', SC.Work,
WS_SKINNED_SIZABLE + WS_CLIENT_COORDS + WS_CAPTION, CAPTION_MOVABLE);
GetThreadInfo($FFFFFFFF, ThreadInfo);
DrawButton(0, 0, 16, 16, $0077FF77, 0, BUTTON_OPEN);
with ImgViewPort do
begin
Width := TBox(ThreadInfo.Client).Width - Left + 1;
Height := TBox(ThreadInfo.Client).Height - Top + 1;
end;
with HScrollbar do
begin
bckg_col := SC.Work;
frnt_col := SC.WorkButton;
line_col := SC.WorkButtonText;
all_redraw := 1;
max_area := imgBuffer.Width;
if (max_area > ImgViewPort.Width) and (max_area <> cur_area) then
position := position * longint(max_area - ImgViewPort.Width) div (max_area - cur_area)
else
position := 0;
cur_area := ImgViewPort.Width;
size_x := TBox(ThreadInfo.Client).Width - start_x + 1;
ar_offset := (max_area - cur_area) div 100; // смещение при нажатии на кнопки скроллбара 1 процент(одна сотая часть)
if ar_offset = 0 then ar_offset := 1 // но не менее единицы
end;
with VScrollbar do
begin
bckg_col := SC.Work;
frnt_col := SC.WorkButton;
line_col := SC.WorkButtonText;
all_redraw := 1;
max_area := imgBuffer.Height;
if (max_area > ImgViewPort.Height) and (max_area <> cur_area) then
position := position * longint(max_area - ImgViewPort.Height) div (max_area - cur_area)
else
position := 0;
cur_area := ImgViewPort.Height;
size_y := TBox(ThreadInfo.Client).Height - start_y + 1;
ar_offset := (max_area - cur_area) div 100; // смещение при нажатии на кнопки скроллбара 1 процент(одна сотая часть)
if ar_offset = 0 then ar_offset := 1 // но не менее единицы
end;
scrollbar_v_draw(VScrollbar);
scrollbar_h_draw(HScrollbar);
On_Change;
EndDraw;
end;
procedure On_MouseEvent();
var
HScrollBarLastPos, VScrollBarLastPos: LongInt;
begin
// запоминаем позиции скроллбаров
HScrollBarLastPos := HScrollBar.position;
VScrollBarLastPos := VScrollBar.position;
scrollbar_v_mouse(VScrollbar);
scrollbar_h_mouse(HScrollbar);
// похоже есть баг в самом скроллбаре, делаем workaround для него
// при нажатии на кнопки со стрелочками при опр. условии позиция не должна меняться
with VScrollBar do
if not (max_area > cur_area) then position := 0;
with HScrollBar do
if not (max_area > cur_area) then position := 0;
// если позиции изменились, то нужно перерисовать изменённую область
if (HScrollBarLastPos <> HScrollBar.position) or
(VScrollBarLastPos <> VScrollBar.position) then
On_Change;
end;
procedure ChangeScrollBarPosition(var ScrollBar: TScrollBar; Value: LongInt); // Value в процентах
begin
with Scrollbar do
begin
if max_area > cur_area then
begin
Value := (max_area - cur_area) * Value div 100;
Inc(Position, Value);
if Position < 0 then
Position := 0
else
if Position > max_area - cur_area then
Position := max_area - cur_area;
if @ScrollBar = @VScrollBar then
scrollbar_v_draw(VScrollbar)
else
if @ScrollBar = @HScrollBar then
scrollbar_h_draw(HScrollbar);
On_Change;
end;
end;
end;
procedure OpenFile(FilePath: PAnsiChar);
var
FileAttributes: TFileAttributes;
BytesRead: LongWord;
MaxStringLength: LongInt;
procedure ProcessStrings;
var
i: LongWord;
P: PAnsiChar;
begin
P := PAnsiChar(@TxtFile[0]);
i := 0;
while i < TxtFileSize do
begin
case TxtFile[i] of
#13{CR}:
begin
TxtFile[i] := #0; // нулевой символ конца строки
if i + 1 < TxtFileSize then
if TxtFile[i + 1] = #10{LF} then // если CR + LF(стиль DOS\Windows)
begin
Inc(i);
TxtFile[i] := #0; // нулевой символ конца строки
end;
AddString(P);
P := PAnsiChar(@TxtFile[i + 1]);
end;
#10{LF}:
begin
TxtFile[i] := #0; // нулевой символ конца строки
AddString(P);
P := PAnsiChar(@TxtFile[i + 1]);
end;
else
// ничего не делаем
end;
Inc(i);
end;
// если в файле вообще хоть что-то было
if TxtFileSize > 0 then
// если предыдущий символ не был заменён на нулевой символ конца строки
// то это значит, что предыдущая строка ещё не добавлена и её надо добавить
if TxtFile[i - 1] <> #0 then
AddString(P);
end;
begin
if GetFileAttributes(FilePath, FileAttributes) = 0 then // если файл доступен
begin
if Assigned(TxtFile) then
HeapFree(TxtFile);
TxtFileSize := FileAttributes.Size;
TxtFile := HeapAllocate(TxtFileSize);
ReadFile(FilePath, TxtFile^, TxtFileSize, 0, BytesRead);
StringsCount := 0;
ProcessStrings;
MaxStringLength := GetMaxStringLength;
imgBuffer := HeapAllocate(CharWidth * CharHeight * MaxStringLength * StringsCount * SizeOf(LongWord) + SizeOf(LongWord) * 2);
with imgBuffer^ do
begin
Width := MaxStringLength * CharWidth;
Height := StringsCount * CharHeight;
FillLongWord(imgBuffer.Img, Width * Height, BackColor);
end;
DrawStringsToBuffer;
HScrollbar.Position := 0;
VScrollbar.Position := 0;
end;
end;
procedure ShowOpenDialog;
begin
OpenDialogStart(OpenDialog);
if OpenDialog.Status = ODS_OK then
OpenFile(OpenDialog.OpenFilePath);
end;
begin
BoxLib := LoadLibrary('/sys/lib/box_lib.obj');
scrollbar_v_draw := GetProcAddress(BoxLib, 'scrollbar_v_draw');
scrollbar_v_mouse := GetProcAddress(BoxLib, 'scrollbar_v_mouse');
scrollbar_h_draw := GetProcAddress(BoxLib, 'scrollbar_h_draw');
scrollbar_h_mouse := GetProcAddress(BoxLib, 'scrollbar_h_mouse');
ProcLib := LoadLibrary('/sys/lib/proc_lib.obj');
OpenDialogInit := GetProcAddress(proclib, 'OpenDialog_init');
OpenDialogStart := GetProcAddress(proclib, 'OpenDialog_start');
OpenDialogInit(OpenDialog);
OpenDialogSetFilter('txt, log, dat, ini, inf, conf, cpp, h, c, c--, pas, pp, ob07, asm, inc, mac, lua, php, py, rb, vbs, mak');
// пробуем загрузить файл по умолчанию
OpenFile(FilePath);
with GetScreenSize do
begin
WndWidth := Width * 2 div 3;
WndHeight := Height * 3 div 4;
WndLeft := (Width - WndWidth) div 2;
WndTop := (Height - WndHeight) div 2;
end;
SetEventMask(EM_REDRAW + EM_KEY + EM_BUTTON + EM_MOUSE);
On_Redraw;
while True do
case WaitEvent of
REDRAW_EVENT:
On_Redraw;
KEY_EVENT:
begin
case GetKey.Code of
KC_ENTER:
ShowOpenDialog;
KC_LEFT:
ChangeScrollBarPosition(HScrollBar, -10{процентов});
KC_RIGHT:
ChangeScrollBarPosition(HScrollBar, +10{процентов});
KC_UP:
ChangeScrollBarPosition(VScrollBar, -10{процентов});
KC_DOWN:
ChangeScrollBarPosition(VScrollBar, +10{процентов});
end;
end;
MOUSE_EVENT:
if GetActiveWindow = GetSlotById(ThreadInfo.Identifier) then
On_MouseEvent;
BUTTON_EVENT:
case GetButton.ID of
BUTTON_OPEN:
ShowOpenDialog;
else
Break;
end;
end;
end.Прикладываю скомпилированный пример TextView.kex
Post's attachments
TextView.kex 2.18 Кб, 57 скачиваний с 2022-01-10
TextView.PNG 19.03 Кб, 55 скачиваний с 2022-01-10