paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-10 22:07:33 +01:00
Code Issues Packages Projects Releases Wiki Activity

implemented ByteOrder for TLazIntfImage and added call of to LM_SETFONT

Browse Source 
git-svn-id: trunk@5183 -
This commit is contained in:
mattias 2004-02-09 19:52:52 +00:00
parent 683d3564ff
commit 63221956e2
6 changed files with 148 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lcl/graphtype.pp
View File

@ -155,6 +155,8 @@ const
'riloTopToBottom',
'riloBottomToTop'
);
DefaultByteOrder = {$IFDEF Endian_Little}riboLSBFirst{$ELSE}riboMSBFirst{$ENDIF};
function RawImageDescriptionAsString(Desc: PRawImageDescription): string;
@ -209,6 +211,9 @@ end.
{ =============================================================================
$Log$
Revision 1.24 2004/02/09 19:52:52 mattias
implemented ByteOrder for TLazIntfImage and added call of to LM_SETFONT
Revision 1.23 2003/12/06 19:20:46 mattias
codecompletion: forward proc body position now block sensitive

7
lcl/include/custommemo.inc
View File

@ -30,7 +30,7 @@ begin
inherited Create(AOwner);
fCompStyle := csMemo;
FWordWrap := True;
FFont := TFont.Create;
//FFont := TFont.Create;
FLines := TMemoStrings.Create(Self);
FVertScrollbar := TMemoScrollBar.Create(Self, sbVertical);
FHorzScrollbar := TMemoScrollBar.Create(Self, sbHorizontal);
@ -47,7 +47,7 @@ end;
destructor TCustomMemo.Destroy;
begin
FreeThenNil(FLines);
FreeThenNil(FFont);
//FreeThenNil(FFont);
FreeThenNil(FVertScrollbar);
FreeThenNil(FHorzScrollbar);
inherited destroy;
@ -168,6 +168,9 @@ end;
{ =============================================================================
$Log$
Revision 1.19 2004/02/09 19:52:52 mattias
implemented ByteOrder for TLazIntfImage and added call of to LM_SETFONT
Revision 1.18 2004/01/27 17:36:01 mattias
fixed switching menus in menueditor

6
lcl/include/wincontrol.inc
View File

@ -1295,8 +1295,7 @@ procedure TWinControl.FontChanged(Sender: TObject);
begin
if HandleAllocated and ([csLoading,csDestroying]*ComponentState=[]) then
begin
// ToDo: replace with correct intf call
CNSendMessage(LM_SETCOLOR, Self, nil);
CNSendMessage(LM_SETFONT, Self, Pointer(Font.Handle));
Exclude(FFlags,wcfFontChanged);
//NotifyControls(CM_ ...);
end else
@ -3292,6 +3291,9 @@ end;
{ =============================================================================
$Log$
Revision 1.199 2004/02/09 19:52:52 mattias
implemented ByteOrder for TLazIntfImage and added call of to LM_SETFONT
Revision 1.198 2004/02/04 23:30:18 mattias
completed TControl actions

9
lcl/interfaces/win32/win32object.inc
View File

@ -683,6 +683,12 @@ activate_time : the time at which the activation event occurred.
If Handle <> 0 Then
SetFocus(Handle);
End;
LM_SETFONT:
begin
if Sender is TControl then begin
Windows.SendMessage(Handle, WM_SETFONT, windows.wParam(integer(data)), 1);
end;
end;
LM_SETSIZE:
Begin
If (Sender Is TWinControl) Then // Handle is already tested --> see above
@ -3008,6 +3014,9 @@ End;
{
$Log$
Revision 1.166 2004/02/09 19:52:52 mattias
implemented ByteOrder for TLazIntfImage and added call of to LM_SETFONT
Revision 1.165 2004/02/06 23:58:44 marc
+ patch from Jesus Reyes, it enables TCustomEdit SelStart/Length

127
lcl/intfgraphics.pas
View File

@ -147,7 +147,9 @@ type
TheLineEnd: TRawImageLineEnd); virtual;
procedure SetDataDescription(const NewDescription: TRawImageDescription); virtual;
procedure ChooseGetSetColorFunctions; virtual;
procedure ChooseRawBitsProc(BitsPerPixel: cardinal; BitOrder: TRawImageBitOrder;
procedure ChooseRawBitsProc(BitsPerPixel: cardinal;
ByteOrder: TRawImageByteOrder;
BitOrder: TRawImageBitOrder;
var ProcReadRawImageBits: TOnReadRawImageBits;
var ProcWriteRawImageBits: TOnWriteRawImageBits);
// get color functions
@ -638,6 +640,29 @@ begin
end;
end;
procedure ReadRawImageBits_ReversedBytes_16(TheData: PByte;
const Position: TRawImagePosition;
Prec, Shift: cardinal;
var Bits: word);
var
P: PByte;
PrecMask: Cardinal;
TwoBytes: Word;
begin
PrecMask:=(Cardinal(1) shl Prec)-1;
P:=@(TheData[Position.Byte]);
TwoBytes:=PWord(P)^;
TwoBytes:=(TwoBytes shr 8) or ((TwoBytes and $ff) shl 8); // switch byte order
Bits:=Word(cardinal(TwoBytes shr Shift) and PrecMask);
if Prec<16 then begin
// add missing bits
Bits:=(Bits shl (16-Prec));
Bits:=Bits or MissingBits[Prec,Bits shr 13];
end;
end;
procedure ReadRawImageBits_32(TheData: PByte;
const Position: TRawImagePosition;
Prec, Shift: cardinal;
@ -660,6 +685,33 @@ begin
end;
end;
procedure ReadRawImageBits_ReversedBytes_32(TheData: PByte;
const Position: TRawImagePosition;
Prec, Shift: cardinal;
var Bits: word);
var
P: PByte;
PrecMask: Cardinal;
FourBytes: Cardinal;
begin
PrecMask:=(Cardinal(1) shl Prec)-1;
P:=@(TheData[Position.Byte]);
FourBytes:=PDWord(P)^;
// switch byte order
FourBytes:=(FourBytes shr 24) or ((FourBytes shr 8) and $FF00)
or ((FourBytes and $ff00) shl 8) or ((FourBytes and $ff) shl 24);
Bits:=Word(cardinal(FourBytes shr Shift) and PrecMask);
if Prec<16 then begin
// add missing bits
Bits:=(Bits shl (16-Prec));
Bits:=Bits or MissingBits[Prec,Bits shr 13];
end;
end;
procedure WriteRawImageBits_1_2_4_BIO(TheData: PByte;
const Position: TRawImagePosition;
Prec, Shift: cardinal; Bits: word);
@ -740,6 +792,27 @@ begin
PWord(P)^:=TwoBytes;
end;
procedure WriteRawImageBits_ReversedBytes_16(TheData: PByte;
const Position: TRawImagePosition;
Prec, Shift: cardinal; Bits: word);
var
P: PByte;
PrecMask: Cardinal;
TwoBytes: Word;
begin
P:=@(TheData[Position.Byte]);
PrecMask:=(Cardinal(1) shl Prec)-1;
Bits:=Bits shr (16-Prec);
TwoBytes:=PWord(P)^;
TwoBytes:=(TwoBytes shr 8) or ((TwoBytes and $ff) shl 8); // switch byte order
PrecMask:=not (PrecMask shl Shift);
TwoBytes:=TwoBytes and PrecMask; // clear old
TwoBytes:=TwoBytes or (Bits shl Shift); // set new
TwoBytes:=(TwoBytes shr 8) or ((TwoBytes and $ff) shl 8); // switch byte order
PWord(P)^:=TwoBytes;
end;
procedure WriteRawImageBits_32(TheData: PByte;
const Position: TRawImagePosition;
Prec, Shift: cardinal; Bits: word);
@ -759,6 +832,34 @@ begin
PDWord(P)^:=FourBytes;
end;
procedure WriteRawImageBits_ReversedBytes_32(TheData: PByte;
const Position: TRawImagePosition;
Prec, Shift: cardinal; Bits: word);
var
P: PByte;
PrecMask: Cardinal;
FourBytes: Cardinal;
begin
P:=@(TheData[Position.Byte]);
PrecMask:=(Cardinal(1) shl Prec)-1;
Bits:=Bits shr (16-Prec);
FourBytes:=PDWord(P)^;
// switch byte order
FourBytes:=(FourBytes shr 24) or ((FourBytes shr 8) and $FF00)
or ((FourBytes and $ff00) shl 8) or ((FourBytes and $ff) shl 24);
PrecMask:=not (PrecMask shl Shift);
FourBytes:=FourBytes and PrecMask; // clear old
FourBytes:=FourBytes or cardinal(Bits shl Shift); // set new
// switch byte order
FourBytes:=(FourBytes shr 24) or ((FourBytes shr 8) and $FF00)
or ((FourBytes and $ff00) shl 8) or ((FourBytes and $ff) shl 24);
PDWord(P)^:=FourBytes;
end;
procedure ReadRawImageBits_NULL(TheData: PByte;
const Position: TRawImagePosition;
Prec, Shift: cardinal;
@ -801,7 +902,7 @@ begin
end;
procedure TLazIntfImage.ChooseRawBitsProc(BitsPerPixel: cardinal;
BitOrder: TRawImageBitOrder;
ByteOrder: TRawImageByteOrder; BitOrder: TRawImageBitOrder;
var ProcReadRawImageBits: TOnReadRawImageBits;
var ProcWriteRawImageBits: TOnWriteRawImageBits);
begin
@ -827,14 +928,24 @@ begin
16:
begin
ProcReadRawImageBits := @ReadRawImageBits_16;
ProcWriteRawImageBits := @WriteRawImageBits_16;
if DefaultByteOrder=ByteOrder then begin
ProcReadRawImageBits := @ReadRawImageBits_16;
ProcWriteRawImageBits := @WriteRawImageBits_16;
end else begin
ProcReadRawImageBits := @ReadRawImageBits_ReversedBytes_16;
ProcWriteRawImageBits := @WriteRawImageBits_ReversedBytes_16;
end;
end;
32:
begin
ProcReadRawImageBits := @ReadRawImageBits_32;
ProcWriteRawImageBits := @WriteRawImageBits_32;
if DefaultByteOrder=ByteOrder then begin
ProcReadRawImageBits := @ReadRawImageBits_32;
ProcWriteRawImageBits := @WriteRawImageBits_32;
end else begin
ProcReadRawImageBits := @ReadRawImageBits_ReversedBytes_32;
ProcWriteRawImageBits := @WriteRawImageBits_ReversedBytes_32;
end;
end;
else
@ -850,6 +961,7 @@ procedure TLazIntfImage.ChooseGetSetColorFunctions;
begin
//writeln('ChooseRGBAFunctions ',RawImageDescriptionAsString(@FDataDescription));
ChooseRawBitsProc(FDataDescription.BitsPerPixel,
FDataDescription.ByteOrder,
FDataDescription.BitOrder,
FReadRawImageBits, FWriteRawImageBits);
@ -877,13 +989,14 @@ procedure TLazIntfImage.ChooseGetSetColorFunctions;
OnSetInternalColor:=@SetColor_NoPalette_RGBA_NoAlpha;
end;
ChooseRawBitsProc(FDataDescription.AlphaBitsPerPixel,
FDataDescription.AlphaByteOrder,
FDataDescription.AlphaBitOrder,
FAlphaReadRawImageBits, FAlphaWriteRawImageBits);
end else begin
OnGetInternalColor:=@GetColor_NoPalette_RGBA_Alpha_NoSep;
OnSetInternalColor:=@SetColor_NoPalette_RGBA_Alpha_NoSep;
ChooseRawBitsProc(FDataDescription.BitsPerPixel,
FDataDescription.AlphaBitOrder,
FDataDescription.AlphaByteOrder, FDataDescription.AlphaBitOrder,
FAlphaReadRawImageBits, FAlphaWriteRawImageBits);
end;
end else begin

7
lcl/stdctrls.pp
View File

@ -539,7 +539,7 @@ type
TCustomMemo = class(TCustomEdit)
private
FFont : TFont;
//FFont : TFont;
FHorzScrollBar: TMemoScrollBar;
FLines: TStrings;
FScrollBars: TScrollStyle;
@ -564,7 +564,7 @@ type
property Lines: TStrings read FLines write SetLines;
property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars;
property WordWrap: Boolean read FWordWrap write SetWordWrap default true;
property Font : TFont read FFont write FFont;
//property Font : TFont read FFont write FFont;
property HorzScrollBar: TMemoScrollBar
read FHorzScrollBar write SetHorzScrollBar stored StoreScrollBars;
property VertScrollBar: TMemoScrollBar
@ -1496,6 +1496,9 @@ end.
{ =============================================================================
$Log$
Revision 1.130 2004/02/09 19:52:52 mattias
implemented ByteOrder for TLazIntfImage and added call of to LM_SETFONT
Revision 1.129 2004/02/06 16:58:58 mattias
updated polish translation