modified KBLVisualizer.dof
modified KBLVisualizer.dpr modified KBLVisualizer.txt modified KBLVisualizerU.dfm modified KBLVisualizerU.pas -FIXED: palette of loaded .bmp was used instead of truecolor -unicode support -"New"-button -"Modified"-checks and questions to save/abort -ColorEditor -unicode-Table from unicode-index.txt -Syntax-Helper -some error handling -PopOnTop icon for application -Support for row-specific colors -rewrote keymap-painting, now behaves correctly -renamed from "KBL-Editor" to "KBL-Visualizer"
This commit is contained in:
mbirth
parent
b154ad549e
commit
bf6566904c
@ -113,9 +113,9 @@ RootDir=
|
||||
IncludeVerInfo=1
|
||||
AutoIncBuild=1
|
||||
MajorVer=1
|
||||
MinorVer=0
|
||||
MinorVer=1
|
||||
Release=0
|
||||
Build=3
|
||||
Build=8
|
||||
Debug=0
|
||||
PreRelease=0
|
||||
Special=0
|
||||
@ -125,12 +125,12 @@ Locale=1033
|
||||
CodePage=1252
|
||||
[Version Info Keys]
|
||||
CompanyName=
|
||||
FileDescription=KBL-Editor
|
||||
FileVersion=1.0.0.3
|
||||
InternalName=KBLEdit
|
||||
FileDescription=KBL-Visualizer
|
||||
FileVersion=1.1.0.8
|
||||
InternalName=KBLVisualizer
|
||||
LegalCopyright=(c)2004 by Markus Birth <mbirth@webwriters.de>
|
||||
LegalTrademarks=
|
||||
OriginalFilename=KBLEdit.exe
|
||||
ProductName=KBL-Editor
|
||||
ProductVersion=1.0.0.0
|
||||
OriginalFilename=KBLVisualizer.exe
|
||||
ProductName=KBL-Visualizer
|
||||
ProductVersion=1.1.0.0
|
||||
Comments=Editor to visualize keyboard layouts for PopOnTop of Symbitz Software.
|
||||
|
||||
@ -1,14 +1,14 @@
|
||||
program KBLEdit;
|
||||
program KBLVisualizer;
|
||||
|
||||
uses
|
||||
Forms,
|
||||
KBLEditU in 'KBLEditU.pas' {KBLEditForm};
|
||||
KBLVisualizerU in 'KBLVisualizerU.pas' {KBLEditForm};
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
Application.Initialize;
|
||||
Application.Title := 'PopOnTop Keyboard Layout Editor';
|
||||
Application.Title := 'PopOnTop Keyboard Layout Visualizer';
|
||||
Application.CreateForm(TKBLEditForm, KBLEditForm);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
KBL-Editor
|
||||
KBL-Visualizer
|
||||
(c)2004 by Markus Birth <mbirth@webwriters.de>
|
||||
==============================================
|
||||
|
||||
@ -11,8 +11,7 @@ The program itself should be self-explanatory.
|
||||
The left area is the working space which
|
||||
contains the keyboard layout you are working
|
||||
on. You can open and save your work using the
|
||||
buttons above the text area. THE PROGRAM WON'T
|
||||
ASK YOU TO SAVE YOUR WORK BEFORE EXITING!
|
||||
buttons above the text area.
|
||||
|
||||
The right hand side shows a preview of the
|
||||
keyboard so that you get an idea how it
|
||||
@ -20,15 +19,33 @@ looks like. Use the SpinControl next to the
|
||||
"Visualize!"-button to select the map you
|
||||
want to see.
|
||||
|
||||
The bottom left corner contains the unicode
|
||||
table. It is loaded from the file
|
||||
unicode-index.txt . A double-click on a row
|
||||
will paste the unicode at the cursor position.
|
||||
|
||||
Bottom right there is the color editor. If you
|
||||
selected a color-value in your kbl, click on
|
||||
the "Get"-button to load the value into the
|
||||
color editor. After changing it, you can paste
|
||||
it back into your file with the "Insert"-button.
|
||||
|
||||
Landscape keyboards are not yet supported.
|
||||
|
||||
I don't take *ANY* responsibility for any
|
||||
damage to your computer which might occur by
|
||||
using this program.
|
||||
|
||||
Please make sure the file KBLEdit.bmp is in
|
||||
the same directory as KBLEdit.exe. If you
|
||||
rename KBLEdit.exe, do so with KBLEdit.bmp.
|
||||
Please make sure the file KBLVisualizer.bmp is
|
||||
in the same directory as KBLVisualizer.exe. If
|
||||
you rename KBLVisualizer.exe, do so with the bmp.
|
||||
|
||||
Feel free to replace KBLEdit.bmp by a screen-
|
||||
Also make sure the file unicode-index.txt is
|
||||
besides the other files. You can get an updated
|
||||
list of unicodes from [1]. After download, just
|
||||
rename it to unicode-index.txt .
|
||||
|
||||
Feel free to replace KBLVisualizer.bmp by a screen-
|
||||
shot of your own Px00. (208x320 pixels)
|
||||
|
||||
[1] http://www.unicode.org/Public/UNIDATA/Index.txt
|
||||
|
||||
1188
KBLVisualizerU.dfm
1188
KBLVisualizerU.dfm
File diff suppressed because it is too large
Load Diff
@ -1,10 +1,10 @@
|
||||
unit KBLEditU;
|
||||
unit KBLVisualizerU;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows, Forms, Graphics, SysUtils, StrUtils, Spin, ExtCtrls, Dialogs,
|
||||
StdCtrls, Controls, Classes;
|
||||
StdCtrls, Controls, Classes, ComCtrls, Grids, Clipbrd;
|
||||
|
||||
type
|
||||
TKBLEditForm = class(TForm)
|
||||
@ -12,18 +12,46 @@ type
|
||||
SaveDialog1: TSaveDialog;
|
||||
Px00Screen: TImage;
|
||||
Memo1: TMemo;
|
||||
Button1: TButton;
|
||||
Button2: TButton;
|
||||
Button3: TButton;
|
||||
Button4: TButton;
|
||||
Stat: TListBox;
|
||||
ButtonOpen: TButton;
|
||||
ButtonSave: TButton;
|
||||
ButtonSaveAs: TButton;
|
||||
ButtonVisualize: TButton;
|
||||
Status: TListBox;
|
||||
SpinEdit1: TSpinEdit;
|
||||
Label1: TLabel;
|
||||
procedure Button4Click(Sender: TObject);
|
||||
procedure Button1Click(Sender: TObject);
|
||||
procedure Button3Click(Sender: TObject);
|
||||
LabelByMarkusBirth: TLabel;
|
||||
Unicodes: TStringGrid;
|
||||
ButtonNew: TButton;
|
||||
TrackR: TTrackBar;
|
||||
LabelR: TLabel;
|
||||
TrackG: TTrackBar;
|
||||
TrackB: TTrackBar;
|
||||
LabelG: TLabel;
|
||||
LabelB: TLabel;
|
||||
ButtonColorInsert: TButton;
|
||||
ButtonColorGet: TButton;
|
||||
ColorPanel: TPanel;
|
||||
LabelColorEditor: TLabel;
|
||||
LabelUnicodeTable: TLabel;
|
||||
LabelFile: TLabel;
|
||||
LabelSyntax: TLabel;
|
||||
TimerScroll: TTimer;
|
||||
procedure ButtonVisualizeClick(Sender: TObject);
|
||||
procedure ButtonOpenClick(Sender: TObject);
|
||||
procedure ButtonSaveAsClick(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure Button2Click(Sender: TObject);
|
||||
procedure ButtonSaveClick(Sender: TObject);
|
||||
procedure UnicodesKeyPress(Sender: TObject; var Key: Char);
|
||||
procedure UnicodesDblClick(Sender: TObject);
|
||||
procedure ButtonNewClick(Sender: TObject);
|
||||
procedure TrackRChange(Sender: TObject);
|
||||
procedure TrackGChange(Sender: TObject);
|
||||
procedure TrackBChange(Sender: TObject);
|
||||
procedure ButtonColorInsertClick(Sender: TObject);
|
||||
procedure ButtonColorGetClick(Sender: TObject);
|
||||
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
||||
procedure Memo1Change(Sender: TObject);
|
||||
procedure TimerScrollTimer(Sender: TObject);
|
||||
procedure Memo1Click(Sender: TObject);
|
||||
private
|
||||
{ Private declarations }
|
||||
public
|
||||
@ -38,6 +66,12 @@ implementation
|
||||
|
||||
{$R *.dfm}
|
||||
|
||||
const
|
||||
Hexmap = '0123456789ABCDEF';
|
||||
unicodefile = 'unicode-index.txt';
|
||||
debug = false;
|
||||
CRLF = Chr(13)+Chr(10);
|
||||
|
||||
type
|
||||
TArray = array of string;
|
||||
TKey = record
|
||||
@ -48,7 +82,11 @@ type
|
||||
ink: TColor;
|
||||
legend: string;
|
||||
end;
|
||||
TRow = array of TKey;
|
||||
TRow = record
|
||||
keys: array of TKey;
|
||||
keycap: TColor;
|
||||
ink: TColor;
|
||||
end;
|
||||
TMap = record
|
||||
landscape: boolean;
|
||||
fullscreen: boolean;
|
||||
@ -62,9 +100,33 @@ type
|
||||
Data: array of TRow;
|
||||
end;
|
||||
|
||||
var titlestore: AnsiString;
|
||||
exoc: boolean = false;
|
||||
|
||||
procedure ClearScreen;
|
||||
begin
|
||||
KBLEditForm.Px00Screen.Picture.LoadFromFile(ChangeFileExt(Application.ExeName,'.bmp'));
|
||||
with KBLEditForm.Px00Screen do begin
|
||||
Picture.LoadFromFile(ChangeFileExt(Application.ExeName,'.bmp'));
|
||||
Picture.Bitmap.PixelFormat := pf24bit;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Stat(s: string);
|
||||
begin
|
||||
if (debug) then begin
|
||||
with KBLEditForm.Status do begin
|
||||
Items.Add(s);
|
||||
TopIndex := Items.Count-3;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure UpdateTitle;
|
||||
begin
|
||||
with KBLEditForm do begin
|
||||
if (Length(titlestore)=0) then titlestore := Caption;
|
||||
if (Length(LabelFile.Caption)>0) then Caption := titlestore + ' - [' + LabelFile.Caption + ']' else Caption := titlestore;
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetMap(x: integer): TArray;
|
||||
@ -89,19 +151,19 @@ begin
|
||||
Result := r;
|
||||
end;
|
||||
|
||||
function Split(x: string): TArray;
|
||||
function Split(x, s: string): TArray;
|
||||
var i,p,o: integer;
|
||||
r: TArray;
|
||||
begin
|
||||
i := 0;
|
||||
o := 1;
|
||||
SetLength(r, 50);
|
||||
p := PosEx(',',x,o);
|
||||
p := PosEx(s,x,o);
|
||||
while (p>0) do begin
|
||||
r[i] := Copy(x,o,p-o);
|
||||
Inc(i);
|
||||
o := p+1;
|
||||
p := PosEx(',',x,o);
|
||||
p := PosEx(s,x,o);
|
||||
end;
|
||||
r[i] := Copy(x,o,Length(x)-o+1);
|
||||
Inc(i);
|
||||
@ -110,24 +172,35 @@ begin
|
||||
end;
|
||||
|
||||
function Hex2Col(h: string): TColor;
|
||||
const Hexmap = '0123456789ABCDEF';
|
||||
var r,g,b: integer;
|
||||
begin
|
||||
h := UpperCase(h);
|
||||
r := (Pos(h[1],hexmap)-1)*16 + (Pos(h[2],hexmap)-1);
|
||||
g := (Pos(h[3],hexmap)-1)*16 + (Pos(h[4],hexmap)-1);
|
||||
b := (Pos(h[5],hexmap)-1)*16 + (Pos(h[6],hexmap)-1);
|
||||
// KBLEditForm.Stat.Items.Add('In:'+h+' --- Out r:'+IntToStr(r)+' g:'+IntToStr(g)+' b:'+IntToStr(b));
|
||||
Stat('In:'+h+' --- Out r:'+IntToStr(r)+' g:'+IntToStr(g)+' b:'+IntToStr(b));
|
||||
Result := rgb(r, g, b);
|
||||
end;
|
||||
|
||||
function Dec2Hex(i: integer): string;
|
||||
var s: string;
|
||||
begin
|
||||
s := '';
|
||||
while i>15 do begin
|
||||
s := s + Hexmap[(i MOD 16)+1];
|
||||
i := i DIV 16;
|
||||
end;
|
||||
s := Hexmap[i+1] + s;
|
||||
while Length(s) MOD 2>0 do s := '0' + s;
|
||||
Result := LowerCase(s);
|
||||
end;
|
||||
|
||||
function Hex2Str(h: string): string;
|
||||
const Hexmap = '0123456789ABCDEF';
|
||||
var c: integer;
|
||||
t: string;
|
||||
t: widestring;
|
||||
begin
|
||||
h := UpperCase(h);
|
||||
c := (Pos(h[3],hexmap)-1)*16 + (Pos(h[4],hexmap)-1);
|
||||
c := (Pos(h[1],hexmap)-1)*4096 + (Pos(h[2],hexmap)-1)*256 + (Pos(h[3],hexmap)-1)*16 + (Pos(h[4],hexmap)-1);
|
||||
t := Chr(c);
|
||||
Result := t;
|
||||
end;
|
||||
@ -143,7 +216,7 @@ begin
|
||||
keys := 0;
|
||||
for i:=0 to Length(m)-1 do begin
|
||||
if (Length(m[i])>0) then begin
|
||||
l := Split(m[i]);
|
||||
l := Split(m[i], ',');
|
||||
if Length(l)>0 then begin
|
||||
if (l[0]='M') then begin
|
||||
if (Length(l)=17) then begin
|
||||
@ -165,17 +238,21 @@ begin
|
||||
r.background := Hex2Col(l[16]);
|
||||
end;
|
||||
end else if (l[0]='R') then begin
|
||||
if (rows>0) then SetLength(r.Data[rows-1], keys);
|
||||
if (rows>0) then SetLength(r.Data[rows-1].keys, keys);
|
||||
Inc(rows);
|
||||
SetLength(r.Data[rows-1], 100);
|
||||
with r.Data[rows-1] do begin
|
||||
SetLength(keys, 100);
|
||||
if (Length(l)>2) then keycap := Hex2Col(l[2]) else keycap := r.keycap;
|
||||
if (Length(l)>3) then ink := Hex2Col(l[3]) else ink := r.ink;
|
||||
end;
|
||||
keys := 0;
|
||||
end else if (l[0]='L') OR (l[0]='K') OR (l[0]='S') then begin
|
||||
with r.Data[rows-1][keys] do begin
|
||||
with r.Data[rows-1].keys[keys] do begin
|
||||
typ := l[0][1];
|
||||
value := l[1];
|
||||
if (Length(l)>2) then width := StrToInt(l[2]) else width := 1;
|
||||
if (Length(l)>3) then keycap := Hex2Col(l[3]) else keycap := r.keycap;
|
||||
if (Length(l)>4) then ink := Hex2Col(l[4]) else ink := r.ink;
|
||||
if (Length(l)>3) then keycap := Hex2Col(l[3]) else keycap := r.Data[rows-1].keycap;
|
||||
if (Length(l)>4) then ink := Hex2Col(l[4]) else ink := r.Data[rows-1].ink;
|
||||
if (Length(l)>5) then legend := l[5] else legend := Hex2Str(l[1]);
|
||||
end;
|
||||
Inc(keys);
|
||||
@ -184,33 +261,51 @@ begin
|
||||
end;
|
||||
end;
|
||||
if (rows>0) then begin
|
||||
SetLength(r.Data[rows-1], keys);
|
||||
SetLength(r.Data[rows-1].keys, keys);
|
||||
SetLength(r.Data, rows);
|
||||
end;
|
||||
Result := r;
|
||||
end;
|
||||
|
||||
procedure KeyRect(map: TMap; i,j,ki: integer; lbl: string);
|
||||
const space = 3;
|
||||
var top, left, bottom, right: integer;
|
||||
kw, kh: integer;
|
||||
hc, vc: integer;
|
||||
const space = 2;
|
||||
var top, left, bottom, right: integer; // final rect for key
|
||||
dt, dl, db, dr: double; // final rect as double
|
||||
mw, mh: double; // keymap width/height
|
||||
tw, th: integer; // Text width/height
|
||||
ow, oh: double; // output key width/height
|
||||
key: TKey;
|
||||
begin
|
||||
key := map.Data[i][j];
|
||||
hc := map.left + Round((map.right-map.left)/(map.cols+1)) * ki;
|
||||
vc := map.top + Round((map.bottom-map.top)/(map.rows+1)) * (i+1);
|
||||
kw := Round(( map.right - map.left ) / (map.cols+1)) - space;
|
||||
kh := Round(( map.bottom - map.top ) / (map.rows+1)) - space;
|
||||
left := hc - Round(kw/2);
|
||||
right := hc + Round(kw/2) + (key.width-1)*(kw+space);
|
||||
top := vc - Round(kh/2);
|
||||
bottom := vc + Round(kh/2);
|
||||
try
|
||||
key := map.Data[i].keys[j];
|
||||
Stat('map: ('+IntToStr(map.left)+','+IntToStr(map.top)+'),('+IntToStr(map.right)+','+IntToStr(map.bottom)+')');
|
||||
mw := map.right-map.left;
|
||||
mh := map.bottom-map.top;
|
||||
Stat('map: width:'+FloatToStr(mw)+' height:'+FloatToStr(mh));
|
||||
dl := map.left + (mw/map.cols) * (ki-1) + space;
|
||||
dr := map.left + (mw/map.cols) * (ki-1+key.width) - space;
|
||||
dt := map.top + (mh/(map.rows)) * i + space; // ki=keyindex 1..x; i=row 0..x
|
||||
db := map.top + (mh/(map.rows)) * (i+1) - space;
|
||||
ow := dr-dl+1;
|
||||
oh := db-dt+1;
|
||||
left := Round(dl);
|
||||
right := Round(dr);
|
||||
top := Round(dt);
|
||||
bottom := Round(db);
|
||||
with KBLEditForm.Px00Screen.Canvas do begin
|
||||
Brush.Color := map.Data[i][j].keycap;
|
||||
Font.Color := map.Data[i][j].ink;
|
||||
Brush.Color := map.Data[i].keys[j].keycap;
|
||||
Font.Color := map.Data[i].keys[j].ink;
|
||||
Rectangle(left, top, right+1, bottom+1);
|
||||
TextRect(Rect(left,top,right+1,bottom+1),hc-2,vc-Round(kh/2),key.legend);
|
||||
th := TextHeight(key.legend);
|
||||
tw := TextWidth(key.legend);
|
||||
TextRect(Rect(left,top,right+1,bottom+1),Round(left+(ow-tw)/2),Round(top+(oh-th)/2),key.legend);
|
||||
end;
|
||||
except
|
||||
on e: Exception do begin
|
||||
ShowMessage('Exception: '+e.Message+CRLF+CRLF+'Something seems to be wrong with this map.');
|
||||
exoc := true;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -235,43 +330,326 @@ begin
|
||||
FillRect(Rect(map.left, map.top, map.right+1, map.bottom+1));
|
||||
for i:=0 to Length(map.Data)-1 do begin
|
||||
keyindex := 1;
|
||||
for j:=0 to Length(map.Data[i])-1 do begin
|
||||
Keyrect(map, i, j, keyindex, map.Data[i][j].legend);
|
||||
Inc(keyindex, map.Data[i][j].width);
|
||||
for j:=0 to Length(map.Data[i].keys)-1 do begin
|
||||
Keyrect(map, i, j, keyindex, map.Data[i].keys[j].legend);
|
||||
if (exoc) then begin
|
||||
exoc := false;
|
||||
Exit;
|
||||
end;
|
||||
Inc(keyindex, map.Data[i].keys[j].width);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TKBLEditForm.Button4Click(Sender: TObject);
|
||||
procedure TKBLEditForm.ButtonVisualizeClick(Sender: TObject);
|
||||
begin
|
||||
ClearScreen;
|
||||
VisMap(SpinEdit1.Value);
|
||||
end;
|
||||
|
||||
procedure TKBLEditForm.Button1Click(Sender: TObject);
|
||||
procedure TKBLEditForm.ButtonOpenClick(Sender: TObject);
|
||||
var r: integer;
|
||||
begin
|
||||
if (Memo1.Modified) then begin
|
||||
r := Application.MessageBox('Do you want to save your work first?','Please confirm',MB_YESNO);
|
||||
if (r=IDYES) then begin
|
||||
if (ButtonSave.Enabled) then ButtonSaveClick(Sender) else ButtonSaveAsClick(Sender);
|
||||
end;
|
||||
end;
|
||||
if (OpenDialog1.Execute) then begin
|
||||
Memo1.Lines.LoadFromFile(OpenDialog1.FileName);
|
||||
Button2.Enabled := true;
|
||||
Memo1.Modified := false;
|
||||
LabelFile.Caption := ExtractFileName(OpenDialog1.FileName);
|
||||
UpdateTitle;
|
||||
ButtonSave.Enabled := true;
|
||||
SpinEdit1.Value := 1;
|
||||
ClearScreen;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TKBLEditForm.Button3Click(Sender: TObject);
|
||||
procedure TKBLEditForm.ButtonSaveAsClick(Sender: TObject);
|
||||
begin
|
||||
SaveDialog1.FileName := OpenDialog1.FileName;
|
||||
if (SaveDialog1.Execute) then begin
|
||||
Memo1.Lines.SaveToFile(SaveDialog1.FileName);
|
||||
Memo1.Modified := false;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure AddUnicode(code, desc: AnsiString);
|
||||
begin
|
||||
with KBLEditForm.Unicodes do begin
|
||||
RowCount := RowCount + 1;
|
||||
Cells[0, RowCount-1] := desc;
|
||||
Cells[1, RowCount-1] := code;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure LoadUnicodes;
|
||||
var f: TextFile;
|
||||
t: AnsiString;
|
||||
d: integer;
|
||||
t2: TArray;
|
||||
begin
|
||||
d := 1;
|
||||
with KBLEditForm.Unicodes do begin
|
||||
SetLength(t2, 50);
|
||||
Cells[0,0] := 'Description';
|
||||
Cells[1,0] := 'Unicode';
|
||||
if (FileExists(unicodefile)) then begin
|
||||
try
|
||||
AssignFile(f, unicodefile);
|
||||
Reset(f);
|
||||
while Not Eof(f) do begin
|
||||
ReadLn(f, t);
|
||||
t2 := Split(t, Chr(9));
|
||||
if (Length(t2[1])>2) then begin
|
||||
if (d>0) then Dec(d) else RowCount := RowCount + 1;
|
||||
Cells[0, RowCount-1] := Trim(t2[0]);
|
||||
Cells[1, RowCount-1] := Trim(t2[1]);
|
||||
end;
|
||||
end;
|
||||
CloseFile(f);
|
||||
except
|
||||
on e: Exception do ShowMessage('ERROR: Couldn''t load unicode list from '+unicodefile+'. ('+e.Message+')');
|
||||
end;
|
||||
end;
|
||||
AddUnicode('', '-------------- useful PopOnTop codes follow here ---------------');
|
||||
AddUnicode('0008', 'BS Backspace');
|
||||
AddUnicode('000D', 'CR Carriage Return');
|
||||
AddUnicode('F6DC', 'Next - Move cursor to next field');
|
||||
AddUnicode('F6DD', 'Prev - Move cursor to previous field');
|
||||
AddUnicode('F802', 'Home - Move cursor to start of field/line');
|
||||
AddUnicode('F803', 'End - Move cursor to end of field/line');
|
||||
AddUnicode('F807', 'Left - Move cursor left one character');
|
||||
AddUnicode('F808', 'Right - Move cursor right one character');
|
||||
AddUnicode('F809', 'Up - Move cursor up one character');
|
||||
AddUnicode('F80A', 'Down - Move cursor down one character');
|
||||
AddUnicode('F7FE', 'Horizontal - Move keyboard horizontally');
|
||||
AddUnicode('F7FF', 'Vertical - Move keyboard vertically');
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TKBLEditForm.FormCreate(Sender: TObject);
|
||||
begin
|
||||
if (debug) then Status.Visible := true;
|
||||
TimerScroll.Enabled := false;
|
||||
LabelFile.Caption := '';
|
||||
LabelSyntax.Caption := '';
|
||||
ClearScreen;
|
||||
LoadUnicodes;
|
||||
end;
|
||||
|
||||
procedure TKBLEditForm.Button2Click(Sender: TObject);
|
||||
procedure TKBLEditForm.ButtonSaveClick(Sender: TObject);
|
||||
begin
|
||||
if (Length(OpenDialog1.FileName)>0) then begin
|
||||
Memo1.Lines.SaveToFile(OpenDialog1.FileName);
|
||||
Memo1.Modified := false;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TKBLEditForm.UnicodesKeyPress(Sender: TObject; var Key: Char);
|
||||
var i: integer;
|
||||
s: TGridRect;
|
||||
begin
|
||||
for i:=1 to Unicodes.RowCount-1 do begin
|
||||
if (UpCase(Unicodes.Cells[0,i][1])=UpCase(Key)) then begin
|
||||
s.Left := 0;
|
||||
s.Right := 1;
|
||||
s.Top := i;
|
||||
s.Bottom := i;
|
||||
Unicodes.Selection := s;
|
||||
Unicodes.TopRow := i;
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure InsertIntoMemo(x: AnsiString);
|
||||
var m: AnsiString;
|
||||
ss, sl: longint;
|
||||
tmp: TClipboard;
|
||||
begin
|
||||
tmp := Clipboard;
|
||||
with KBLEditForm.Memo1 do begin
|
||||
m := Lines.Text;
|
||||
ss := SelStart;
|
||||
sl := SelLength;
|
||||
if (sl>0) then begin
|
||||
CutToClipboard;
|
||||
// Delete(m, ss+1, sl);
|
||||
end;
|
||||
{ Insert(x, m, ss+1);
|
||||
Lines.Text := m; }
|
||||
Clipboard.SetTextBuf(PChar(x));
|
||||
PasteFromClipboard;
|
||||
SelStart := ss;
|
||||
SelLength := Length(x);
|
||||
SetFocus;
|
||||
end;
|
||||
SetClipboard(tmp);
|
||||
end;
|
||||
|
||||
procedure TKBLEditForm.UnicodesDblClick(Sender: TObject);
|
||||
var s: TGridRect;
|
||||
r: integer;
|
||||
c: string;
|
||||
begin
|
||||
s := Unicodes.Selection;
|
||||
r := s.Top;
|
||||
c := Unicodes.Cells[1,r];
|
||||
InsertIntoMemo(c);
|
||||
end;
|
||||
|
||||
procedure TKBLEditForm.ButtonNewClick(Sender: TObject);
|
||||
begin
|
||||
if (Memo1.Modified) then if (Application.MessageBox('Are you sure to clear everything?', 'Please confirm', MB_YESNO)=IDNO) then Exit;
|
||||
Memo1.Clear;
|
||||
Memo1.SetFocus;
|
||||
ButtonSave.Enabled := false;
|
||||
Memo1.Modified := false;
|
||||
LabelFile.Caption := '';
|
||||
UpdateTitle;
|
||||
end;
|
||||
|
||||
procedure UpdateColor;
|
||||
var r,g,b: integer;
|
||||
begin
|
||||
with KBLEditForm do begin
|
||||
r := TrackR.Position;
|
||||
g := TrackG.Position;
|
||||
b := TrackB.Position;
|
||||
ColorPanel.Caption := Dec2Hex(r)+Dec2Hex(g)+Dec2Hex(b);
|
||||
ColorPanel.Color := rgb(r,g,b);
|
||||
ColorPanel.Font.Color := rgb(r XOR $FF, g XOR $FF, b XOR $FF);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure UpdateColorFromHex(s: string);
|
||||
var col: TColor;
|
||||
r,g,b: integer;
|
||||
begin
|
||||
with KBLEditForm do begin
|
||||
col := Hex2Col(s);
|
||||
r := (col AND $0000FF);
|
||||
g := (col AND $00FF00) DIV $FF;
|
||||
b := (col AND $FF0000) DIV $FFFF;
|
||||
TrackR.Position := r;
|
||||
TrackG.Position := g;
|
||||
TrackB.Position := b;
|
||||
ColorPanel.Color := col;
|
||||
ColorPanel.Font.Color := col XOR $FFFFFF;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TKBLEditForm.TrackRChange(Sender: TObject);
|
||||
begin
|
||||
UpdateColor;
|
||||
end;
|
||||
|
||||
procedure TKBLEditForm.TrackGChange(Sender: TObject);
|
||||
begin
|
||||
UpdateColor;
|
||||
end;
|
||||
|
||||
procedure TKBLEditForm.TrackBChange(Sender: TObject);
|
||||
begin
|
||||
UpdateColor;
|
||||
end;
|
||||
|
||||
procedure TKBLEditForm.ButtonColorInsertClick(Sender: TObject);
|
||||
begin
|
||||
InsertIntoMemo(ColorPanel.Caption);
|
||||
end;
|
||||
|
||||
function StringIsNum(s: string): boolean;
|
||||
var i: integer;
|
||||
begin
|
||||
for i:=1 to Length(s) do begin
|
||||
if Pos(UpCase(s[i]),Hexmap)=0 then begin
|
||||
Result := false;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
Result := true;
|
||||
end;
|
||||
|
||||
procedure TKBLEditForm.ButtonColorGetClick(Sender: TObject);
|
||||
var s: AnsiString;
|
||||
begin
|
||||
s := Copy(Memo1.Lines.Text, Memo1.SelStart+1, Memo1.SelLength);
|
||||
if (Length(s)=6) AND (StringIsNum(s)) then begin
|
||||
UpdateColorFromHex(s);
|
||||
end else begin
|
||||
ShowMessage('Please select a color value first. (6-digit hexadecimal number)');
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TKBLEditForm.FormCloseQuery(Sender: TObject;
|
||||
var CanClose: Boolean);
|
||||
begin
|
||||
if (Memo1.Modified) then begin
|
||||
CanClose := (Application.MessageBox('You have not saved your work. Are you sure to quit?', 'Please confirm', MB_YESNO)=IDYES);
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetFirstCharInLine(s: AnsiString; i: integer): char;
|
||||
var j: integer;
|
||||
begin
|
||||
Result := Chr(0);
|
||||
for j:=i downto 1 do begin
|
||||
if (Ord(s[j])=13) OR (Ord(s[j])=10) then Break;
|
||||
Result := s[j];
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure SetSyntax(s: AnsiString);
|
||||
var tw: integer;
|
||||
begin
|
||||
with KBLEditForm do begin
|
||||
if (s<>'') then s := 'Syntax: ' + s;
|
||||
LabelSyntax.Caption := s;
|
||||
Px00Screen.Canvas.Font := LabelSyntax.Font;
|
||||
tw := Px00Screen.Canvas.TextWidth(s);
|
||||
if (tw>LabelSyntax.Width) then TimerScroll.Enabled := true else TimerScroll.Enabled := false;
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetHelpByKey(x: char): AnsiString;
|
||||
begin
|
||||
case UpCase(x) of
|
||||
'T': Result := 'T,Title Text';
|
||||
'M': Result := 'M,landscape,full,top,left,bottom,right,rows,cols,top,left,bottom,right,keycap,ink,highlight,background';
|
||||
'R': Result := 'R,keycap,ink';
|
||||
'K': Result := 'K,value,width,keycap,ink,legend';
|
||||
'L': Result := 'L,map,width,keycap,ink,legend';
|
||||
'S': Result := 'S,map,width,keycap,ink,legend';
|
||||
'!': Result := '! Helpful Text';
|
||||
else
|
||||
Result := '';
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TKBLEditForm.Memo1Change(Sender: TObject);
|
||||
var x: char;
|
||||
begin
|
||||
x := GetFirstCharInLine(Memo1.Lines.Text, Memo1.SelStart);
|
||||
SetSyntax(GetHelpByKey(x));
|
||||
end;
|
||||
|
||||
procedure TKBLEditForm.TimerScrollTimer(Sender: TObject);
|
||||
var x: AnsiString;
|
||||
begin
|
||||
x := LabelSyntax.Caption;
|
||||
if (Pos(' +++ ',x)=0) then x := x + ' +++ ';
|
||||
LabelSyntax.Caption := Copy(x,2,Length(x)-1)+x[1];
|
||||
end;
|
||||
|
||||
procedure TKBLEditForm.Memo1Click(Sender: TObject);
|
||||
begin
|
||||
Memo1Change(Sender);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user