[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