Hi Pierre and Lazarus List
see my comments below...
Fond Regards,
Peter Eric (aka 'pew') WILLIAMS
from Hobart, Tasmania, Australia -- phone (03) 6236-9675
My free website is: http://pewtas.googlepages.com (or)
http://tinyurl.com/yuyejs
(please visit my free website and let me know what you think about it.)
2010/2/22 Pierre Delore <[email protected]>:
> hi all,
>
> Thanks for your answers.
>
> I forgot to specify that I'm in Win32 with 0.9.28.2 (not a snapshot).
>
> Peter, I uncommented the 2 lines and I replaced clGreen by clWhite. The
> image is displayed correctly.
> I changed the background of the image and I set it to blue (FF0000). The
> image is displayed correctly.
> I also replace the clWhite by clBlue. The image is displayed correctly.
>
>From Delphi graphical game I created, which I converted to Lazarus ...
some time ago,
( code from the attached file "uFixedWidthFonts.pas" )
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
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 TSDL_Rect;
//...
TransparentColor : Tcolor;
//...
//code...
// Determine the transparent color
TransparentColor := Image.Canvas.Pixels[Rects[Rects_low].x +
Rects[Rects_low].w, 0];
Note: the above line can be simplified as:
// this will return a TColor of the colour of the pixel @ location [0,0] of
// TBitmap e.g. the top left corner pixel of the image.
// You could choose ANY x,y pixel of the image to be the background colour.
TransparentColor := Image.Canvas.Pixels[0, 0];
// set colour of the Canvas Brush to TransparentColor
Canvas.Brush.Color := TransparentColor;
// now fill the background of the Canvas with the TransparentColor
Canvas.FillRect(0,0,pwidth,pheight);
// my modifications to your code *should* make the background of the
// Canvas to the same colour as the TBitmap's colour at pixel [0,0]
// before you draw Bitmap -- with the next line of code.
> Canvas.Draw(0, 0, Bitmap);
// or with my var declarations it would be:
Canvas.Draw(0, 0, Image);
// hopefully now Bitmap will be drawn on a clWhite background... which
is the effect you said in your email you're wanting.
> finally
> Bitmap.Free;
// or with my var declarations it would be:
Image.Free
> end;
>
> inherited Paint;
> end;
> Somebody can explain me why I had this problem?
>
<snip>
>
> Regards
>
> --
> Pierre Delore
>
> http://datalinkwristapps.free.fr
> http://dpsite.free.fr
>
<snip>
unit uFixedWidthFonts;
{$MODE Delphi}
interface
uses
graphics, ExtCtrls, SysUtils, Dialogs;
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;
implementation
// Use with caution! The procedure allocates memory for TSDL_Rect and return with its pointer.
// But you MUST free it after you don't need it anymore!!!
// this procedure pinched from SDL
// [ALVAROGP] PROCEDURE REWRITTEN BELOW TO AVOID WARNINGS
{
function PSDLRect(aLeft, aTop, aWidth, aHeight: integer): PSDL_Rect;
var
Rect: PSDL_Rect;
begin
New(Rect);
with Rect^ do
begin
x := aLeft;
y := aTop;
w := aWidth;
h := aHeight;
end;
Result := Rect;
end;
}
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;
{---------------------------------------------------------}
procedure TFixedFont.FreeUpAll;
var
i: integer;
begin
for i := Rects_low to Rects_high do
if Rects[i] <> nil then
// [ALVAROGP] Rects are not records any more
{
Dispose(Rects[i]);
}
Rects[i].Free;
if Image <> nil then
Image.Free;
end;
{---------------------------------------------------------}
destructor TFixedFont.Finalize;
begin
FreeUpAll;
end;
{---------------------------------------------------------}
// Draw a partial text in a single line without clipping x
procedure TFixedFont.WriteText2(x, y: integer; Txt: string; TextLength:
cardinal;
var PaintBox1: TPaintBox);
var
i: cardinal; // PEW
ch, px, py: integer;
begin
if (Image = nil) or (Txt = '') then
exit;
PaintBox1.Canvas.Lock;
i := 1;
while i <= TextLength do
begin
ch := ord(Txt[i]);
if (ch >= Rects_low) and (ch <= LastCharacterDefined) then
begin
// [ALVAROGP] Rects are not records any more
for px := 0 to Rects[ch].w - 1 do
// [ALVAROGP] Rects are not records any more
for py := 0 to Rects[ch].h - 1 do
if y + py < PaintBox1.Canvas.ClipRect.Left +
PaintBox1.Canvas.ClipRect.Bottom - PaintBox1.Canvas.ClipRect.Top
then
begin
if ReverseVideo then
begin
// reversed text
// [ALVAROGP] Rects are not records any more
if Image.Canvas.Pixels[Rects[ch].x + px, Rects[ch].y + py] =
TransparentColor then
PaintBox1.Canvas.Pixels[x + px, y + py] := TextColor
else if not UseTransparentBackground then
PaintBox1.Canvas.Pixels[x + px, y + py] := BackgroundColor;
end
else
begin
// normal text
// [ALVAROGP] Rects are not records any more
if Image.Canvas.Pixels[Rects[ch].x + px, Rects[ch].y + py] <>
TransparentColor then
PaintBox1.Canvas.Pixels[x + px, y + py] := TextColor
else if not UseTransparentBackground then
PaintBox1.Canvas.Pixels[x + px, y + py] := BackgroundColor;
end
end;
x := x + Rects[ch].w + HorizontalGap
end;
inc(i);
end;
PaintBox1.Canvas.Unlock;
//PaintBox1.invalidate;
end;
{---------------------------------------------------------}
end.
--
_______________________________________________
Lazarus mailing list
[email protected]
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
