2026-07-11 15:55:22 +08:00

298 lines
7.0 KiB
ObjectPascal
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

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.