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; //加入paintbox 分块显示 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; //先找到最高的值和总共的宽度 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 //中文 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.