298 lines
7.3 KiB
Plaintext
Raw Normal View History

unit uallpreview;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, BaseGrid, AdvGrid, ExtCtrls, StdCtrls;
type
TForm4 = class(TForm)
Panelall: TPanel;
AdvStringGrid1: TAdvStringGrid;
Panelsingal: TPanel;
Panel1: TPanel;
Label2: TLabel;
ComboBox1: TComboBox;
Label1: TLabel;
Button1: TButton;
Memo1: TMemo;
AdvStringGrid2: TAdvStringGrid;
ScrollBox1: TScrollBox;
Image1: TImage;
procedure LoadImages;
procedure MakeImages;
procedure makegrid(w, h: integer; bmp: tbitmap);
procedure FormShow(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
procedure ComboBox1Change(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
tRowCount, tColCount, tcellwidth, tcellheight, tpixels: integer;
end;
var
Form4: TForm4;
implementation
uses umain, Math, umodify;
{$R *.dfm}
procedure TForm4.LoadImages;
var
i: integer;
r, c: integer;
begin
advstringgrid1.Clear;
r := 1;
c := 1;
advstringgrid1.beginupdate;
with advstringgrid1 do
for i := 1 to Form1.listcount do
begin
// advstringgrid1.CreatePicture(c,r,true,StretchWithAspectRatio,20,haCenter,vaCenter).LoadFromFile(dirpath+items[i-1]);
// advstringgrid1.CreatePicture(c,r,true,ShrinkWithAspectRatio,20,haCenter,vaCenter).LoadFromFile(dirpath+items[i-1]);
advstringgrid1.cells[c, r] := inttostr(i - 1);
advstringgrid1.CreatePicture(c, r, true, StretchWithAspectRatio, 25, haCenter, vaAboveText).Bitmap := form1.fontlist[i - 1].bmplist;
inc(c);
if c = colcount then
begin
c := 1;
inc(r);
end;
if r = rowcount then
begin
rowcount := rowcount + 1;
rowheights[rowcount - 1] := rowheights[rowcount - 2];
end;
end;
advstringgrid1.endupdate;
end;
procedure TForm4.makegrid(w, h: integer; bmp: tbitmap);
var
tmp, bmp1: tbitmap;
i, j, x, y: integer;
p: PByteArray;
Frame: trect;
begin
tmp := TBitmap.Create;
tmp.PixelFormat := pf24bit;
tmp.Width := w;
tmp.height := h;
tmp.Canvas.Brush.Color := clblack;
tmp.Canvas.FillRect(rect(0, 0, w, h));
tmp.Canvas.Draw(0, 0, bmp);
// advstringgrid2.beginupdate;
{ for i := 0 to tmp.Height - 1 do
begin
p := tmp.scanline[i];
for j := 0 to tmp.Width - 1 do
begin
if P[j * 3 + 2] = 255 then
AdvStringGrid2.Colors[j, i]:=clred else
AdvStringGrid2.Colors[j, i]:=clblack
end;
end; }
// advstringgrid2.EndUpdate;
Image1.Visible := true;
//<2F><><EFBFBD><EFBFBD>paintbox <20>ֿ<EFBFBD><D6BF><EFBFBD>ʾ
Image1.Width := w * tpixels + 1;
Image1.height := h * tpixels + 1;
bmp1 := TBitmap.Create;
bmp1.PixelFormat := pf24bit;
bmp1.Width := Image1.Width;
bmp1.height := Image1.height;
bmp1.Canvas.Brush.Color := rgb(64, 64, 64);
bmp1.Canvas.FillRect(Rect(0, 0, bmp1.Width, bmp1.height));
tColCount := w;
tRowCount := h;
// Calculate grid cell size
tCellWidth := tpixels;
tCellHeight := tpixels;
y := 0;
for i := 0 to tmp.height - 1 do
begin
p := tmp.ScanLine[i];
x := 0;
for j := 0 to tmp.Width - 1 do
begin
Frame.Left := x;
Frame.Right := x + tCellWidth;
Frame.Top := y;
Frame.Bottom := y + tCellHeight;
DrawEdge(bmp1.Canvas.Handle, Frame, BDR_SUNKENINNER, BF_ADJUST or BF_LEFT);
DrawEdge(bmp1.Canvas.Handle, Frame, BDR_SUNKENINNER, BF_ADJUST or BF_top);
bmp1.Canvas.Brush.Color := rgb(p[j * 3 + 2], p[j * 3 + 1], p[j * 3]);
bmp1.Canvas.FillRect(Frame);
inc(x, tCellWidth);
end;
inc(y, tCellHeight);
end;
Image1.Picture.Bitmap := bmp1;
bmp1.Free;
tmp.Free;
end;
procedure TForm4.FormShow(Sender: TObject);
begin
LoadImages;
end;
procedure TForm4.Button1Click(Sender: TObject);
begin
MakeImages;
end;
procedure TForm4.MakeImages;
var
s: string;
usewidth, maxwidth, maxheight, i, v, j,
tmp1, tmp2, lineheight, linewidth: integer;
bmp: tbitmap;
vlist: TStringList;
begin
vlist := TStringList.Create;
vlist.Assign(Memo1.Lines);
if Length(vlist.Text) = 0 then
begin
AdvStringGrid2.Clear;
vlist.Free;
exit;
end;
AdvStringGrid2.Clear;
maxwidth := 0;
maxheight := 0;
lineheight := 0;
linewidth := 0;
tmp1 := 0;
tmp2 := 0;
bmp := TBitmap.create;
bmp.PixelFormat := pf4bit;
//<2F><><EFBFBD>ҵ<EFBFBD><D2B5><EFBFBD><EFBFBD>ߵ<EFBFBD>ֵ<EFBFBD><D6B5><EFBFBD>ܹ<EFBFBD><DCB9>Ŀ<EFBFBD><C4BF><EFBFBD>
for j := 0 to vlist.Count - 1 do
begin
s := vlist.Strings[j];
maxwidth := 0;
for i := 1 to Length(s) do
begin
v := ord(s[i]);
maxwidth := maxwidth + Form1.fontlist[v].width;
tmp1 := Form1.fontlist[v].height;
maxheight := Max(tmp1, maxheight);
end;
tmp2 := maxwidth;
lineheight := lineheight + maxheight;
linewidth := Max(tmp2, linewidth);
end;
tRowCount := linewidth;
tColCount := lineheight;
//AdvStringGrid2.ColCount := linewidth;
//AdvStringGrid2.RowCount := lineheight;
bmp.Width := linewidth;
bmp.height := lineheight;
bmp.Canvas.Brush.Color := clblack;
bmp.Canvas.FillRect(rect(0, 0, bmp.Width, bmp.height));
tmp2 := 0;
for j := 0 to vlist.Count - 1 do
begin
s := vlist.Strings[j];
maxwidth := 0;
for i := 1 to Length(s) do
begin
v := ord(s[i]);
maxwidth := maxwidth + Form1.fontlist[v].width;
tmp1 := Form1.fontlist[v].height;
maxheight := Max(tmp1, maxheight);
end;
usewidth := 0;
for i := 1 to Length(s) do
begin
v := ord(s[i]);
bmp.Canvas.Draw(usewidth, tmp2 + maxheight - Form1.fontlist[v].height, Form1.fontlist[v].bmplist);
usewidth := usewidth + Form1.fontlist[v].width;
end;
tmp2 := tmp2 + maxheight;
end;
if tpixels = 1 then
begin
Image1.Visible := true;
Image1.Width := linewidth;
Image1.height := linewidth;
Image1.Picture.Bitmap := bmp;
end else
makegrid(linewidth, lineheight, bmp);
bmp.Free;
vlist.Free;
end;
procedure TForm4.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if (ord(key) > 128) then //<2F><><EFBFBD><EFBFBD>
key := #0 else
key := key;
end;
procedure TForm4.ComboBox1Change(Sender: TObject);
begin
case ComboBox1.ItemIndex of
0:
begin
AdvStringGrid2.DefaultRowHeight := 1;
AdvStringGrid2.DefaultColWidth := 1;
AdvStringGrid2.GridLineWidth := 0;
tpixels := 1;
end;
1:
begin
AdvStringGrid2.GridLineWidth := 1;
AdvStringGrid2.DefaultRowHeight := 5;
AdvStringGrid2.DefaultColWidth := 5;
tpixels := 5;
end;
2:
begin
AdvStringGrid2.GridLineWidth := 1;
AdvStringGrid2.DefaultRowHeight := 8;
AdvStringGrid2.DefaultColWidth := 8;
tpixels := 8;
end;
3:
begin
AdvStringGrid2.GridLineWidth := 1;
AdvStringGrid2.DefaultRowHeight := 12;
AdvStringGrid2.DefaultColWidth := 12;
tpixels := 12;
end;
end;
MakeImages;
end;
procedure TForm4.FormCreate(Sender: TObject);
begin
AdvStringGrid2.HideSelection;
tpixels := 8;
end;
end.