この発言は
#01160　geo             さんのフォントを滑らかに
に対するコメントです




簡易縮小ルーチンを作ってみましたのであげておきます。
( nifty:FDELPHI/MES/9/05526 参照)

> {
>     ここで、TextBmp に対して 1 / V1 の縮小処理を行ってください
> }

DrawText 手続きの上記部分で、
Resize(TextBmp, V1);
としてください。



注）タイプ宣言が前にアップしたものと一部ダブってますので適当にまとめ
ちゃって下さい。

uses Math;

type
  TRGBQuad = Packed Record
    B, G, R, X: Byte;
  end;
  PRGBQuadArray = ^TRGBQuadArray;
  TRGBQuadArray = Array[0..9999] of TRGBQuad;

 //簡易縮小ルーチン
 //Ratio: 縮小の比率(1-16の整数)
procedure Resize(SrcBmp: TBitmap; Ratio: Integer);
var
  bmp: TBitmap;
  DestSL: PRGBQuadArray;
  SrcSL: Array[1..16] of PRGBQuadArray;
  i, j: Integer;
  x, y: Integer;
  Value: Integer;
begin
  bmp := TBitmap.Create;
  try
    SrcBmp.PixelFormat := pf32bit;
    bmp.PixelFormat := pf32bit;
    bmp.Width := SrcBmp.Width div Ratio;
    bmp.Height := SrcBmp.Height div Ratio;
    for y := 0 to Bmp.Height - 1 do
    begin
      DestSL := bmp.ScanLine[y];
      for i := 1 to Ratio do
      begin
        SrcSL[i] := SrcBmp.ScanLine[(y * Ratio) + (i - 1)];
      end;
      for x := 0 to Bmp.Width - 1 do
      begin
        Value := 0;
        for i := 1 to Ratio do
        begin
          for j := 0 to Ratio - 1 do
          begin
            Value := Value + SrcSL[i][(x * Ratio) + j].B;
          end;
        end;
        Value := Min(Value div (Ratio * Ratio), 255);
        with DestSL[x] do
        begin
          B := Value; G := Value; R := Value;
        end;
      end;
    end;
    SrcBMP.Assign(bmp);
  finally
    bmp.Free;
  end;
end;


geo / BYQ01321
 



Original document by geo             氏 ID:(BYQ01321)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。