求大神，关于字体的拉伸和缩小？

zmingits 2015-07-16 10:57:45

上图数字10和11，有拉伸和缩水效果（和单个数字的，占用的相同的高和宽）。

请问在advStrinGrid上画，如何实现上面的效果，谢谢

...全文

178 7 打赏收藏转发到动态举报

写回复

用AI写文章

7 条回复

切换为时间正序

请发表友善的回复…

发表回复

lyhoo163 2015-07-17

打赏
举报

建议使用canvas对象上画图，通过 OutText，画出数字，可以设置字体位置，字体类型、字体大小、字体颜色....

zmingits 2015-07-16

打赏
举报

10和11字体是小了，但高度没变小

缘中人 2015-07-16

打赏
举报

是否字体变小了

日立奔腾浪潮微软松下联想 2015-07-16

打赏
举报

你这代码没做cleanup，要记得DeleteObject。

缘中人 2015-07-16

打赏
举报

可以看到效果

procedure TForm1.Button1Click(Sender: TObject);
var
  n: integer;
  int1, int2: integer;
  OldFont, NewFont: HFONT;
  LogRec: TLOGFONT;
begin
  GetObject(Canvas.Font.Handle, SizeOf(LogRec), @LogRec); // Get the current LogicFont setting
  with LogRec do
  begin
    lfheight := 70;
    lfwidth := 50;
    lfFaceName := '宋体';
    lfCharset := GB2312_CHARSET;
    lfEscapement := 0;
    lfUnderLine := 0;
    lfItalic := 0;
    lfStrikeOut := 0;
  end;
  NewFont := CreateFontIndirect(LogRec);
  OldFont := SelectObject(Canvas.Handle, NewFont);
  Canvas.textout(1, 1, '10');


  LogRec.lfwidth := 100;
  NewFont := CreateFontIndirect(LogRec);
  OldFont := SelectObject(Canvas.Handle, NewFont);
  Canvas.textout(1, 100, '9');
end;

zmingits 2015-07-16

打赏
举报

unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) procedure FormCreate(Sender: TObject); procedure FormKeyPress(Sender: TObject; var Key: Char); procedure FormPaint(Sender: TObject); private { Private declarations } zfstr :array[0..255]of char; zfcount :integer; ZFHeight ,zfwidth :integer; xexp,yexp :integer; public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.FormCreate(Sender: TObject); begin zfcount := 0; ZFHeight := 16; zfwidth := 8; xexp := 5; yexp := 50; end; procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char); begin zfstr[ZFCount] := key; ZFCount := ZFCount + 1; invalidate; end; procedure TForm1.FormPaint(Sender: TObject); var n :integer; int1,int2:integer; OldFont, NewFont: HFONT; LogRec: TLOGFONT; begin GetObject(Canvas.Font.Handle, SizeOf(LogRec), @LogRec);//Get the current LogicFont setting with LogRec do begin lfheight:=MulDiv(ZFHeight * xexp, GetDeviceCaps(Canvas.Handle, LOGPIXELSY), 108); lfwidth:=MulDiv(ZFWidth * yexp, GetDeviceCaps(Canvas.Handle, LOGPIXELSY), 108); lfFaceName := '宋体'; lfCharset:=GB2312_CHARSET; lfEscapement:=0; lfUnderLine:=0; lfItalic:=0; lfStrikeOut:=0; end; NewFont := CreateFontIndirect(LogRec); OldFont := SelectObject(Canvas.Handle,NewFont); for n:= low(zfstr) to high(zfstr) do begin canvas.textout(100,100,zfstr[0]); end; end; end. (*ZFCount ：= 0；ZFHeight := 16;ZFWidth := 8; x := x方向倍数 ; y := y方向倍数 FormKeyPress事件中 zfstr[ZFCount] := key; ZFCount := ZFCount + 1; invalidate; FormPaint事件中; GetObject(Canvas.Font.Handle, SizeOf(LogRec), @LogRec); with LogRec do begin lfheight:=MulDiv(ZFHeight * x, GetDeviceCaps(Canvas.Handle, LOGPIXELSY), 108); lfwidth:=MulDiv(ZFWidth * y, GetDeviceCaps(Canvas.Handle, LOGPIXELSY), 108); lfFaceName := '宋体'; lfCharset:=GB2312_CHARSET; lfEscapement:=0; lfUnderLine:=0; lfItalic:=0; lfStrikeOut:=0; end; NewFont := CreateFontIndirect(LogRec); OldFont := SelectObject(Canvas.Handle,NewFont); n := 0; while n <= ZFCount - 1 do begin canvas.textout(int1,int2,zfstr[n]); //打印字符位置没有做控制 n := n + 1; end; 问题如下能不能得到x方向放大x倍、y方向放大y倍的字符串呢 *) 你说的这个下载了，好像用不起，代码如上

缘中人 2015-07-16