unit uMainForm;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, StdCtrls;
type
TForm1 = class(TForm)
ListBox1: TListBox;
procedure FormCreate(Sender: TObject);
procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
ARect: TRect; {%H-}State: TOwnerDrawState);
end;
procedure LoadListboxFromFile(const aFilename: String; aListbox: TListBox);
var
Form1: TForm1;
implementation
procedure LoadListboxFromFile(const aFilename: String; aListbox: TListBox);
type
Ts2 = String[2];
THexBytes = record
case Boolean of
True: (arr: array[1..3] of Byte);
False: (value: longword);
end;
var
sl: TStringList;
sa: TStringArray;
h: PtrInt;
i: Integer;
function Str6ToHex(aString: String): Int64;
var
hb: THexBytes;
function StrToHex(s: Ts2): Byte;
function GetValue(c: Char): Byte;
begin
if c in ['0'..'9'] then
Exit(Ord(c) - 48)
else if c in ['A'..'F'] then
Exit(Ord(c) - 55)
else if c in ['a'..'f'] then
Exit(Ord(c) - 87)
else Assert(True,'Error in hex string value');
end;
begin
result := GetValue(s[2]) + 16*GetValue(s[1]);
WriteLn('Result is $',Result);
end;
begin
hb := Default(THexBytes);
hb.arr[3] := StrToHex(Copy(aString, 1, 2));
hb.arr[2] := StrToHex(Copy(aString, 3, 2));
hb.arr[1] := StrToHex(Copy(aString, 5, 2));
Result := hb.value;
end;
begin
if FileExists(aFilename) then
begin
aListbox.Clear;
sl := TStringList.Create;
try
sl.LoadFromFile(aFilename);
for i := 0 to sl.Count-1 do
begin
sa := sl[i].Split([','], '"');
Assert(Length(sa[1])=6,'invalid hex string "'+sa[1]+'"');
h := Str6ToHex(sa[1]);
aListbox.Items.AddObject(sa[0], TObject(h));
end;
finally
sl.Free;
end;
end;
end;
{$R *.lfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
LoadListboxFromFile('text.txt', ListBox1);
end;
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer; ARect: TRect; State: TOwnerDrawState);
var
lb: TListBox absolute Control;
ts: TTextStyle;
begin
lb.Canvas.Brush.Color := PtrInt(lb.Items.Objects[Index]);
lb.Canvas.FillRect(ARect);
ts := lb.Canvas.TextStyle;
ts.Alignment := taLeftJustify;
ts.Layout := tlCenter;
lb.Canvas.Pen.Color := clBlack;
lb.Canvas.TextRect(ARect, ARect.Left+2, ARect.Top, lb.Items[Index], ts);
end;
end.