[Lazarus] How can I improve my bitmap font drawing unit (attached) ?

Dominique Louis dominique at savagesoftware.com.au
Sun Aug 24 17:53:56 CEST 2008


Hi Peter,
   Please check out SDLMonoFonts.pas and of course sdl_ttf.pas both or 
which are included in the JEDI-SDL v1.0 beta release. They also some 
with some demos to get you going.

IHTH,


Dominique.

Peter Williams wrote:
> 
> Hi All,
> 
> I'd like some advice about the attached unit, named 
> "uFixedWidthFonts.pas". It is designed to read 2-colour bitmaps of font 
> character sets of different sizes, from files which are Windowz BMP 
> format. For example, "Chars_Lower_8x8.bmp" -- this is a 320 x 56 pixels, 
> 1 layer BMP file, file size 2.25 KB. E.g. the BMP file is a 2 colour 
> image of a 256 character bitmap, where each character in the BMP file 
> (in this case) is 8x8 pixels.
> 
> There are 8 BMP files:
> 
> Chars_Lower_8x8.bmp
> Chars_Lower_16x16.bmp
> Chars_Lower_24x24.bmp
> Chars_Lower_32x32.bmp
> Chars_Upper_8x8.bmp
> Chars_Upper_16x16.bmp
> Chars_Upper_24x24.bmp
> Chars_Upper_32x32.bmp
> 
> The *Lower* files define the Commodore PET 4032 upper/lower case 
> character set & the *Upper* files define the Graphics/Uppercase 
> character set.
> 
> My main question is: would I be better off using a TImageList?!? Can 
> someone please post sample code. Note: I tried to run the TImageList 
> example program for Lazarus... it compiles okay... but when run it does 
> not find some of its files (BMPs) in the Image sub-folder of the example 
> program. e.g. it gets a runtime error.
> 
> Note that this unit is based strongly on a unit from the Jedi SDL 
> component, sample unit for drawing bitmap fonts onto a graphic canvas.
> 
> At the moment I use statements like this to define the bitmap font (some 
> of the code is pasted below):
> 
> Best Regards & Happy Programming ;-)))
> PEW
> 
> -----------------
> const
>   Rects_low = 0;
>   Rects_high = 255;
> 
> type
>   // these lines "borrowed" from SDL.pas
>   SInt16 = smallint;
>   UInt16 = word;
> 
> // [ALVAROGP] TSDL_Rect converted to class, to avoid warnings
> {
>   PSDL_Rect = ^TSDL_Rect;
>   TSDL_Rect = record
>     x, y: SInt16;
>     w, h: UInt16;
>   end;
> }
>   TSDL_Rect = class
>   public
>     x, y: SInt16;
>     w, h: UInt16;
>   end;
> 
>   // end lines from SDL
> 
>   PFixedFont = ^TFixedFont;
>   TFixedFont = object
>   private
>     Image: TBitmap;
> // [ALVAROGP] Rects redefined as array of class TSDL_Rect
> {
>     Rects: array[Rects_low..Rects_high] of PSDL_Rect;
> }
>     Rects: array[Rects_low..Rects_high] of TSDL_Rect;
>   public
>     LastCharacterDefined: byte;
>     TransparentColor,
>       TextColor,
>       BackgroundColor: Tcolor;
>     // this is used only when UseTransparentBackground is false
>     Char_width,
>       Char_height: byte; // default is 8x8
>     ReverseVideo: Boolean; // default =false
>     HorizontalGap: byte;
>     // Horizontal Gap between characters in Pixels -- default =1
>     UseTransparentBackground: Boolean;
> 
>     constructor Initialize;
>     procedure LoadFont(const Fontfile: string);
>     procedure FreeUpAll;
>     destructor Finalize;
>     procedure WriteText2(x, y: integer; Txt: string; TextLength: cardinal;
>       var PaintBox1: TPaintBox);
>   end;
> 
> var
>   Font1: PFixedFont;
> -----------------
> 
> [...snip...]
> 
> function PSDLRect(aLeft, aTop, aWidth, aHeight: integer): TSDL_Rect;
> var
>   Rect: TSDL_Rect;
> begin
>   Rect := TSDL_Rect.Create;
>   with Rect do
>   begin
>     x := aLeft;
>     y := aTop;
>     w := aWidth;
>     h := aHeight;
>   end;
>   Result := Rect;
> end;
> 
> {---------------------------------------------------------}
> 
> constructor TFixedFont.Initialize;
> begin
>   // defaults
>   LastCharacterDefined := 0; // PEW
>   Char_width := 8;
>   Char_height := 8;
>   HorizontalGap := 1; // 1 pixel by default
>   ReverseVideo := False; // off by default
> end;
> {---------------------------------------------------------}
> 
> procedure TFixedFont.LoadFont(const Fontfile: string);
> var
>   i, x, y: integer;
> begin
>   FreeUpAll;
>   if not fileexists(Fontfile) then
>   begin
>     showmessage('Error: font file does not exist: "' + fontfile + '"');
>     exit;
>   end;
> 
>   Image := TBitmap.Create;
>   try
>     Image.LoadFromFile(Fontfile);
>   except
>     showmessage('Error: Exception occurred trying to load font file.');
>     exit;
>   end;
> 
>   if Image = nil then
>     exit;
>   x := 0;
>   y := 0;
>   i := Rects_low;
>   repeat
>     if x >= Image.width then
>       break;
> 
>     Rects[i] := PSDLRect(x, y, Char_width, Char_height);
> 
>     LastCharacterDefined := i; // PEW
>     inc(i);
>     inc(x, Char_width);
>     if x >= Image.width then
>     begin
>       // font bitmap is a block of characters, so if we go past
>       // the end of bitmap, then go down to next row of characters.
>       x := 0;
>       inc(y, Char_height);
>     end;
> 
>   until (y >= Image.height) or (i > Rects_High);
>   // Determine the transparent color
>   TransparentColor := Image.Canvas.Pixels[Rects[Rects_low].x +
>     Rects[Rects_low].w, 0];
> 
>   UseTransparentBackground := true; // default
> end;
> {---------------------------------------------------------}



More information about the Lazarus mailing list